Random numbers in array without any duplicates - vb.net

I'm trying to randomize an array from numbers 0 to 51 using loops but I just cannot seem to pull it off. My idea was that
Generate a Random Number
Check if this random number has been used by storing the previous in an array
If this random number has been used, generate new random number until it is not a duplicate
If it's not a duplicate, store it
My attempt:
Dim list(51) As Integer
Dim templist(51) As Integer
For i As Integer = 0 To 51 Step 1
list(i) = i
Next i
Do While counter <= 51
p = rand.Next(0, 52)
templist(counter) = p
For n As Integer = 0 To 51 Step 1
p = rand.Next(0, 52)
If templist(n) = p Then
Do While templist(n) = p
p = rand.Next(0, 52)
Loop
templist(n) = p
Else
templist(n) = p
End If
Next
counter += 1
Loop
For n As Integer = 0 To 51 Step 1
ListBox1.Items.Add(templist(n))
Next

It will be a lot easier if you just have a list of all of the possible numbers (0 to 51 in your case), then remove the number from the list so it can't be picked again. Try something like this:
Dim allNumbers As New List (Of Integer)
Dim randomNumbers As New List (Of Integer)
Dim rand as New Random
' Fill the list of all numbers
For i As Integer = 0 To 51 Step 1
allNumbers.Add(i)
Next i
' Grab a random entry from the list of all numbers
For i As Integer = 0 To 51 Step 1
Dim selectedIndex as Integer = rand.Next(0, (allNumbers.Count - 1) )
Dim selectedNumber as Integer = allNumbers(selectedIndex)
randomNumbers.Add(selectedNumber)
allNumbers.Remove(selectedNumber)
' Might as well just add the number to ListBox1 here, too
ListBox1.Items.Add(selectedNumber)
Next i
If your goal is to get the numbers into ListBox1, then you don't even need the "randomNumbers" list.
EDIT:
If you must have an array, try something like this:
Function RandomArray(min As Integer, max As Integer) As Integer()
If min >= max Then
Throw New Exception("Min. must be less than Max.)")
End If
Dim count As Integer = (max - min)
Dim randomNumbers(count) As Integer
Dim rand As New Random()
' Since an array of integers sets every number to zero, and zero is possibly within our min/max range (0-51 here),
' we have to initialize every number in the array to something that is outside our min/max range.
If min <= 0 AndAlso max >= 0 Then
For i As Integer = 0 To count
randomNumbers(i) = (min - 1) ' Could also be max + 1
Next i
End If
Dim counter As Integer = 0
' Loop until the array has count # of elements (so counter will be equal to count + 1, since it is incremented AFTER we place a number in the array)
Do Until counter = count + 1
Dim someNumber As Integer = rand.Next(min, max + 1)
' Only add the number if it is not already in the array
If Not randomNumbers.Contains(someNumber) Then
randomNumbers(counter) = someNumber
counter += 1
End If
Loop
Return randomNumbers
End Function
This is good enough for your assignment, but the computer scientist in my hates this algorithm.
Here's why this algorithm is much less desirable. If zero is in your range of numbers, you will have to loop through the array at least 2N times (so 104+ times if you are going from 0 to 51). This is a best case scenario; the time complexity of this algorithm actually gets worse as the range of numbers scales higher. If you try running it from 0 to 100,000 for example, it will fill the first few thousand numbers very quickly, but as it goes on, it will take longer and longer to find a number that isn't already in the list. By the time you get to the last few numbers, you could potentially have randomly generated a few trillion different numbers before you find those last few numbers. If you assume an average complexity of 100000! (100,000 factorial), then the loop is going to execute almost ten to the half-a-millionth power times.
An array is more difficult to "shuffle" because it is a fixed size, so you can't really add and remove items like you can with a list or collection. What you CAN do, though, is fill the array with your numbers in order, then go through a random number of iterations where you randomly swap the positions of two numbers.

