Deal cards for FreeCell

From Rosetta Code
Revision as of 01:55, 11 October 2011 by rosettacode>Kernigh (→‎{{header|Ruby}}: Fix a bug in Enumerable#each_slice for old Ruby. This method must not modify the Array after yielding it.)
Task
Deal cards for FreeCell
You are encouraged to solve this task according to the task description, using any language you may know.

Free Cell is the solitaire card game that Paul Alfille introduced to the PLATO system in 1978. Jim Horne, at Microsoft, changed the name to FreeCell and reimplemented the game for DOS, then Windows. This version introduced 32000 numbered deals. (The Freecell FAQ tells this history.)

As the game became popular, Jim Horne disclosed the algorithm, and other implementations of FreeCell began to reproduce the Microsoft deals. These deals are numbered from 1 to 32000. Newer versions from Microsoft have 1 million deals, numbered from 1 to 1000000; some implementations allow numbers outside that range.

The algorithm uses this linear congruential generator from Microsoft C:

  • is in range 0 to 32767.
  • Rosetta Code has another task, linear congruential generator, with code for this RNG in several languages.

The algorithm follows:

  1. Seed the RNG with the number of the deal.
  2. Create an array of 52 cards: Ace of Clubs, Ace of Diamonds, Ace of Hearts, Ace of Spades, 2 of Clubs, 2 of Diamonds, and so on through the ranks: Ace, 2, 3, 4, 5, 6, 7, 8, 9, 10, Jack, Queen, King. The array indexes are 0 to 51, with Ace of Clubs at 0, and King of Spades at 51.
  3. Until the array is empty:
    • Choose a random card at indexnext random number (mod array length).
    • Swap this random card with the last card of the array.
    • Remove this random card from the array. (Array length goes down by 1.)
    • Deal this random card.
  4. Deal all 52 cards, face up, across 8 columns. The first 8 cards go in 8 columns, the next 8 cards go on the first 8 cards, and so on.
Order to deal cards Game #1 Game #617
 1  2  3  4  5  6  7  8
 9 10 11 12 13 14 15 16
17 18 19 20 21 22 23 24
25 26 27 28 29 30 31 32
33 34 35 36 37 38 39 40
41 42 43 44 45 46 47 48
49 50 51 52
JD 2D 9H JC 5D 7H 7C 5H
KD KC 9S 5S AD QC KH 3H
2S KS 9D QD JS AS AH 3C
4C 5C TS QH 4H AC 4D 7S
3S TD 4S TH 8H 2C JH 7D
6D 8S 8D QS 6C 3D 8C TC
6S 9C 2H 6H
7D AD 5C 3S 5S 8C 2D AH
TD 7S QD AC 6D 8H AS KH
TH QC 3H 9D 6S 8D 3D TC
KD 5H 9S 3C 8S 7H 4D JS
4C QS 9C 9H 7C 6H 2C 2S
4S TS 2H 5D JC 6C JH QH
JD KS KC 4H

Deals can also be checked against FreeCell solutions to 1000000 games. (Summon a video solution, and it displays the initial deal.)

Write a program to take a deal number and deal cards in the same order as this algorithm. The program may display the cards with ASCII, with Unicode, by drawing graphics, or any other way.

C

<lang c>#include <stdio.h>

  1. include <stdlib.h>
  2. include <locale.h>

wchar_t s_suits[] = L"♣♦♥♠", s_nums[] = L"A23456789TJQK";

  1. define RMAX32 ((1U << 31) - 1)
  2. define RMAX ((1U << 15) - 1)

static int seed = 1; int rnd(void) { return (seed = (seed * 214013 + 2531011) & RMAX32) >> 16; } void srnd(int x) { seed = x; }

void show(int *c) { int i; for (i = 0; i < 52; c++) { printf(" \033[%dm%lc\033[m%lc", 32 - (1 + *c) % 4 / 2, s_suits[*c % 4], s_nums[*c / 4]); if (!(++i % 8) || i == 52) putchar('\n'); } }

void deal(int s, int *t) { int i, j; srnd(s);

for (i = 0; i < 52; i++) t[i] = 51 - i; for (i = 0; i < 51; i++) { j = 51 - rnd() % (52 - i); s = t[i], t[i] = t[j], t[j] = s; } }

int main(int c, char **v) { int s, card[52]; if (c < 2 || (s = atoi(v[1])) <= 0) s = 11982;

setlocale(LC_ALL, "");

deal(s, card); printf("Hand %d\n", s); show(card);

return 0; }</lang>

D

Translation of: C

<lang d>import std.stdio, std.conv, std.algorithm, std.range;

struct RandomGenerator {

   uint seed = 1;
   @property uint next() pure nothrow {
       seed = (seed * 214_013 + 2_531_011) & int.max;
       return seed >> 16;
   }

}

struct Deck {

   int[52] cards;
   void deal(in uint seed) /*pure nothrow*/ {
       enum int nc = cards.length; // Must be signed for iota.
       // DMD 2.055 iota isn't pure nothrow.
       copy(iota(nc - 1, -1, -1), cards[]);
       auto rnd = RandomGenerator(seed);
       foreach (i, ref c; cards)
           swap(c, cards[(nc - 1) - rnd.next % (nc - i)]);
   }
   void show() {
       foreach (row; std.range.chunks(cards[], 8)) {
           foreach (c; row)
               write(" ", "A23456789TJQK"[c / 4], "CDHS"[c % 4]);
           writeln();
       }
   }

}

void main(in string[] args) {

   immutable seed = (args.length == 2) ? to!uint(args[1]) : 11_982;
   writeln("Hand ", seed);
   Deck cards;
   cards.deal(seed);
   cards.show();

}</lang>

Hand 11982
 AH AS 4H AC 2D 6S TS JS
 3D 3H QS QC 8S 7H AD KS
 KD 6H 5S 4D 9H JH 9S 3C
 JC 5D 5C 8C 9D TD KH 7C
 6C 2C TH QH 6D TC 4S 7S
 JD 7D 8H 9C 2H QD 4C 5H
 KC 8D 2S 3S

Icon and Unicon

<lang Icon>procedure main(A) # freecelldealer

  freecelldealer(\A[1] | &null)      # seed from command line

end

procedure newDeck() #: return a new unshuffled deck

  every D := list(52) & i := 0 & r := !"A23456789TJQK" & s := !"CDHS" do 
     D[i +:= 1] := r || s   # initial deck AC AD ... KS
  return D

end

procedure freecelldealer(gamenum) #: deal a freecell hand

  /gamenum := 11982
  return showHand(freecellshuffle(newDeck(),gamenum))

end

procedure showHand(D) #: show a freecell hand

  write("Hand:\n")
  every writes("  ",(1 to 8) | "\n")
  every writes(" ",D[i := 1 to *D]) do 
     if i%8 = 0 then write()  
  write("\n")
  return D

end

procedure freecellshuffle(D,gamenum) #: freecell shuffle

  srand_freecell(gamenum)                        # seed random number generator
  D2 := []
  until *D = 0 do {                              # repeat until all dealt
     D[r := rand_freecell() % *D + 1] :=: D[*D]  # swap random & last cards
     put(D2,pull(D))                             # remove dealt card from list 
     }
  return D2 

end

procedure srand_freecell(x) #: seed random static seed

  return seed := \x | \seed | 0      # parm or seed or zero if none 

end

procedure rand_freecell() #: lcrng

  return ishift(srand_freecell((214013 * srand_freecell() + 2531011) % 2147483648),-16)

end</lang>

Sample output for game 1:

Hand:

  1  2  3  4  5  6  7  8
 JD 2D 9H JC 5D 7H 7C 5H
 KD KC 9S 5S AD QC KH 3H
 2S KS 9D QD JS AS AH 3C
 4C 5C TS QH 4H AC 4D 7S
 3S TD 4S TH 8H 2C JH 7D
 6D 8S 8D QS 6C 3D 8C TC
 6S 9C 2H 6H

J

Paraphrase of C:

<lang j>deck=: ,/ 'A23456789TJQK' ,"0/ 7 u: '♣♦♥♠'

srnd=: 3 :'SEED=:{.y,11982' srnd seed=: do bind 'SEED' rnd=: (2^16) <.@%~ (2^31) srnd@| 2531011 + 214013 * seed

pairs=: <@<@~.@(<: , (| rnd))@>:@i.@-@# NB. indices to swap, for shuffle swaps=: [: > C.&.>/@|.@; NB. implement the specified shuffle deal=: |.@(swaps pairs) bind deck

show=: (,"2)@:(_8 ]\ ' '&,.)</lang>

Example use:

<lang j> show deal srnd 1

J♦ 2♦ 9♥ J♣ 5♦ 7♥ 7♣ 5♥
K♦ K♣ 9♠ 5♠ A♦ Q♣ K♥ 3♥
2♠ K♠ 9♦ Q♦ J♠ A♠ A♥ 3♣
4♣ 5♣ T♠ Q♥ 4♥ A♣ 4♦ 7♠
3♠ T♦ 4♠ T♥ 8♥ 2♣ J♥ 7♦
6♦ 8♠ 8♦ Q♠ 6♣ 3♦ 8♣ T♣
6♠ 9♣ 2♥ 6♥
  show deal srnd 617
7♦ A♦ 5♣ 3♠ 5♠ 8♣ 2♦ A♥
T♦ 7♠ Q♦ A♣ 6♦ 8♥ A♠ K♥
T♥ Q♣ 3♥ 9♦ 6♠ 8♦ 3♦ T♣
K♦ 5♥ 9♠ 3♣ 8♠ 7♥ 4♦ J♠
4♣ Q♠ 9♣ 9♥ 7♣ 6♥ 2♣ 2♠
4♠ T♠ 2♥ 5♦ J♣ 6♣ J♥ Q♥
J♦ K♠ K♣ 4♥ </lang>

OCaml

Translation of: C

<lang ocaml>let srnd =

 let ( + ) = Int32.add
 and ( * ) = Int32.mul
 and ( & ) = Int32.logand
 and ( >> ) = Int32.shift_right
 and rmax32 = Int32.max_int in
 function x ->
   let seed = ref (Int32.of_int x) in
   function () ->
     seed := (!seed * 214013l + 2531011l) & rmax32;
     Int32.to_int (!seed >> 16)

let deal s =

 let rnd = srnd s in
 let t = Array.init 52 (fun i -> i) in
 let cards =
   Array.init 52 (fun j ->
     let n = 52 - j in
     let i = rnd() mod n in
     let this = t.(i) in
     t.(i) <- t.(pred n);
     this)
 in
 (cards)

let show cards =

 let suits = "CDHS"
 and nums = "A23456789TJQK" in
 Array.iteri (fun i card ->
   Printf.printf "%c%c%c"
     nums.[card / 4]
     suits.[card mod 4]
     (if (i mod 8) = 7 then '\n' else ' ')
 ) cards;
 print_newline()

let () =

 let s =
   try int_of_string Sys.argv.(1)
   with _ -> 11982
 in
 Printf.printf "Deal %d:\n" s;
 let cards = deal s in
 show cards</lang>

Execution:

$ ocaml freecell.ml 617
Deal 617:
7D AD 5C 3S 5S 8C 2D AH
TD 7S QD AC 6D 8H AS KH
TH QC 3H 9D 6S 8D 3D TC
KD 5H 9S 3C 8S 7H 4D JS
4C QS 9C 9H 7C 6H 2C 2S
4S TS 2H 5D JC 6C JH QH
JD KS KC 4H

Perl

<lang perl>use utf8; sub deal { my ($s, @a, @d) = shift; sub rnd { ($s = ($s * 214013 + 2531011) & 0x7fffffff) >> 16 }

print "Hand $s\n"; for my $b (split "", "A23456789TJQK") { push @d, map("$_$b", qw/♣ ♦ ♥ ♠/); }

for (reverse 0 .. 51) { my $r = rnd() % ($_ + 1); ($d[$r], $d[$_]) = ($d[$_], $d[$r]); } reverse @d }

  1. This may look confusing.

(my $s = "@{[deal(shift @ARGV // 11982)]}") =~ s/(.{1,24})(?: |$)/$1\n/g; print $s;</lang>

PicoLisp

Using the random generator from Linear congruential generator#PicoLisp: <lang PicoLisp>(setq *MsSeed 11982)

(de msRand ()

  (>> 16
     (setq *MsSeed
        (& (+ 2531011 (* 214013 *MsSeed)) `(dec (** 2 31))) ) ) )

(let L

  (make
     (for Num (range 13 1)
        (for Suit '((32 . "♠") (31 . "♥") (31 . "♦") (32 . "♣"))
           (link (cons (get '`(chop "A23456789TJQK") Num) Suit)) ) ) )
  (for I 51
     (xchg
        (nth L I)
        (nth L (- 52 (% (msRand) (- 53 I)))) ) )
  (for C L
     (prin "  ^[[" (cadr C) "m" (cddr C) "^[[m" (car C))
     (at (0 . 8) (prinl)) )
  (prinl) )</lang>

