i'm trying to replicate the Linear Congruential Generator in VBA but my procedure returns to me an Error '6': Overflow...
Sub test()
Dim a As Long, c As Long, period As Long
Dim seed As Long, sample As Long, max As Long
Dim i As Long
seed = 1234
sample = 2
max = 100
a = 48271
c = 0
period = 2 ^ 31 - 1
For i = 1 To sample
seed = (a * seed + c) Mod period
Next i
End Sub
I think the problem is in the first expression of the for cycle, in detail
a*seed
in the second step of the cycle.
Any suggestion to solve the problem without splitting
a*seed
in
(100*seed+100*seed+100*seed+...+(a-100*n)*seed
You can use the decimal subtype of variant and write your own mod function for decimals:
Function DecMod(a As Variant, n As Variant) As Variant
Dim q As Variant
q = Int(CDec(a) / CDec(n))
DecMod = a - n * q
End Function
Sub test()
Dim a As Variant, c As Variant, period As Variant
Dim seed As Variant, sample As Long, max As Long
Dim i As Long
seed = CDec(1234)
sample = 5
max = 100
a = CDec(48271)
c = 0
period = CDec(2 ^ 31 - 1)
For i = 1 To sample
Debug.Print seed
seed = DecMod(seed * a + c, period)
Next i
End Sub
Output:
1234
59566414
1997250508
148423250
533254358
Related
This is the program I need to re-write and I dont understand.
Sub Main()
Dim array(24) As Double, i As Long
array(0) = 1
For i = 1 To 24
array(i) = 2 * array(i - 1)
Next i
Call DisplayArray(array)
End Sub
Sub DisplayArray(ByVal array() As Double)
Dim i As Long, n As Long
n = array.GetLength(0)
For i = 0 To n - 1
Console.WriteLine(array(i))
Next i
End Sub
I need it to
be a function
with two parameters, an array and constant k
should return an array where each elemtn of the array is equal to k ^ i
Well I can't really say I completely understand what you're doing. And I suspect this might be a homework question I'm giving the answers too against my better judgement. It's really not that complicated and likely something you could of done yourself with the appropriate research.
And calling a function for this does seem complete overkill as can be done quite simply when outputting your array in the DisplayArray method
Sub Main()
Dim array(24) As Double, i As Long
array(0) = 1
For i = 1 To 24
array(i) = 2 * array(i - 1)
Next i
'Calling the function here with the constant 3
Dim results() As Double = CalculateResults(array, 3)
Call DisplayArray(array)
Call DisplayArray(results)
Console.ReadLine()
End Sub
Sub DisplayArray(ByVal array() As Double)
Dim i As Long, n As Long
n = array.GetLength(0)
For i = 0 To n - 1
Console.WriteLine(array(i))
Next i
End Sub
Function CalculateResults(ByVal array As Double(), ByVal k As Integer) As Double()
Dim retVal(array.Length) As Double
For index = 0 To array.Length
retVal(index) = index ^ k
Next
Return retVal
End Function
hello im trying to do this calculation : [365!/((365^x)((365-x)!))]
the problem is when i do it it doesn't give me the decimals just the integer it give me 0 or 1 because the answer is 0
Public Class Form1
Private Function fact(ByVal n As Integer) As Numerics.BigInteger
Dim Z As New Numerics.BigInteger(1)
For i As Integer = 1 To n
Z = Z * i
Next
Return Z
End Function
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim min As Integer
Dim max As Integer
Dim ranum As Integer
Dim ind() As Integer
Dim ran As New Random
Dim F365 As New Numerics.BigInteger(0)
F365 = Numerics.BigInteger.Parse("25104128675558732292929443748812027705165520269876079766872595193901106138220937419666018009000254169376172314360982328660708071123369979853445367910653872383599704355532740937678091491429440864316046925074510134847025546014098005907965541041195496105311886173373435145517193282760847755882291690213539123479186274701519396808504940722607033001246328398800550487427999876690416973437861078185344667966871511049653888130136836199010529180056125844549488648617682915826347564148990984138067809999604687488146734837340699359838791124995957584538873616661533093253551256845056046388738129702951381151861413688922986510005440943943014699244112555755279140760492764253740250410391056421979003289600000000000000000000000000000000000000000000000000000000000000000000000000000000000000000")
min = Integer.Parse(Tmin.Text)
max = Integer.Parse(Tmax.Text)
ranum = Integer.Parse(TRan.Text)
ReDim ind(ranum)
For x As Integer = 1 To ranum
ind(x) = ran.Next(min, max + 1)
Answer.Items.Add(ind(x))
Next
Dim P(ranum) As Numerics.BigInteger
Dim facts(ranum) As Numerics.BigInteger
For x = 1 To ranum
P(x) = 365 ^ (ind(x))
facts(x) = fact(365 - ind(x))
Next
Dim phenB(ranum) As Numerics.BigInteger
Dim phen(ranum) As Double
For x = 1 To ranum
phenB(x) = (P(x) * facts(x))
phen(x) = F365 / phenB(x)
tx.Text = phen(x) (here is the aswer)
Next
End Sub
End Class
The BigInteger class does not have a function to give a non-integer result for division. However, it does have BigInteger.Log, so, using these logarithmic identities:
ln(a⋅b) = ln(a) + ln(b)
ln(a/b) = ln(a) - ln(b)
ln(a^b) = b⋅ln(a)
we can perform the calculation like this:
Function SomeCalc(n As Integer) As Double
Dim lnF365 = BigInteger.Log(fact(365))
Dim lnPower = n * Math.Log(365)
Dim lnOtherFact = BigInteger.Log(fact(365 - n))
Return Math.Exp(lnF365 - lnPower - lnOtherFact)
End Function
where fact() is a pre-calculated array:
Option Strict On
Option Infer On
' ... other code ...
Dim fact(365) As BigInteger
' ... other code ...
Private Sub CalcFacts()
Dim z = BigInteger.One
For i = 1 To 365
z *= i
fact(i) = z
Next
End Sub
You could even have an array of pre-calculated logs of the factorials, instead of an array of the factorials. It depends on if you're using them elsewhere, and if there is any need for it to go a tiny tiny bit faster:
Function SomeCalc(n As Integer) As Double
Dim lnF365 = lnFact(365)
Dim lnPower = n * Math.Log(365)
Dim lnOtherFact = lnFact(365 - n)
Return Math.Exp(lnF365 - lnPower - lnOtherFact)
End Function
and
Dim lnFact(365) As Double
' ...
Private Sub CalcLnFacts()
Dim z = BigInteger.One
For i As Integer = 1 To largestNum
z *= i
lnFact(i) = BigInteger.Log(z)
Next
End Sub
That number 365 should be a named variable - I had no idea what a sensible name for it would be.
I have a 2-dimensional array in vba and I want to use worksheetfunction.max and worksheetfunction.maxifs to find the maximum value in a 'column' of the array. I'm aware that I can use a loop to do this, but the dataset is very large and I want to reduce the processing time. Does anyone know if worksheetfunction.max and worksheetfunction.maxifs can be used in this manner, and if yes, any ideas on the syntax to use?
I ran a simple test timing an array loop against the Max WorksheetFunction on a one-dimensional array. It seems that their speed is comparable.
You would need to use WorksheetFunction.Index in conjunction with the WorksheetFunction.Max for multi-dimensional arrays. This would make an array loop clearly faster form multi-dimensional arrays
Test Code
Option Explicit
Sub TestTimes()
Dim Max1 As Long, Max2 As Long, results() As Long, n As Long, t1 As Double, t2 As Double
results = getData
For n = 1 To 10
t1 = getWorksheetFunctionMaxTime(results, Max1)
t2 = getWorksheetFunctionMaxTime(results, Max2)
Debug.Print "WorksheetFunction Time: "; t1, "Array Loop Time: "; t2, Max1 = Max2
Next
End Sub
Function getData() As Long()
Dim results(1 To 10000000) As Long
Dim r As Long
For r = 1 To 10000000
results(r) = r
Next
getData = results
End Function
Function getWorksheetFunctionMaxTime(ByRef results() As Long, ByRef Max As Long) As Double
Dim t As Double: t = Timer
Max = WorksheetFunction.Max(results)
getWorksheetFunctionMaxTime = Round(Timer - t, 2)
End Function
Function getLoopArrayMaxTime(ByRef results() As Long, ByRef Max As Long) As Double
Dim r As Long, LocalMax As Long
Dim t As Double: t = Timer
For r = 1 To 10000000
If results(r) > LocalMax Then LocalMax = r
Next
Max = LocalMax
getLoopArrayMaxTime = t
End Function
I am writing a user-defined function in excel vba. So this new function:
takes 4 input value
some calculation to generate into 8 numbers. ( 2 arrays - each array has 4 numbers)
do a chisquare test
return 1 output value
Code:
Sub test()
Dim A, B, C, D As Variant
A = 33
B = 710
C = 54
D = 656
'Observed Value
Dim O_A As Variant
Dim O_B As Variant
Dim O_V As Variant
Dim O_D As Variant
'Define Observer Value
O_C_A = 'Some Calucation'
O_C_B = 'Some Calucation'
O_T_C = 'Some Calucation'
O_T_C = 'Some Calucation'
'Expected Value
Dim E_C_A As Variant
Dim E_C_B As Variant
Dim E_T_C As Variant
Dim E_T_D As Variant
'Define Expected Value
E_C_A = 'Some Calucation'
E_C_B = 'Some Calucation'
E_T_C = 'Some Calucation'
E_T_D = 'Some Calucation'
'Create array(2x2)
Dim Chi_square_result As Variant
Dim my_array(1, 1)
my_array(0, 0) = O_C_Mesaurement
my_array(0, 1) = O_C_Balance
my_array(1, 0) = O_T_Measurement
my_array(1, 1) = O_T_Balance
Dim my_array2(1, 1)
my_array2(0, 0) = E_C_Mesaurement
my_array2(0, 1) = E_C_Balance
my_array2(1, 0) = E_T_Measurement
my_array2(1, 1) = E_T_Balance
'Create a chi square test formula'
Dim formula(1 To 5) As String
formula(1) = "CHITEST("
formula(2) = my_array
formula(3) = ","
formula(4) = my_array2
formula(5) = ")"
'Chi Square
Chi_square_result = evaluate(Join(formula, ""))
end sub
It gives a runtime error '13', saving type mismatch. This is because of the concatenation of the formula.
If you are writing a function, you have your format wrong.
Function Chi_square_result(A as Long, B as Long, C as Long, D as Long) as Double
'All your manipulations here
Chi_square_result = (Your math equation)
End Function
You also never defined my_array1, I am assuming it is supposed to be where you typed 'my_array'. I also do not think Join is your best bet. You are trying to do an awful lot of array manipulation, and I think your dimensions are getting you. It would be better to do it in a more straight forward way.
The evaluate is expecting worksheet cell ranges. Use the Excel Application object or WorksheetFunction object to compute the function within VBA.
This proofs out.
Dim dbl As Double
Dim my_array1(1, 1)
my_array1(0, 0) = 1
my_array1(0, 1) = 2
my_array1(1, 0) = 3
my_array1(1, 1) = 4
Dim my_array2(1, 1)
my_array2(0, 0) = 2
my_array2(0, 1) = 3
my_array2(1, 0) = 4
my_array2(1, 1) = 5
dbl = Application.ChiTest(my_array1, my_array2)
Debug.Print dbl
Result from the VBE's Immediate window: 0.257280177154182.
please help me with this problem. I'm just starting to use VBA and after searching the forum was not able to find a solution. I have 1000 single digit numbers in my spreadsheet. 20 rows of 50 numbers in each. my program suppose to find the largest product. For some reason my final answer is 0. I've done some debugging and the program goes through all the loops and iterations as expected. I suspect that my function does not pass the value back to my main
Public Sub problem8()
Dim product, i, j, maxproduct As Long
maxproduct = product = 1
For i = 1 To 20
For j = 1 To 50
product = calcproduct(i, j)
If product > maxproduct Then maxproduct = product
Next j
Next i
Range("AY1").Value = maxproduct
End Sub
Function calcproduct(ByVal a As Long, ByVal b As Long) As Long
Dim i, j, count As Long
counter = calcproduct = 1
For i = a To 20
For j = b To 50
calcproduct = Cells(i, j).Value * calcproduct
counter = counter + 1
If counter = 13 Then Exit Function
Next j
Next i
End Function
Change:
Dim product, i, j, maxproduct As Long
to:
Dim product as long, i as long, j as long, maxproduct As Long
and:
Dim i, j, count As Long
to:
Dim i as long, j as long, count As Long
I used to think putting it on the end applied it to everything on the row but it doesn't and I encountered a similar issue to you.
I might add though, the way you have done this (assigning i and j to new variables a and b then using i and j in the second routine) is extremely confusing and I would strongly recommend against it.
First off, this is the wrong way to express what you are trying to accomplish.
maxproduct = product = 1
This says "maxproduct is equal to False". product was just declared so it is for all intents and purposes a zero and not equal to 1. You wanted to say,
maxproduct = 1
product = 1
If you really need to put those last two on a single line then use a colon like this,
maxproduct = 1: product = 1
The same holds true for the similar syntax in the function.
Now it is important to understand that VBA treats True as -1 and False as 0 (zero). Since you are essentially initializing maxproduct and product as zeroes, you can multiply anything you want by it and you will still end up with zero. Again, the same holds true for the way this similar variable assignment was handled in the function.
Here is my take on your project.
Option Explicit
Public Const maxA As Long = 20
Public Const maxB As Long = 50
Public Const cntC As Long = 13
Public Sub problem8()
Dim product As Long, i As Long, j As Long, maxproduct As Long
maxproduct = 1: product = 1
For i = 1 To maxA
For j = 1 To maxB
product = calcproduct(i, j)
If product > maxproduct Then maxproduct = product
Next j
Next i
Range("AY1").Value = maxproduct
End Sub
Function calcproduct(ByVal a As Long, ByVal b As Long) As Long
Dim i As Long, j As Long, counter As Long
counter = 1: calcproduct = 1
For i = a To maxA
For j = b To maxB
calcproduct = Cells(i, j).Value * calcproduct
counter = counter + 1
If counter = cntC Then Exit Function
Next j
Next i
End Function
I moved the limits to public constants which make it easier to modify for different sized regions. In your function you declared a count then started using a var called counter so I changed that to suit. As mentioned in another post, the variable declaration needs to be specific or you end up with a bunch of variants and a few longs.