52 card shuffle

General FreeBASIC programming questions.
IvorU
Posts: 7
Joined: Apr 20, 2018 18:44

52 card shuffle

Post by IvorU »

I have tried to resolve the 52 card shuffle covering all permutations.
The random number routine is a bit clunky but seems to work.

A program to simulate shuffling a deck of 52 cards that is based on using a rank from one of the
possible ranks of a permutation of 52 cards: 52! is a 68 digit number:
80658175170943878571660636856403766975289505440883277824000000000000.
The rank is a number that has a value of, and including, 0 to 52!-1 .
e.g. a value of '0' will be shown as a string containing 68 zeroes and would
equate to 1 to 52 in consecutive order .

A rnd number is generated for each of the 68 digits position to obtain a 68 digit number that has a value of 0 to 52!-1.
52!-1 = 80658175170943878571660636856403766975289505440883277823999999999999
Each rnd number is generated within bounds for each digit e.g. 0-8 for the first digit or 0-9 for the last.
The 68 random digits are then concatenated and used as a rank that will unpack to 52 shuffled numbers.
The shuffled numbers are then assigned a suit: hearts,clubs,diamonds and spades - values of 1-13 are for the hearts suit.

I'm a newcomer to FB and this contribution could probably do with a good polish to turn it into a more eloquent,effecient and
economic work - the program was originally written in QB64 - constructive criticism appreciated.

Code: Select all

'A fairer shuffle of a deck of 52 cards.
#Include Once "gmp_int.bi" 'used in large interger division

dim as byte a,b,count,pntr,cut
Dim Shared As string aa,Suit(0 to 3),rank(1 To 13),Player(1 To 4)
Dim Shared As String deck(1 to 52),Dividend,deal(1 To 4,1 To 13)
dim Shared As byte rndBounds(1 To 68),totDigits,cardNbr,suitNbr,rankNbr,n,i,j


Declare Function rndNbrs (Dividend As String="") As String
Declare sub unRank(Dividend As String,deck() As string)
Declare sub nbr2Card(deck() As string)


'data to represent 52!-1
DATA 8,0,6,5,8,1,7,5,1,7,0,9,4,3,8,7,8,5,7,1,6,6,0,6,3,6,8,5,6,4,0,3,7,6,6,9,7,5,2,8,9,5,0,5,4,4,0,8,8,3,2,7,7,8,2,3,9,9,9,9,9,9,9,9,9,9,9,9
DATA "A",2,3,4,5,6,7,8,9,10,"J","Q","K" 

totDigits = 68 'total digits in 52!-1
n = 52 'cards
FOR a = 1 TO totDigits
    read rndBounds(a) '0-n(whatever the upperbound is for the digit position)
NEXT a
'card values
For a=1 To 13 
	Read rank(a)
Next
'card symbols
Suit(0) = chr(3)
Suit(1) = chr(5)
Suit(2) = chr(4)
Suit(3) = chr(6)

rndNbrs(Dividend)
Print "Rank is (a 68 digit string): "
Print Dividend
unRank(Dividend,deck()) 
'allot suits and rank to cards
nbr2Card(deck())

PRINT "Above value unranked as :"
print
FOR a = 1 TO n
	If asc(Right(deck(a),1))=3 Or asc(Right(deck(a),1))=4 Then
            color 12, 15
      Else
            color 0, 15
	End If
    PRINT Using "\ \";deck(a); " ";
    If a Mod 13 = 0 Then print
NEXT a
Print
sleep
end


'**************************************************************
'rndNbrs 

Function rndNbrs(Dividend As String) As String
	dim as byte a,rndDigit,upperBound
Randomize,5
upperBound = 0 'a switch from 0-n to 0 - 9 in rnd nbr generation
'rnd numbers for all 68 elements
FOR a = 1 TO totDigits 
    'upperbound digit - if rnd digit less, then all following rnd digits can be 0-9
    IF upperBound <> 10 THEN upperBound = rndBounds(a) + 1
    rndDigit = INT(RND * upperBound)
    'test to see if rndDigit <Ubound & if so all following digits can be 0-9
    IF rndDigit < rndBounds(a) THEN upperBound = 10
    'concatenate the 68 random digits 
    dividend = dividend + STR(rndDigit)
