How could I round an integer number based on the last digit of the number?
For example:
Dim x As Integer = 12
Dim y As Integer = 139
Dim z As Integer = 2322
The result should be:
x = 20
y = 140
z = 2330
Use:
Math.Ceiling(value / 10) * 10
reference: http://msdn.microsoft.com/en-us/library/zx4t0t48.aspx#Y0
x = Math.Ceiling(x / 10.0) * 10
Module Module1
Public Function RoundUp(ByVal val As Double, ByVal pos As Integer) As Double
Dim base10 As Double = System.Math.Pow(10, pos) 'pos +: right from float point, -: left from float point.
If val > 0 Then
Return System.Math.Ceiling(val * base10) / base10
Else
Return System.Math.Floor(val * base10) / base10
End If
End Function
Sub Main()
System.Console.WriteLine(RoundUp(12, -1)) '20
System.Console.WriteLine(RoundUp(139, -1)) '140
System.Console.WriteLine(RoundUp(2322, -1)) '2330
System.Console.WriteLine(RoundUp(3.1415926, 3)) '3.142
System.Console.ReadKey()
End Sub
End Module
As an alternative, doing this subtraction is a fast way:
x = value + ((2200000000 - value) % 10)
Considering that value is int (2200000000 > int.MaxValue):
Related
Hey I have no idea why I get an error "run time error 13 type mismatch". Thats my code and the place where I get an error:
EDIT: That is my code:
Function payoff(S_T, K, CallPut As String)
If CallPut = "call" Then
omega = 1
Else: omega = -1
End If
payoff = WorksheetFunction.Max(omega * (S_T - K), 0)
End Function
Function BS_trajektoria(S_0 As Double, T As Double, r As Double, q As Double, sigma As Double, N As Long) As Double()
Randomize
Dim S() As Double
Dim delta_t As Double
Dim i As Long
ReDim S(N)
S(0) = S_0
delta_t = T / N
For i = 1 To N
S(i) = S(i - 1) * Exp((r - q - 0.5 * sigma ^ 2) * delta_t + sigma * delta_t ^ 0.5 * Application.NormSInv(Rnd))
Next i
BS_trajektoria = S
End Function
Function barrier_MC(S_0 As Double, K As Double, T As Double, r As Double, q As Double, sigma As Double, _
B As Double, N As Long, num_of_sim As Long, CallPut As String, BarType As String) As Double
Randomize
Dim max_value As Double
Dim suma_wyplat As Double
Dim wyplata As Double
Dim i As Long
Dim S() As Double
suma_wyplat = 0
If (BarType = "DO" Or BarType = "DI") And B > S_0 Then
MsgBox "Too high barrier!"
Exit Function
ElseIf (BarType = "UO" Or BarType = "UI") And B < S_0 Then
MsgBox "Too low barrier!"
Exit Function
End If
With WorksheetFunction
For i = 1 To num_of_sim
S = BS_trajektoria(S_0, T, r, q, sigma, N)
max_value = .Max(S)
If max_value >= B Then
wyplata = 0
Else
wyplata = payoff(S(N), K, CallPut)
End If
suma_wyplat = suma_wyplat + wyplata
Next i
End With
barrier_MC = Exp(-r * T) * suma_wyplat / num_of_sim
End Function
Sub test3()
MsgBox barrier_MC(100, 100, 1, 0.05, 0.02, 0.2, 120, 1000, 1000000, "call", "UO")
End Sub
Anyone know where is the problem? For smaller value of N and num_of_sim everything works fine, the problem is when I use bigger values for these variables.
If you declare a new Double variable called rand and modify the main loop so that it looks like:
For i = 1 To N
rand = Rnd
S(i) = S(i - 1) * Exp((r - q - 0.5 * sigma ^ 2) * delta_t + sigma * delta_t ^ 0.5 * Application.NormSInv(rand))
Next i
you will see that the problem always happens when rand = 0. Why it throws that particular error is a bit of a mystery, but it is what it is. As a fix, what you could do is to keep the code as modified above with the following twist:
For i = 1 To N
rand = Rnd
If rand = 0 Then rand = 0.0000001
S(i) = S(i - 1) * Exp((r - q - 0.5 * sigma ^ 2) * delta_t + sigma * delta_t ^ 0.5 * Application.NormSInv(rand))
Next i
Then the code will run without error. It is still somewhat slow, but optimizing it (if possible) would be for a different question.
I have this code below, and I'm getting an overflow error at the line:
s = s + (x Mod 10) [first line in the Do Loop]
Why? I declared x and s to be of type Double. Adding two doubles, why is this not working?
Thanks for your help.
Public Sub bidon1()
Dim i As Double, x As Double, s As Double, k As Byte, h As Byte
Dim y(1 To 6) As Double
For i = 1 To 1000000
x = i ^ 3
Do
s = s + (x Mod 10)
x = x \ 10
Loop Until x = 0
If s = x Then
k = k + 1
y(k) = x
If y(6) > 0 Then
For h = 1 To 6
Debug.Print y(h)
Next
Exit Sub
End If
End If
Next
End Sub
The problem is that the VBA mod operator coerces its arguments to be integers (if they are not already so). It is this implicit coercion which is causing the overflow. See this question: Mod with Doubles
On Edit:
Based on your comments, you want to be able to add together the digits in a largish integer. The following function might help:
Function DigitSum(num As Variant) As Long
'Takes a variant which represents an integer type
'such as Integer, Long or Decimal
'and returns the sum of its digits
Dim sum As Long, i As Long, s As String
s = CStr(num)
For i = 1 To Len(s)
sum = sum + Val(Mid(s, i, 1))
Next i
DigitSum = sum
End Function
The following test sub shows how it can be used to correctly get the sum of the digits in 999999^3:
Sub test()
Dim x As Variant, y As Variant
Debug.Print "Naive approach: " & DigitSum(999999 ^ 3)
y = CDec(999999)
x = y * y * y
Debug.Print "CDec approach: " & DigitSum(x)
End Sub
Output:
Naive approach: 63
CDec approach: 108
Since 999999^3 = 999997000002999999, only the second result is accurate. The first result is only the sum of the digits in the string representation of the double 999999^3 = 9.99997000003E+17
If I have a convex curve, and want to find the minimum point (x,y) using a for or while loop. I am thinking of something like
dim y as double
dim LastY as double = 0
for i = 0 to a large number
y=computefunction(i)
if lasty > y then exit for
next
how can I that minimum point? (x is always > 0 and integer)
Very Close
you just need to
dim y as double
dim smallestY as double = computefunction(0)
for i = 0 to aLargeNumber as integer
y=computefunction(i)
if smallestY > y then smallestY=y
next
'now that the loop has finished, smallestY should contain the lowest value of Y
If this code takes a long time to run, you could quite easily turn it into a multi-threaded loop using parallel.For - for example
dim y as Double
dim smallestY as double = computefunction(0)
Parallel.For(0, aLargeNumber, Sub(i As Integer)
y=computefunction(i)
if smallestY > y then smallestY=y
End Sub)
This would automatically create separate threads for each iteration of the loop.
For a sample function:
y = 0.01 * (x - 50) ^ 2 - 5
or properly written like this:
A minimum is mathematically obvious at x = 50 and y = -5, you can verify with google:
Below VB.NET console application, converted from python, finds a minimum at x=50.0000703584199, y=-4.9999999999505, which is correct for the specified tolerance of 0.0001:
Module Module1
Sub Main()
Dim result As Double = GoldenSectionSearch(AddressOf ComputeFunction, 0, 100)
Dim resultString As String = "x=" & result.ToString + ", y=" & ComputeFunction(result).ToString
Console.WriteLine(resultString) 'prints x=50.0000703584199, y=-4.9999999999505
End Sub
Function GoldenSectionSearch(f As Func(Of Double, Double), xStart As Double, xEnd As Double, Optional tol As Double = 0.0001) As Double
Dim gr As Double = (Math.Sqrt(5) - 1) / 2
Dim c As Double = xEnd - gr * (xEnd - xStart)
Dim d As Double = xStart + gr * (xEnd - xStart)
While Math.Abs(c - d) > tol
Dim fc As Double = f(c)
Dim fd As Double = f(d)
If fc < fd Then
xEnd = d
d = c
c = xEnd - gr * (xEnd - xStart)
Else
xStart = c
c = d
d = xStart + gr * (xEnd - xStart)
End If
End While
Return (xEnd + xStart) / 2
End Function
Function ComputeFunction(x As Double)
Return 0.01 * (x - 50) ^ 2 - 5
End Function
End Module
Side note: your initial attempt to find minimum is assuming a function is discrete, which is very unlikely in real life. What you would get with a simple for loop is a very rough estimate, and a long time to find it, as linear search is least efficient among other methods.
I am performing linear regression using this data in VB.Net
1411478155,71.9700012207031
1411478150,72.9700012207031
1411478145,73.9700012207031
1411478140,74.9700012207031
1411478135,76.9700012207031
1411478130,78.9700012207031
1411478125,80.9700012207031
1411478120,81.9700012207031
1411478115,82.9700012207031
1411478110,84.9700012207031
1411478105,85.9700012207031
1411478100,88.9700012207031
The formula that I am using is this,
where x = UTC Seconds, y = Values
In the denominator, I am getting a zero value because both expressions in the denominator equal to a value of 2.8688695263517E+20.
I defined my series as,
Dim xs(12) As [Double]
Dim ys(12) As [Double]
I am not sure if the square brackets matter.
For now, I am not able to get results due to zero denominator. What data type should I use?
I expect more rows of data in future.
Edit:
Given below is the sub
`
Public Sub GetLinearRegressionParams(ByVal xs() As Double, ByVal ys() As Double, ByRef a As Double, ByRef b As Double)
Dim sumX As Double = 0
Dim sumY As Double = 0
Dim sumXY As Double = 0
Dim sumX2 As Double = 0
Dim n As Integer
n = 0
For index = 0 To xs.Length - 1
If xs(index) = Nothing Then
Else
sumX = sumX + xs(index)
sumY = sumY + ys(index)
sumXY = sumXY + xs(index) * ys(index)
sumX2 = sumX2 + xs(index) * xs(index)
n = n + 1
End If
Next
a = (sumY * sumX2 - sumX * sumXY) / (n * sumX2 - sumX * sumX)
b = (n * sumXY - sumX * sumY) / (n * sumX2 - sumX * sumX)
End Sub
`
I am trying to implement a 2D Perlin Noise in VB.Net. I've spent the whole day searching for sources that explain the subject and one of the most notable was this article by Hugo Elias
Most of the implementation went well. On the exception of a very important part that did not seem to work in VB.Net, causing overflows.
function Noise1(integer x, integer y)
n = x + y * 57
n = (n<<13) ^ n;
return ( 1.0 - ( (n * (n * n * 15731 + 789221) + 1376312589) & 7fffffff) / 1073741824.0);
end function
In VB.net I translated it to
Private Function Noise(tX As Integer, tY As Integer) As Double
'Return a double between -1 & 1 according to a fixed random seed
Dim n As Integer = tX + tY * 57
n = (n << 13) Xor n
Return (1.0 - ((n * (n * n * 15731 + 789221) + BaseSeed) And &H7FFFFFFF) / 1073741824.0)
End Function
Which cause overflows.
Since the idea seem to be to simply generate a fractional number between -1 and 1. I've made this little function which create a Integer Number based on the coordinates and BaseSeed. BaseSeed(999999) being the base for every noise I'll create in this particular part of my game.
Private Function Noise(tX As Integer, tY As Integer) As Double
Dim tSeed As Integer
tSeed = WrapInteger(789221, BaseSeed, (tX * 1087) + (tY * 2749))
RandomGenerator = New Random(tSeed)
Return (RandomGenerator.Next(-10000, 10001) / 10000)
End Function
WrapInteger simply makes sure that the number will always be in the range of an integer, to avoid overflow errors.
Public Function WrapInteger(ByVal Lenght As Integer, ByVal Position As Integer, ByVal Movement As Integer) As Integer
Lenght += 1
Return ((Position + Movement) + (Lenght * ((Abs(Movement) \ Lenght) + 1))) Mod Lenght
End Function
When I fire it up with a Persistence of 0.25, 6 Octaves and a starting frequency of 2. this is what I get. This is a 128x128 pixel bitmap that I scaled.
Result
Anyone have an idea of why it would be so linear? When I look at this picture I have the feeling that it's not far from the truth, as if it only worked in 1D. All suposition.
Below you will find my entire PerlinNoise Class. I think the rest of it is just fine, but I added it for reference purpose. Beside, I haven't been able to find a single VB implementation of Perlin Noise on the internet. So I guess if I can fix this one, it might help others. There seem to be alot of question about Perlin noise malfunction on StackOverflow
Public Class cdPerlinNoise
Private RandomGenerator As Random
Private BaseSeed As Integer
Private Persistence As Double
Private Frequency As Integer
Private Octaves As Integer
Public Sub New(tSeed As Integer, tPersistence As Double, tOctaves As Integer, tFrequency As Integer)
Frequency = tFrequency
BaseSeed = tSeed
Persistence = tPersistence
Octaves = tOctaves
End Sub
Private Function Noise(tX As Integer, tY As Integer) As Double
Dim tSeed As Integer
tSeed = WrapInteger(789221, BaseSeed, (tX * 1087) + (tY * 2749))
RandomGenerator = New Random(tSeed)
Return (RandomGenerator.Next(-10000, 10001) / 10000)
End Function
Private Function SmoothNoise(tX As Integer, tY As Integer) As Double
Dim Corners As Double = (Noise(tX - 1, tY - 1) + Noise(tX + 1, tY - 1) + Noise(tX - 1, tY + 1) + Noise(tX + 1, tY + 1)) / 16
Dim Sides As Double = (Noise(tX - 1, tY) + Noise(tX + 1, tY) + Noise(tX, tY - 1) + Noise(tX, tY + 1)) / 8
Return (Noise(tX, tY) / 4) + Corners + Sides
End Function
Private Function InterpolateCosine(tA As Double, tB As Double, tX As Double) As Double
Dim f As Double = (1 - Cos(tX * 3.1415927)) * 0.5
Return tA * (1 - f) + tB * f
End Function
Private Function Interpolate2D(tX As Double, tY As Double) As Double
Dim WholeX As Integer = CInt(Fix(tX))
Dim RemainsX As Double = tX - WholeX
Dim WholeY As Integer = CInt(Fix(tY))
Dim RemainsY As Double = tY - WholeY
Dim v1 As Double = SmoothNoise(WholeX, WholeY)
Dim v2 As Double = SmoothNoise(WholeX + 1, WholeY)
Dim v3 As Double = SmoothNoise(WholeX, WholeY + 1)
Dim v4 As Double = SmoothNoise(WholeX + 1, WholeY + 1)
Dim i1 As Double = InterpolateCosine(v1, v2, RemainsX)
Dim i2 As Double = InterpolateCosine(v3, v4, RemainsX)
Return InterpolateCosine(i1, i2, RemainsY)
End Function
Public Function PerlinValue(tX As Double, tY As Double) As Double
Dim Total As Double = 0
Dim Frequency As Double
Dim Amplitude As Double
For i = 0 To Octaves - 1
Frequency = Frequency ^ i
Amplitude = Persistence ^ i
Total = Total + (Interpolate2D(tX * Frequency, tY * Frequency) * Amplitude)
Next
Return Total
End Function
Public Function ScaleNoise(ByVal tX As Double, ByVal tY As Double, ByVal OutputLow As Double, ByVal OutputHigh As Double) As Double
Dim Range1 As Double
Dim Range2 As Double
Dim Result As Double
Range1 = 1 - -1
Range2 = OutputHigh - OutputLow
'(B*C - A*D)/R1 + n1*(R2/R1)
Result = (((1 * OutputLow) - (-1 * OutputHigh)) / Range1) + ((PerlinValue(tX, tY) * (Range2 / Range1)))
If Result < OutputLow Then
Return OutputLow
ElseIf Result > OutputHigh Then
Return OutputHigh
Else
Return Result
End If
End Function
End Class