Python

Translation of: D

<lang python>from sys import argv

class RandomGenerator:

   def __init__(self, seed=1):
       max_uint32 = (1 << 32) - 1
       self.seed = seed & max_uint32
   def next(self):
       max_int32 = (1 << 31) - 1
       self.seed = (self.seed * 214013 + 2531011) & max_int32
       return self.seed >> 16

def deal(seed):

   nc = 52
   cards = range(nc - 1, -1, -1)
   rnd = RandomGenerator(seed)
   for i in xrange(nc):
       j = (nc - 1) - rnd.next() % (nc - i)
       cards[i], cards[j] = cards[j], cards[i]
   return cards

def show(cards):

   l = ["A23456789TJQK"[c / 4] + "CDHS"[c % 4] for c in cards]
   for i in xrange(0, len(cards), 8):
       print " ", " ".join(l[i : i+8])

if __name__ == '__main__':

   seed = int(argv[1]) if len(argv) == 2 else 11982
   print "Hand", seed
   deck = deal(seed)
   show(deck)</lang>

Output:

Hand 11982
  AH AS 4H AC 2D 6S TS JS
  3D 3H QS QC 8S 7H AD KS
  KD 6H 5S 4D 9H JH 9S 3C
  JC 5D 5C 8C 9D TD KH 7C
  6C 2C TH QH 6D TC 4S 7S
  JD 7D 8H 9C 2H QD 4C 5H
  KC 8D 2S 3S