NEXT a
Return Dividend
End Function


'**************************************************************
'transform a random 68 digit value into 52 different card values

Sub unRank(Dividend As String,deck() As String)
	
	Dim As Byte i,j
	Dim As String Quotient,Remainder,Divisor
	dim as ulongint e,f
	
Dim As gmp_int m
Dim As gmp_int p 

deck(n) = "1" 'element 52
FOR i = n-1 TO 1 STEP -1 'n-1 to 1
    Divisor = STR((n - i + 1))
    m= gmp_int(dividend)'used with gmp.bi
    p=gmp_int(divisor)
    Quotient= m\p
    Remainder= m mod p
        IF VAL(Remainder) = 0 THEN
        Remainder = "1"
    ELSE
        e = VAL(Remainder) + 1
        Remainder = STR(e)
        END IF
    deck(i) = Remainder
    Dividend = Quotient
    Quotient = ""
    FOR j = i + 1 TO n 
        e = VAL(deck(j))
        f = VAL(deck(i))
        IF e >= f THEN
            e = e + 1
            deck(j) = STR(e)
        END IF
    NEXT j
NEXT i
end Sub
'**************************************************************
'the values 1 to 52 into card suits and rank
'1=AH...14=AC...27=AD...40=AS...52=KS

Sub nbr2Card(deck() As String)
Dim As Byte b	

FOR b = 1 TO 52
    cardNbr = Val(deck(b))-1'cardNbr - 1
    suitNbr = cardNbr / 13' 0-3
    rankNbr = (cardNbr MOD 13) + 1
    deck(b)=rank(rankNbr)+suit(suitNbr)
Next b
End Sub

Last edited by IvorU on Jun 26, 2018 23:21, edited 2 times in total.
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: 52 card shuffle

Post by deltarho[1859] »

Hi IvorU, welcome to FreeBASIC.

Before publishing code make sure it compiles.
srvaldez
Posts: 3373
Joined: Sep 25, 2005 21:54

Re: 52 card shuffle

Post by srvaldez »

@IvorU
you need to include GMP_INT.BI found here viewtopic.php?f=7&t=25684
apart from that, perhaps change the functions unRank and nbr2Card to sub's as they don't return a value but modify the deck array
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: 52 card shuffle

Post by deltarho[1859] »

I still cannot get a successful compilation after taking srvaldez's advice.

Anyway, here is another way to do a 52 card shuffle using Fisher-Yates shuffle, aka Knuth shuffle.

However, we need to be careful in the choice of random number generator used.

52! is approximately equal to 2^225.6 so we must use a generator which can generate at least that many permutations. You may think that Mersenne Twister (MT), with a period of 2^19937-1, can do that easily. However, most MT implementations populate the state vector with a Linear congruential generator having a period of 2^32 bits. This means that we can only get up to 2^32 possible state vectors which are a minuscule amount compared with MT's potential. I have a generator which can generate 2^131086 permutations.

However, there is another way, which the WikiPedia link above fails to mention, and that is to use a cryptographic random number generator. These generators just grin at us when we mention the term period. I have such a generator but so does FreeBASIC with its generator #5.

I don't know about Linux but with Windows CryptGenRandom is used. This is designed to populate a buffer and not satisfy single requests when it becomes pitifully slow compared to PRNGs. However, on my machine, I see a 52 card deck get shuffled in about 10 milliseconds. That is a very long time for a modern PC but less than the blink of an eye for us mere mortals.

In the following code "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" is used to represent a deck of cards. FreeBASIC does not have a random range function but there is a BASIC solution, rnd_range, on the manual's Rnd page. For the Knuth Shuffle that is a 'Copy and Paste' from some of my own code. It is a general purpose shuffle providing the means to shuffle a sub-string from a main-string. I have left it as it is but, obviously, can be edited to be less versatile.