Do While counter <= 51
p = rand.Next(0, 52)
While Array.IndexOf(list, p) = -1
p = rand.Next(0, 52)
End While
counter += 1
Loop

Haven't written VB in about 5 years, but try this out:
Function GetRandomUniqueNumbersList(ByVal fromNumber As Integer, ByVal toNumber As Integer) As List(Of Integer)
If (toNumber <= fromNumber) Then
Throw New ArgumentException("toNumber must be greater than fromNumber", toNumber)
End If
Dim random As New Random
Dim randomNumbers As New HashSet(Of Integer)()
Do
randomNumbers.Add(random.Next(fromNumber, toNumber))
Loop While (randomNumbers.Count < toNumber - fromNumber)
Return randomNumbers.ToList()
End Function
Ok, that was painful. Please someone correct it if I made any mistakes. Should be very quick because it's using a HashSet.

First response to forum on stackoverflow - be gentle.
I was looking for a way to do this but couldn't find a suitable example online.
I've had a go myself and eventually got this to work:
Sub addUnique(ByRef tempList, ByVal n, ByRef s)
Dim rand = CInt(Rnd() * 15) + 1
For j = 0 To n
If tempList(j) = rand Then
s = True
End If
Next
If s = False Then
tempList(n) = rand
Else
s = False
addUnique(tempList, n, s)
End If
End Sub
Then call the sub using:
Dim values(15) As Byte
Dim valueSeen As Boolean = False
For i = 0 To 15
addUnique(values, i, valueSeen)
Next
This will randomly add the numbers 1 to 16 into an array. Each time a value is added, the previous values in the array are checked and if any of them are the same as the randomly generated value, s is set to true. If a value is not found (s=false), then the randomly generated value is added. The sub is recursively called again if s is still true at the end of the 'For' loop. Probably need 'Randomize()' in there somewhere.
Apologies if layout is a bit wobbly.

Related

Random number creating

I got some help from one, and the code works perfectly fine.
What im looking for, is an explanation of the code, since my basic VBA-knowledge does not provide me with it.
Can someone explain what happens from "Function" and down?
Sub Opgave8()
For i = 2 To 18288
If Left(Worksheets("arab").Cells(i, 12), 6) = "262015" Then
Worksheets("arab").Cells(i, 3) = "18" & UniqueRandDigits(5)
End If
Next i
End Sub
Function UniqueRandDigits(x As Long) As String
Dim i As Long
Dim n As Integer
Dim s As String
Do
n = Int(Rnd() * 10)
If InStr(s, n) = 0 Then
s = s & n
i = i + 1
End If
Loop Until i = x + 1
UniqueRandDigits = s
End Function
n = Int(Rnd()*10) returns a value between 0 and 9, since Rnd returns a value between 0 and 1 and Int converts it to an integer, aka, a natural number.
Then If InStr(s, n) = 0 checks if the random number is already in your result: if not, it adds it using the string concatenation operator &.
This process loops (do) until i = x + 1 where x is your input argument, so you get a string of length x. Then the first part just fills rows with these random strings.
N.B. : I explained using the logical order of the code. Your friend function UniqRandDigits is defined after the "business logic", but it's the root of the code.
The code loops from row 2 to 18288 in Worksheet "arab". If first 6 characters in 12th column are "262015", then in 3rd column macro will fill cell with value "18" followed by result of function UniqueRandDigits(5) which generates 5 unique digits (0-9).
About the UniqueRandDigits function, the most important is that Rnd() returns a value lesser than 1 but greater than or equal to zero.
Int returns integer value, so Int(Rnd() * 10) will generate a random integer number from 0 to 9.
If InStr(s, n) = 0 Then makes sure than generated integer value doesn't exist in already generated digits of this number, because as the function name says, they must be unique.

Visual basic 2008 - Do...While until infinite loop when shuffling 52 card deck

