/*REXX program displays a sphere with another sphere subtracted where it's superimposed.*/
call deathStar   2,   .5,   v3('-50  30  50')
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
dot:   #=0;  do j=1  for words(x);  #=# + word(x,j)*word(y,j);  end; return #
dot.:  procedure; parse arg x,y; d=dot(x,y); if d<0  then return -d; return 0
ceil:  procedure; parse arg x;   _=trunc(x);                         return _+(x>0)*(x\=_)
floor: procedure; parse arg x;   _=trunc(x);                         return _-(x<0)*(x\=_)
v3:    procedure; parse arg a b c;      #=sqrt(a**2 + b**2 + c**2);  return a/#  b/#  c/#
/*──────────────────────────────────────────────────────────────────────────────────────*/
sqrt:  procedure; parse arg x; if x=0  then return 0;  d=digits();  h= d+6; numeric digits
       m.=9; numeric form; parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_%2
         do j=0  while h>9;      m.j= h;              h= h % 2 + 1;    end /*j*/
         do k=j+5  to 0  by -1;  numeric digits m.k;  g= (g +x/g)* .5; end /*k*/; return g
/*──────────────────────────────────────────────────────────────────────────────────────*/
hitSphere: procedure expose !.; parse arg xx yy zz r,x0,y0;  z= r*r -(x0-xx)**2-(y0-yy)**2
           if z<0  then return 0;  _= sqrt(z);  !.z1= zz - _;    !.z2= zz + _;    return 1
/*──────────────────────────────────────────────────────────────────────────────────────*/
deathStar: procedure; parse arg k,ambient,sun    /* [↓]  display the deathstar to screen*/
parse var  sun   s1 s2 s3                        /*identify the light source coördinates*/
if 5=="f5"x  then shading= '.:!*oe&#%@'          /*dithering chars for an EBCDIC machine*/
             else shading= '·:!º[email protected]░▒▓'          /*    "       "    "   "  ASCII    "   */
shadingL= length(shading)                        /*the number of dithering characters.  */
shades.= ' ';            do i=1  for shadingL;    shades.i= substr(shading, i, 1)
                         end   /*i*/
ship=  20   20  0 20  ;           parse var  ship    shipX  shipY  shipZ  shipR
hole= ' 1    1 -6 20' ;           parse var  hole    holeX  holeY  holeZ  .

  do   i=floor(shipY-shipR  )  to ceil(shipY+shipR  )+1;    y= i +.5;   @= /*@   is a single line of the deathstar to be displayed.*/
    do j=floor(shipX-shipR*2)  to ceil(shipX+shipR*2)+1;    !.= 0
    x=.5 * (j-shipX+1) + shipX;       $bg= 0;    $pos= 0;    $neg= 0       /*$BG,  $POS,  and  $NEG  are boolean values.           */
    ?= hitSphere(ship, x, y);                    b1= !.z1;   b2= !.z2      /*?  is boolean,  "true"  indicates ray hits the sphere.*/
                                                                           /*$BG:  if 1, its background;  if zero, it's foreground.*/
    if \? then $bg= 1                                                      /*ray lands in blank space, so draw the background.     */
          else do; ?= hitSphere(hole, x, y);     s1= !.z1;   s2= !.z2
               if \? then $pos= 1                                          /*ray hits ship but not the hole, so draw ship surface. */
                     else if s1>b1 then $pos=1                             /*ray hits both, but ship front surface is closer.      */
                                   else if s2>b2 then $bg= 1               /*ship surface is inside hole,  so show the background. */
                                                 else if s2>b1 then $neg=1 /*hole back surface is inside ship;  the only place ··· */
                                                               else $pos=1 /*························ a hole surface will be shown.*/
               end
        select
        when $bg   then do;   @= @' ';    iterate j;     end               /*append a blank character to the line to be displayed. */
        when $pos  then vec_= v3(x-shipX  y-shipY  b1-shipZ)
        when $neg  then vec_= v3(holeX-x  holeY-y  holeZ-s2)
        end    /*select*/

    b=1 +min(shadingL, max(0, trunc((1 - (dot.(sun, v3(vec_))**k + ambient)) * shadingL)))
    @[email protected] || shades.b                                 /*B:  the ray's intensity│brightness*/
    end      /*j*/                                  /* [↑]  build a line for the sphere.*/

  if @\=''  then say strip(@, 'T')                  /*strip trailing blanks from line.  */
  end        /*i*/                                  /* [↑]  show all lines for sphere.  */
return


set ! 32
set ! 32
set ! 46
set ! 45
set ! 126
set ! 34
set ! 34
set ! 126
set ! 45
set ! 46
set ! 10
set ! 46
set ! 39
set ! 40
set ! 95
set ! 41
set ! 32
set ! 32
set ! 32
set ! 32
set ! 32
set ! 39
set ! 46
set ! 10
set ! 124
set ! 61
set ! 61
set ! 61
set ! 61
set ! 61
set ! 61
set ! 61
set ! 61
set ! 61
set ! 61
set ! 124
set ! 10
set ! 39
set ! 46
set ! 32
set ! 32
set ! 32
set ! 32
set ! 32
set ! 32
set ! 32
set ! 32
set ! 46
set ! 39
set ! 10
set ! 32
set ! 32
set ! 126
set ! 45
set ! 46
set ! 95
set ! 95
set ! 46
set ! 45
set ! 126


func hitf(sph, x, y) {
    x -= sph[0]
    y -= sph[1]

    var z = (sph[3]**2 - (x**2 + y**2))

    z < 0 && return nil

    z.sqrt!
    [sph[2] - z, sph[2] + z]
}

func normalize(v) {
    v / v.abs
}

func dot(x, y) {
    max(0, x*y)
}

var pos = [120, 120, 0, 120]
var neg = [-77, -33, -100, 190]
var light = normalize(Vector(-12, 13, -10))

func draw(k, amb) {
    STDOUT.binmode(':raw')
    print ("P5\n", pos[0]*2 + 3, " ", pos[1]*2 + 3, "\n255\n")

    for y in ((pos[1] - pos[3] - 1) .. (pos[1] + pos[3] + 1)) {
        var row = []
        for x in ((pos[0] - pos[3] - 1) .. (pos[0] + pos[3] + 1)) {

            var hit = 0
            var hs = []
            var h = hitf(pos, x, y)

            if    (!h)                      { hit = 0; h  = [0, 0] }
            elsif (!(hs = hitf(neg, x, y))) { hit = 1; hs = [0, 0] }
            elsif (hs[0] > h[0])            { hit = 1 }
            elsif (hs[1] > h[0])            { hit = (hs[1] > h[1] ? 0 : 2) }
            else                            { hit = 1 }

            var (val, v)

            given(hit) {
                when (0) { val = 0}
                when (1) { v = Vector(x-pos[0], y-pos[1], h[0]-pos[2]) }
                default  { v = Vector(neg[0]-x, neg[1]-y, neg[2]-hs[1]) }
            }

            if (defined(v)) {
                v = normalize(v)
                val = int((dot(v, light)**k + amb) * 255)
                val = (val > 255 ? 255 : (val < 0 ? 0 : val))
            }
            row.append(val)
        }
        print 'C*'.pack(row...)
    }
}

draw(2, 0.2)


package require Tcl 8.5

proc normalize vec {
    upvar 1 $vec v
    lassign $v x y z
    set len [expr {sqrt($x**2 + $y**2 + $z**2)}]
    set v [list [expr {$x/$len}] [expr {$y/$len}] [expr {$z/$len}]]
    return
}

proc dot {a b} {
    lassign $a ax ay az
    lassign $b bx by bz
    return [expr {-($ax*$bx + $ay*$by + $az*$bz)}]
}

# Intersection code; assumes that the vector is parallel to the Z-axis
proc hitSphere {sphere x y z1 z2} {
    dict with sphere {
	set x [expr {$x - $cx}]
	set y [expr {$y - $cy}]
	set zsq [expr {$r**2 - $x**2 - $y**2}]
	if {$zsq < 0} {return 0}
	upvar 1 $z1 _1 $z2 _2
	set zsq [expr {sqrt($zsq)}]
	set _1 [expr {$cz - $zsq}]
	set _2 [expr {$cz + $zsq}]
	return 1
    }
}

# How to do the intersection with our scene
proc intersectDeathStar {x y vecName} {
    global big small
    if {![hitSphere $big $x $y zb1 zb2]} {
	# ray lands in blank space
	return 0
    }
    upvar 1 $vecName vec
    # ray hits big sphere; check if it hit the small one first
    set vec [if {
	![hitSphere $small $x $y zs1 zs2] || $zs1 > $zb1 || $zs2 <= $zb1
    } then {
	dict with big {
	    list [expr {$x - $cx}] [expr {$y - $cy}] [expr {$zb1 - $cz}]
	}
    } else {
	dict with small {
	    list [expr {$cx - $x}] [expr {$cy - $y}] [expr {$cz - $zs2}]
	}
    }]
    normalize vec
    return 1
}

# Intensity calculators for different lighting components
proc diffuse {k intensity L N} {
    expr {[dot $L $N] ** $k * $intensity}
}
proc specular {k intensity L N S} {
    # Calculate reflection vector
    set r [expr {2 * [dot $L $N]}]
    foreach l $L n $N {lappend R [expr {$l-$r*$n}]}
    normalize R
    # Calculate the specular reflection term
    return [expr {[dot $R $S] ** $k * $intensity}]
}

# Simple raytracing engine that uses parallel rays
proc raytraceEngine {diffparms specparms ambient intersector shades renderer fx tx sx fy ty sy} {
    global light
    for {set y $fy} {$y <= $ty} {set y [expr {$y + $sy}]} {
	set line {}
	for {set x $fx} {$x <= $tx} {set x [expr {$x + $sx}]} {
	    if {![$intersector $x $y vec]} {
		# ray lands in blank space
		set intensity end
	    } else {
		# ray hits something; we've got the normalized vector
		set b [expr {
		    [diffuse {*}$diffparms $light $vec]
		    + [specular {*}$specparms $light $vec {0 0 -1}]
		    + $ambient
		}]
		set intensity [expr {int((1-$b) * ([llength $shades]-1))}]
		if {$intensity < 0} {
		    set intensity 0
		} elseif {$intensity >= [llength $shades]-1} {
		    set intensity end-1
		}
	    }
	    lappend line [lindex $shades $intensity]
	}
	{*}$renderer $line
    }
}

# The general scene settings
set light {-50 30 50}
set big   {cx 20 cy 20 cz 0   r 20}
set small {cx 7  cy 7  cz -10 r 15}
normalize light

# Render as text
proc textDeathStar {diff spec lightBrightness ambient} {
    global big
    dict with big {
	raytraceEngine [list $diff $lightBrightness] \
	    [list $spec $lightBrightness] $ambient intersectDeathStar \
	    [split ".:!*oe&#%@ " {}] {apply {l {puts [join $l ""]}}} \
	    [expr {$cx+floor(-$r)}] [expr {$cx+ceil($r)+0.5}] 0.5 \
	    [expr {$cy+floor(-$r)+0.5}] [expr {$cy+ceil($r)+0.5}] 1
    }
}
textDeathStar 3 10 0.7 0.3


import "dome" for Window
import "graphics" for Canvas, Color, ImageData
import "math" for Vector

var Normalize = Fn.new{ |vec|
    var invLen = 1 / vec.dot(vec).sqrt
    vec.x = vec.x * invLen
    vec.y = vec.y * invLen
    vec.z = vec.z * invLen
}

class Sphere {
    construct new(cx, cy, cz, r) {
        _cx = cx
        _cy = cy
        _cz = cz
        _r  = r
    }

    cx { _cx }
    cy { _cy }
    cz { _cz }
    r  { _r  }

    hit(x, y) {
        x = x - _cx
        y = y - _cy
        var zsq = _r*_r - x*x - y*y
        if (zsq >= 0) {
            var zsqrt = zsq.sqrt
            return [_cz - zsqrt, _cz + zsqrt, true]
        }
        return [0, 0, false]
    }
}

class DeathStar {
    construct new(width, height) {
        Window.title = "Death star"
        Window.resize(width, height)
        Canvas.resize(width, height)
    }

    init() {
        Canvas.cls(Color.white)
        var dir = Vector.new(20, -40, 10)
        Normalize.call(dir)
        var pos = Sphere.new(220, 190, 220, 120)
        var neg = Sphere.new(130, 100, 190, 100)
        deathStar(pos, neg, 1.5, 0.2, dir)
    }

    deathStar(pos, neg, k, amb, dir) {
        var w = pos.r * 4
        var h = pos.r * 3
        var img = ImageData.create("deathStar", w, h)
        var vec = Vector.new(0, 0, 0)
        for (y in pos.cy - pos.r..pos.cy + pos.r) {
            for (x in pos.cx - pos.r..pos.cx + pos.r) {
                var res = pos.hit(x, y)
                var zb1 = res[0]
                var zb2 = res[1]
                var hit = res[2]
                if (!hit) continue
                res = neg.hit(x, y)
                var zs1 = res[0]
                var zs2 = res[1]
                hit = res[2]
                if (hit) {
                    if (zs1 > zb1) {
                        hit = false
                    } else if (zs2 > zb2) {
                        continue
                    }
                }
                if (hit) {
                    vec.x = neg.cx - x
                    vec.y = neg.cy - y
                    vec.z = neg.cz - zs2
                } else {
                    vec.x = x - pos.cx
                    vec.y = y - pos.cy
                    vec.z = zb1 - pos.cz
                }
                Normalize.call(vec)
                var s = dir.dot(vec)
                if (s < 0) s = 0
                var lum = 255 * (s.pow(k) + amb) / (1 + amb)
                lum = lum.clamp(0, 255)
                img.pset(x, y, Color.rgb(lum, lum, lum))
            }
        }
        img.draw(pos.cx - w/2, pos.cy - h/2)
        img.saveToFile("deathStar.png")
    }