Having done a shuffle we need to convert the string's elements to a card. This is what the function GetCard does. GetCard will do a conversion, on my machine, in about 1½ micro-seconds.

That is it!

I have included an example usage in the following and use GetCard on the unshuffled deck just to make sure it does what it is supposed to do. Of course, we would not do that in practice.

Code plus example usage. (Revised 27/06/2018)

Code: Select all

Function KnuthShuffle( Byval sText As String ) As String  ' Specifically for a deck of 52 cards
Dim As Ulong i
  #define range(f,l) Int(Rnd*((l+1)-(f))+(f))
  For i = 0 To 50
    Swap sText[i], sText[( range( i, 51 ) )]
  Next
  Return sText
End Function

Function GetCard( Byval v As Ubyte ) As String
Dim As String Suit, sFaceValue
Dim As Ubyte ubFaceValue
  Select Case v
    Case 97 To 109
      Suit = "H"
      ubFaceValue = v - 96
    Case 110 To 122
      Suit = "C"
      ubFaceValue = v - 109
    Case 65 To 77
      Suit = "D"
      ubFaceValue = v - 64
    Case 78 To 90
      Suit = "S"
      ubFaceValue = v - 77
  End Select
  Select Case ubFaceValue
    Case 1
      sFaceValue = "A"
    Case 2 To 10
      sFaceValue = Trim(Str(ubFaceValue))
    Case 11
      sFaceValue = "J"
    Case 12
      sFaceValue = "Q"
    Case 13
      sFacevalue = "K"
  End Select
  Return sFaceValue + Suit
End Function

' *************
' Example usage

Dim As String sText
Dim As Ulong i, j

' Display unshuffled deck
sText = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
Print "Unshuffled deck" : Print
Print "abcdefghijklm"
Print "nopqrstuvwxyz"
Print "ABCDEFGHIJKLM"
Print "NOPQRSTUVWXYZ"
Print
For i = 0 To 3
  For j = 0 To 12
    Print GetCard(sText[i*13 + j]);" ";
  Next
  Print
Next
Print

Randomize , 5

' Display shuffled deck
sText = KnuthShuffle( sText )
Print "Shuffled deck" : Print
Print sText : Print
For i = 0 To 3
  For j = 0 To 12
    Print GetCard(sText[i*13 + j]);" ";
  Next
  Print
Next

' Pick a card, Any card 0 To 51
Dim As Ubyte v
v = Rnd*51
Print
Print "I will pick a card, any card 0 To 51"
Print "I picked ";Str(v);" => ";GetCard(sText[v])

Sleep
Last edited by deltarho[1859] on Jun 27, 2018 5:00, edited 1 time in total.
Imortis
Moderator
Posts: 1923
Joined: Jun 02, 2005 15:10
Location: USA
Contact:

Re: 52 card shuffle

Post by Imortis »

deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: 52 card shuffle

Post by deltarho[1859] »

@Imortis

I have never used dropbox - how do I get to look at Blackjack.bas?
Imortis
Moderator
Posts: 1923
Joined: Jun 02, 2005 15:10
Location: USA
Contact:

Re: 52 card shuffle

Post by Imortis »

deltarho[1859] wrote:@Imortis

I have never used dropbox - how do I get to look at Blackjack.bas?
Click on the file name, then go to the top right corner of the page and click the "..." menu. From there choose Download.
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: 52 card shuffle

Post by deltarho[1859] »

Thanks, Imortis.

I may be wrong but it looks like your code is falling fall of a random number generator's inability to provide us with all the possible permutations of shuffling a deck of 52 cards. FB's implementation of Mersenne Twister does not pass muster. See my ramblings above following "However, we need to be careful in the choice of random number generator used."