I'm starting to make a Hearts game in VB2008. Currently I'm stuck with the dealing:
For q = 0 To 51
Do
Randomize()
dealrand = Int(Rnd() * 51)
cards(q).Image = pics(dealrand)
Loop Until dealused(dealrand) = False
dealused(dealrand) = True
Next
What I'm trying to do is check if the card has been used and generate a different card, so nobody would get the same card.
When I press the button, the program crashes. I think it's an infinite loop, because when I changed cards(q).Image = pics(dealrand) to cards(q).hide, it hid one card and crashed.
P.S:
All of the "dealused" variables are set to False when created.
"pics" is an image array (as in image files), but I don't think that's the reason.
I believe the problem may be that you've missed that Rnd returns a value between 0 (inclusive) and 1 (exclusive), meaning when cast to integer, it will never return the upper bound value. So you will need to extend the upper bound to 52 to ensure that index #51 is eventually 'found'.
You can also save some work by only assigning the qth card after the next empty index is found, and I believe seeding Randomize just once will suffice:
Dim q As Integer
Dim dealrand As Integer
Dim dealused = Enumerable.Range(0, 52).Select(Function(x) False).ToArray
Randomize()
For q = 0 To 51
Do
dealrand = Int(Rnd() * 52)
Loop Until dealused(dealrand) = False
cards(q).Image = pics(dealrand)
dealused(dealrand) = True
Next
Edit
I believe the card shuffling routine can be done in a single loop, without the hit-or-miss approach of trying to find an unused card, by projecting all 52 cards available (0..51) and then eliminating them once a random card is pulled from the deck. It exploits the fact that List also has a index operator.
Dim dealrand As Integer
Dim cardsAvailable = Enumerable.Range(0, 52).ToList()
Dim q As Integer = 0
Randomize()
While (cardsAvailable.Any())
dealrand = Int(Rnd() * cardsAvailable.Count)
cards(q).Image = pics(cardsAvailable(dealrand))
cardsAvailable.RemoveAt(dealrand)
q = q + 1
End While

Ordering Outputted random numbers

I am making a program that outputs random numbers and then organizes them.
I am organizing the numbers so later I can add code to tell the user how many matching numbers he or she has received.
The program compiles fine, but then when I run the exe, after the first line of random numbers is outputted it crashes. The error I receive is:
the index is outside the boundaries of the array.
Any help at all would be gratefully appreciated.
Option Explicit On
Option Strict On
Imports System
Module Yahtzed
Sub Main()
Randomize()
Dim Index, Values, NumberOfPlayers,Temp as Integer
Dim order(index) as integer
Dim Last As Integer = 0 'to Order.Length-2
Console.Write("How many people will be playing Yahtzed?: ")
NumberOfPlayers = convert.toint32(Console.Readline)
Do while NumberOfPlayers > 0
Index = 0
Do until index = 5
Values = CInt(Int((6 * Rnd()) + 1))
Console.Write(" "&values)
Index += 1
Loop
Do Until Index = 0
If Order(Index + 1) < Order(index)
Temp = Order(Index + 1)
Order(Index + 1) = order(index)
Order(index) = Temp
Console.WriteLine(Order(Index))
End if
index -= 1
loop
Console.Writeline
NumberOfPlayers -= 1
Console.Writeline()
Loop
End Sub
End Module
The code doesn't really make sense as it is now. You create some random numbers, then you throw them away, and sort an array that never has been assigned anything. Also, the array only has one item, so it would not be able to hold the random values.
I think that you want to declare the array for five items, not one (as index is zero by the time you create the array):
Dim order(4) As Integer
Then put the random numbers in the array instead of putting them in a variable where each random number will replace the previous one:
Index = 0
Do until index = 5
order(index) = CInt(Int((6 * Rnd()) + 1))
Console.Write(" " & order(index))
Loop
When you sort the array, you start looking at index 6 (as the variable index is 5), which is outside the array. You would want to start at one item from the last in the array (i.e. at index 3). Then you loop until index is -1, otherwise you won't be comparing the two first items in the array.
Also, you have to continue sorting until there are no more swaps, just going through the array once doesn't make it sorted:
Dim swapped as Boolean = True
Do While swapped
index = 3
swapped = False
Do Until index = -1
If order(index + 1) < order(index)
temp = order(index + 1)
order(index + 1) = order(index)
order(index) = temp
swapped = True
End if
index -= 1
Loop
Loop
This sorting algorithm is called Bubble Sort.
There is also sorting built into the framework, if you want to use that instead:
Array.Sort(order)
If you would write out the values while sorting, you would get them several times over, so you do that after they are sorted:
index = 0
Do until index = 5
Console.Write(" " & order(index))
Loop