Ruby

<lang ruby># Deal cards for FreeCell.

  1. http://rosettacode.org/wiki/Deal_cards_for_FreeCell

require 'optparse'

  1. Parse command-line arguments.
  2. games = ARGV converted to Integer
  3. No arguments? Pick any of first 32000 games.

games = nil OptionParser.new do |o|

 begin
   o.banner = "Usage: #{o.program_name} number..."
   o.parse!
   games = ARGV.map {|s| Integer(s)}
   games.empty? and games = [rand(32000)]
 rescue => e
   $stderr.puts e, o
   abort
 end

end

  1. Define methods for old Ruby versions.
  2. Enumerable#each_slice appeared in Ruby 1.8.7.
  3. Enumerable#flat_map appeared in Ruby 1.9.2.

module Enumerable

 unless method_defined? :each_slice
   def each_slice(count)
     block_given? or return enum_for(:each_slice, count)
     ary = []
     each {|e|
       ary << e
       ary.length == count and (yield ary.dup; ary.clear)}
     ary.empty? or yield ary.dup
     nil
   end
 end
 unless method_defined? :flat_map
   def flat_map
     block_given? or return enum_for(:flat_map)
     ary = []
     each {|e|
       y = yield e
       ary.concat(y) rescue ary.push(y)}
     ary
   end
 end