The remedy is very simple. Replace 'Randomize Timer' with 'Randomize , 5'. This will use FB's cryptographic generator and open the door to all possible permutations.
Imortis
Moderator
Posts: 1923
Joined: Jun 02, 2005 15:10
Location: USA
Contact:

Re: 52 card shuffle

Post by Imortis »

deltarho[1859] wrote:Thanks, Imortis.

I may be wrong but it looks like your code is falling fall of a random number generator's inability to provide us with all the possible permutations of shuffling a deck of 52 cards. FB's implementation of Mersenne Twister does not pass muster. See my ramblings above following "However, we need to be careful in the choice of random number generator used."

The remedy is very simple. Replace 'Randomize Timer' with 'Randomize , 5'. This will use FB's cryptographic generator and open the door to all possible permutations.
Interesting. Thanks for the info. I will update the code when I get a chance.
IvorU
Posts: 7
Joined: Apr 20, 2018 18:44

Re: 52 card shuffle

Post by IvorU »

Thanks for that srvaldez - just what I was seeking - my original submission has been modified.

Hi deltarho - it compiles all right on my Windows 10 setup - I hope you can get this version to execute successfully.
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: 52 card shuffle

Post by deltarho[1859] »

IvorU wrote:Hi deltarho - it compiles all right on my Windows 10 setup - I hope you can get this version to execute successfully.
Nope!

I got gmp_int.bi, from srvaldez's link, which has #Include Once "gmp.bi" within it. I have "gmp.bi" on my system but that, in turn, calls #inclib "gmp" which I don't have so went back to srvaldez's link and found libgmp.a.

Finally got it to compile.

A lot of folk on this forum will not do that. You need to spell out in no uncertain terms what it takes to compile code.

Anyway, your code now works and does what it says 'on the box'.

I do not want to be critical on your first post here especially since it is well written and very readable but I cannot help feeling that you are using a sledgehammer to crack a nut. I thought your code would take longer than mine but it is coming in at about 10 milliseconds, before printing - the same as mine.

So, yeah, well done. <smile>
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: 52 card shuffle

Post by dodicat »

I have this running now IvorU , with the gmp file (srvaldez)
I messed around with the Kooth shuffle, and inspired by Imortis, made a simple little pontoon game.

Code: Select all

Type image
    As Any Ptr i
    As String s
    As Long xval
    As Long yval
End Type

Dim As String deck(1 To 52)={"a"+Chr(3),"2"+Chr(3),"3"+Chr(3),"4"+Chr(3),"5"+Chr(3),"6"+Chr(3),"7"+Chr(3),"8"+Chr(3),"9"+Chr(3),"10"+Chr(3),"j"+Chr(3),"q"+Chr(3),"k"+Chr(3), _
"a"+Chr(4),"2"+Chr(4),"3"+Chr(4),"4"+Chr(4),"5"+Chr(4),"6"+Chr(4),"7"+Chr(4),"8"+Chr(4),"9"+Chr(4),"10"+Chr(4),"j"+Chr(4),"q"+Chr(4),"k"+Chr(4),_
"a"+Chr(5),"2"+Chr(5),"3"+Chr(5),"4"+Chr(5),"5"+Chr(5),"6"+Chr(5),"7"+Chr(5),"8"+Chr(5),"9"+Chr(5),"10"+Chr(5),"j"+Chr(5),"q"+Chr(5),"k"+Chr(5), _
"a"+Chr(6),"2"+Chr(6),"3"+Chr(6),"4"+Chr(6),"5"+Chr(6),"6"+Chr(6),"7"+Chr(6),"8"+Chr(6),"9"+Chr(6),"10"+Chr(6),"j"+Chr(6),"q"+Chr(6),"k"+Chr(6)}                         
Sub shuffle(a() As String)
    #define range(f,l) Int(Rnd*((l+1)-(f))+(f))
    For n As Integer = Lbound(a) To Ubound(a)-1
        Swap a(n), a(range(n,Ubound(a)))
    Next n