Why one over another: UBound or Length

Could there be any specific reason why one can choose UBound over Length?
Here is the code and 1-dimension is passed as second parameter.
For iIndex = 0 To UBound(myList)
If Left(Request.ServerVariables("REMOTE_ADDR"), Len(myList(iIndex))) = saIPList(iIndex) Then
bAuth = True
Exit For
End If
Next
Any performance gain against Length
They do different things! UBound gives you the last index in the array, while Length gives you the length. Those are not the same, because usually UBound will be Length - 1.
Ubound exists mainly for backwards compatibility to old code. I haven't seen anything saying it's deprecated just yet, but at the same time I recognize it's not really aligned with the way they have been taking the language in recent years. The same is true for the Len() and Left() functions in that code; they are the way of the past, not the future. The sooner you adapt, the happier you will be.
For what it's worth, the argument is largely moot. More "modern" ways to write that code look entirely different. Here's one example:
bAuth = myList.Zip(saIPList, Function(a,b) New With {.Length = a.Length, .saIP = b} ) _
.Any(Function(i) Request.ServerVariables("REMOTE_ADDR").ToString().SubString(0,i.Length) = i.saIP)
For performance gain I was also interested in what function has the best performance.
It seems that the length -1 is much faster than the UBound. I expected UBound to be faster somehow.
After 100.000.000 times it seems the time for length -1 is 952ms and for UBound: 5844ms.
(length -1) is ~6 times faster than UBound
Code used for testing
Private Sub UboundlengthToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles UboundlengthToolStripMenuItem.Click
ListBox1.Items.Clear()
ListBox1.Items.Add("BEGIN")
'set required vars
Dim ints() As Integer = {1, 2, 3, 4, 5}
'end vars setting
Dim t As New Stopwatch
Dim gt As New Stopwatch
Dim time1 As Integer
Dim temp As Integer
Dim d As Double = GC.GetTotalMemory(False)
GC.Collect()
GC.WaitForPendingFinalizers()
GC.Collect()
GC.GetTotalMemory(False)
ListBox1.Items.Add("Free Memory: " & d)
gt.Start()
t.Reset()
'starting test---------------------------------------
'single test---------------------------------------
t.Start()
For i As Integer = 0 To TextBox1.Text
temp = ints(ints.Length - 1)
Next
t.Stop()
time1 = t.ElapsedMilliseconds
ListBox1.Items.Add("arr.length - 1")
ListBox1.Items.Add("Func1 total time: " & time1)
ListBox1.Items.Add("Func1 single time: " & time1 / TextBox1.Text)
t.Reset()
'single test---------------------------------------
'single test---------------------------------------
t.Start()
For i As Integer = 0 To TextBox1.Text
temp = ints(UBound(ints))
Next
t.Stop()
time1 = t.ElapsedMilliseconds
ListBox1.Items.Add("UBound:")
ListBox1.Items.Add("Func1 total time: " & time1)
ListBox1.Items.Add("Func1 single time: " & time1 / TextBox1.Text)
t.Reset()
'single test---------------------------------------
'Finishing test--------------------------------------
gt.Stop()
ListBox1.Items.Add("Total time " & gt.ElapsedMilliseconds)
d = GC.GetTotalMemory(True) - d
ListBox1.Items.Add("Total Memory Heap consuming (bytes)" & d)
ListBox1.Items.Add("END")
End Sub
Tried different things to eliminate possible optimalisations of the compiler, all with the same result as stated above.
It's carried over from earlier VB days. UBound can give you the highest index of any single dimension in a multi-dimensional array. Length only gives you the total number of elements.
If you declare:
' A 5x10 array:
Dim array(4, 9) As Integer
The values are:
array.Length = 50 ' Total number of elements.
array.Rank = 2 ' Total number of dimensions.
array.LBound(0) = 0 ' Minimum index of first dimension.
array.LBound(1) = 0 ' Minimum index of second dimension.
array.UBound(0) = 4 ' Maximum index of first dimension.
array.UBound(1) = 9 ' Maximum index of second dimension.
Interesting UBounds is quite a bit faster in this example
Dim startTick As Long
For j As Integer = 1 To 5
Dim rnd As New Random(Now.Subtract(Now.Date).TotalSeconds)
Dim RandomMax As Integer = rnd.Next(10000, 100000)
Dim cumbersome() As Integer = New Integer() {rnd.Next}
'Ubound is better than Length. Using Length takes as much time as redimensioning the entire array.
startTick = Environment.TickCount
For i As Integer = 1 To RandomMax - 1
ReDim Preserve cumbersome(UBound(cumbersome) + 1)
cumbersome(UBound(cumbersome)) = Rnd.Next
Next
Debug.Print("{0}) Array Method UBound: {1} Ticks to construct {2} integers", j, Environment.TickCount - startTick, RandomMax)
'Length is slow don't use it
startTick = Environment.TickCount
For i As Integer = 1 To RandomMax - 1
ReDim Preserve cumbersome(cumbersome.Length)
cumbersome(cumbersome.Length - 1) = Rnd.Next
Next
Debug.Print("{0}) Array Method Length: {1} Ticks to construct {2} integers", j, Environment.TickCount - startTick, RandomMax)
Next