    update() {
    }

    draw(alpha) {
    }
}

var Game = DeathStar.new(400, 400)


open window 100,100
window origin "cc"
backcolor 0,0,0
clear window

tonos = 100
interv = int(255 / tonos)
dim shades(tonos)

shades(1) = 255
for i = 2 to tonos
	shades(i) = shades(i-1) - interv
next i

dim light(3)

light(0) = 30
light(1) = 30
light(2) = -50

sub normalize(v())
    local long

    long = sqrt(v(0)*v(0) + v(1)*v(1) + v(2)*v(2))
    v(0) = v(0) / long
    v(1) = v(1) / long
    v(2) = v(2) / long
end sub

sub punto(x(), y())
    local d

    d = x(0)*y(0) + x(1)*y(1) + x(2)*y(2)
    if d < 0 then
    	return -d
    else
    	return 0
    end if
end sub

//* positive shpere and negative sphere */
dim pos(3)
dim neg(3)

// x, y, z, r

pos(0) = 10
pos(1) = 10
pos(2) = 0
pos(3) = 20

neg(0) = 0
neg(1) = 0
neg(2) = -5
neg(3) = 15

sub hit_sphere(sph(), x, y)
	local zsq

	x = x - sph(0)
	y = y - sph(1)
	zsq = sph(3) * sph(3) - (x * x + y * y)
	if (zsq < 0) then
		return 0
	else
		return sqrt(zsq)
	end if
end sub

sub draw_sphere(k, ambient)
    local i, j, intensity, hit_result, result, b, vec(3), x, y, zb1, zb2, zs1, zs2, ini1, fin1, ini2, fin2

    ini1 = int(pos(1) - pos(3))
    fin1 = int(pos(1) + pos(3) + .5)
    for i = ini1 to fin1
        y = i + .5
        ini2 = int(pos(0) - 2 * pos(3))
        fin2 = int(pos(0) + 2 * pos(3) + .5)
        for j = ini2 to fin2
            x = (j - pos(0)) / 2 + .5 + pos(0)

            // ray lands in blank space, draw bg
            result = hit_sphere(pos(), x, y)

            if not result then
		hit_result = 0

		//* ray hits pos sphere but not neg, draw pos sphere surface */
	    else
		zb1 = pos(2) - result
		zb2 = pos(2) + result
		result = hit_sphere(neg(), x, y)
		if not result then
		    hit_result = 1
		else
		    zs1 = neg(2) - result
		    zs2 = neg(2) + result
		    if (zs1 > zb1) then
			hit_result = 1
		    elseif (zs2 > zb2) then
			hit_result = 0
		    elseif (zs2 > zb1) then
			hit_result = 2
		    else
			hit_result = 1
		    end if
		end if
	    end if

  	    if not hit_result then
  	        color 0,0,0
  	        dot x, y
  	    else
	        switch(hit_result)
	        case 1:
		    vec(0) = x - pos(0)
		    vec(1) = y - pos(1)
		    vec(2) = zb1 - pos(2)
		    break
	        default:
		    vec(0) = neg(0) - x
		    vec(1) = neg(1) - y
		    vec(2) = neg(2) - zs2
	        end switch

                normalize(vec())
                b = (punto(light(), vec())^k) + ambient
                intensity = (1 - b) * tonos
                if (intensity < 1) intensity = 1
                if (intensity > tonos) intensity = tonos
                color shades(intensity),shades(intensity),shades(intensity)
                dot x,y
            end if
        next j
    next i
end sub

ang = 0

while(true)
	//clear window
	light(1) = cos(ang * 2)
	light(2) = cos(ang)
	light(0) = sin(ang)
	normalize(light())
	ang = ang + .05

	draw_sphere(2, .3)
wend


with Ada.Text_IO; use Ada.Text_IO;

procedure Main is
   package real_io is new Float_IO (Long_Float);
   use real_io;

   type Vector is array (Natural range <>) of Long_Float;

   function deconv (g, f : Vector) return Vector is
      len : Positive :=
        Integer'Max ((g'Length - f'length), (f'length - g'length));
      h     : Vector (0 .. len);
      Lower : Natural := 0;
   begin
      for n in h'range loop
         h (n) := g (n);
         if n >= f'length then
            Lower := n - f'length + 1;
         end if;
         for i in Lower .. n - 1 loop
            h (n) := h (n) - (h (i) * f (n - i));
         end loop;
         h (n) := h (n) / f (0);
      end loop;
      return h;
   end deconv;

   procedure print (v : Vector) is
   begin
      Put ("(");
      for I in v'range loop
         Put (Item => v (I), Fore => 1, Aft => 1, Exp => 0);
         if I < v'Last then
            Put (" ");
         else
            Put_Line (")");
         end if;
      end loop;
   end print;

   h : Vector := (-8.0, -9.0, -3.0, -1.0, -6.0, 7.0);
   f : Vector :=
     (-3.0, -6.0, -1.0, 8.0, -6.0, 3.0, -1.0, -9.0, -9.0, 3.0, -2.0, 5.0, 2.0,
      -2.0, -7.0, -1.0);
   g : Vector :=
     (24.0, 75.0, 71.0, -34.0, 3.0, 22.0, -45.0, 23.0, 245.0, 25.0, 52.0, 25.0,
      -67.0, -96.0, 96.0, 31.0, 55.0, 36.0, 29.0, -43.0, -7.0);
begin
   print (h);
   print (deconv (g, f));
   print (f);
   print (deconv (g, h));
end Main;


#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <complex.h>

double PI;
typedef double complex cplx;

void _fft(cplx buf[], cplx out[], int n, int step)
{
	if (step < n) {
		_fft(out, buf, n, step * 2);
		_fft(out + step, buf + step, n, step * 2);

		for (int i = 0; i < n; i += 2 * step) {
			cplx t = cexp(-I * PI * i / n) * out[i + step];
			buf[i / 2]     = out[i] + t;
			buf[(i + n)/2] = out[i] - t;
		}
	}
}

void fft(cplx buf[], int n)
{
	cplx out[n];
	for (int i = 0; i < n; i++) out[i] = buf[i];
	_fft(buf, out, n, 1);
}

/* pad array length to power of two */
cplx *pad_two(double g[], int len, int *ns)
{
	int n = 1;
	if (*ns) n = *ns;
	else while (n < len) n *= 2;

	cplx *buf = calloc(sizeof(cplx), n);
	for (int i = 0; i < len; i++) buf[i] = g[i];
	*ns = n;
	return buf;
}

void deconv(double g[], int lg, double f[], int lf, double out[]) {
	int ns = 0;
	cplx *g2 = pad_two(g, lg, &ns);
	cplx *f2 = pad_two(f, lf, &ns);

	fft(g2, ns);
	fft(f2, ns);

	cplx h[ns];
	for (int i = 0; i < ns; i++) h[i] = g2[i] / f2[i];
	fft(h, ns);

	for (int i = 0; i >= lf - lg; i--)
		out[-i] = h[(i + ns) % ns]/32;
	free(g2);
	free(f2);
}

int main()
{
	PI = atan2(1,1) * 4;
	double g[] = {24,75,71,-34,3,22,-45,23,245,25,52,25,-67,-96,96,31,55,36,29,-43,-7};
	double f[] = { -3,-6,-1,8,-6,3,-1,-9,-9,3,-2,5,2,-2,-7,-1 };
	double h[] = { -8,-9,-3,-1,-6,7 };

	int lg = sizeof(g)/sizeof(double);
	int lf = sizeof(f)/sizeof(double);
	int lh = sizeof(h)/sizeof(double);

	double h2[lh];
	double f2[lf];

	printf("f[] data is : ");
	for (int i = 0; i < lf; i++) printf(" %g", f[i]);
	printf("\n");

	printf("deconv(g, h): ");
	deconv(g, lg, h, lh, f2);
	for (int i = 0; i < lf; i++) printf(" %g", f2[i]);
	printf("\n");

	printf("h[] data is : ");
	for (int i = 0; i < lh; i++) printf(" %g", h[i]);
	printf("\n");

	printf("deconv(g, f): ");
	deconv(g, lg, f, lf, h2);
	for (int i = 0; i < lh; i++) printf(" %g", h2[i]);
	printf("\n");
}