End Sub

Function Filter(Byref tim As Uinteger Pointer,_
    byval rad As Single,_
    byval destroy As Integer=1,_
    byval fade As Integer=0) As Uinteger Pointer
    #define map(a,b,_x_,c,d) ((d)-(c))*((_x_)-(a))/((b)-(a))+(c)
    If fade<0 Then fade=0:If fade>100 Then fade=100
    Type p2
        As Integer x,y
        As Uinteger col
    End Type
    #macro ppoint(_x,_y,colour)
    pixel=row+pitch*(_y)+(_x)*4
    (colour)=*pixel
    #endmacro
    #macro ppset(_x,_y,colour)
    pixel=row+pitch*(_y)+(_x)*4
    *pixel=(colour)
    #endmacro
    #macro average()
    ar=0:ag=0:ab=0:inc=0
    xmin=x:If xmin>rad Then xmin=rad
    xmax=rad:If x>=(_x-1-rad) Then xmax=_x-1-x
    ymin=y:If ymin>rad Then ymin=rad
    ymax=rad:If y>=(_y-1-rad) Then ymax=_y-1-y
    For y1 As Integer=-ymin To ymax
        For x1 As Integer=-xmin To xmax
            inc=inc+1 
            ar=ar+(NewPoints(x+x1,y+y1).col Shr 16 And 255)
            ag=ag+(NewPoints(x+x1,y+y1).col Shr 8 And 255)
            ab=ab+(NewPoints(x+x1,y+y1).col And 255)
        Next x1
    Next y1
    If fade=0 Then
        averagecolour=Rgb(ar/(inc),ag/(inc),ab/(inc))
    Else
        averagecolour=Rgb(fd*ar/(inc),fd*ag/(inc),fd*ab/(inc))
    End If
    #endmacro
    Dim As Single fd=map(0,100,fade,1,0)
    Dim As Integer _x,_y
    Imageinfo tim,_x,_y
    Dim  As Uinteger Pointer im=Imagecreate(_x,_y)
    Dim As Integer pitch
    Dim  As Any Pointer row
    Dim As Uinteger Pointer pixel
    Dim As Uinteger col
    Imageinfo tim,,,,pitch,row
    Dim As p2 NewPoints(_x-1,_y-1)
    For y As Integer=0 To (_y)-1
        For x As Integer=0 To (_x)-1
            ppoint(x,y,col)
            NewPoints(x,y)=Type<p2>(x,y,col)
        Next x
    Next y
    Dim As Uinteger averagecolour
    Dim As Integer ar,ag,ab
    Dim As Integer xmin,xmax,ymin,ymax,inc
    Imageinfo im,,,,pitch,row
    For y As Integer=0 To _y-1
        For x As Integer=0 To _x-1  
            average()
            ppset((NewPoints(x,y).x),(NewPoints(x,y).y),averagecolour) 
        Next x
    Next y
    If destroy Then Imagedestroy tim: tim = 0
    Function= im
End Function

Function resize(im As Any Ptr,Wdth As Single,Hght As Single,dx As Long=0,dy As Long=0) As Any Ptr
    #define putpixel(_x,_y,colour)    *Cptr(Ulong Ptr,rowS+ (_y)*pitchS+ (_x) Shl 2)  =(colour)
    #define _getpixel(_x,_y)           *Cptr(Ulong Ptr,row + (_y)*pitch + (_x) Shl 2)
    #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))\((b)-(a))+(c)
    Static As Integer pitch,pitchs
    Static As Any Ptr row,rowS
    Static As Ulong Ptr pixel,pixels
    Static As Integer ddx,ddy,resultx,resulty
    Imageinfo im,ddx,ddy,,pitch,row
    Dim As Any Ptr im2=Imagecreate(Wdth-dx,Hght-dy)
    Imageinfo im2,,,,pitchS,rowS
    For y As Long=0+dy To Hght-1 -dy
        resulty=map(0,Hght,y,0,ddy)
        For x As Long=0+dx To Wdth-1 -dx
            resultx=map(0,Wdth,x,0,ddx)
            putpixel(x,y,_getpixel(resultx,resulty))
        Next x
    Next y
    Return im2
