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
Related
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 trying to create an empty/defined array of Double which would reflect as Double(0, -1).
I'm able to create one for an array of String, Variant and Byte:
Dim arr_variant() As Variant
arr_variant = Array() ' Variant(0 to -1) '
Dim arr_string() As String
arr_string = Split(Empty) ' String(0 to -1) '
Dim arr_byte() As Byte
arr_byte = "" ' Byte(0 to -1) '
Dim arr_double() As Double
arr_double = ??? ' Double(0 to -1) '
, but still haven't found a way for Double.
Maybe with LSet or with a native function?
It seems that the only way is to call a native function:
Private Declare PtrSafe Function SafeArrayRedim Lib "OleAut32" ( _
ByVal arr As LongPtr, ByRef dims As Any) As Long
Public Sub RedimDouble(arr() As Double, ByVal count As Long)
If count Then
ReDim Preserve arr(0 To count - 1)
Else
ReDim arr(0 To 0)
SafeArrayRedim Not Not arr, 0#
End If
End Sub
Public Sub Usage()
Dim arr_double() As Double
RedimDouble arr_double, 0 ' Double(0 to -1) '
End Sub
I would go with - not possible.
Take a look at the following code:
Option Explicit
Sub TestMe()
Dim arr 'Line 1
arr = Array(CDbl(0)) 'Line 2
arr = Array(Empty) 'Line 3
End Sub
Line 1 - It takes a Variant array
Line 2 - Makes it Double array
Line 3 - When emptied, it is converted from double to Variant again.
this is my first time posting so please accept my apologies if im not doing this right and please feel free to correct me for any formatting or posting guidelines. I am doing this in VB.Net with .NET Framework 4.5.2.
I have a large collection called gBoard in a class.
Private gBoard As Collection
It contains roughly 2000 instances of a class.
What i am trying to achieve is for each item in the class, i want to look at each other item in the class and then update the first item based on variables in the second.
Currently i have the following code:
In the main class:
Private gBoard As New Collection ' This is populated elsewhere in the code
Private Sub CheckSurroundings()
For i As Integer = 1 To (xBoxes)
For j As Integer = 1 To (yBoxes)
For x = 1 As Integer To (xBoxes)
For y = 1 As Integer To (yBoxes)
Tile(New Point(i, j)).CheckDistance(Tile(New Point(x, y)))
Next y
Next x
Next j
Next i
End Sub
Private Function Tile(ByVal aPoint As Point) As clsTile
Return gBoard.Item("r" & aPoint.Y & "c" & aPoint.X)
End Function
In clsTile i have the following (as well as other items):
Private Function SurroundingTerrain(ByVal aTer As String) As clsTerrain
Return mySurroundings.Item(aTer) ' a small collection (6 items of clsTerrain type)
End Function
Public Sub CheckDistance(ByRef aTile As clsTile)
SurroundingTerrain(aTile.Terrain).CheckDistance(CalcDistance(Location, aTile.Location))
End Sub
Private Function CalcDistance(ByVal myPoint As Point, ByVal aPoint As Point) As Double
Dim myReturn As Double = 0
Dim xDiff As Integer = 0
Dim yDiff As Integer = 0
Dim tDiff As Integer = 0
xDiff = Math.Abs(myPoint.X - aPoint.X)
yDiff = Math.Abs(myPoint.Y - aPoint.Y)
tDiff = xDiff + yDiff
myReturn = (MinInt(xDiff, yDiff) * 1.4) + (tDiff - MinInt(xDiff, yDiff))
Return myReturn
End Function
Private Function MinInt(ByVal a As Integer, ByVal b As Integer) As Integer
Dim myReturn As Integer = a
If b < myReturn Then
myReturn = b
End If
Return myReturn
End Function
in clsTerrain i have the following sub that is called:
Public Sub CheckDistance(ByVal aDist As Double)
If aDist < Distance Then
Distance = aDist
End If
End Sub
This runs and works file but as you can guess it runs so slow... I have been trying to work out how to make this run faster and i looked into threading/tasks but it doesnt seem to work. There are no errors but the objects don't appear to update correctly (or at all). The code i tried was:
In the main class:
Private Sub CheckSurroundings()
Dim tasks As New List(Of Task)
Dim pTile As clsTile
For Each pTile In gBoard
tasks.Add(Task.Run(Sub() TileToCheck(pTile)))
Next
Task.WaitAll(tasks.ToArray())
End Sub
Private Sub TileToCheck(ByRef aTile As clsTile)
For x As Integer = 1 To (xBoxes)
For y As Integer = 1 To (yBoxes)
aTile.CheckDistance(Tile(New Point(x, y)))
Next y
Next x
End Sub
Does anyone have any suggestions or ideas for how to get this to work?
Sorry for any headaches or facepalms caused...
I created a trivia game using visual basic for applications (Excel) that chooses questions by going through a case statement where the cases are numbers. I have the program randomly select a number from 1 to the max amount of questions there are. Using this method, the game repeats questions.
Is there a way to make something that generates numbers randomly (different results every time) and doesn't repeat a number more than once? And after it's gone through all the numbers it needs to execute a certain code. (I'll put in code that ends the game and displays the number of questions they got right and got wrong)
I thought of a few different ways to do this, however I couldn't even begin to think of what the syntax might be.
Sounds like you need an Array Shuffler!
Check out the below link -
http://www.cpearson.com/excel/ShuffleArray.aspx
Function ShuffleArray(InArray() As Variant) As Variant()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ShuffleArray
' This function returns the values of InArray in random order. The original
' InArray is not modified.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim N As Long
Dim Temp As Variant
Dim J As Long
Dim Arr() As Variant
Randomize
L = UBound(InArray) - LBound(InArray) + 1
ReDim Arr(LBound(InArray) To UBound(InArray))
For N = LBound(InArray) To UBound(InArray)
Arr(N) = InArray(N)
Next N
For N = LBound(InArray) To UBound(InArray)
J = CLng(((UBound(InArray) - N) * Rnd) + N)
Temp = InArray(N)
InArray(N) = InArray(J)
InArray(J) = Temp
Next N
ShuffleArray = Arr
End Function
Sub ShuffleArrayInPlace(InArray() As Variant)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ShuffleArrayInPlace
' This shuffles InArray to random order, randomized in place.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim N As Long
Dim Temp As Variant
Dim J As Long
Randomize
For N = LBound(InArray) To UBound(InArray)
J = CLng(((UBound(InArray) - N) * Rnd) + N)
If N <> J Then
Temp = InArray(N)
InArray(N) = InArray(J)
InArray(J) = Temp
End If
Next N
End Sub
Here's yet another take. It generates an array of unique, random longs.
In this example, I use 1 to 100. It does this by using the collection object. Then you can just do a normal loop through each array element in qArray without the need to randomize more than once.
Sub test()
Dim qArray() As Long
ReDim qArray(1 To 100)
qArray() = RandomQuestionArray
'loop through your questions
End Sub
Function RandomQuestionArray()
Dim i As Long, n As Long
Dim numArray(1 To 100) As Long
Dim numCollection As New Collection
With numCollection
For i = 1 To 100
.Add i
Next
For i = 1 To 100
n = Rnd * (.Count - 1) + 1
numArray(i) = numCollection(n)
.Remove n
Next
End With
RandomQuestionArray = numArray()
End Function
I see you have an answer, I was working on this but lost my internet connection. Anyway here is another method.
'// Builds a question bank (make it a hidden sheet)
Sub ResetQuestions()
Const lTotalQuestions As Long = 300 '// Total number of questions.
With Range("A1")
.Value = 1
.AutoFill Destination:=Range("A1").Resize(lTotalQuestions), Type:=xlFillSeries
End With
End Sub
'// Gets a random question number and removes it from the bank
Function GetQuestionNumber()
Dim lCount As Long
lCount = Cells(Rows.Count, 1).End(xlUp).Row
GetQuestionNumber = Cells(Int(lCount * Rnd + 1), 1).Value
Cells(lRandom, 1).Delete
End Function
Sub Test()
Msgbox (GetQuestionNumber)
End Sub
For whatever it's worth here is my stab at this question. This one uses a boolean function instead of numerical arrays. It's very simple yet very fast. The advantage of it, which I'm not saying is perfect, is an effective solution for numbers in a long range because you only ever check the numbers you have already picked and saved and don't need a potentially large array to hold the values you have rejected so it won't cause memory problems because of the size of the array.
Sub UniqueRandomGenerator()
Dim N As Long, MaxNum As Long, MinNum As Long, Rand As Long, i As Long
MinNum = 1 'Put the input of minimum number here
MaxNum = 100 'Put the input of maximum number here
N = MaxNum - MinNum + 1
ReDim Unique(1 To N, 1 To 1)
For i = 1 To N
Randomize 'I put this inside the loop to make sure of generating "good" random numbers
Do
Rand = Int(MinNum + N * Rnd)
If IsUnique(Rand, Unique) Then Unique(i, 1) = Rand: Exit Do
Loop
Next
Sheet1.[A1].Resize(N) = Unique
End Sub
Function IsUnique(Num As Long, Data As Variant) As Boolean
Dim iFind As Long
On Error GoTo Unique
iFind = Application.WorksheetFunction.Match(Num, Data, 0)
If iFind > 0 Then IsUnique = False: Exit Function
Unique:
IsUnique = True
End Function