;; Assemble the mxn matrix A from the 2D row vector x.
(defun make-conv-matrix (x m n)
  (let ((lx (cadr (array-dimensions x)))
        (A  (make-array `(,m ,n) :initial-element 0)))

    (loop for j from 0 to (- n 1) do
         (loop for i from 0 to (- m 1) do
              (setf (aref A i j)
                    (cond ((or (< i j) (>= i (+ j lx)))
                           0)
                          ((and (>= i j) (< i (+ j lx)))
                           (aref x 0 (- i j)))))))
    A))

;; Solve the overdetermined system A(f)*h=g by linear least squares.
(defun deconv (g f)
  (let* ((lg (cadr (array-dimensions g)))
         (lf (cadr (array-dimensions f)))
         (lh (+ (- lg lf) 1))
         (A  (make-conv-matrix f lg lh)))

    (lsqr A (mtp g))))


T[] deconv(T)(in T[] g, in T[] f) pure nothrow {
    int flen = f.length;
    int glen = g.length;
    auto result = new T[glen - flen + 1];
    foreach (int n, ref e; result) {
        e = g[n];
        immutable lowerBound = (n >= flen) ? n - flen + 1 : 0;
        foreach (i; lowerBound .. n)
                e -= result[i] * f[n - i];
        e /= f[0];
    }
    return result;
}

void main() {
    import std.stdio;
    immutable h = [-8,-9,-3,-1,-6,7];
    immutable f = [-3,-6,-1,8,-6,3,-1,-9,-9,3,-2,5,2,-2,-7,-1];
    immutable g = [24,75,71,-34,3,22,-45,23,245,25,52,25,-67,
                   -96,96,31,55,36,29,-43,-7];
    writeln(deconv(g, f) == h, " ", deconv(g, f));
    writeln(deconv(g, h) == f, " ", deconv(g, h));
}


! Build
! Windows: ifort /I "%IFORT_COMPILER11%\mkl\include\ia32" deconv1d.f90 "%IFORT_COMPILER11%\mkl\ia32\lib\*.lib"
! Linux:

program deconv
  ! Use gelsd from LAPACK95.
  use mkl95_lapack, only : gelsd

  implicit none
  real(8), allocatable :: g(:), href(:), A(:,:), f(:)
  real(8), pointer     :: h(:), r(:)
  integer              :: N
  character(len=16)    :: cbuff
  integer              :: i
  intrinsic            :: nint

  ! Allocate data arrays
  allocate(g(21),f(16))
  g = [24,75,71,-34,3,22,-45,23,245,25,52,25,-67,-96,96,31,55,36,29,-43,-7]
  f = [-3,-6,-1,8,-6,3,-1,-9,-9,3,-2,5,2,-2,-7,-1]

  ! Calculate deconvolution
  h => deco(f, g)

  ! Check result against reference
  N = size(h)
  allocate(href(N))
  href = [-8,-9,-3,-1,-6,7]
  cbuff = ' '
  write(cbuff,'(a,i0,a)') '(a,',N,'(i0,a),i0)'
  if (any(abs(h-href) > 1.0d-4)) then
     write(*,'(a)') 'deconv(f, g) - FAILED'
  else
     write(*,cbuff) 'deconv(f, g) = ',(nint(h(i)),', ',i=1,N-1),nint(h(N))
  end if

  ! Calculate deconvolution
  r => deco(h, g)

  cbuff = ' '
  N = size(r)
  write(cbuff,'(a,i0,a)') '(a,',N,'(i0,a),i0)'
  if (any(abs(r-f) > 1.0d-4)) then
     write(*,'(a)') 'deconv(h, g) - FAILED'
  else
     write(*,cbuff) 'deconv(h, g) = ',(nint(r(i)),', ',i=1,N-1),nint(r(N))
  end if

contains
  function deco(p, q)
    real(8), pointer    :: deco(:)
    real(8), intent(in) :: p(:), q(:)

    real(8), allocatable, target :: r(:)
    real(8), allocatable         :: A(:,:)
    integer :: N

    ! Construct derived arrays
    N = size(q) - size(p) + 1
    allocate(A(size(q),N),r(size(q)))
    A = 0.0d0
    do i=1,N
       A(i:i+size(p)-1,i) = p
    end do

    ! Invoke the LAPACK routine to do the work
    r = q
    call gelsd(A, r)

    deco => r(1:N)
  end function deco

end program deconv


Ai=: ([email protected]]  =/ [email protected][ -/ [email protected]>:@-)&#
divide=: [ +/ .*~ [:%.&.x: ] +/ .* Ai


import java.util.Arrays;

public class Deconvolution1D {
    public static int[] deconv(int[] g, int[] f) {
        int[] h = new int[g.length - f.length + 1];
        for (int n = 0; n < h.length; n++) {
            h[n] = g[n];
            int lower = Math.max(n - f.length + 1, 0);
            for (int i = lower; i < n; i++)
                h[n] -= h[i] * f[n - i];
            h[n] /= f[0];
        }
        return h;
    }

    public static void main(String[] args) {
        int[] h = { -8, -9, -3, -1, -6, 7 };
        int[] f = { -3, -6, -1, 8, -6, 3, -1, -9, -9, 3, -2, 5, 2, -2, -7, -1 };
        int[] g = { 24, 75, 71, -34, 3, 22, -45, 23, 245, 25, 52, 25, -67, -96,
                96, 31, 55, 36, 29, -43, -7 };

        StringBuilder sb = new StringBuilder();
        sb.append("h = " + Arrays.toString(h) + "\n");
        sb.append("deconv(g, f) = " + Arrays.toString(deconv(g, f)) + "\n");
        sb.append("f = " + Arrays.toString(f) + "\n");
        sb.append("deconv(g, h) = " + Arrays.toString(deconv(g, h)) + "\n");
        System.out.println(sb.toString());
    }
}


function deconvolve(f, g)
   local h = setmetatable({}, {__index = function(self, n)
      if n == 1 then self[1] = g[1] / f[1]
      else
         self[n] = g[n]
         for i = 1, n - 1 do
            self[n] = self[n] - self[i] * (f[n - i + 1] or 0)
         end
         self[n] = self[n] / f[1]
      end
      return self[n]
   end})
   local _ = h[#g - #f + 1]
   return setmetatable(h, nil)
end


deconv[f_List, g_List] :=
 Module[{A =
    SparseArray[
     Table[Band[{n, 1}] -> f[[n]], {n, 1, Length[f]}], {Length[g], Length[f] - 1}]},
  Take[LinearSolve[A, g], Length[g] - Length[f] + 1]]


use Math::Cartesian::Product;

sub deconvolve {
    our @g; local *g = shift;
    our @f; local *f = shift;
    my(@m,@d);

    my $h = 1 + @g - @f;
    push @m, [(0) x $h, $g[$_]] for 0..$#g;
    for my $j (0..$h-1) {
        for my $k (0..$#f) {
            $m[$j + $k][$j] = $f[$k]
        }
    }
    rref(\@m);
    push @d, @{ $m[$_] }[$h] for 0..$h-1;
    @d;
}

sub convolve {
    our @f; local *f = shift;
    our @h; local *h = shift;
    my @i;
    for my $x (cartesian {@_} [0..$#f], [0..$#h]) {
        push @i, @$x[0]+@$x[1];
    }
    my $cnt = 0;
    my @g = (0) x (@f + @h - 1);
    for my $x (cartesian {@_} [@f], [@h]) {
        $g[$i[$cnt++]] += @$x[0]*@$x[1];
    }
    @g;
}

sub rref {
  our @m; local *m = shift;
  @m or return;
  my ($lead, $rows, $cols) = (0, scalar(@m), scalar(@{$m[0]}));

  foreach my $r (0 .. $rows - 1) {
     $lead < $cols or return;
      my $i = $r;

      until ($m[$i][$lead])
         {++$i == $rows or next;
          $i = $r;
          ++$lead == $cols and return;}

      @m[$i, $r] = @m[$r, $i];
      my $lv = $m[$r][$lead];
      $_ /= $lv foreach @{ $m[$r] };

      my @mr = @{ $m[$r] };
      foreach my $i (0 .. $rows - 1)
         {$i == $r and next;
          ($lv, my $n) = ($m[$i][$lead], -1);
          $_ -= $lv * $mr[++$n] foreach @{ $m[$i] };}

      ++$lead;}
}

my @h = qw<-8 -9 -3 -1 -6 7>;
my @f = qw<-3 -6 -1 8 -6 3 -1 -9 -9 3 -2 5 2 -2 -7 -1>;
print '  conv(f,h) = g = ' . join(' ', my @g = convolve(\@f, \@h)) . "\n";
print 'deconv(g,f) = h = ' . join(' ', deconvolve(\@g, \@f)) . "\n";
print 'deconv(g,h) = f = ' . join(' ', deconvolve(\@g, \@h)) . "\n";


with javascript_semantics
function deconv(sequence g, f)
    integer lf = length(f), lg = length(g), lh = lg-lf+1
    sequence h = repeat(0,lh)
    for n=1 to lh do
        atom e = g[n]
        for i=max(n-lf,0) to n-2 do
            e -= h[i+1] * f[n-i]
        end for
        h[n] = e/f[1]
    end for
    return h
end function

function conv(sequence f, h)
    integer lf = length(f), lh = length(h), lg = lf+lh-1
    sequence g = repeat(0,lg)
    for i=1 to lh do
        for j=1 to lf do
            integer k = i+j-1
            g[k] += f[j] * h[i]
        end for
    end for
    return g
end function

constant h = {-8,-9,-3,-1,-6,7},
    f = {-3,-6,-1,8,-6,3,-1,-9,-9,3,-2,5,2,-2,-7,-1},
g = {24,75,71,-34,3,22,-45,23,245,25,52,25,-67,-96,96,31,55,36,29,-43,-7}

procedure test(string desc, eq, sequence r, e)
    printf(1,"%s (%ssame as %s): %V\n",{desc,iff(r==e?"":"**NOT** "),eq,r})
end procedure

test("  conv(h,f)","g",  conv(h,f),g)
test("deconv(g,f)","h",deconv(g,f),h)
test("deconv(g,h)","f",deconv(g,h),f)


(load "@lib/math.l")

(de deconv (G F)
   (let A (pop 'F)
      (make
         (for (N . H) (head (- (length F)) G)
            (for (I . M) (made)
               (dec 'H
                  (*/ M (get F (- N I)) 1.0) ) )
            (link (*/ H 1.0 A)) ) ) ) )


def ToReducedRowEchelonForm( M ):
    if not M: return
    lead = 0
    rowCount = len(M)
    columnCount = len(M[0])
    for r in range(rowCount):
        if lead >= columnCount:
            return
        i = r
        while M[i][lead] == 0:
            i += 1
            if i == rowCount:
                i = r
                lead += 1
                if columnCount == lead:
                    return
        M[i],M[r] = M[r],M[i]
        lv = M[r][lead]
        M[r] = [ mrx / lv for mrx in M[r]]
        for i in range(rowCount):
            if i != r:
                lv = M[i][lead]
                M[i] = [ iv - lv*rv for rv,iv in zip(M[r],M[i])]
        lead += 1
    return M

def pmtx(mtx):
    print ('\n'.join(''.join(' %4s' % col for col in row) for row in mtx))

def convolve(f, h):
    g = [0] * (len(f) + len(h) - 1)
    for hindex, hval in enumerate(h):
        for findex, fval in enumerate(f):
            g[hindex + findex] += fval * hval
    return g

def deconvolve(g, f):
    lenh = len(g) - len(f) + 1
    mtx = [[0 for x in range(lenh+1)] for y in g]
    for hindex in range(lenh):
        for findex, fval in enumerate(f):
            gindex = hindex + findex
            mtx[gindex][hindex] = fval
    for gindex, gval in enumerate(g):
        mtx[gindex][lenh] = gval
    ToReducedRowEchelonForm( mtx )
    return [mtx[i][lenh] for i in range(lenh)]  # h

if __name__ == '__main__':
    h = [-8,-9,-3,-1,-6,7]
    f = [-3,-6,-1,8,-6,3,-1,-9,-9,3,-2,5,2,-2,-7,-1]
    g = [24,75,71,-34,3,22,-45,23,245,25,52,25,-67,-96,96,31,55,36,29,-43,-7]
    assert convolve(f,h) == g
    assert deconvolve(g, f) == h


conv <- function(a, b) {
	p <- length(a)
	q <- length(b)
	n <- p + q - 1
	r <- nextn(n, f=2)
	y <- fft(fft(c(a, rep(0, r-p))) * fft(c(b, rep(0, r-q))), inverse=TRUE)/r
	y[1:n]
}

deconv <- function(a, b) {
	p <- length(a)
	q <- length(b)
	n <- p - q + 1
	r <- nextn(max(p, q), f=2)
	y <- fft(fft(c(a, rep(0, r-p))) / fft(c(b, rep(0, r-q))), inverse=TRUE)/r
	return(y[1:n])
}


#lang racket
(require math/matrix)
(define T matrix-transpose)

(define (convolution-matrix f m n)
  (define l (matrix-num-rows f))
  (for*/matrix m n ([i (in-range 0 m)] [j (in-range 0 n)])
      (cond [(or  (< i j) (>= i (+ j l)))  0]
            [(matrix-ref f (- i j) 0)])))

(define (least-square X y)
  (matrix-solve (matrix* (T X) X) (matrix* (T X) y)))

(define (deconvolve g f)
  (define lg (matrix-num-rows g))
  (define lf (matrix-num-rows f))
  (define lh (+ (- lg lf) 1))
  (least-square (convolution-matrix f lg lh) g))


sub deconvolve (@g, @f) {
    my \h = 1 + @g - @f;
    my @m;
    @m[^@g;^h] »+=» 0;
    @m[^@g; h] »=«  @g;
    for ^h -> \j { for @f.kv -> \k, \v { @m[j+k;j] = v } }
    (rref @m)[^h;h]
}

sub convolve (@f, @h) {
    my @g = 0 xx + @f + @h - 1;
    @g[^@f X+ ^@h] »+=« (@f X× @h);
    @g
}

# Reduced Row Echelon Form simultaneous equation solver
# Can handle over-specified systems of equations (N unknowns in N + M equations)
sub rref (@m) {
    @m = trim-system @m;
    my ($lead, $rows, $cols) = 0, @m, @m[0];
    for ^$rows -> $r {
        return @m unless $lead < $cols;
        my $i = $r;
        until @m[$i;$lead] {
            next unless ++$i == $rows;
            $i = $r;
            return @m if ++$lead == $cols;
        }
        @m[$i, $r] = @m[$r, $i] if $r != $i;
        @m[$r] »/=» $ = @m[$r;$lead];
        for ^$rows -> $n {
            next if $n == $r;
            @m[$n] »-=» @m[$r] »×» (@m[$n;$lead] // 0);
        }
        ++$lead;
    }
    @m
 }

# Reduce to N equations in N unknowns; a no-op unless rows > cols
sub trim-system (@m) {
    return @m unless @m ≥ @m[0];
    my (\vars, @t) = @m[0] - 1;
    for ^vars -> \lead {
        for ^@m -> \row {
            @t.append: @m.splice(row, 1) and last if @m[row;lead];
        }
    }
    while @t < vars and @m { @t.push: shift @m }
    @t
}

my @h = (-8,-9,-3,-1,-6,7);
my @f = (-3,-6,-1,8,-6,3,-1,-9,-9,3,-2,5,2,-2,-7,-1);
my @g = (24,75,71,-34,3,22,-45,23,245,25,52,25,-67,-96,96,31,55,36,29,-43,-7);

.say for ~@g,   ~convolve(@f, @h),'';
.say for ~@h, ~deconvolve(@g, @f),'';
.say for ~@f, ~deconvolve(@g, @h),'';


/*REXX pgm performs deconvolution of two arrays:    deconv(g,f)=h   and   deconv(g,h)=f */
call make 'H',  "-8 -9 -3 -1 -6 7"
call make 'F',  "-3 -6 -1 8 -6 3 -1 -9 -9 3 -2 5 2 -2 -7 -1"
call make 'G',  "24 75 71 -34 3 22 -45 23 245 25 52 25 -67 -96 96 31 55 36 29 -43 -7"
call show 'H'                                    /*display the elements of array  H.    */
call show 'F'                                    /*   "     "     "      "   "    F.    */
call show 'G'                                    /*   "     "     "      "   "    G.    */
call deco 'G',  "F", 'X'                         /*deconvolution of  G  and  F  ───►  X */
call test 'X',  "H"                              /*test: is array  H  equal to array  X?*/
call deco 'G',  "H", 'Y'                         /*deconvolution of  G  and  H  ───►  Y */
call test 'F',  "Y"                              /*test: is array  F  equal to array  Y?*/
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
deco: parse arg $1,$2,$r;   b= @.$2.# + 1;   a= @.$1.# + 1      /*get sizes of array 1&2*/
      @.$r.#= a - b                                             /*size of return array. */
            do n=0  to a-b                                      /*define  return array. */
            @.$r.n= @.$1.n                                      /*define RETURN element.*/
            if n<b  then L= 0                                   /*define the variable L.*/
                    else L= n - b + 1                           /*   "    "     "     " */
            if n>0  then do j=L  to n-1;                _= n-j  /*define elements > 0.  */
                         @.$r.n= @.$r.n - @.$r.j * @.$2._       /*compute   "     " "   */
                         end   /*j*/                            /* [↑] subtract product.*/
            @.$r.n= @.$r.n / @.$2.0                             /*divide array element. */
            end   /*n*/;                     return
/*──────────────────────────────────────────────────────────────────────────────────────*/
make: parse arg $,z;                     @.$.#= words(z) - 1    /*obtain args; set size.*/
            do k=0  to @.$.#;            @.$.k= word(z, k + 1)  /*define array element. */
            end   /*k*/;                     return             /*array starts at unity.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
show: parse arg $,z,_;    do s=0  to @.$.#;  _= strip(_ @.$.s)  /*obtain the arguments. */
                          end   /*s*/                           /* [↑]  build the list. */
      say 'array' $": " _;                   return             /*show the list;  return*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
test: parse arg $1,$2;    do t=0  to max(@.$1.#, @.$2.#)        /*obtain the arguments. */
                          if @.$1.t= @.$2.t  then iterate       /*create array list.    */
                          say "***error*** arrays"   $1    ' and '    $2   "aren't equal."
                          end   /*t*/;       return             /* [↑]  build the list. */


package require Tcl 8.5
namespace eval 1D {
    namespace ensemble create;   # Will be same name as namespace
    namespace export convolve deconvolve
    # Access core language math utility commands
    namespace path {::tcl::mathfunc ::tcl::mathop}

    # Utility for converting a matrix to Reduced Row Echelon Form
    # From http://rosettacode.org/wiki/Reduced_row_echelon_form#Tcl
    proc toRREF {m} {
	set lead 0
	set rows [llength $m]
	set cols [llength [lindex $m 0]]
	for {set r 0} {$r < $rows} {incr r} {
	    if {$cols <= $lead} {
		break
	    }
	    set i $r
	    while {[lindex $m $i $lead] == 0} {
		incr i
		if {$rows == $i} {
		    set i $r
		    incr lead
		    if {$cols == $lead} {
			# Tcl can't break out of nested loops
			return $m
		    }
		}
	    }
	    # swap rows i and r
	    foreach j [list $i $r] row [list [lindex $m $r] [lindex $m $i]] {
		lset m $j $row
	    }
	    # divide row r by m(r,lead)
	    set val [lindex $m $r $lead]
	    for {set j 0} {$j < $cols} {incr j} {
		lset m $r $j [/ [double [lindex $m $r $j]] $val]
	    }

	    for {set i 0} {$i < $rows} {incr i} {
		if {$i != $r} {
		    # subtract m(i,lead) multiplied by row r from row i
		    set val [lindex $m $i $lead]
		    for {set j 0} {$j < $cols} {incr j} {
			lset m $i $j \
			    [- [lindex $m $i $j] [* $val [lindex $m $r $j]]]
		    }
		}
	    }
	    incr lead
	}
	return $m
    }

    # How to apply a 1D convolution of two "functions"
    proc convolve {f h} {
	set g [lrepeat [+ [llength $f] [llength $h] -1] 0]
	set fi -1
	foreach fv $f {
	    incr fi
	    set hi -1
	    foreach hv $h {
		set gi [+ $fi [incr hi]]
		lset g $gi [+ [lindex $g $gi] [* $fv $hv]]
	    }
	}
	return $g
    }

    # How to apply a 1D deconvolution of two "functions"
    proc deconvolve {g f} {
	# Compute the length of the result vector
	set hlen [- [llength $g] [llength $f] -1]

	# Build a matrix of equations to solve
	set matrix {}
	set i -1
	foreach gv $g {
	    lappend matrix [list {*}[lrepeat $hlen 0] $gv]
	    set j [incr i]
	    foreach fv $f {
		if {$j < 0} {
		    break
		} elseif {$j < $hlen} {
		    lset matrix $i $j $fv
		}
		incr j -1
	    }
	}

	# Convert to RREF, solving the system of simultaneous equations
	set reduced [toRREF $matrix]

	# Extract the deconvolution from the last column of the reduced matrix
	for {set i 0} {$i<$hlen} {incr i} {
	    lappend result [lindex $reduced $i end]
	}
	return $result
    }
}


#import std
#import nat

band = pad0+ ~&rSS+ zipt^*D(~&r,^lrrSPT/~&ltK33tx zipt^/~&r ~&lSNyCK33+ zipp0)^/~&rx ~&B->NlNSPC ~&bt

deconv = lapack..dgelsd^\~&l ~&||0.!**+ band


var [const] GSL=Import("zklGSL");	// libGSL (GNU Scientific Library)
fcn dconv1D(f,g){
   fsz,hsz:=f.len(), g.len() - fsz +1;
   A:=GSL.Matrix(g.len(),hsz);
   foreach n,fn in ([0..].zip(f)){ foreach rc in (hsz){ A[rc+n,rc]=fn } }
   h:=A.AxEQb(g);
   h
}


F randomGenerator(=seed, n)
   [Int] r
   -V max_int32 = 7FFF'FFFF
   seed = seed [&] max_int32

   L r.len < n
      seed = (seed * 214013 + 2531011) [&] max_int32
      r [+]= seed >> 16

   R r

F deal(seed)
   V nc = 52
   V cards = Array((nc - 1 .< -1).step(-1))
   V rnd = randomGenerator(seed, nc)
   L(r) rnd
      V j = (nc - 1) - r % (nc - L.index)
      swap(&cards[L.index], &cards[j])
   R cards

F show(cards)
   V l = cards.map(c -> ‘A23456789TJQK’[Int(c / 4)]‘’‘CDHS’[c % 4])
   L(i) (0 .< cards.len).step(8)
      print((l[i .< i + 8]).join(‘ ’))

:start:
V seed = I :argv.len == 2 {Int(:argv[1])} E 11982
print(‘Hand #.’.format(seed))
V deck = deal(seed)
show(deck)


with Ada.Text_IO; use Ada.Text_IO;
procedure FreeCell is
   type State is mod 2**31;
   type Deck is array (0..51) of String(1..2);

   package Random is
      procedure Init(Seed: State);
      function Rand return State;
   end Random;
   package body Random is
      S : State := State'First;
      procedure Init(Seed: State) is begin S := Seed; end Init;
      function Rand return State is begin
         S := S * 214013 + 2531011;  return S / 2**16;
      end Rand;
   end Random;

   procedure Deal (num : State) is
      thedeck : Deck;  pick : State;
      Chars : constant String := "A23456789TJQKCDHS";
   begin
      for i in thedeck'Range loop
         thedeck(i):= Chars(i/4+1) & Chars(i mod 4 + 14);
      end loop;
      Random.Init(num);
      for i in 0..51 loop
         pick := Random.Rand mod State(52-i);
         Put(thedeck(Natural(pick))&' ');
         if (i+1) mod 8 = 0 then New_Line; end if;
         thedeck(Natural(pick)) := thedeck(51-i);
      end loop; New_Line;
   end Deal;

begin
   Deal(1);
   New_Line;
   Deal(617);
end FreeCell;


FreeCell(num){
	cards := "A23456789TJQK", suits := "♣♦♥♠", card := [], Counter := 0
	loop, parse, cards
	{
		ThisCard := A_LoopField
		loop, parse, suits
			Card[Counter++] := ThisCard . A_LoopField
	}
	loop, 52
	{
		a := MS(num)
		num:=a[1]
		MyCardNo := mod(a[2],53-A_Index)
		MyCard := Card[MyCardNo]
		Card[MyCardNo] := Card[52-A_Index]
		Card.Remove(52-A_Index)
		Res .= MyCard (Mod(A_Index,8)?"  ":"`n")
	}
	return Res
}
MS(Seed) {
	Seed := Mod(214013 * Seed + 2531011, 2147483648)
	return, [Seed, Seed // 65536]
}


      *FLOAT 64

      hand% = 617

      REM Initialise card library:
      SYS "LoadLibrary", "CARDS.DLL" TO cards%
      IF cards% = 0 ERROR 100, "No CARDS library"
      SYS "GetProcAddress", cards%, "cdtInit" TO cdtInit%
      SYS "GetProcAddress", cards%, "cdtDraw" TO cdtDraw%
      SYS cdtInit%, ^dx%, ^dy%
      VDU 23,22,8*dx%;5*dy%;8,16,16,128

      REM Initialise deck:
      DIM card&(51)
      FOR I% = 0 TO 51 : card&(I%) = I% : NEXT

      REM Shuffle deck:
      dummy% = FNrng(hand%)
      FOR I% = 51 TO 0 STEP -1
        C% = FNrng(-1) MOD (I% + 1)
        SWAP card&(C%), card&(I%)
      NEXT

      REM Display deck:
      FOR I% = 0 TO 51
        C% = card&(51 - I%)
        X% = (I% MOD 8) * dx%
        Y% = (I% DIV 8) * dy% * 2 / 3
        SYS cdtDraw%, @memhdc%, X%, Y%, C%, 0, 0
      NEXT
      SYS "InvalidateRect", @hwnd%, 0, 0
      *GSAVE freecell
      END

      DEF FNrng(seed)
      PRIVATE state, M%
      IF seed >= 0 THEN
        state = seed
      ELSE
        state = (state * 214013 + 2531011)
        FOR M% = 52 TO 31 STEP -1
          IF state >= 2^M% state -= 2^M%
        NEXT
      ENDIF
      = state >> 16


(  ( createArray
  =   array rank ranks suit suits
    .   A 2 3 4 5 6 7 8 9 T J Q K:?ranks
      & :?array
      &   whl
        ' ( !ranks:%?rank ?ranks
          & ♣ ♦ ♥ ♠:?suits
          &   whl
            ' ( !suits:%?suit ?suits
              & !array str$(!rank !suit):?array
              )
          )
      & !array
  )
& ( deal
  =     A B D L Z pick card dealt deck
      , i last rand row state
    .   !arg:(?deck:? [?L.?state)
      & 8:?row
      & :?dealt
      & ( pick
        =   sep
          .   (   -1+!row:>0:?row
                & " ":?sep
              | \n:?sep&8:?row
              )
            & !dealt !arg !sep:?dealt
        )
      & 2^31:?B
      & 2^16:?D
      & "
        'Hard code' the numbers B and D into the rand function using
        macro expansion. (Gives a marginally faster execution speed.)
        "
      &
          ' (
            .   mod$(!state*214013+2531011.$B):?state
              & div$(!state.$D)
            )
        : (=?rand)
      & !L+1:?L
      &   whl
        ' ( mod$(rand$.!L+-1:?L):?i
          & !deck:?A [!i %?card ?Z
          &   ( !Z:?Z %@?last&!A !last !Z
              | !A
              )
            : ?deck
          & pick$!card
          )
      & pick$\n
      & str$!dealt
  )
& createArray$:?deck
& put$("Game #1\n","dealt.txt",NEW)
& put$(deal$(!deck.1),"dealt.txt",APP)
& put$("

Game #617
","dealt.txt",APP)
& put$(deal$(!deck.617),"dealt.txt",APP)
&
)


#include <stdio.h>
#include <stdlib.h>
#include <locale.h>

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

#define RMAX32 ((1U << 31) - 1)
static int seed = 1;
int  rnd(void) { return (seed = (seed * 214013 + 2531011) & RMAX32) >> 16; }
void srnd(int x) { seed = x; }

void show(const 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;
}


using System;
using System.Collections.Generic;
using System.Text;

namespace FreeCellDeals
{
    public class RNG
    {
        private int _state;

        public RNG()
        {
            _state = (int)DateTime.Now.Ticks;
        }

        public RNG(int n)
        {
            _state = n;
        }
        public int Next()
        {
            return ((_state = 214013 * _state + 2531011) & int.MaxValue) >> 16;
        }
    }

    public enum Rank
    {
        Ace,
        One,
        Two,
        Three,
        Four,
        Five,
        Six,
        Seven,
        Eight,
        Nine,
        Ten,
        Jack,
        Queen,
        King
    }

    public enum Suit
    {
        Clubs,
        Diamonds,
        Hearts,
        Spades
    }

    public class Card
    {
        private const string Ranks = "A23456789TJQK";
        private const string Suits = "CDHS";

        private Rank _rank;
        public Rank Rank
        {
            get
            {
                return _rank;
            }
            set
            {
                if ((int)value < 0 || (int)value > 12)
                {
                    throw new InvalidOperationException("Setting card rank out of range");
                }
                _rank = value;
            }
        }

        private Suit _suit;
        public Suit Suit
        {
            get
            {
                return _suit;
            }
            set
            {
                if ((int)value < 0 || (int)value > 3)
                {
                    throw new InvalidOperationException("Setting card rank out of range");
                }
                _suit = value;
            }
        }

        public Card(Rank rank, Suit suit)
        {
            Rank = rank;
            Suit = suit;
        }

        public int NRank()
        {
            return (int) Rank;
        }

        public int NSuit()
        {
            return (int) Suit;
        }

        public override string ToString()
        {
            return new string(new[] {Ranks[NRank()], Suits[NSuit()]});
        }
    }

    public class FreeCellDeal
    {
        public List<Card> Deck { get; private set; }

        public FreeCellDeal(int iDeal)
        {
            RNG rng = new RNG(iDeal);

            List<Card> rDeck = new List<Card>();
            Deck = new List<Card>();

            for (int rank = 0; rank < 13; rank++)
            {
                for (int suit = 0; suit < 4; suit++)
                {
                    rDeck.Add(new Card((Rank)rank, (Suit)suit));
                }
            }

            // Normally we deal from the front of a deck.  The algorithm "deals" from the back so we reverse the
            // deck here to more conventionally deal from the front/start of the array.
            for (int iCard = 51; iCard >= 0; iCard--)
            {
                int iSwap = rng.Next() % (iCard + 1);
                Deck.Add(rDeck[iSwap]);
                rDeck[iSwap] = rDeck[iCard];
            }
        }

        public override string ToString()
        {
            StringBuilder sb = new StringBuilder();
            for (int iRow = 0; iRow < 6; iRow++ )
            {
                for (int iCol = 0; iCol < 8; iCol++)
                {
                    sb.AppendFormat("{0} ", Deck[iRow * 8 + iCol]);
                }
                sb.Append("\n");
            }
            for (int iCard = 48; iCard < 52; iCard++)
            {
                sb.AppendFormat("{0} ", Deck[iCard]);
            }
            return sb.ToString();
        }
    }

    class Program
    {
        static void Main()
        {
            Console.WriteLine(new FreeCellDeal(1));
            Console.WriteLine();
            Console.WriteLine(new FreeCellDeal(617));
        }
    }
}


shared void freeCellDeal() {

	//a function that returns a random number generating function
	function createRNG(variable Integer state) =>
			() => (state = (214_013 * state + 2_531_011) % 2^31) / 2^16;

	void deal(Integer num) {
		// create an array with a list comprehension
		variable value deck = Array {
			for(rank in "A23456789TJQK")
			for(suit in "CDHS")
			"``rank````suit``"
		};
		value rng = createRNG(num);
		for(i in 1..52) {
			value index = rng() % deck.size;
			assert(exists lastIndex = deck.lastIndex);
			//swap the random card with the last one
			deck.swap(index, lastIndex);
			//print the last one
			process.write("``deck.last else "missing card"`` " );
			if(i % 8 == 0) {
				print("");
			}
			//and shrink the array to remove the last card
			deck = deck[...lastIndex - 1];
		}
	}

	deal(1);
	print("\n");
	deal(617);
}


(def deck (into [] (for [rank "A23456789TJQK" suit "CDHS"] (str rank suit))))

(defn lcg [seed]
  (map #(bit-shift-right % 16)
    (rest (iterate #(mod (+ (* % 214013) 2531011) (bit-shift-left 1 31)) seed))))

(defn gen [seed]
  (map (fn [rnd rng] (into [] [(mod rnd rng) (dec rng)]))
    (lcg seed) (range 52 0 -1)))

(defn xchg [v [src dst]] (assoc v dst (v src) src (v dst)))

(defn show [seed] (map #(println %) (partition 8 8 ""
  (reverse (reduce xchg deck (gen seed))))))

(show 1)


(defun make-rng (seed)
    #'(lambda ()
	(ash (setf seed (mod (+ (* 214013 seed) 2531011) (expt 2 31))) -16)))

(defun split (s) (map 'list #'string s))

(defun make-deck (seed)
  (let ((hand (make-array 52 :fill-pointer 0))
	(rng (make-rng seed)))
    (dolist (d (split "A23456789TJQK"))
      (dolist (s (split "♣♦♥♠"))
	(vector-push (concatenate 'string d s) hand)))
    (dotimes (i 52)
	(rotatef (aref hand (- 51 i))
		 (aref hand (mod (funcall rng) (- 52 i)))))
    (nreverse hand)))

(defun show-deck (seed)
  (let ((hand (make-deck seed)))
    (format t "~%Hand ~d~%" seed)
    (dotimes (i 52)
      (format t "~A " (aref hand i))
      (if (= (mod i 8) 7) (write-line "")))))

(show-deck 1)
(show-deck 617)


import std.stdio, std.conv, std.algorithm, std.range;

struct RandomGenerator {
    uint seed = 1;

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

struct Deck {
    int[52] cards;

    void deal(in uint seed) pure nothrow @safe @nogc {
        enum int nc = cards.length; // Must be signed for iota.
        nc.iota.retro.copy(cards[]);

        auto rnd = RandomGenerator(seed);
        foreach (immutable i, ref c; cards)
            c.swap(cards[(nc - 1) - rnd.next % (nc - i)]);
    }

    void show() const @safe {
        writefln("%(%-( %s%)\n%)",
                 cards[]
                 .chunks(8)
                 .map!(row => row.map!(c => only("A23456789TJQK"[c / 4],
                                                 "CDHS"[c % 4]))));
    }
}

void main(in string[] args) @safe {
    immutable seed = (args.length == 2) ? args[1].to!uint : 11_982;
    writeln("Hand ", seed);
    Deck cards;
    cards.deal(seed);
    cards.show;
}


program Deal_cards_for_FreeCell;

{$APPTYPE CONSOLE}

uses
  System.SysUtils;

type
  TRandom = record
    Seed: Int64;
    function Next: Integer;
  end;

  TCard = record
    const
      kSuits = '♣♦♥♠';
      kValues = 'A23456789TJQK';
    var
      Value: Integer;
      Suit: Integer;
    procedure Create(rawvalue: Integer); overload;
    procedure Create(value, suit: Integer); overload;
    procedure Assign(other: TCard);
    function ToString: string;
  end;

  TDeck = record
    Cards: TArray<TCard>;
    procedure Create(Seed: Integer);
    function ToString: string;
  end;

{ TRandom }

function TRandom.Next: Integer;
begin
  Seed := ((Seed * 214013 + 2531011) and Integer.MaxValue);
  Result := Seed shr 16;
end;

{ TCard }

procedure TCard.Create(rawvalue: Integer);
begin
  Create(rawvalue div 4, rawvalue mod 4);
end;

procedure TCard.Assign(other: TCard);
begin
  Create(other.Value, other.Suit);
end;

procedure TCard.Create(value, suit: Integer);
begin
  self.Value := value;
  self.Suit := suit;
end;

function TCard.ToString: string;
begin
  result := format('%s%s', [kValues[value + 1], kSuits[suit + 1]]);
end;

{ TDeck }

procedure TDeck.Create(Seed: Integer);
var
  r: TRandom;
  i, j: integer;
  tmp: Tcard;
begin
  r.Seed := Seed;
  SetLength(Cards, 52);
  for i := 0 to 51 do
    Cards[i].Create(51 - i);
  for i := 0 to 50 do
  begin
    j := 51 - (r.Next mod (52 - i));
    tmp.Assign(Cards[i]);
    Cards[i].Assign(Cards[j]);
    Cards[j].Assign(tmp);
  end;
end;

function TDeck.ToString: string;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to length(Cards) - 1 do
  begin
    Result := Result + Cards[i].ToString;
    if i mod 8 = 7 then
      Result := Result + #10
    else
      Result := Result + ' ';
  end;
end;

var
  Deck: TDeck;

begin
  Deck.Create(1);
  Writeln('Deck 1'#10, Deck.ToString, #10);
  Deck.Create(617);
  Writeln('Deck 617'#10, Deck.ToString);
  readln;
end.


defmodule FreeCell do
  import Bitwise

  @suits ~w( C D H S )
  @pips ~w( A 2 3 4 5 6 7 8 9 T J Q K )
  @orig_deck for pip <- @pips, suit <- @suits, do: pip <> suit

  def deal(games) do
    games = if length(games) == 0, do: [Enum.random(1..32000)], else: games
    Enum.each(games, fn seed ->
      IO.puts "Game ##{seed}"
      Enum.reduce(52..2, {seed,@orig_deck}, fn len,{state,deck} ->
        state = ((214013 * state) + 2531011) &&& 0x7fff_ffff
        index = rem(state >>> 16, len)
        last = len - 1
        {a, b} = {Enum.at(deck, index), Enum.at(deck, last)}
        {state, deck |> List.replace_at(index, b) |> List.replace_at(last, a)}
      end)
      |> elem(1)
      |> Enum.reverse
      |> Enum.chunk(8,8,[])
      |> Enum.each(fn row -> Enum.join(row, " ") |> IO.puts end)
      IO.puts ""
    end)
  end
end

System.argv |> Enum.map(&String.to_integer/1)
|> FreeCell.deal


PROGRAM FREECELL

!$DOUBLE

DIM CARDS%[52]

PROCEDURE XRANDOM(SEED->XRND)
    POW31=2^31
    POW16=2^16
    SEED=SEED*214013+2531011
    SEED=SEED-POW31*INT(SEED/POW31)
    XRND=INT(SEED/POW16)
END PROCEDURE

PROCEDURE DEAL(CARDS%[],GAME_NUM)
    LOCAL I%,J%,S%
    SEED=GAME_NUM
    FOR I%=1 TO 52 DO
      CARDS%[I%]=52-I%
    END FOR
    FOR I%=1 TO 51 DO
      XRANDOM(SEED->XRND)
      J%=52-XRND MOD (53-I%)
      S%=CARDS%[I%]
      CARDS%[I%]=CARDS%[J%]
      CARDS%[J%]=S%
    END FOR
END PROCEDURE

PROCEDURE SHOW(CARDS%[])
    LOCAL INDEX%
    FOR INDEX%=1 TO 52 DO
      PRINT(MID$(SUITS$,CARDS%[INDEX%] MOD 4+1,1);MID$(NUMS$,CARDS%[INDEX%] DIV 4+1,1);" ";)
      IF INDEX% MOD 8=0 OR INDEX%=52 THEN
        PRINT
      END IF
    END FOR
END PROCEDURE

BEGIN
    PRINT(CHR$(12);)
    SUITS$="♣♦♥♠"
    NUMS$="A23456789TJQK"
    GAME_NUM=1982  ! if missing command line
    IF CMDLINE$<>"" THEN GAME_NUM=VAL(CMDLINE$) END IF
    SEED=1
    DEAL(CARDS%[],GAME_NUM)
    PRINT("Hand ";GAME_NUM)
    SHOW(CARDS%[])
END PROGRAM


let msKindaRand seed =
  let state = ref seed
  (fun (_:unit) ->
      state := (214013 * !state + 2531011) &&& System.Int32.MaxValue
      !state / (1<<<16))

let unshuffledDeck = [0..51] |> List.map(fun n->sprintf "%c%c" "A23456789TJQK".[n / 4] "CDHS".[n % 4])

let deal boot idx =
  let (last,rest) = boot |> List.rev |> fun xs->(List.head xs),(xs |> List.tail |> List.rev)
  if idx=((List.length boot) - 1) then last, rest
  else
    rest
    |> List.mapi (fun i x -> i,x)
    |> List.partition (fst >> ((>) idx))
    |> fun (xs,ys) -> (List.map snd xs),(List.map snd ys)
    |> fun (xs,ys) -> (List.head ys),(xs @ last::(List.tail ys))

let game gameNo =
  let rnd = msKindaRand gameNo
  [52..-1..1]
  |> List.map (fun i->rnd() % i)
  |> List.fold (fun (dealt, boot) idx->deal boot idx |> fun (x,xs) -> (x::dealt, xs)) ([],unshuffledDeck)
  |> fst |> List.rev
  |> List.chunkBySize 8
  |> List.map (String.concat " ")
  |> String.concat "\n"
  |> printfn "Game #%d\n%s\n" gameNo

[1; 617] |> List.iter game


USING: formatting grouping io kernel literals make math
math.functions namespaces qw sequences sequences.extras ;
IN: rosetta-code.freecell

CONSTANT: max-rand-ms $[ 1 15 shift 1 - ]
CONSTANT: suits qw{ C D H S }
CONSTANT: ranks qw{ A 2 3 4 5 6 7 8 9 T J Q K }
SYMBOL: seed

: (random) ( n1 n2 -- n3 ) seed get * + dup seed set ;

: rand-ms ( -- n )
    max-rand-ms 2531011 214013 (random) -16 shift bitand ;

: init-deck ( -- seq )
    ranks suits [ append ] cartesian-map concat V{ } like ;

: swap-cards ( seq -- seq' )
    rand-ms over length [ mod ] [ 1 - ] bi pick exchange ;

: (deal) ( seq -- seq' )
    [ [ swap-cards dup pop , ] until-empty ] { } make ;

: deal ( game# -- seq ) seed set init-deck (deal) ;

: .cards ( seq -- ) 8 group [ [ write bl ] each nl ] each nl ;

: .game ( game# -- ) dup "Game #%d\n" printf deal .cards ;

: freecell ( -- ) 1 617 [ .game ] [email protected] ;

MAIN: freecell


module Freecell
  use lcgs
  implicit none

  character(4)  :: suit = "CDHS"
  character(13) :: rank = "A23456789TJQK"
  character(2) :: deck(0:51)

contains

subroutine Createdeck()
  integer :: i, j, n

  n = 0
  do i = 1, 13
    do j = 1, 4
      deck(n) = rank(i:i) // suit(j:j)
      n = n + 1
    end do
  end do

end subroutine

subroutine Freecelldeal(game)
  integer, intent(in) :: game
  integer(i64) :: rnum
  integer :: i, n
  character(2) :: tmp

  call Createdeck()
  rnum = msrand(game)

  do i = 51, 1, -1
    n = mod(rnum, i+1)
    tmp = deck(n)
    deck(n) = deck(i)
    deck(i) = tmp
    rnum = msrand()
  end do

  write(*, "(a, i0)") "Game #", game
  write(*, "(8(a, tr1))") deck(51:0:-1)
  write(*,*)

end subroutine
end module Freecell

program Freecell_test
  use Freecell
  implicit none

  call Freecelldeal(1)
  call Freecelldeal(617)

end program


' version 04-11-2016
' compile with: fbc -s console

' to seed ms_lcg(seed > -1)
' to get random number ms_lcg(-1) or ms_lcg() or just ms_lcg
Function ms_lcg(seed As Integer = -1) As UInteger

    Static As UInteger ms_state

    If seed <> -1 Then
        ms_state = seed Mod 2 ^ 31
    Else
        ms_state = (214013 * ms_state + 2531011) Mod 2 ^ 31
    End If

    Return ms_state Shr 16

End Function

' ------=< MAIN >=------

Dim As UByte card(51)
Dim As String suit = "CDHS", value = "A23456789TJQK"
Dim As Long i, c, s, v, game = 1
Dim As ULong game_nr(1 To 2) = { 1, 617}

Do

    ms_lcg(game_nr(game))       ' seed generator
    Print "game #"; game_nr(game)
    game = game + 1

    For i = 0 To 51             ' set up the cards
        card(i) = i
    Next

    For i = 51 To 0 Step -1     ' shuffle
        c = ms_lcg Mod (i +1)
        Swap card(i), card(c)
    Next

    c = 0
    Do
        For i = 0 To 7
            s = card(51 - c) Mod 4
            v = card(51 - c) \ 4
            Print Chr(value[v]); Chr(suit[s]); " ";
            c = c +1
            If c > 51 Then Exit Do
        Next
        Print
    Loop
    Print : Print

Loop Until game > UBound(game_nr)

' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End


package main

import (
    "fmt"
    "math"
    "math/rand"
    "os"
    "strconv"
    "time"
)

const sSuits = "CDHS"
const sNums = "A23456789TJQK"
const rMax32 = math.MaxInt32

var seed = 1

func rnd() int {
    seed = (seed*214013 + 2531011) & rMax32
    return seed >> 16
}

func deal(s int) []int {
    seed = s
    t := make([]int, 52)
    for i := 0; i < 52; i++ {
        t[i] = 51 - i
    }
    for i := 0; i < 51; i++ {
        j := 51 - rnd()%(52-i)
        t[i], t[j] = t[j], t[i]
    }
    return t
}

func show(cs []int) {
    for i, c := range cs {
        fmt.Printf(" %c%c", sNums[c/4], sSuits[c%4])
        if (i+1)%8 == 0 || i+1 == len(cs) {
            fmt.Println()
        }
    }
}

func main() {
    var game int
    switch len(os.Args) {
    case 1:
        rand.Seed(time.Now().UnixNano())
        game = 1 + rand.Intn(32000)
    case 2:
        var err error
        game, err = strconv.Atoi(os.Args[1])
        if err == nil && game >= 1 && game <= 32000 {
            break
        }
        fallthrough
    default:
        fmt.Println("usage: deal [game]")
        fmt.Println("       where game is a number in the range 1 to 32000")
        return
    }
    fmt.Printf("\nGame #%d\n", game)
    show(deal(game))
}


class FreeCell{
    int seed

    List<String> createDeck(){
        List<String> suits = ['♣','♦','♥','♠']
        List<String> values = ['A','2','3','4','5','6','7','8','9','10','J','Q','K']
        return [suits,values].combinations{suit,value -> "$suit$value"}
    }

    int random() {
        seed = (214013 * seed + 2531011) & Integer.MAX_VALUE
        return seed >> 16
    }

    List<String> shuffledDeck(List<String> cards) {
        List<String> deck = cards.clone()

       (deck.size() - 1..1).each{index ->
            int r = random() % (index + 1)
            deck.swap(r, index)
        }

        return deck
    }

    List<String> dealGame(int seed = 1){
        this.seed= seed
        List<String> cards = shuffledDeck(createDeck())

        (1..cards.size()).each{ number->
            print "${cards.pop()}\t"
            if(number % 8 == 0) println('')
        }

        println('\n')
    }
}

def freecell = new FreeCell()
freecell.dealGame()
freecell.dealGame(617)


import Data.Int
import Data.Bits
import Data.List
import Data.Array.ST
import Control.Monad
import Control.Monad.ST
import System.Environment

srnd :: Int32 -> [Int]
srnd = map (fromIntegral . flip shiftR 16) .
       tail . iterate (\x -> (x * 214013 + 2531011) .&. maxBound)

deal :: Int32 -> [String]
deal s = runST (do
    ar <- newListArray (0,51) $ sequence ["A23456789TJQK", "CDHS"]
          :: ST s (STArray s Int String)
    forM (zip [52,51..1] rnd) $ \(n, r) -> do
      let j = r `mod` n
      vj <- readArray ar j
      vn <- readArray ar (n - 1)
      writeArray ar j vn
      return vj)
  where rnd = srnd s

showCards :: [String] -> IO ()
showCards = mapM_ (putStrLn . unwords) .
            takeWhile (not . null) .
            unfoldr (Just . splitAt 8)

main :: IO ()
main = do
  args <- getArgs
  let s = read (head args) :: Int32
  putStrLn $ "Deal " ++ show s ++ ":"
  let cards = deal s
  showCards cards


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


deck=: ,/ 'A23456789TJQK' ,"0/ 7 u: '♣♦♥♠'

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

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

show=: (,"2)@:(_8 ]\ ' '&,.)


import java.util.Arrays;

public class Shuffler {

	private int seed;

	private String[] deck = {
			"AC", "AD", "AH", "AS",
			"2C", "2D", "2H", "2S",
			"3C", "3D", "3H", "3S",
			"4C", "4D", "4H", "4S",
			"5C", "5D", "5H", "5S",
			"6C", "6D", "6H", "6S",
			"7C", "7D", "7H", "7S",
			"8C", "8D", "8H", "8S",
			"9C", "9D", "9H", "9S",
			"TC", "TD", "TH", "TS",
			"JC", "JD", "JH", "JS",
			"QC", "QD", "QH", "QS",
			"KC", "KD", "KH", "KS",
	};

	private int random() {
		seed = (214013 * seed + 2531011) & Integer.MAX_VALUE;
		return seed >> 16;
	}

	//shuffled cards go to the end
	private String[] getShuffledDeck() {
		String[] deck = Arrays.copyOf(this.deck, this.deck.length);
		for(int i = deck.length - 1; i > 0; i--) {
			int r = random() % (i + 1);
			String card = deck[r];
			deck[r] = deck[i];
			deck[i] = card;
		}
		return deck;
	}

	//deal from end first
	public void dealGame(int seed) {
		this.seed = seed;
		String[] shuffledDeck = getShuffledDeck();
		for(int count = 1, i = shuffledDeck.length - 1; i >= 0; count++, i--) {
			System.out.print(shuffledDeck[i]);
			if(count % 8 == 0) {
				System.out.println();
			} else {
				System.out.print(" ");
			}
		}
		System.out.println();
	}

	public static void main(String[] args) {
		Shuffler s = new Shuffler();
		s.dealGame(1);
		System.out.println();
		s.dealGame(617);
	}

}


"use strict";
/*
 * Microsoft C Run-time-Library-compatible Random Number Generator
 * Copyright by Shlomi Fish, 2011.
 * Released under the MIT/X11 License
 * ( http://en.wikipedia.org/wiki/MIT_License ).
 * */
/* This uses Joose 2.x-or-above, an object system for JavaScript - http://code.google.com/p/joose-js/ . */

Class('MSRand', {
    has: {
        seed: { is: rw, },
    },
    methods: {
        rand: function() {
            this.setSeed((this.getSeed() * 214013 + 2531011) & 0x7FFFFFFF);
            return ((this.getSeed() >> 16) & 0x7fff);
        },
        max_rand: function(mymax) {
            return this.rand() % mymax;
        },
        shuffle: function(deck) {
            if (deck.length) {
                var i = deck.length;
                while (--i) {
                    var j = this.max_rand(i+1);
                    var tmp = deck[i];
                    deck[i] = deck[j];
                    deck[j] = tmp;
                }
            }
            return deck;
        },
    },
});

/*
 * Microsoft Windows Freecell / Freecell Pro boards generation.
 *
 * See:
 *
 * - http://rosettacode.org/wiki/Deal_cards_for_FreeCell
 *
 * - http://www.solitairelaboratory.com/mshuffle.txt
 *
 * Under MIT/X11 Licence.
 *
 * */

function deal_ms_fc_board(seed) {
    var randomizer = new MSRand({ seed: seed });
    var num_cols = 8;

    var _perl_range = function(start, end) {
        var ret = [];

        for (var i = start; i <= end; i++) {
            ret.push(i);
        }

        return ret;
    };

    var columns = _perl_range(0, num_cols-1).map(function () { return []; });
    var deck = _perl_range(0, 4*13-1);

    randomizer.shuffle(deck);

    deck = deck.reverse()

    for (var i = 0; i < 52; i++) {
        columns[i % num_cols].push(deck[i]);
    }

    var render_card = function (card) {
        var suit = (card % 4);
        var rank = Math.floor(card / 4);

        return "A23456789TJQK".charAt(rank) + "CDHS".charAt(suit);
    }

    var render_column = function(col) {
        return ": " + col.map(render_card).join(" ") + "\n";
    }

    return columns.map(render_column).join("");
}


const rank  = split("A23456789TJQK", "")
const suit  = split("♣♦♥♠", "")
const deck  = Vector{String}()

const mslcg = [0]
rng() = (mslcg[1] = ((mslcg[1] * 214013 + 2531011) & 0x7fffffff)) >> 16

initdeck() = for r in rank, s in suit push!(deck, "$r$s") end

function deal(num = rand(UInt,1)[1] % 32000 + 1)
    initdeck()
    mslcg[1] = num
    println("\nGame # ", num)
    while length(deck) > 0
        choice = rng() % length(deck) + 1
        deck[choice], deck[end] = deck[end], deck[choice]
        print(" ", pop!(deck), length(deck) % 8 == 4 ? "\n" : "")
    end
end

deal(1)
deal(617)
deal()


// version 1.1.3

class Lcg(val a: Long, val c: Long, val m: Long, val d: Long, val s: Long) {
    private var state = s

    fun nextInt(): Long {
        state = (a * state + c) % m
        return state / d
    }
}

const val CARDS  = "A23456789TJQK"
const val SUITS  = "♣♦♥♠"

fun deal(): Array<String?> {
    val cards = arrayOfNulls<String>(52)
    for (i in 0 until 52) {
       val card = CARDS[i / 4]
       val suit = SUITS[i % 4]
       cards[i] = "$card$suit"
    }
    return cards
}

fun game(n: Int) {
    require(n > 0)
    println("Game #$n:")
    val msc = Lcg(214013, 2531011, 1 shl 31, 1 shl 16, n.toLong())
    val cards = deal()
    for (m in 52 downTo 1) {
        val index = (msc.nextInt() % m).toInt()
        val temp = cards[index]
        cards[index] = cards[m - 1]
        print("$temp  ")
        if ((53 - m) % 8 == 0) println()
    }
    println("\n")
}

fun main(args: Array<String>) {
    game(1)
    game(617)
}


; Linear congruential random number generator
make "_lcg_state 0

to seed_lcg :seed
  make "_lcg_state :seed
end

to sample_lcg
  make "_lcg_state modulo sum product 214013 :_lcg_state 2531011 2147483648
  output int quotient :_lcg_state 65536
end

; FreeCell
to card_from_number :number
  output word item sum 1 int quotient :number 4 "A23456789TJQK item sum 1 modulo :number 4 "CDHS
end

to generate_deal :number
  (local "deck "size "index "deal)
  seed_lcg :number
  make "deck []
  repeat 52 [
    make "deck lput difference # 1 :deck
  ]
  make "deck listtoarray :deck
  make "deal []
  repeat 52 [
    make "size difference 53 #
    make "index sum 1 modulo sample_lcg :size
    make "deal lput item :index :deck :deal
    setitem :index :deck item :size :deck
  ]
  output :deal
end

to print_deal :number
  (local "deal "i "j "index)
  make "deal generate_deal :number
  repeat 7 [
    make "i difference # 1
    repeat (ifelse [equal? :i 6] 4 8) [
      make "j difference # 1
      make "index (sum 1 product :i 8 :j)
      type (word (card_from_number item :index :deal) "| |)
    ]
    print "||
  ]
end

print [Game #1]
print_deal 1
print "||
print [Game #617]
print_deal 617
print "||
bye


deck = {}
rank = {"A", "2", "3", "4", "5", "6", "7", "8", "9", "T", "J", "Q", "K"}
suit = {"C", "D", "H", "S"}
two31, state = bit32.lshift(1, 31), 0

function rng()
    state = (214013 * state + 2531011) % two31
    return bit32.rshift(state, 16)
end

function initdeck()
    for i, r in ipairs(rank) do
        for j, s in ipairs(suit) do
            table.insert(deck, r .. s)
        end
    end
end

function deal(num)
    initdeck()
    state = num
    print("Game #" .. num)
    repeat
        choice = rng(num) % #deck + 1
        deck[choice], deck[#deck] = deck[#deck], deck[choice]
        io.write(" " .. deck[#deck])
        if (#deck % 8 == 5) then
            print()
        end
        deck[#deck] = nil
    until #deck == 0
    print()
end

deal(1)
deal(617)


next[last_] := Mod[214013 last + 2531011, 2^31];
deal[n_] :=
  Module[{last = n, idx,
    deck = StringJoin /@
      Tuples[{{"A", "2", "3", "4", "5", "6", "7", "8", "9", "T", "J",
         "Q", "K"}, {"C", "D", "H", "S"}}], res = {}},
   While[deck != {}, last = next[last];
    idx = Mod[BitShiftRight[last, 16], Length[deck]] + 1;
    deck = ReplacePart[deck, {idx -> deck[[-1]], -1 -> deck[[idx]]}];
    AppendTo[res, deck[[-1]]]; deck = deck[[;; -2]]]; res];
format[deal_] := Grid[Partition[deal, 8, 8, {1, 4}, Null]];
Print[format[deal[1]]];
Print[format[deal[617]]];


import sequtils, strutils, os

proc randomGenerator(seed: int): iterator: int =
  var state = seed
  return iterator: int =
    while true:
      state = (state * 214013 + 2531011) and int32.high
      yield state shr 16

proc deal(seed: int): seq[int] =
  const nc = 52
  result = toSeq countdown(nc - 1, 0)
  var rnd = randomGenerator seed
  for i in 0 ..< nc:
    let r = rnd()
    let j = (nc - 1) - r mod (nc - i)
    swap result[i], result[j]

proc show(cards: seq[int]) =
  var l = newSeq[string]()
  for c in cards:
    l.add "A23456789TJQK"[c div 4] & "CDHS"[c mod 4]
  for i in countup(0, cards.high, 8):
    echo " ", l[i..min(i+7, l.high)].join(" ")

let seed = if paramCount() == 1: paramStr(1).parseInt else: 11982
echo "Hand ", seed
let deck = deal seed
show deck


class FreeCell {
  function : Main(args : String[]) ~ Nil {
    Deal(1)->PrintLine();
    Deal(617)->PrintLine();
  }

  function : Deal(seed : Int) ~ String {
    deck := Deck->New(seed)->ToString();
    return "Game #{$seed}:\n{$deck}\n";
  }
}

class Deck {
  @cards : Card[];

  New(seed : Int) {
    r := Random->New(seed);

    @cards := Card->New[52];
    for(i := 0; i < 52; i+= 1;) {
      @cards[i] := Card->New(51 - i);
    };

    for(i := 0; i < 51; i += 1;) {
      j := 51 - r->Next() % (52 - i);
      tmp := @cards[i]; @cards[i] := @cards[j]; @cards[j] := tmp;
    };
  }

  method : public : ToString() ~ String {
    buffer := "";

    each(i : @cards) {
      buffer += @cards[i]->ToString();
      buffer += (i % 8 = 7 ? "\n" : " ");
    };

    return buffer;
  }

}

class Random {
  @seed : Int;

  New(seed : Int) {
    @seed := seed;
  }

  method : public : Next() ~ Int {
    @seed := (@seed * 214013 + 2531011) and Int->MaxSize();
    return @seed >> 16;
  }
}

class Card {
  @value : Int;
  @suit : Int;

  New(value : Int) {
    @value := value / 4; @suit := value % 4;
  }

  method : public : ToString() ~ String {
    suits := "♣♦♥♠"; values := "A23456789TJQK";
    value := values->Get(@value); suit := suits->Get(@suit);
    return "{$value}{$suit}";
  }
}


#define RMAX32 ((1U << 31) - 1)

//--------------------------------------------------------------------

@interface Rand : NSObject
-(instancetype) initWithSeed: (int)seed;
-(int) next;
@property (nonatomic) long seed;
@end

@implementation Rand
-(instancetype) initWithSeed: (int)seed {
    if ((self = [super init])) {
        self.seed = seed;
    }
    return self;
}
-(int) next {
    return (int) ((_seed = (_seed * 214013 + 2531011) & RMAX32) >> 16);
}
@end

//--------------------------------------------------------------------

@interface Card : NSObject
-(instancetype) initWithSequence: (int)n;
-(instancetype) initWithValue: (int)v suit: (int)s;
@property (nonatomic) int value;
@property (nonatomic) int suit;
@end

@implementation Card
-(instancetype) initWithSequence: (int)n {
    return [self initWithValue:n/4 suit:n%4];
}
-(instancetype) initWithValue: (int)v suit: (int)s {
    if ((self = [super init])) {
        _value = v;  _suit = s;
    }
    return self;
}
-(NSString *) description {
    static NSString * const kSuits = @"♣♦♥♠";
    static NSString * const kValues = @"A23456789TJQK";
    return [NSString stringWithFormat:@"%C%C",
            [kValues characterAtIndex:_value],
            [kSuits characterAtIndex:_suit]];
}
@end

//--------------------------------------------------------------------

@interface Deck : NSObject
-(instancetype) initWithSeed: (int)seed;
@property (nonatomic, strong) NSMutableArray *cards;
@end

@implementation Deck
-(instancetype) initWithSeed: (int)seed {
    if ((self = [super init])) {
        Rand *r = [[Rand alloc] initWithSeed:seed];
        _cards = [NSMutableArray array];
        for (int i = 0; i < 52; i++)
            [_cards addObject:[[Card alloc] initWithSequence:51 - i]];
        for (int i = 0; i < 51; i++)
            [_cards exchangeObjectAtIndex:i withObjectAtIndex:51 - [r next] % (52 - i)];
    }
    return self;
}
-(NSString *) description {
    NSMutableString *s = [NSMutableString string];
    for (int i = 0; i < [_cards count]; i++) {
        [s appendString:[_cards[i] description]];
        [s appendString:i%8==7 ? @"\n" : @" "];
    }
    return s;
}
@end

//--------------------------------------------------------------------

int main(int argc, const char * argv[])
{
    @autoreleasepool {
        NSLog(@"Deck 1\n%@\n", [[Deck alloc] initWithSeed:1]);
        NSLog(@"Deck 617\n%@\n", [[Deck alloc] initWithSeed:617]);
    }
    return 0;
}


let srnd x =
  (* since OCaml's built-in int type is at least 31 (note: not 32) bits wide,
     and this problem takes mod 2^31, it is just enough if we treat it as
     an unsigned integer, which means taking the logical right shift *)
  let seed = ref x in
  fun () ->
    seed := (!seed * 214013 + 2531011) land 0x7fffffff;
    !seed lsr 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


#!/usr/bin/perl

use strict;
use warnings;

use utf8;

sub deal {
    my $s = shift;

    my $rnd = sub {
        return (($s = ($s * 214013 + 2531011) & 0x7fffffff) >> 16 );
    };

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

    for my $idx (reverse 0 .. $#d) {
        my $r = $rnd->() % ($idx + 1);
        @d[$r, $idx] = @d[$idx, $r];
    }

    return [reverse @d];
}

my $hand_idx = shift(@ARGV) // 11_982;

my $cards = deal($hand_idx);

my $num_cards_in_height = 8;
my $string = '';

while (@$cards)
{
    $string .= join(' ', splice(@$cards, 0, 8)) . "\n";
}

binmode STDOUT, ':encoding(utf-8)';
print "Hand $hand_idx\n";
print $string;


with javascript_semantics
atom seed

function xrnd()
    seed = and_bits(seed*214013+2531011,#7FFFFFFF)
    return floor(seed/power(2,16))
end function

sequence cards = repeat(0,52)

procedure deal(integer game_num)
    seed = game_num
    for i=1 to 52 do
        cards[i] = 52-i
    end for
    for i=1 to 51 do
        integer j = 52-mod(xrnd(),53-i)
        integer s = cards[i]
        cards[i] = cards[j]
        cards[j] = s
    end for
end procedure

constant suits = "CDHS",
         ranks = "A23456789TJQK"

procedure show()
    for idx=1 to 52 do
        integer rank = floor(cards[idx]/4)+1
        integer suit = mod(cards[idx],4)+1
        integer eol = remainder(idx-1,13)=12
        printf(1,"%c%c%s",{ranks[rank],suits[suit],iff(eol?"\n":" ")})
    end for
end procedure

integer game_num = 1
--integer game_num=617
deal(game_num)
printf(1,"hand %d\n",{game_num})
show()


class FreeCell_Deal {

    protected $deck = array(
        'AC', 'AD', 'AH', 'AS', '2C', '2D', '2H', '2S', '3C', '3D', '3H', '3S',
        '4C', '4D', '4H', '4S', '5C', '5D', '5H', '5S', '6C', '6D', '6H', '6S',
        '7C', '7D', '7H', '7S', '8C', '8D', '8H', '8S', '9C', '9D', '9H', '9S',
        'TC', 'TD', 'TH', 'TS', 'JC', 'JD', 'JH', 'JS', 'QC', 'QD', 'QH', 'QS',
        'KC', 'KD', 'KH', 'KS'
    );

    protected $game;        // Freecell Game Number
    protected $state;       // Current state of the LCG

    public $deal = array(); // Generated card sequence to deal

    function __construct( $game ) {

        $this->game = max( min( $game, 32000 ), 1 );

        // seed RNG with game number
        $this->state = $this->game;

        while ( ! empty( $this->deck ) ) {

            // choose random card
            $i = $this->lcg_rnd() % count( $this->deck );

            // move random card to game deal pile
            $this->deal[] = $this->deck[ $i ];

            // move last card to random card spot
            $this->deck[ $i ] = end( $this->deck );

            // remove last card from deck
            array_pop( $this->deck );

        }

    }

    protected function lcg_rnd() {
        return ( $this->state = ( $this->state * 214013 + 2531011 ) % 2147483648 ) >> 16;
    }

    function print( $cols = 8 ) {
        echo str_pad( " Game " . $this->game . " ", $cols * 3 - 1, '=', STR_PAD_BOTH ), PHP_EOL;
        foreach ( array_chunk( $this->deal, $cols ) as $row ) {
            echo implode( " ", $row ), PHP_EOL;
        }
        echo PHP_EOL;
    }

}

$tests = array( 1, 617, 11982 );

foreach ( $tests as $game_num ) {
    $deal = new FreeCell_Deal( $game_num );
    $deal->print();
}


#MaxCardNum = 51 ;zero-based count of cards in a deck
Global deckSize
Global Dim cards(#MaxCardNum) ;card with highest index is at the top of deck

Procedure RNG(seed.q = -1)
  Static state.q
  If seed >= 0
    state = seed
  Else
    state = (state * 214013 + 2531011) % (1 << 31)
    ProcedureReturn state >> 16
  EndIf
EndProcedure

Procedure makeDeck(hand)
  Protected i, c
  For i = 0 To #MaxCardNum: cards(i) = i: Next

  RNG(hand) ;set seed value
  deckSize = #MaxCardNum
  While deckSize
    c = RNG() % (deckSize + 1)
    Swap cards(c), cards(deckSize)
    deckSize - 1
  Wend
  deckSize = #MaxCardNum
EndProcedure

Procedure showDeck(hand)
  Protected i, c
  PrintN("Hand #" + Str(hand))
  makeDeck(hand)
  For i = 0 To #MaxCardNum
    c = cards(#MaxCardNum - i)
    Print(" " + Mid("A23456789TJQK", (c / 4) + 1, 1) + Mid("CDHS",(c % 4) + 1, 1))
    If (i + 1) % 8 = 0 Or i = #MaxCardNum: PrintN(""): EndIf
  Next
EndProcedure

If OpenConsole()
  showDeck(1)
  showDeck(617)
  showDeck(11982)

  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
  CloseConsole()
EndIf


def randomGenerator(seed=1):
    max_int32 = (1 << 31) - 1
    seed = seed & max_int32

    while True:
        seed = (seed * 214013 + 2531011) & max_int32
        yield seed >> 16

def deal(seed):
    nc = 52
    cards = list(range(nc - 1, -1, -1))
    rnd = randomGenerator(seed)
    for i, r in zip(range(nc), rnd):
        j = (nc - 1) - r % (nc - i)
        cards[i], cards[j] = cards[j], cards[i]
    return cards

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

if __name__ == '__main__':
    from sys import argv
    seed = int(argv[1]) if len(argv) == 2 else 11982
    print("Hand {}".format(seed))
    deck = deal(seed)
    show(deck)


## Linear congruential generator code not original -
## copied from
## http://www.rosettacode.org/wiki/Linear_congruential_generator#R
## altered to allow seed as an argument

library(gmp) # for big integers

rand_MS <- function(n = 1, seed = 1) {
  a <- as.bigz(214013)
  c <- as.bigz(2531011)
  m <- as.bigz(2^31)
  x <- rep(as.bigz(0), n)
  x[1] <- (a * as.bigz(seed) + c) %% m
  i <- 1
  while (i < n) {
    x[i+1] <- (a * x[i] + c) %% m
    i <- i + 1
  }
  as.integer(x / 2^16)
}

## =============================
## New code follows:
## =============================

dealFreeCell <- function(seedNum) {
  deck <- paste(rep(c("A",2,3,4,5,6,7,8,9,10,"J","Q","K"), each = 4), c("C","D","H","S"), sep = "")
  cards = rand_MS(52,seedNum)

  for (i in 52:1) {
    cardToPick <- (cards[53-i]%% i)+1 # R indexes from 1, not 0
    deck[c(cardToPick,i)] <- deck[c(i, cardToPick)]
  }

  deck <- rev(deck) # flip the deck to deal
  deal = matrix(c(deck,NA,NA,NA,NA),ncol = 8, byrow = TRUE)
  # using a matrix for simple printing, but requires filling with NA
  # if implementing as a game, a list for each pile would make more sense
  print(paste("Hand numer:",seedNum), quote = FALSE)
  print(deal, quote = FALSE, na.print = "")
}


#lang racket

(module Linear_congruential_generator racket
  ;; taken from http://rosettacode.org/wiki/Linear_congruential_generator#Racket
  ;; w/o BSD generator
  (require racket/generator)
  (provide ms-rand)
  (define (ms-update state_n)
    (modulo (+ (* 214013 state_n) 2531011)
            (expt 2 31)))
  (define ((rand update ->rand) seed)
    (generator () (let loop ([state_n seed])
                    (define state_n+1 (update state_n))
                    (yield (->rand state_n+1))
                    (loop state_n+1))))
  (define ms-rand (rand ms-update (lambda (x) (quotient x (expt 2 16))))))

(require (submod "." Linear_congruential_generator))

;; Personally I prefer CDHS to the unicode characters (on an aesthetic basis,
;; rather than anything else. Plus it helps match with the examples given at the
;; head of the task.
(define suits "CDHS")
(define (initial-deck)
  (for*/vector #:length 52
    ((face "A23456789TJQK")
     (suit suits))
    (cons face suit)))

;; srfi/43 has one of these, but is quick enough to reimplement!
(define (vector-swap! v i j)
  (let ((t (vector-ref v i)))
    (vector-set! v i (vector-ref v j))
    (vector-set! v j t)))

(define (deal hand)
  (define pack (initial-deck))
  (define rnd (ms-rand hand))
  (define (deal-nth-card pack-sz card-no deal)
    (vector-swap! pack card-no (sub1 pack-sz))
    (cons (vector-ref pack (sub1 pack-sz)) deal))

  (let inner-deal ((pack-sz (vector-length pack)) (deal null))
    (if (zero? pack-sz) (reverse deal) ;; we accumulated this backwards!
        (inner-deal (sub1 pack-sz)
                    (deal-nth-card pack-sz (modulo (rnd) pack-sz) deal)))))

(define (present-deal hand)
  (printf "Game #~a~%" hand)
  (let inner-present-deal ((pile 0) (deck (deal hand)))
    (unless (null? deck)
      (printf "~a~a~a" (caar deck) (cdar deck)
              (if (or (null? (cdr deck)) (= 7 (modulo pile 8))) "\n" " "))
      (inner-present-deal (add1 pile) (cdr deck)))))

;; Run it so we get some output:
(present-deal 1)
(newline)
(present-deal 617)


sub dealgame ($game-number = 1) {
    sub ms-lcg-method($seed = $game-number) { ( 214013 * $seed + 2531011 ) % 2**31 }

    # lazy list of the random sequence
    my @ms-lcg = |(&ms-lcg-method ... *).map: * +> 16;

    constant CardBlock = '🂠'.ord;
    my @deck = gather for flat(1..11,13,14) X+ (48,32...0) -> $off {
        take chr CardBlock + $off;
    }

    my @game = gather while @deck {
        @deck[@ms-lcg.shift % @deck, @deck-1] .= reverse;
        take @deck.pop;
    }

    say "Game #$game-number";
    say @game.splice(0, 8 min +@game) while @game;
}

dealgame;
dealgame 617;


/*REXX program deals cards for a specific  FreeCell solitaire  card game  (0 ──► 32767).*/
numeric digits 15                                /*ensure enough digits for the random #*/
parse arg game cols .                            /*obtain optional arguments from the CL*/
if game=='' | game==","  then game=1             /*No game specified?  Then use default.*/
if cols=='' | cols==","  then cols=8             /* " cols     "         "   "     "    */
state=game                                       /*seed random # generator with game num*/
if 8=='f8'x  then suit= "cdhs"                   /*EBCDIC?   Then use letters for suits.*/
             else suit= "♣♦♥♠"                   /* ASCII?     "   "  symbols  "    "   */
rank= 'A23456789tJQK'                            /*t  in the rank represents a ten (10).*/
pad=left('', 13)                                 /*used for indentation for the tableau.*/
say center('tableau for FreeCell game' game, 50, "─")   /*show title for FreeCell game #*/
say                                              /* [↓]  @  is an array of all 52 cards.*/
#=-1;  do   r=1  for length(rank)                /*build the deck  first   by the rank. */
         do s=1  for length(suit);       #=#+1   /*  "    "    "  secondly  "  "  suit. */
         @.#=substr(rank, r,1)substr(suit, s,1)  /*build the $ array one card at at time*/
         end   /*s*/                             /* [↑]  first card is number  0 (zero).*/
       end     /*r*/                             /* [↑]  build deck per FreeCell rules. */
$=pad                                            /*@: cards to be dealt, eight at a time*/
       do cards=51  by -1  for 52                /* [↓]  deal the cards for the tableau.*/
       ?=rand() // (cards+1)                     /*get next rand#;  card # is remainder.*/
       $=$ @.?;                 @.[email protected].cards      /*swap two cards:  use random and last.*/
       if words($)==cols  then do;  say $; $=pad /*deal FreeCell cards for the tableau. */
                               end
       end   /*cards*/                           /*normally, 8 cards are dealt to a row.*/
                                                 /* [↓]  residual cards may exist.      */
if $\=''  then say $                             /*Any residual cards in the tableau ?  */
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
rand:  state=(214013*state + 2531011) // 2**31;  return state % 2**16   /*FreeCell rand#*/


#   games = ARGV converted to Integer
#   No arguments? Pick any of first 32000 games.
begin
  games = ARGV.map {|s| Integer(s)}
rescue => err
  $stderr.puts err.inspect
  $stderr.puts "Usage: #{__FILE__} number..."
  abort
end
games.empty? and games = [rand(32000)]

# 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}.product(%w{C D H S}).map(&:join)

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(" ")}
  puts
end


projectDir$	= "a_project"                                            ' project directory
imageDir$ 	= DefaultDir$ + "\projects\" + projectDir$ + "\image\"   ' directory of deck images
imagePath$	= "../";projectDir$;"/image/"                            ' path of deck images

suite$ = "C,D,H,S"                                                       ' Club,Diamond,Heart,Spades
card$  = "A,2,3,4,5,6,7,8,9,T,J,Q,K"                                     ' Cards Ace to King

dim n(55)                                                                ' make ordered deck
for i = 1 to 52                                                          '  of 52 cards
 n(i) 	= i
next i

for i = 1 to 52 * 3                                                      ' shuffle deck 3 times
  i1    = int(rnd(1)*52) + 1
  i2    = int(rnd(1)*52) + 1
  h2    = n(i1)
  n(i1) = n(i2)
  n(i2) = h2
next i

for yy = 1 to 8                                                        ' display 7 across and 8 down
  for xx = 1 to 7
    card = card + 1
    s    = (n(card) mod 4)  + 1                                        ' determine suite
    c    = (n(card) mod 13) + 1                                        ' determine card
    cardId$ = word$(card$,c,",");word$(suite$,s,",");".gif"
    html "
"
    html "
"
    html ""
    html "

"
    if card = 52 then end                                              ' out of cards
  next xx
next yy


// Code available at https://rosettacode.org/wiki/Linear_congruential_generator#Rust
extern crate linear_congruential_generator;

use linear_congruential_generator::{MsLcg, Rng, SeedableRng};

// We can't use `rand::Rng::shuffle` because it uses the more uniform `rand::Rng::gen_range`
// (`% range` is subject to modulo bias).  If an exact match of the old dealer is not needed,
// `rand::Rng::shuffle` should be used.
fn shuffle<T>(rng: &mut MsLcg, deck: &mut [T]) {
    let len = deck.len() as u32;
    for i in (1..len).rev() {
        let j = rng.next_u32() % (i + 1);
        deck.swap(i as usize, j as usize);
    }
}

fn gen_deck() -> Vec<String> {
    const RANKS: [char; 13] = ['A','2','3','4','5','6','7','8','9','T','J','Q','K'];
    const SUITS: [char; 4] = ['C', 'D', 'H', 'S'];

    let render_card = |card: usize| {
        let (suit, rank) = (card % 4, card / 4);
        format!("{}{}", RANKS[rank], SUITS[suit])
    };

    (0..52).map(render_card).collect()
}

fn deal_ms_fc_board(seed: u32) -> Vec<String> {
    let mut rng = MsLcg::from_seed(seed);
    let mut deck = gen_deck();

    shuffle(&mut rng, &mut deck);
    deck.reverse();

    deck.chunks(8).map(|row| row.join(" ")).collect::<Vec<_>>()
}

fn main() {
    let seed = std::env::args()
        .nth(1)
        .and_then(|n| n.parse().ok())
        .expect("A 32-bit seed is required");

    for row in deal_ms_fc_board(seed) {
        println!(": {}", row);
    }
}


object Shuffler extends App {

  private val suits = Array("C", "D", "H", "S")
  private val values = Array("A", "2", "3", "4", "5", "6", "7", "8", "9", "T", "J", "Q", "K")
  private val deck = values.flatMap(v => suits.map(s => s"$v$s"))

  private var seed: Int = _

  private def random() = {
    seed = (214013 * seed + 2531011) & Integer.MAX_VALUE
    seed >> 16
  }

  private def getShuffledDeck = {
    val d = deck.map(c => c)
    for(i <- deck.length - 1 until 0 by -1) {
      val r = random() % (i + 1)
      val card = d(r)
      d(r) = d(i)
      d(i) = card
    }
    d.reverse
  }

  def deal(seed: Int): Unit = {
    this.seed = seed
    getShuffledDeck.grouped(8).foreach(e => println(e.mkString(" ")))
  }

  deal(1)
  println
  deal(617)
}


$ include "seed7_05.s7i";
  include "console.s7i";

const string: suits is "♣♦♥♠";
const string: nums is "A23456789TJQK";

var integer: randomSeed is 1;

const func integer: random is func
  result
    var integer: rand is 1;
  begin
    randomSeed := (randomSeed * 214013 + 2531011) mod 2 ** 31;
    rand := randomSeed >> 16;
  end func;

const proc: show (in array integer: cards) is func
  local
    var integer: index is 0;
  begin
    for index range 1 to 52 do
      write("  " <& suits[succ(cards[index] rem 4)] <& nums[succ(cards[index] div 4)]);
      if index rem 8 = 0 or index = 52 then
        writeln;
      end if;
    end for;
  end func;

const func array integer: deal (in integer: gameNum) is func
  result
    var array integer: cards is 52 times 0;
  local
    var integer: i is 0;
    var integer: j is 0;
    var integer: s is 0;
  begin
    randomSeed := gameNum;
    for i range 1 to 52 do
      cards[i] := 52 - i;
    end for;
    for i range 1 to 51 do
      j := 52 - random mod (53 - i);
      s := cards[i];
      cards[i] := cards[j];
      cards[j] := s;
    end for;
  end func;

const proc: main is func
  local
    var integer: gameNum is 11982;
    var array integer: cards is 0 times 0;
  begin
    OUT := STD_CONSOLE;
    if length(argv(PROGRAM)) >= 1 then
      block
        gameNum := integer parse (argv(PROGRAM)[1]);
      exception
        catch RANGE_ERROR: noop;
      end block;
    end if;
    cards := deal(gameNum);
    writeln("Hand " <& gameNum);
    show(cards);
  end func;


enum Suit : String, CustomStringConvertible, CaseIterable {
    case clubs = "C", diamonds = "D", hearts = "H", spades = "S"
    var description: String {
        return self.rawValue
    }
}
enum Rank : Int, CustomStringConvertible, CaseIterable {
    case ace=1, two, three, four, five, six, seven
    case eight, nine, ten, jack, queen, king
    var description: String {
        let d : [Rank:String] = [.ace:"A", .king:"K", .queen:"Q", .jack:"J", .ten:"T"]
        return d[self] ?? String(self.rawValue)
    }
}
struct Card : CustomStringConvertible {
    let rank : Rank, suit : Suit
    var description : String {
        return String(describing:self.rank) + String(describing:self.suit)
    }
    init(rank:Rank, suit:Suit) {
        self.rank = rank; self.suit = suit
    }
    init(sequence n:Int) {
        self.init(rank:Rank.allCases[n/4], suit:Suit.allCases[n%4])
    }
}
struct Deck : CustomStringConvertible {
    var cards = [Card]()
    init(seed:Int) {
        for i in (0..<52).reversed() {
            self.cards.append(Card(sequence:i))
        }
        struct MicrosoftLinearCongruentialGenerator {
            var seed : Int
            mutating func next() -> Int {
                self.seed = (self.seed * 214013 + 2531011) % (Int(Int32.max)+1)
                return self.seed >> 16
            }
        }
        var r = MicrosoftLinearCongruentialGenerator(seed: seed)
        for i in 0..<51 {
            self.cards.swapAt(i, 51-r.next()%(52-i))
        }
    }
    var description : String {
        var s = ""
        for (ix,c) in self.cards.enumerated() {
            s.write(String(describing:c))
            s.write(ix % 8 == 7 ? "\n" : " ")
        }
        return s
    }
}
let d1 = Deck(seed: 1)
print(d1)
let d617 = Deck(seed: 617)
print(d617)


proc rnd {{*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


test $# -gt 0 || set -- $((RANDOM % 32000))
for seed; do
	print Game $seed:

	# Shuffle deck.
	deck=({A,{2..9},T,J,Q,K}{C,D,H,S})
	for i in {52..1}; do
		((seed = (214013 * seed + 2531011) & 0x7fffffff))
		((j = (seed >> 16) % i + 1))
		t=$deck[$i]
		deck[$i]=$deck[$j]
		deck[$j]=$t
	done

	# Deal cards.
	print -n ' '
	for i in {52..1}; do
		print -n ' '$deck[$i]
		((i % 8 == 5)) && print -n $'\n '
	done
	print
done


class Lcg {
    construct new(a, c, m, d, s) {
        _a = a
        _c = c
        _m = m
        _d = d
        _s = s
    }

    nextInt() {
        _s = (_a * _s + _c) % _m
        return _s / _d
    }
}

var CARDS = "A23456789TJQK"
var SUITS = "♣♦♥♠".toList

var deal = Fn.new {
    var cards = List.filled(52, null)
    for (i in 0...52) {
        var card = CARDS[(i/4).floor]
        var suit = SUITS[i%4]
        cards[i] = card + suit
    }
    return cards
}

var game = Fn.new { |n|
    if (n.type != Num || !n.isInteger || n <= 0) {
        Fiber.abort("Game number must be a positive integer.")
    }
    System.print("Game #%(n):")
    var msc = Lcg.new(214013, 2531011, 1<<31, 1<<16, n)
    var cards = deal.call()
    for (m in 52..1) {
        var index = (msc.nextInt() % m).floor
        var temp = cards[index]
        cards[index] = cards[m - 1]
        System.write("%(temp) ")
        if ((53 - m) % 8 == 0) System.print()
    }
    System.print("\n")
}

game.call(1)
game.call(617)


include c:\cxpl\codes;                  \intrinsic 'code' declarations
string 0;                               \use zero-terminated string convention
int  RandState;

func Rand;                              \Random number in range 0 to 32767
[RandState:= (214013*RandState + 2531011) & $7FFF_FFFF;
return RandState >> 16;
];

int  Card, Deck(52), Size;
char Suit, Rank;
[RandState:= IntIn(8);                  \seed RNG with number from command line
for Card:= 0 to 52-1 do Deck(Card):= Card; \create array of 52 cards
Rank:= "A23456789TJQK";
Suit:= "CDHS";
Size:= 52;
repeat  Card:= rem(Rand/Size);          \choose a random card
        ChOut(0, Rank(Deck(Card)/4));   \deal it by showing it
        ChOut(0, Suit(rem(0)));
        if rem(Size/8)=5 then CrLf(0) else ChOut(0, ^ );
        Size:= Size-1;                  \one less card in deck
        Deck(Card):= Deck(Size);        \replace dealt card with last card
until   Size = 0;                       \all cards have been dealt
]


var suits=T(0x1F0D1,0x1F0C1,0x1F0B1,0x1F0A1); //unicode 🃑,🃁,🂱,🂡

var seed=1; const RMAX32=(1).shiftLeft(31) - 1;
fcn rnd{ (seed=((seed*214013 + 2531011).bitAnd(RMAX32))).shiftRight(16) }

fcn game(n){
   seed=n;
   deck:=(0).pump(52,List,'wrap(n){ if(n>=44) n+=4; // I want JQK, not JCQ
       (suits[n%4] + n/4).toString(8) }).copy();  // int-->UTF-8
   [52..1,-1].pump(Void,'wrap(len){ deck.swap(len-1,rnd()%len); });
   deck.reverse();
   println("Game #",n);
   foreach n in ([0..51,8]){ deck[n,8].concat(" ").println(); }
}

game(1);
game(617);