End Function

Sub set(a() As String,i() As image)
    Dim As Ulong f
    For n As Long=Lbound(a) To Ubound(a)
        If Instr(a(n),Chr(3)) Or Instr(a(n),Chr(4)) Then f=Rgb(200,0,0) Else f=Rgb(0,0,0)
        If Len(a(n))=3 Then
            Draw String i(n).i,(0,0),Ucase(Left(a(n),2))+Right(a(n),1),f
        Else
            Draw String i(n).i,(5,0),Ucase(Left(a(n),1))+Right(a(n),1),f
        End If
        Line i(n).i,(0,0)-(24,15),Rgb(0,0,0),b
        i(n).i=resize(i(n).i,3*25,3*16) 
        i(n).i=filter(i(n).i,1)
    Next
End Sub

Sub createimages(i() As image,deck() As String)
    For n As Long=1 To 52
        i(n).i=Imagecreate(25,16,Rgb(255,255,255))
        i(n).s=deck(n)
    Next
End Sub

Sub destroyimages(i() As image)
    For n As Long=1 To 52
        Imagedestroy i(n).i
        i(n).i=0
    Next
End Sub

Sub setup(deck() As String,i() As image)
    shuffle(deck())
    createimages(i(),deck())
    set(deck(),i())
End Sub