end

  1. Create original deck of 52 cards, not yet shuffled.

orig_deck = %w{A 2 3 4 5 6 7 8 9 T J Q K }.flat_map {|rank| %w{C D H S}.map {|suit| "#{rank}#{suit}"}}

games.each do |seed|

 deck = orig_deck.dup
 # Shuffle deck with random index from linear congruential
 # generator like Microsoft.
 state = seed
 52.downto(2) do |len|
   state = ((214013 * state) + 2531011) & 0x7fff_ffff
   index = (state >> 16) % len
   last = len - 1
   deck[index], deck[last] = deck[last], deck[index]
 end
 deck.reverse!  # Shuffle did reverse deck. Do reverse again.
 # Deal cards.
 puts "Game ##{seed}"
 deck.each_slice(8) {|row| puts " " + row.join(" ")}

end</lang>

$ ruby freecell.rb 11982 
Game #11982
 AH AS 4H AC 2D 6S TS JS
 3D 3H QS QC 8S 7H AD KS
 KD 6H 5S 4D 9H JH 9S 3C
 JC 5D 5C 8C 9D TD KH 7C
 6C 2C TH QH 6D TC 4S 7S
 JD 7D 8H 9C 2H QD 4C 5H
 KC 8D 2S 3S

Tcl

Translation of: C

<lang tcl>proc rnd Template:*r seed {

   upvar 1 ${*r} r
   expr {[set r [expr {($r * 214013 + 2531011) & 0x7fffffff}]] >> 16}

} proc show cards {

   set suits {\u2663 \u2666 \u2665 \u2660}
   set values {A 2 3 4 5 6 7 8 9 T J Q K}
   for {set i 0} {$i < 52} {incr i} {

set c [lindex $cards $i] puts -nonewline [format " \033\[%dm%s\033\[m%s" [expr {32-(1+$c)%4/2}] \ [lindex $suits [expr {$c % 4}]] [lindex $values [expr {$c / 4}]]] if {($i&7)==7 || $i==51} {puts ""}

   }

} proc deal {seed} {

   for {set i 0} {$i < 52} {incr i} {lappend cards [expr {51 - $i}]}
   for {set i 0} {$i < 51} {incr i} {

set j [expr {51 - [rnd]%(52-$i)}] set tmp [lindex $cards $i] lset cards $i [lindex $cards $j] lset cards $j $tmp

   }
   return $cards

}

if {![scan =[lindex $argv 0]= =%d= s] || $s <= 0} {

   set s 11982

} set cards [deal $s] puts "Hand $s" show $cards</lang>