I have a function:
Public Function F(ByVal a As Double, ByVal b As Double,
ByVal c As Double, ByVal x As Double) As Double
y = ax ^ 3 + bx ^ 2 + cx + d
Return y
End Function
How could I create a function that allows me to read parameters a,b,c,d and return an unary function? For example a=1,b=1,c=3,d=4:
Public Function F(ByVal x As Double) As Double
y = 1x ^ 3 + 2x ^ 2 + 3x + 4
Return y
End Function
or in other words, how could I create a function that returns a function of type
Func(Of Double, Double)
Use a lambda function.
Public Function F(ByVal a As Double, ByVal b As Double, ByVal c As Double) As Func(of Double, Double)
Return Function(ByVal x As Double) As Double
Return ax ^ 3 + bx ^ 2 + cx + d
End Function
End Function
Related
The program keep saying that there is a division by zero in Term = (-1 ^ (i - 1)) * (X ^ (2 * (i - 1))) / M even though M was set to equal 1 before this calculation took place. I have tried change the value of M but it continuously keeps giving the division by 0 error message. This program is supposed to calculate sin(x) without using the built in function. Any insight towards this is very much appriciated.
Option Explicit
Sub MainPrg()
Dim X As Single, LastTerm As Long, M As Double, Term As Long, i As
Single, _
ActVal As Single, Sum As Long
'
'
X = InputBox("Please input the angle in degrees")
X = X * (3.14159 / 180)
LastTerm = InputBox("Please enter the largest value for the last
term in the series")
ActVal = Sin(X)
Call SinCalc(LastTerm, M, i, Term, Sum, X)
MsgBox ("The calculated value is " & Sum & " And the actual value
is " & ActVal)
End Sub
Function Fact(ByVal i As Single, ByRef M As Double)
M = M * (2 * (i - 1))
End Function
Sub SinCalc(ByVal LastTerm As Double, ByVal M As Double, ByVal i As
Single, _
ByRef Term As Long, ByRef Sum As Long, ByVal X As Single)
i = 1
M = 1
Sum = 0
Do
Term = (-1 ^ (i - 1)) * (X ^ (2 * (i - 1))) / M
Sum = Sum + Term
If (Abs(Term) < LastTerm) Then Exit Do
i = i + 1
Call Fact (i,M)
Loop
End Sub
Your line with the issue
Term = (-1 ^ (i - 1)) * (X ^ (2 * (i - 1))) / M
is inside a loop so even if at the beginning M is equal to 1 it can become equal to 0 after (this happens during the fact function)
I'm currently writing VBA code for a lab for one of my engineering classes. The goal is to use a single function to approximate (Trapezoidal Rule) the integral of a given equation. The equation will need to change at some point. I'm new to programming so I'm planning on seeing some sort of simple logic error. Here's what I currently have:
Function Trapezoidal(ByVal sFx As String, ByVal A As Double, _
ByVal B As Double, ByVal N As Integer) As Double
' Calculates the area under the curve using the Trapezoidal rule.
'
' Parameters:
'
' sFx - String expression that has the function to be
' integrated. The variable X as to appear as $X.
' An example is: $X*LOG(X$) which is an expression for function
' f(x)=x*ln(x)
' A, B - Lower and Upper limit for the integral.
' N - The number of integration intervals.
'
Dim Sum As Double, DeltaX As Double, X As Double
Dim I As Integer
Sum = 0
DeltaX = (B - A) / N
X = A
For I = 1 To N
Sum = Sum + (Fx(sFx, X) + Fx(sFx, X + DeltaX)) / 2
X = X + DeltaX
Next I
Sum = DeltaX * Sum
Trapezoidal = Sum
End Function
I've sort of Frankensteined a few pieces of code together in my research.Something clearly isn
Sub Tester()
Debug.Print Trapezoidal("$X*LN($X)", 1, 20, 5)
End Sub
Function Trapezoidal(ByVal sFx As String, ByVal A As Double, _
ByVal B As Double, ByVal N As Integer) As Double
' Calculates the area under the curve using the Trapezoidal rule.
'
' Parameters:
'
' sFx - String expression that has the function to be
' integrated. The variable X as to appear as $X.
' An example is: $X*LOG(X$) which is an expression for function
' f(x)=x*ln(x)
' A, B - Lower and Upper limit for the integral.
' N - The number of integration intervals.
'
Dim Sum As Double, DeltaX As Double, X As Double
Dim I As Integer, f As String
Sum = 0
DeltaX = (B - A) / N
X = A
For I = 1 To N
'Sum = Sum + (Fx(sFx, X) + Fx(sFx, X + DeltaX)) / 2
f = "(" & Replace(sFx, "$X", X) & " + " & Replace(sFx, "$X", X + DeltaX) & ")/2"
Debug.Print f
Sum = Sum + Application.Evaluate(f)
X = X + DeltaX
Next I
Sum = DeltaX * Sum
Trapezoidal = Sum
End Function
Debug output:
(1*LN(1) + 4.8*LN(4.8))/2
(4.8*LN(4.8) + 8.6*LN(8.6))/2
(8.6*LN(8.6) + 12.4*LN(12.4))/2
(12.4*LN(12.4) + 16.2*LN(16.2))/2
(16.2*LN(16.2) + 20*LN(20))/2
502.848119401941
I'm trying to find the number that gives me the result, here's the equation:
x=y mod z
y=?
In this equation, I know values of x and z but I need to find of y too, does anyone has an idea?
There are many solutions to your problem because mapping integers to values in ring Zz (z integer numbers: 0, 1, ..., z - 1) is not a bijection:
y = { x + n * z : n is integer }
So, the simplest function that will provide you with an answer can be as simple as that:
Function solution( ByVal x As Integer) As Integer
Return x
End Function
You can also write something that will return you next possible solution:
Function solution_next( ByVal x As Integer, ByVal z As Integer) As Integer
Static n As Integer = 0
i + z * n
n += 1
Return i
End Function
You can adjust this further given more conditions.
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
Calling Test1 in Excel gives 0 for any real A and B. Why does this occur?
Public Function Min(X As Double, y As Double, Optional y2 As Double, Optional y3 As Double) As Double
Min = Application.WorksheetFunction.Min(X, y, y2, y3)
End Function
Function Test1(A As Double, B As Double)
Test1 = Min(A, B)
End Function
In Excel: =Test1(5,2).
Optional parameters use their default value if not passed into the function.
For doubles the default value is 0. if you do not provide y2 or y3 essentially, you are testing Application.WorksheetFunction.Min(A,B,0,0).
If you want to change the default value, you can do something like this:
Public Function Min(X As Double, y As Double, Optional y2 As Double = 10000000, Optional y3 As Double = 10000000) As Double
Min = Application.WorksheetFunction.Min(X, y, y2, y3)
End Function
which makes y2 and y3 default to 10000000 which would be your new built in artificial min.