Function incircle(cx As Long,cy As Long,radius As Long,x As Long,y As Long) As Long
    Return (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
End Function

Function score(i As image) As Long
    Dim As Long t
    Select Case Left(i.s,1)
    Case "a":t=11
    Case "j","q","k":t=10
    Case Else:t=Valint(i.s)
    End Select
    Return t
End Function

Function Regulate(Byval MyFps As Long,Byref fps As Long=0) As Long
    Static As Double timervalue,lastsleeptime,t3,frames
    frames+=1
    If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
    Var sleeptime=lastsleeptime+((1/myfps)-Timer+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    lastsleeptime=sleeptime
    timervalue=Timer
    Return sleeptime
End Function

Randomize Timer,5
Screenres 600,600,32
width 600\8,600\16
Color ,Rgb(255,255,255)

start:
Dim As Long mx,my,btn,flag,num=2,tally,stk,lck
Dim As Long scoreplayer,scorecomputer,counter,hit
Dim As String msg,done
Dim As image i(1 To 52)
setup(deck(),i())
done=""
msg="Hit"
counter=1
Do
    tally=0
    Screenlock
    Cls
    Getmouse mx,my,,btn
    Put(0,100),i(1).i,Pset
    scorecomputer=score(i(1))
    'game loop
    For n As Long=2 To num
        If stk=0 Then i(n).yval=300:tally+=score(i(n)):scoreplayer=tally 'plater draws cards
        
        If stk And n>lck Then   'stick has been clicked
            i(n).yval=100:tally+=score(i(n)):scorecomputer=tally+score(i(1))
            counter+=1
            If  scorecomputer<=scoreplayer And scorecomputer<21 And done="" Then
                'slight delay for computer draw
                If    counter Mod 50=0 Then
                    num+=1
                    i(num).xval=(num-2)*70
                End If
            Else 'game end point
                done="continue"  
                If scorecomputer> scoreplayer And scorecomputer<=21 Then
                     Draw String(250,550),string(20,chr(219)),Rgb(255,255,255)
                     Draw String(250,550),"COMPUTER WINS",Rgb(200,0,0)
                Else
                    Draw String(250,550),"PLAYER WINS",Rgb(200,0,0)
                End If
            End If
        End If
        'show all cards
        Put(i(n).xval-Iif(n>lck,stk,0),i(n).yval),i(n).i,Pset
    Next n
    
    Draw String(10,280),"Player Score = "&scoreplayer,Rgb(0,0,200)
    If stk Then Draw String(10,80),"Computer Score = "&scorecomputer,Rgb(0,0,200)
    
    If counter=1 Then 'player loop
        
        Circle(50,400),40,Rgb(100,0,0)
        Draw String(50-4*Len(msg),400-8),msg,Rgb(0,0,200)
        If incircle(50,400,40,mx,my) And btn=1 And flag=0 Then'hit
            flag=1
            num+=1
            hit=1
            i(num).xval=(num-2)*70
        End If
        
        If hit Then
            Circle(250,400),40,Rgb(100,0,0)
            Draw String(250-18,400-8),"stick",Rgb(0,0,200)
            If incircle(250,400,40,mx,my) And btn=1 And flag=0 Then'stick
                flag=1
                stk=(num-2)*70
                lck=num
                msg="Compute"
            End If
        End If
        
    Else   'new game choice 
        Circle(450,400),40,Rgb(100,0,0)
        Draw String(450-28,390),done,Rgb(0,0,200)
        If incircle(450-18,400,40,mx,my) And btn=1 And flag=0 Then
            destroyimages(i())
            Screenunlock
            Goto start
        End If
    End If' end player loop
     'Draw String(300,550),"PLAYER WINS",Rgb(200,0,0)
    If scoreplayer>21 Then
        Draw String(300,550),"BUST",Rgb(200,0,0)
        counter=2
        done="continue" 
    End If
    Screenunlock
    flag=btn
    Sleep regulate(50),1
Loop Until Inkey=Chr(27)
destroyimages(i())
Sleep 
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: 52 card shuffle

Post by deltarho[1859] »

@dodicat

Use 'Randomize , 5' otherwise the gaming board will be after you. <smile>

Added: Oops, apologies - you are doing with 'Randomize Timer,5'. I should have gone to Specsavers ( UK joke ). I need to get myself out of a hole. '5' is cryptographic so a seed is redundant - 'Randomize , 5' will do; although Timer may still get 'pulled in' but not actually used.
frisian
Posts: 249
Joined: Oct 08, 2009 17:25

Re: 52 card shuffle

Post by frisian »

@IvorU

The include file GMP_INT.bi, has a GMP_rnd and fac() function that can be used to create a random number
Fac(n) calculates the factorial of n.
GMP_rnd(n) return a integer number in the range from 0 to n-1.

A little program to show how it can be done.

Code: Select all

#Include"gmp_int.bi"

' without Randomize Timer the gmp_rnd function will produce the same sequence 
' just as the normal FB rnd function
Randomize Timer 

Dim As String temp
Dim As gmp_int fac52 = fac(52)

Print fac52
Print
For a As Integer = 1 To 15
	'the non-repeating period is 2^19937 -1
	Print gmp_rnd(fac52)
Next

Print
temp = gmp_rnd(fac(52))
Print temp, Len(temp)

Print
temp = gmp_rnd(fac52)
Print temp, Len(temp)

Sleep
End
A different way of using the GMP random function can be found here Rosetta Code Permutations/Rank of a permutation.

Some remarks about your program.
In FB the STR() function does not return strings with extra spaces, hence Trim is not needed.
suitNbr = INT(cardNbr / 13) ' 0-3 can be replace with suitNbr = cardNbr \ 13 ' 0-3 you use only integers in your program.
To print Heart and Diamond cards you use color 4, 15 (red on white), personally I prefer color 12, 15 (bright red on white).
IvorU
Posts: 7
Joined: Apr 20, 2018 18:44

Re: 52 card shuffle

Post by IvorU »

@frisian

Much obliged for your input - it has shone a searchlight on how to handle large values.
Your example is neat and tidy.
Any idea what is the maximum factorial GMP can output correctly?

I used to tinker around with Ubasic when I wanted to manipulate large numbers but GMP seems to be a much better solution.

Thanks again for pointing out my wayward programming issues.
Post Reply