Thanks, Dodicat!dodicat wrote:randomize is the same as randomize timer
Desperately in need of help coding for High School computer science project
Re: Desperately in need of help coding for High School computer science project
-
- Posts: 4308
- Joined: Jan 02, 2017 0:34
- Location: UK
- Contact:
Re: Desperately in need of help coding for High School computer science project
The dealer is called Christopher Peter Underwood and is renowned for his perfect shuffling. His friends refer to him by his intiails: CPU <smile>badidea wrote:But in real life, cards are shuffled in a different (imperfect) way.
@dodicat
Code: Select all
Sub shuffle(a() As long)
dim as long x
For n As Integer=1 To 52
do
x=range(1,52)
loop until x<>n
Swap a(n),a(x)
Next n
End Sub
Starting at n = 1. We swap with any of [1,52] except 1.
For n = 2 we swap with any of [1,52] except 2 which means we could swap with 1.
For n = 3 we swap with any of [1,52] except 3 which means we could swap with 1 and 2.
... and so on.
This will not give a perfect shuffle.
With a Knuth shuffle we allow 1 to swap with any of [1,52] so 1 could shuffle with itself.
For n = 2 we allow 2 to swap with any of [2,52]
For n= 3 we allow 3 to swap with any of [3,52]
... and so on.
With your shuffle I did 100,000 loops and noted the position of 21. 53.1% of the time it was <=26.
With drshuffle, 21 was <= 26 49.9% of the time. All numbers will be <=26 for 50% of the time for an infinite test.
I did a similar test using 49 as the target. With your shuffle I got 43.6% of the time <=26. With the drshuffle I got 50.1%
Code: Select all
Sub drshuffle(a() As long)
For n As Integer = 1 To 51
Swap a(n), a( range(n,52) )
Next n
End Sub
Re: Desperately in need of help coding for High School computer science project
shuffleKnuth() added
Wikipedia says:
j ← random integer such that i ≤ j < n
But it i = j, swapping them is useless, shouldn't it be:
j ← random integer such that i < j < n ?
Never mind, same discussion as above. I think.
Wikipedia says:
j ← random integer such that i ≤ j < n
But it i = j, swapping them is useless, shouldn't it be:
j ← random integer such that i < j < n ?
Never mind, same discussion as above. I think.
Code: Select all
type cardInfo_type
dim as string displayName
dim as integer displayColour
end type
type deck_type
private:
const as integer NUM_COLOUR = 4, NUM_RANK = 13
const as integer NUM_CARDS = NUM_COLOUR * NUM_RANK
const as ulong C_RED = 12, C_BLACK = 15 'white is the new black :-)
dim as string colour(NUM_COLOUR-1) = {"Clubs", "Diamonds", "Hearts", "Spades"}
dim as ulong displayColour(NUM_COLOUR-1) = {C_BLACK, C_RED, C_RED, C_BLACK}
dim as string rank(NUM_RANK-1) = {"Ace", "2", "3", "4", "5", "6", "7", "8", "9", "10", "Jack", "Queen", "King"}
dim as cardInfo_type cardInfo(NUM_CARDS-1)
public:
dim as integer card(NUM_CARDS-1)
declare sub init()
declare sub list()
declare sub shuffleTwoSwap(numSwaps as integer)
declare sub shuffleKnuth()
end type
sub deck_type.init()
dim as integer iColour, iRank, iCard
iCard = 0
for iColour = 0 to NUM_COLOUR-1
for iRank = 0 to NUM_RANK-1
card(iCard) = iCard
cardInfo(iCard).displayName = rank(iRank) + " of " + colour(iColour)
cardInfo(iCard).displayColour = displayColour(iColour)
iCard += 1
next
next
end sub
sub deck_type.list()
dim as integer iCard, iInfo
for iCard = 0 to NUM_CARDS-1
iInfo = card(iCard)
color cardInfo(iInfo).displayColour
print iCard, cardInfo(iInfo).displayName
next
color 7
end sub
sub deck_type.shuffleTwoSwap(numSwaps as integer)
dim as integer iSwap, tempCard
dim as integer iCard1, iCard2
randomize timer
for iSwap = 0 to numSwaps-1
iCard1 = int(rnd * NUM_CARDS)
iCard2 = int(rnd * NUM_CARDS)
swap card(iCard1), card(iCard2)
next
end sub
sub deck_type.shuffleKnuth()
dim as integer i, j
for i = 0 to NUM_CARDS-2
j = int(rnd * (NUM_CARDS - i) + i) 'i ≤ j < n
swap card(i), card(j)
next
end sub
dim deck as deck_type
deck.init()
deck.shuffleKnuth()
deck.list()
-
- Posts: 4308
- Joined: Jan 02, 2017 0:34
- Location: UK
- Contact:
Re: Desperately in need of help coding for High School computer science project
The Knuth shuffle is analogous to a shuffle bag. Imagine 52 balls in the bag numbered 1 to 52. We take one out leaving 51. We take another one out leaving 50, and so on. Eventually there is only one ball left and we have no choices now.
Disallowing i <= j and using i < j is like putting our left hand into the bag and grasping one allowing our right hand to choose only from the others. As we progress some balls may be stopped leaving the bag once, twice three times and so on. On the other hand, so to speak (<smile>), one ball may even become the 52nd to leave without being touched by the left hand hand at all. The equality part of <= keeps our left hand from being involved.
Disallowing i <= j and using i < j is like putting our left hand into the bag and grasping one allowing our right hand to choose only from the others. As we progress some balls may be stopped leaving the bag once, twice three times and so on. On the other hand, so to speak (<smile>), one ball may even become the 52nd to leave without being touched by the left hand hand at all. The equality part of <= keeps our left hand from being involved.
-
- Posts: 4308
- Joined: Jan 02, 2017 0:34
- Location: UK
- Contact:
Re: Desperately in need of help coding for High School computer science project
@badidea
I didn't get a chance to look at your code yesterday but today I noticed that your are using FB's default PRNG. There are 52! ~ 2^225.6 possible permutations of a 52 card deck. See Wikipedia. All of FB's PRNGs, except one, are seeded with at most 32 bits. 2^32 is minuscule compared with 2^225.6. The period is irrelevant - it is the number of sequence entry points which matters. At the bottom right of the Wiki link is a table. 32 bits can cover only 12 cards. Last year I extended the Mersenne Twister's entry points from 2^32 to (2^32)^624 which gives 2^19968 entry points. MT's period is 2^19937 - 1 so every possible entry point was covered. In fact, 19937 is mentioned in the Wiki table. That could handle 2080 cards. I also got involved in a 64 bit generator but that will only cover 20 cards.
I am not suggesting we use my MT but a strong candidate is a generator which does not have a finite internal state. Enter cryptographic generators. We have one - generator #5. It is pitifully slow compared with our other generators but we are only requesting 51 random numbers for a Knuth shuffle and they will come in at the blink of an eye. 'Randomize , 5' then will do nicely.
I didn't get a chance to look at your code yesterday but today I noticed that your are using FB's default PRNG. There are 52! ~ 2^225.6 possible permutations of a 52 card deck. See Wikipedia. All of FB's PRNGs, except one, are seeded with at most 32 bits. 2^32 is minuscule compared with 2^225.6. The period is irrelevant - it is the number of sequence entry points which matters. At the bottom right of the Wiki link is a table. 32 bits can cover only 12 cards. Last year I extended the Mersenne Twister's entry points from 2^32 to (2^32)^624 which gives 2^19968 entry points. MT's period is 2^19937 - 1 so every possible entry point was covered. In fact, 19937 is mentioned in the Wiki table. That could handle 2080 cards. I also got involved in a 64 bit generator but that will only cover 20 cards.
I am not suggesting we use my MT but a strong candidate is a generator which does not have a finite internal state. Enter cryptographic generators. We have one - generator #5. It is pitifully slow compared with our other generators but we are only requesting 51 random numbers for a Knuth shuffle and they will come in at the blink of an eye. 'Randomize , 5' then will do nicely.
Re: Desperately in need of help coding for High School computer science project
Here is another shuffle.
The strewth shuffle.
The strewth shuffle.
Code: Select all
width 150,35
type cards
as long n
as double r
static as long c
declare constructor
end type
dim cards.c as long
constructor cards
c+=1
if c>52 then c=1
n=c
r=rnd
end constructor
'strewth shuffle
Sub Sortshuffle(array() As cards,begin As long=1,Finish As long=52)
Dim As Integer i=begin,j=finish
Dim As double x =array(((I+J)\2)).r
While I <= J
While array(I).r < X:I+=1:Wend
While array(J).r > X:J-=1:Wend
If I<=J Then
Swap array(I),array(J)
I+=1
J-=1
End If
Wend
If J > begin Then SortShuffle(array(),begin,J)
If I < Finish Then SortShuffle(array(),I,Finish)
End Sub
'=========================
for z as long=1 to 30
redim as cards deck(1 to 52)
SortShuffle(deck())
for n as long=1 to 52
if deck(n).n=21 then color 3 else color 15
print deck(n).n;
next
print
next z
sleep
-
- Site Admin
- Posts: 6323
- Joined: Jul 05, 2005 17:32
- Location: Manchester, Lancs
Re: Desperately in need of help coding for High School computer science project
This reminds me of a Google Code Jam question (2014, round 1A, question C: Proper Shuffle), where you were given a list of permutations, and had to decide whether they were shuffled with the proper Knuth Shuffle (k..N-1), or an algorithm that swapped each number with any other number in the entire range (0..N-1).
It's not exactly the same case here, but it goes to show that a shuffle algorithm can look "fair", but produce bad results. Bad enough that it can be possible, with surprisingly high accuracy, to detect when some kinds of bad algorithm are used.
Based on the challenge in the Code Jam example, the given algorithm is so bad that with a single input you can detect the use of this algorithm with around 90% accuracy of the time.
(Not only that, but smart people have written programs to accomplish this within a 2:30 hour timeframe, even while solving two other problems!)
It's not exactly the same case here, but it goes to show that a shuffle algorithm can look "fair", but produce bad results. Bad enough that it can be possible, with surprisingly high accuracy, to detect when some kinds of bad algorithm are used.
Based on the challenge in the Code Jam example, the given algorithm is so bad that with a single input you can detect the use of this algorithm with around 90% accuracy of the time.
(Not only that, but smart people have written programs to accomplish this within a 2:30 hour timeframe, even while solving two other problems!)
Re: Desperately in need of help coding for High School computer science project
Compare to KUTH
Any card of 52 (say number 21), after 100000 shuffles should tend towards a central position of [1 to 52].
This would be 26.5
Any card of 52 (say number 21), after 100000 shuffles should tend towards a central position of [1 to 52].
This would be 26.5
Code: Select all
Randomize
Type cards
As Long n
As Double r
Static As Long c
Declare Constructor
End Type
Dim cards.c As Long
Constructor cards
c+=1
If c>52 Then c=1
n=c
r=Rnd
End Constructor
'strewth shuffle
Sub Sortshuffle(array() As cards,begin As Long=1,Finish As Long=52)
Dim As Integer i=begin,j=finish
Dim As Double x =array(((I+J)\2)).r
While I <= J
While array(I).r < X:I+=1:Wend
While array(J).r > X:J-=1:Wend
If I<=J Then
Swap array(I),array(J)
I+=1
J-=1
End If
Wend
If J > begin Then SortShuffle(array(),begin,J)
If I < Finish Then SortShuffle(array(),I,Finish)
End Sub
Function checkposition(array() As cards) As Long
For z As Long=1 To 52
If array(z).n=21 Then Return z
Next
End Function
'===== KUTH STUFF ======
Function Kuthcheckposition(array() As Long) As Long
For z As Long=1 To 52
If array(z)=21 Then Return z
Next
End Function
Sub Kuthshuffle(a() As Long)
#define range(f,l) Int(Rnd*((l+1)-(f))+(f))
For n As Integer = 1 To 51
Swap a(n), a( range(n,52) )
Next n
End Sub
Sub initkutharray(K() As Long)
For n As Long=1 To 52
K(n)=n
Next
End Sub
Redim As Long Ku(1 To 52)
'==============================
Dim As Double average
Dim As Long limit=100000
For k As Long=1 To 10
Dim As Double p
For z As Long=1 To limit
Redim As cards deck(1 To 52)
SortShuffle(deck())
p+=checkposition(deck())
Next z
p=p/limit
Print p,k;" of 10"
average+=p
Next k
Print
Print "overall average ";average/10;" Un Kuth"
'=========================
'Kuth
Print
Print
Sleep 100
average=0
For k As Long=1 To 10
Dim As Double p
For z As Long=1 To limit
initkutharray(Ku())
KuthShuffle(Ku())
p+=Kuthcheckposition(Ku())
Next z
p=p/limit
Print p,k;" of 10"
average+=p
Next k
Print
Print "overall average ";average/10;" Kuth"
Sleep
Re: Desperately in need of help coding for High School computer science project
Quick shuffle tester.
Code: Select all
'===================================================================
' statistics of shuffle, source to destination bias or skew'
'
' Shuffles ten symbols
' track the destination based on source = starting position
' repeat the test a few hundred thousand times
' report the averaged mapping in colour
'
' select the function to test at about line 80
' if you select none it will not shuffle
'
' define your function
' function must shuffle the first ten characters of string s[]
' string index is from 0 to 9
'
' The shuffle being tested has a problem if
' the pattern is far from 100%
' or is similar every time
'
' a good shuffle produces
' values close to 100% each run
' a different random outlier pattern every time
'
'===================================================================
Const As Integer string_length = 10
Const As Integer n = string_length - 1
'===================================================================
' rolliebollocks' scramble string function
Function scramble(Byref instring As String) As String
Dim As String outstring = Space(Len(instring))
Dim As Integer i = 0, r = 0, l = Len(instring) - 1
Do While Instr(outstring, " ")
r = Rnd * l
If outstring[r] = 32 Then
outstring[r] = instring[i]
i += 1
End If
Loop
Return outstring
End Function
'===================================================================
' modified rolliebollocks scramble string function
Function scramble_fair(Byref instring As String) As String
Dim As String outstring = Space(Len(instring))
Dim As Integer i = 0, r, L = Len(instring) ' changed L, + 1
Do While Instr(outstring, " ")
r = Int(Rnd * L) ' changed to Int( )
If outstring[r] = 32 Then
outstring[r] = instring[i]
i += 1
End If
Loop
Return outstring
End Function
'===================================================================
' method from "FreeBASIC Extended Library Development Group"
Function unfair(Byref s As String) As String
' unfair shuffle string s
For i As Integer = 0 To n
Swap s[i], s[Int(Rnd*(n+1))] ' unfair shuffle
Next i
Return s
End Function
'===================================================================
' fair shuffle string using Richard's method
Function Richard(Byref s As String) As String
For i As Integer = n To 1 Step -1
Swap s[i], s[Int(Rnd*(i+1))] ' fair shuffle
Next i
Return s
End Function
'===================================================================
Randomize ' Timer*1e6
'Screen 19 '21
Dim As Integer i, j
Dim As String s, s_init = String(string_length, 32) ' the string to shuffle
For i = 0 To n
s_init[i] = i
Next i
' the source to dest freq distribution and counters
Dim As Longint freq( 0 To n, 0 To n ), count, ncount = 300000
For count As Integer = 1 To ncount
' first initialize the string each time
s = s_init
'---------------------------------------------------------------
' un-comment one, or none, of these routines # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
's = scramble(s)
's = scramble_fair(s)
's = Richard(s)
s = unfair(s) ' unfair shuffle of string (FreeBASIC Extended Library)
'---------------------------------------------------------------
' gather statistics
For i = 0 To n
freq( i, s[ i ] ) += 1
Next i
Next count
'===================================================================
' display the relative frequencies, normalized to 100% = fair
Dim As Double f
Color 7
Print " Number of shuffles tested ="; ncount
Print
Print " % D e s t i n a t i o n "
Print " Source";
For j = 0 To n
Print Using "###### "; j;
Next j
Print
For i = 0 To n
Print Using " ### "; i;
For j = 0 To n
f = (n+1) * 100 * freq(i,j) / ncount
Color 7
If f > 101 Then Color 14
If f < 99 Then Color 12
Print Using " ###.##"; f;
Color 7
Next j
Print
Next i
'===================================================================
Sleep
'===================================================================
-
- Posts: 4308
- Joined: Jan 02, 2017 0:34
- Location: UK
- Contact:
Re: Desperately in need of help coding for High School computer science project
@Richard
I pushed the boat out with a string length of 52 and a count of one million and added my own Knuth shuffle. Needless to say the display suffered but all the results got output.
Of course, if I used 'Randomize , 5' then I would have been pushing up daisies for a long time before any output so I introduced my CryptoRndII which churns out cryptographic random numbers in excess of 500MHz on my machine. I just replaced Rnd with CryptoS and used CryptoR(i,j) for the range.
Scramble_fair was taking about 18 seconds, scramble about 16 seconds. Unfair, Richard and my shuffle were taking about two seconds.
With this 'stress test' both Richard and my shuffle saw red results but nothing like the number with the other methods.
So, the fastest shufflers were the fairest so we need look no further.
Thanks for you code. Nice work. <smile>
I pushed the boat out with a string length of 52 and a count of one million and added my own Knuth shuffle. Needless to say the display suffered but all the results got output.
Of course, if I used 'Randomize , 5' then I would have been pushing up daisies for a long time before any output so I introduced my CryptoRndII which churns out cryptographic random numbers in excess of 500MHz on my machine. I just replaced Rnd with CryptoS and used CryptoR(i,j) for the range.
Scramble_fair was taking about 18 seconds, scramble about 16 seconds. Unfair, Richard and my shuffle were taking about two seconds.
With this 'stress test' both Richard and my shuffle saw red results but nothing like the number with the other methods.
So, the fastest shufflers were the fairest so we need look no further.
Thanks for you code. Nice work. <smile>
Re: Desperately in need of help coding for High School computer science project
With a string of 10 characters.
Get all permutations of these 10 characters.
Pick one at random.
Put into Richard's code:
Get all permutations of these 10 characters.
Pick one at random.
Put into Richard's code:
Code: Select all
'===================================================================
' statistics of shuffle, source to destination bias or skew'
'
' Shuffles ten symbols
' track the destination based on source = starting position
' repeat the test a few hundred thousand times
' report the averaged mapping in colour
'
' select the function to test at about line 80
' if you select none it will not shuffle
'
' define your function
' function must shuffle the first ten characters of string s[]
' string index is from 0 to 9
'
' The shuffle being tested has a problem if
' the pattern is far from 100%
' or is similar every time
'
' a good shuffle produces
' values close to 100% each run
' a different random outlier pattern every time
'
Sub Permutate(Byval s2 As String,perm() As String,OptionalStop As String="")
Dim As Long p,i,j,result
Redim perm(0)
Dim As Long LENS2M1=Len(S2)-1
Dim As Long lens2=Len(s2)
Dim As Double factorial
Dim temp As Double=1
If Len(s2) >1 Then
For n As Integer =1 To Len(s2)
temp =temp * n
Next
factorial =temp
Else
factorial =1
End If
Redim perm(1 To (factorial))
For p1 As Integer =0 To Len(s2)-2
For p2 As Integer =p1 + 1 To Len(s2)-1
If s2[p1]>s2[p2] Then Swap s2[p1],s2[p2]
Next p2
Next p1
Do
p=p+1
perm(p)=s2
If s2=OptionalStop Then Goto skip
Do
For i=Lens2-2 To 0 Step -1
If s2[i] <s2[i+1] Then Exit For
Next
If i <0 Then Result=0:Exit Do
j =LENS2M1
While s2[j] <= s2[i]: j -=1 : Wend
Swap s2[i], s2[j]
i +=1
j =LENS2M1
While i <j
Swap s2[i], s2[j]
i +=1
j -=1
Wend
result=-1:Exit Do
Loop
Loop Until result=0
skip:
Redim Preserve perm(1 To p)
End Sub
redim shared as string p() 'to hold the permutations
'===================================================================
Const As Integer string_length = 10
Const As Integer n = string_length - 1
'===================================================================
' rolliebollocks' scramble string function
Function scramble(Byref instring As String) As String
Dim As String outstring = Space(Len(instring))
Dim As Integer i = 0, r = 0, l = Len(instring) - 1
Do While Instr(outstring, " ")
r = Rnd * l
If outstring[r] = 32 Then
outstring[r] = instring[i]
i += 1
End If
Loop
Return outstring
End Function
'===================================================================
' modified rolliebollocks scramble string function
Function scramble_fair(Byref instring As String) As String
Dim As String outstring = Space(Len(instring))
Dim As Integer i = 0, r, L = Len(instring) ' changed L, + 1
Do While Instr(outstring, " ")
r = Int(Rnd * L) ' changed to Int( )
If outstring[r] = 32 Then
outstring[r] = instring[i]
i += 1
End If
Loop
Return outstring
End Function
'===================================================================
' method from "FreeBASIC Extended Library Development Group"
Function unfair(Byref s As String) As String
' unfair shuffle string s
For i As Integer = 0 To n
Swap s[i], s[Int(Rnd*(n+1))] ' unfair shuffle
Next i
Return s
End Function
'===================================================================
' fair shuffle string using Richard's method
Function Richard(Byref s As String) As String
For i As Integer = n To 1 Step -1
Swap s[i], s[Int(Rnd*(i+1))] ' fair shuffle
Next i
Return s
End Function
'pick one random permutation
function PickOnePermutation(p() as string) as string
#define r(f,l) Int(Rnd*((l+1)-(f))+(f))
return p(r(lbound(p),ubound(p)))
end function
'===================================================================
Randomize ' Timer*1e6
'Screen 19 '21
Dim As Integer i, j
Dim As String s, s_init = String(string_length, 32) ' the string to shuffle
For i = 0 To n
s_init[i] = i
Next i
permutate(s_init,p())'get all permutations of s_init into p()
' the source to dest freq distribution and counters
Dim As Longint freq( 0 To n, 0 To n ), count, ncount = 300000
For count As Integer = 1 To ncount
' first initialize the string each time
s = s_init
'---------------------------------------------------------------
' un-comment one, or none, of these routines # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
s=PickOnePermutation(p())
's = scramble(s)
' s = scramble_fair(s)
's = Richard(s)
's = unfair(s) ' unfair shuffle of string (FreeBASIC Extended Library)
'---------------------------------------------------------------
' gather statistics
For i = 0 To n
freq( i, s[ i ] ) += 1
Next i
Next count
'===================================================================
' display the relative frequencies, normalized to 100% = fair
Dim As Double f
Color 7
Print " Number of shuffles tested ="; ncount
Print
Print " % D e s t i n a t i o n "
Print " Source";
For j = 0 To n
Print Using "###### "; j;
Next j
Print
For i = 0 To n
Print Using " ### "; i;
For j = 0 To n
f = (n+1) * 100 * freq(i,j) / ncount
Color 7
If f > 101 Then Color 14
If f < 99 Then Color 12
Print Using " ###.##"; f;
Color 7
Next j
Print
Next i
'===================================================================
Sleep
'===================================================================
Re: Desperately in need of help coding for High School computer science project
I tried to implement the 'human amateur' shuffle. The shuffle looks pretty bad, even if repeated 10 times. Or I made an error.
shuffleAmateur(numShuffle) moves 1 to 5 cards form one hand (top of deck) to the other hand (bottom of deck) until the first hand is empty. This can be repeated 'numShuffle' times.
shuffleAmateur(numShuffle) moves 1 to 5 cards form one hand (top of deck) to the other hand (bottom of deck) until the first hand is empty. This can be repeated 'numShuffle' times.
Code: Select all
type cardInfo_type
dim as string displayName
dim as integer displayColour
end type
type deck_type
private:
const as integer NUM_COLOUR = 4, NUM_RANK = 13
const as integer NUM_CARDS = NUM_COLOUR * NUM_RANK
const as ulong C_RED = 12, C_BLACK = 15 'white is the new black :-)
dim as string colour(NUM_COLOUR-1) = {"Clubs", "Diamonds", "Hearts", "Spades"}
dim as ulong displayColour(NUM_COLOUR-1) = {C_BLACK, C_RED, C_RED, C_BLACK}
dim as string rank(NUM_RANK-1) = {"Ace", "2", "3", "4", "5", "6", "7", "8", "9", "10", "Jack", "Queen", "King"}
dim as cardInfo_type cardInfo(NUM_CARDS-1)
public:
dim as integer card(NUM_CARDS-1)
declare sub init()
declare sub list()
declare sub shuffleTwoSwap(numSwaps as integer)
declare sub shuffleKnuth()
declare sub shuffleAmateur(numShuffle as integer)
end type
sub deck_type.init()
dim as integer iColour, iRank, iCard
iCard = 0
for iColour = 0 to NUM_COLOUR-1
for iRank = 0 to NUM_RANK-1
card(iCard) = iCard
cardInfo(iCard).displayName = rank(iRank) + " of " + colour(iColour)
cardInfo(iCard).displayColour = displayColour(iColour)
iCard += 1
next
next
end sub
sub deck_type.list()
dim as integer iCard, iInfo
for iCard = 0 to NUM_CARDS-1
iInfo = card(iCard)
color cardInfo(iInfo).displayColour
print iCard, iInfo, cardInfo(iInfo).displayName
next
color 7
end sub
sub deck_type.shuffleTwoSwap(numSwaps as integer)
dim as integer iSwap, tempCard
dim as integer iCard1, iCard2
for iSwap = 0 to numSwaps-1
iCard1 = int(rnd * NUM_CARDS)
iCard2 = int(rnd * NUM_CARDS)
swap card(iCard1), card(iCard2)
next
end sub
sub deck_type.shuffleKnuth()
dim as integer i, j
for i = 0 to NUM_CARDS-2
j = int(rnd * (NUM_CARDS - i) + i) 'i ≤ j < n
swap card(i), card(j)
next
end sub
sub deck_type.shuffleAmateur(numShuffle as integer)
dim as integer totalMoved, numMove
dim as integer cardTemp(NUM_CARDS-1)
dim as integer i, iShuffle, iSrc, iDst
for iShuffle = 0 to numShuffle-1
totalMoved = 0
while totalMoved < 52
'number of cards that go from hand (top) to other hand (bottom)
numMove = int(rnd * 5) + 1
'cannot move more then remaining
if numMove > (52 - totalMoved) then numMove = 52 -totalMoved
for i = 0 to numMove-1
iSrc = (52 - totalMoved) + (i - numMove)
iDst = totalMoved + i
cardTemp(iDst) = card(iSrc)
'print str(iSrc) + " to " + str(iDst)
next
print
totalMoved += numMove
wend
'move deck back to first hand
for i = 0 to NUM_CARDS-1
card(i) = cardTemp(i)
next
next
end sub
dim deck as deck_type
randomize timer, 5
deck.init()
deck.shuffleAmateur(10)
deck.list()
Re: Desperately in need of help coding for High School computer science project
I think you are correct Badidea.
Making fair shuffles seems easier than a little unfair bias.
In fact I would say that fair shuffles are as many and varied as the days of Summer.
Here is yet another fair one.
GOAL 62.5 (mean of 1 to 52)
200000 loops 10 times
Making fair shuffles seems easier than a little unfair bias.
In fact I would say that fair shuffles are as many and varied as the days of Summer.
Here is yet another fair one.
GOAL 62.5 (mean of 1 to 52)
200000 loops 10 times
Code: Select all
Randomize
Function checkposition(array() As Long) As Long
For z As Long=1 To 52
If array(z)=21 Then Return z
Next
End Function
Sub Kuthshuffle(a() As Long)
#define range(f,l) Int(Rnd*((l+1)-(f))+(f))
For n As Integer = 1 To 51
Swap a(n), a( range(n,52) )
Next n
End Sub
Sub initkutharray(K() As Long)
For n As Long=1 To 52
K(n)=n
Next
End Sub
Sub PickShuffle(a() As Long)
#define range(f,l) Int(Rnd*((l+1)-(f))+(f))
Dim As Byte history(1 To 52)
Dim As Long p
Redim a(1 To 52)
For n As Long=1 To 52
Do
p=range(1,52) 'a random number in range 1 to 52
Loop Until history(p)=0 'it has not been chosen already
history(p)=1 'update history
a(n)=p
Next n
End Sub
Redim As Long Ku(1 To 52)
'==============================
Dim As Double average
Dim As Long limit=200000
For k As Long=1 To 10
Dim As Double p
For z As Long=1 To limit
PickShuffle(Ku())
p+=checkposition(Ku())
Next z
p=p/limit
Print p,k;" of 10"
average+=p
Next k
Print
Print "overall average ";average/10;" Un Kuth"
'=========================
'Kuth
Print
Print
Sleep 100
average=0
For k As Long=1 To 10
Dim As Double p
For z As Long=1 To limit
initkutharray(Ku())
KuthShuffle(Ku())
p+=checkposition(Ku())
Next z
p=p/limit
Print p,k;" of 10"
average+=p
Next k
Print
Print "overall average ";average/10;" Kuth"
Sleep