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