Populating 2 dimensional array using a For loop

Currently I'm trying to fill a 3x3 square with random x's and o's to make a tic tac toe
game. Unfortunately the game doesn't seem to output all the x's and o's. Logically, from what I can see, it should be able to but it's not. Any help would be appreciated.
Shared Sub twodimension()
Dim tic(2, 2) As String
Dim min As Integer
Dim x As String
Dim random As New Random()
Dim i As Integer
Dim x1 As Integer
Dim bound0 As Integer = tic.GetUpperBound(0)
Dim bound1 As Integer = tic.GetLowerBound(1)
For i = 0 To bound0
For x1 = 0 To bound1
min = random.Next(2)
If min = 0 Then
x = "x"
Console.WriteLine("{0}", x)
Else
x = "o"
Console.WriteLine("{0}", x)
End If
Console.Write(" "c)
Next
Console.WriteLine()
Next
End Sub
So presumably you've got this declaration somewhere, right?
Public Shared Tic(2, 2) As String
In your code you've got GetLowerBound which will (almost) always returns zero and instead you should have GetUpperBound().
Dim bound0 As Integer = tic.GetUpperBound(0)
Dim bound1 As Integer = Tic.GetUpperBound(1)
EDIT (in response to comment)
GetUpperBound(int) returns the highest number that you can use for the dimension that you specify.
So for the following array:
Dim MyArray(4, 6, 8) As Integer
Trace.WriteLine(MyArray.GetUpperBound(0)) ''//Returns 4
Trace.WriteLine(MyArray.GetUpperBound(1)) ''//Returns 6
Trace.WriteLine(MyArray.GetUpperBound(2)) ''//Returns 8
GetLowerBound(int) returns the lowest number that you can use for the dimension that you specify. In almost every case this is zero but in older versions of VB (and using some COM interop) you can create arrays that don't "start" at zero and instead start at whatever you wanted. So in old VB you could actually say Dim Bob(1 To 4) As Integer and GetLowerBound(0) would return 1 instead of 0. For the most part there is no reason to even be aware that GetLowerBound exists even.