Desperately in need of help coding for High School computer science project

New to FreeBASIC? Post your questions here.
lizard
Posts: 440
Joined: Oct 17, 2017 11:35
Location: Germany

Re: Desperately in need of help coding for High School computer science project

Post by lizard »

dodicat wrote:randomize is the same as randomize timer
Thanks, Dodicat!
deltarho[1859]
Posts: 4305
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: Desperately in need of help coding for High School computer science project

Post by deltarho[1859] »

badidea wrote:But in real life, cards are shuffled in a different (imperfect) way.
The dealer is called Christopher Peter Underwood and is renowned for his perfect shuffling. His friends refer to him by his intiails: CPU <smile>

@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
is not a Knuth shuffle.

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
Note that when n = 51 we can swap with any of [51,52]. It is pointless going to 52 because there is nothing to swap with except itself.
badidea
Posts: 2591
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Desperately in need of help coding for High School computer science project

Post by badidea »

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.

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()
deltarho[1859]
Posts: 4305
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: Desperately in need of help coding for High School computer science project

Post by deltarho[1859] »

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.
deltarho[1859]
Posts: 4305
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: Desperately in need of help coding for High School computer science project

Post by deltarho[1859] »

@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.
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Desperately in need of help coding for High School computer science project

Post by dodicat »

Here is another 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

  
counting_pine
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

Post by counting_pine »

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!)
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Desperately in need of help coding for High School computer science project

Post by dodicat »

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

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
        
        
          
Richard
Posts: 3096
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Desperately in need of help coding for High School computer science project

Post by Richard »

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
'===================================================================
deltarho[1859]
Posts: 4305
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: Desperately in need of help coding for High School computer science project

Post by deltarho[1859] »

@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>
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Desperately in need of help coding for High School computer science project

Post by dodicat »

With a string of 10 characters.
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
'===================================================================  
badidea
Posts: 2591
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Desperately in need of help coding for High School computer science project

Post by badidea »

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.

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()
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Desperately in need of help coding for High School computer science project

Post by dodicat »

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

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


   
Post Reply