program RANDCARD { DEMO of poor & good shuffle methods } ;

{ Different algorithms are often used for shuffling a pack of cards, etc.
  There is exactly ONE good way, which gives an equi-probable distribution
  in a minimum time. Other ways can be slow or wrong, but are usually both.
  This program does one simple uniformity test on two methods.
  See TSFAQP #140. }

uses {$IFDEF WINDOWS} WinCrt {$ELSE} Crt {$ENDIF} ;

procedure Info ;
begin Writeln('RANDCARD - www.merlyn.demon.co.uk >= 2000-01-13 ') ;
  Write(' Plot x for Poor method, + for Good method - enter <cr> ') ;
  Readln end {Info} ;

procedure Exchange(var X, Y : byte) { non-optimal? - see my WWW site } ;
var T : byte ;
begin T := X ; X := Y ; Y := T end {Exchange} ;

const Cards = {$IFDEF BIG} 20 {$ELSE} 10 {$ENDIF} ;
Mean = (Cards+1)/2.0 ; Factor = 60.0/Mean ;

type AST = 1..Cards ;
TPack = array [AST] of byte ;
SarrT = record
  Ar : array [AST] of longint ; Cnt : longint ;
  ID : string [10] ; Ch : char end ;
SProc = procedure (var A : TPack ; const C : byte) ;

{$F+}
procedure RandomCards(var A : TPack ; const C : byte) ;
var J : byte ;
begin for J := 1 to C do A[J] := Succ(Random(Cards)) ;
  end {RandomCards} ;

procedure PoorShuffle(var A : TPack ; const C : byte) ;
var J : byte ;
begin for J := 1 to C do Exchange(A[J], A[Succ(Random(Cards))]);
  end {PoorShuffle} ;

procedure GoodShuffle(var A : TPack ; const C : byte) ;
var J : byte ;
begin for J := C downto 2 do Exchange(A[J], A[Succ(Random(J))]);
  end {GoodShuffle} ;

procedure AllAreMoved(var A : TPack ; const C : byte) ;
var J : byte ;
begin for J := C downto 2 do Exchange(A[J], A[Succ(Random(Pred(J)))]);
  end {AllAreMoved} ;
{$F-}

procedure Show(var Sum : SarrT) ;
var K, N : byte ; R : Real ;
begin with Sum do begin ClrEol ; Writeln(ID) ;
    for N := 1 to Cards do begin R := Ar[N]/Cnt ; K := Round(Factor*R) ;
      ClrEol ; Write(N:2, R-Mean:7:3) ;
      if K<=70 then Write(Ch:K) ; Writeln end ;
    end end {Show} ;

procedure Perform
  (Name : string ; Shuffle : SProc ; var Sum : SarrT ; C : char) ;
var Pack : TPack ; J : byte ;
begin for J := 1 to Cards do Pack[J] := J ;
  Shuffle(Pack, Cards) ;
  with Sum do begin
    if Cnt=0 then begin ID := Name ; Ch := C end ;
    for J := 1 to Cards do Inc(Ar[J], Pack[J]) ;
    Inc(Cnt) end ;
  end {Perform} ;


var Sum1, Sum2 : SarrT ; Count : longint ;


BEGIN ;
{$IFDEF WINDOWS} AutoTracking := false ;
{$ELSE}
{$IFDEF BIG} TextMode(LastMode xor Font8X8) ; {$ENDIF}
{$ENDIF}
Info ; ClrScr ; Count := 0 ; Randomize ;
with Sum1 do FillChar(Ar, SizeOf(Ar)+SizeOf(Cnt), 0) ;
with Sum2 do FillChar(Ar, SizeOf(Ar)+SizeOf(Cnt), 0) ;

repeat (* Edit { } so that Sum1, Sum2 are each used once : *)

  Perform('Poor:', PoorShuffle, Sum1, 'x') ;
  Perform('Good:', GoodShuffle, Sum2, '+') ;
  { Perform('Move:', AllAreMoved, Sum2, '-') ; }
  { Perform('Rand:', RandomCards, Sum2, '|') ; }

  Inc(Count) ;
  if Count mod 80 = 0 then begin GoToXY(1, 1) ;
    Writeln('Box  Diff', Count:16, ' - press space to stop') ;
    Show(Sum1) ; Show(Sum2) ;
    end else begin GoToXY(75, 1) ; Write(char(112-(Count mod 80))) end ;

  until KeyPressed ;

while KeyPressed do if ReadKey=#0 then ;
GoToXY(1, 2*Cards+4) ; ClrEol ; Info ;
{$IFNDEF WINDOWS}
{$IFDEF BIG} TextMode(LastMode xor Font8X8) ; {$ENDIF}
{$ENDIF}


{ Note : Flatness of the result is a necessary but not a sufficent test
  for true uniformity and randomness of distribution.

  There are Cards! possible orders of Cards cards, and the GOOD method
  has precisely Cards! random possibilities, each giving a different order;
  it must therefore be both correct and optimum.  The Poor method has
  Cards^Cards possibilites, which is bigger than Cards! (so is not optimum)
  and not a multiple of Cards! (so is not equitable).

  See http://www.merlyn.demon.co.uk/pas-rand.htm

  In Windows, this program needs code to expand the window. }

END.