new files

Task/Knuth-shuffle/0DESCRIPTION

@@ -0,0 +1 @@
+Implement the [[wp:Knuth shuffle|Knuth shuffle]] (a.k.a. the Fisher-Yates shuffle) for an integer array (or, if possible, an array of any type). The Knuth shuffle is used to create a random permutation of an array.

Task/Knuth-shuffle/1META.yaml

@@ -0,0 +1,2 @@
+---
+note: Classic CS problems and programs

Task/Knuth-shuffle/ACL2/knuth-shuffle.acl2

@@ -0,0 +1,24 @@
+:set-state-ok t
+
+(defun array-swap (name array i j)
+   (let ((ai (aref1 name array i))
+         (aj (aref1 name array j)))
+      (aset1 name
+             (aset1 name array j ai)
+             i aj)))
+
+(defun shuffle-r (name array m state)
+   (if (zp m)
+       (mv array state)
+       (mv-let (i state)
+               (random$ m state)
+          (shuffle-r name
+                     (array-swap name array i m)
+                     (1- m)
+                     state))))
+
+(defun shuffle (name array state)
+   (shuffle-r name
+              array
+              (1- (first (dimensions name array)))
+              state))

Task/Knuth-shuffle/AWK/knuth-shuffle.awk

@@ -0,0 +1,21 @@
+# Shuffle an _array_ with indexes from 1 to _len_.
+function shuffle(array, len,    i, j, t) {
+	for (i = len; i > 1; i--) {
+		# j = random integer from 1 to i
+		j = int(i * rand()) + 1
+
+		# swap array[i], array[j]
+		t = array[i]
+		array[i] = array[j]
+		array[j] = t
+	}
+}
+
+# Test program.
+BEGIN {
+	len = split("11 22 33 44 55 66 77 88 99 110", array)
+	shuffle(array, len)
+
+	for (i = 1; i < len; i++) printf "%s ", array[i]
+	printf "%s\n", array[len]
+}

Task/Knuth-shuffle/Ada/knuth-shuffle-1.ada

@@ -0,0 +1,5 @@
+generic
+   type Element_Type is private;
+   type Array_Type is array (Positive range <>) of Element_Type;
+
+procedure Generic_Shuffle (List : in out Array_Type);

Task/Knuth-shuffle/Ada/knuth-shuffle-2.ada

@@ -0,0 +1,17 @@
+with Ada.Numerics.Discrete_Random;
+
+procedure Generic_Shuffle (List : in out Array_Type) is
+   package Discrete_Random is new Ada.Numerics.Discrete_Random(Result_Subtype => Integer);
+   use Discrete_Random;
+   K : Integer;
+   G : Generator;
+   T : Element_Type;
+begin
+   Reset (G);
+   for I in reverse List'Range loop
+      K := (Random(G) mod I) + 1;
+      T := List(I);
+      List(I) := List(K);
+      List(K) := T;
+   end loop;
+end Generic_Shuffle;

Task/Knuth-shuffle/Ada/knuth-shuffle-3.ada

@@ -0,0 +1,22 @@
+with Ada.Text_IO;
+with Generic_Shuffle;
+
+procedure Test_Shuffle is
+
+   type Integer_Array is array (Positive range <>) of Integer;
+
+   Integer_List : Integer_Array
+     := (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18);
+   procedure Integer_Shuffle is new Generic_Shuffle(Element_Type => Integer,
+                                                    Array_Type => Integer_Array);
+begin
+
+   for I in Integer_List'Range loop
+      Ada.Text_IO.Put(Integer'Image(Integer_List(I)));
+   end loop;
+   Integer_Shuffle(List => Integer_List);
+   Ada.Text_IO.New_Line;
+   for I in Integer_List'Range loop
+      Ada.Text_IO.Put(Integer'Image(Integer_List(I)));
+   end loop;
+end Test_Shuffle;

Task/Knuth-shuffle/BASIC/knuth-shuffle.bas

@@ -0,0 +1,21 @@
+RANDOMIZE TIMER
+
+DIM cards(51) AS INTEGER
+DIM L0 AS LONG, card AS LONG
+
+PRINT "before:"
+FOR L0 = 0 TO 51
+    cards(L0) = L0
+    PRINT LTRIM$(STR$(cards(L0))); " ";
+NEXT
+
+FOR L0 = 51 TO 0 STEP -1
+    card = INT(RND * (L0 + 1))
+    IF card <> L0 THEN SWAP cards(card), cards(L0)
+NEXT
+
+PRINT : PRINT "after:"
+FOR L0 = 0 TO 51
+    PRINT LTRIM$(STR$(cards(L0))); " ";
+NEXT
+PRINT

Task/Knuth-shuffle/C/knuth-shuffle-1.c

@@ -0,0 +1,21 @@
+#include <stdlib.h>
+#include <string.h>
+
+int rrand(int m)
+{
+  return (int)((double)m * ( rand() / (RAND_MAX+1.0) ));
+}
+
+#define BYTE(X) ((unsigned char *)(X))
+void shuffle(void *obj, size_t nmemb, size_t size)
+{
+  void *temp = malloc(size);
+  size_t n = nmemb;
+  while ( n > 1 ) {
+    size_t k = rrand(n--);
+    memcpy(temp, BYTE(obj) + n*size, size);
+    memcpy(BYTE(obj) + n*size, BYTE(obj) + k*size, size);
+    memcpy(BYTE(obj) + k*size, temp, size);
+  }
+  free(temp);
+}

Task/Knuth-shuffle/C/knuth-shuffle-2.c

@@ -0,0 +1,52 @@
+#include <stdio.h>
+#include <stdlib.h>
+
+/* define a shuffle function. e.g. decl_shuffle(double).
+ * advantage: compiler is free to optimize the swap operation without
+ *            indirection with pointers, which could be much faster.
+ * disadvantage: each datatype needs a separate instance of the function.
+ *            for a small funciton like this, it's not very big a deal.
+ */
+#define decl_shuffle(type)				\
+void shuffle_##type(type *list, size_t len) {		\
+	int j;						\
+	type tmp;					\
+	while(len) {					\
+		j = irand(len);				\
+		if (j != len - 1) {			\
+			tmp = list[j];			\
+			list[j] = list[len - 1];	\
+			list[len - 1] = tmp;		\
+		}					\
+		len--;					\
+	}						\
+}							\
+
+/* random integer from 0 to n-1 */
+int irand(int n)
+{
+	int r, rand_max = RAND_MAX - (RAND_MAX % n);
+	/* reroll until r falls in a range that can be evenly
+	 * distributed in n bins.  Unless n is comparable to
+	 * to RAND_MAX, it's not *that* important really. */
+	while ((r = rand()) >= rand_max);
+	return r / (rand_max / n);
+}
+
+/* declare and define int type shuffle function from macro */
+decl_shuffle(int);
+
+int main()
+{
+	int i, x[20];
+
+	for (i = 0; i < 20; i++) x[i] = i;
+	for (printf("before:"), i = 0; i < 20 || !printf("\n"); i++)
+		printf(" %d", x[i]);
+
+	shuffle_int(x, 20);
+
+	for (printf("after: "), i = 0; i < 20 || !printf("\n"); i++)
+		printf(" %d", x[i]);
+	return 0;
+}

Task/Knuth-shuffle/Clojure/knuth-shuffle.clj

@@ -0,0 +1,4 @@
+(defn shuffle [vect]
+  (reduce (fn [v i] (let [r (rand-int i)]
+                      (assoc v i (v r) r (v i)))
+          vect (range (dec (count vect)) 1 -1)))

Task/Knuth-shuffle/CoffeeScript/knuth-shuffle.coffee

@@ -0,0 +1,21 @@
+knuth_shuffle = (a) ->
+  n = a.length
+  while n > 1
+    r = Math.floor(n * Math.random())
+    n -= 1
+    [a[n], a[r]] = [a[r], a[n]]
+  a
+
+counts =
+  "1,2,3": 0
+  "1,3,2": 0
+  "2,1,3": 0
+  "2,3,1": 0
+  "3,1,2": 0
+  "3,2,1": 0
+
+for i in [1..100000]
+  counts[knuth_shuffle([ 1, 2, 3 ]).join(",")] += 1
+
+for key, val of counts
+  console.log "#{key}: #{val}"

Task/Knuth-shuffle/Forth/knuth-shuffle.fth

@@ -0,0 +1,15 @@
+include random.fs
+
+: shuffle ( deck size -- )
+  2 swap do
+    dup i random cells +
+    over @ over @  swap
+    rot  ! over !
+    cell+
+  -1 +loop drop ;
+
+: .array   0 do dup @ . cell+ loop drop ;
+
+create deck 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 ,
+
+deck 10 2dup shuffle .array

Task/Knuth-shuffle/Fortran/knuth-shuffle.f

@@ -0,0 +1,33 @@
+program Knuth_Shuffle
+  implicit none
+
+  integer, parameter :: reps = 1000000
+  integer :: i, n
+  integer, dimension(10) :: a, bins = 0, initial = (/ (n, n=1,10) /)
+
+  do i = 1, reps
+    a = initial
+ 	call Shuffle(a)
+    where (a == initial) bins = bins + 1  ! skew tester
+  end do
+  write(*, "(10(i8))") bins
+! prints  100382  100007   99783  100231  100507   99921   99941  100270  100290  100442
+
+contains
+
+subroutine Shuffle(a)
+  integer, intent(inout) :: a(:)
+  integer :: i, randpos, temp
+  real :: r
+
+  do i = size(a), 2, -1
+    call random_number(r)
+    randpos = int(r * i) + 1
+    temp = a(randpos)
+    a(randpos) = a(i)
+    a(i) = temp
+  end do
+
+end subroutine Shuffle
+
+end program Knuth_Shuffle

Task/Knuth-shuffle/Go/knuth-shuffle-1.go

@@ -0,0 +1,22 @@
+package main
+
+import (
+    "fmt"
+    "math/rand"
+    "time"
+)
+
+func main() {
+    var a [20]int
+    for i := range a {
+        a[i] = i
+    }
+    fmt.Println(a)
+
+    rand.Seed(time.Now().UnixNano())
+    for i := len(a) - 1; i >= 1; i-- {
+        j := rand.Intn(i + 1)
+        a[i], a[j] = a[j], a[i]
+    }
+    fmt.Println(a)
+}

Task/Knuth-shuffle/Go/knuth-shuffle-2.go

@@ -0,0 +1,48 @@
+package main
+
+import (
+    "fmt"
+    "math/rand"
+    "time"
+)
+
+// Generic Knuth Shuffle algorithm.  In Go, this is done with interface
+// types.  The parameter s of function shuffle is an interface type.
+// Any type satisfying the interface "shuffler" can be shuffled with
+// this function.  Since the shuffle function uses the random number
+// generator, it's nice to seed the generator at program load time.
+func init() {
+    rand.Seed(time.Now().UnixNano())
+}
+func shuffle(s shuffler) {
+    for i := s.Len() - 1; i >= 1; i-- {
+        j := rand.Intn(i + 1)
+        s.Swap(i, j)
+    }
+}
+
+// Conceptually, a shuffler is an indexed collection of things.
+// It requires just two simple methods.
+type shuffler interface {
+    Len() int      // number of things in the collection
+    Swap(i, j int) // swap the two things indexed by i and j
+}
+
+// ints is an example of a concrete type implementing the shuffler
+// interface.
+type ints []int
+
+func (s ints) Len() int      { return len(s) }
+func (s ints) Swap(i, j int) { s[i], s[j] = s[j], s[i] }
+
+// Example program.  Make an ints collection, fill with sequential numbers,
+// print, shuffle, print.
+func main() {
+    a := make(ints, 20)
+    for i := range a {
+        a[i] = i
+    }
+    fmt.Println(a)
+    shuffle(a)
+    fmt.Println(a)
+}

Task/Knuth-shuffle/Haskell/knuth-shuffle-1.hs

@@ -0,0 +1,17 @@
+import System.Random
+import Data.List
+import Control.Monad
+import Control.Arrow
+
+mkRands = mapM (randomRIO.(,)0 ). enumFromTo 1. pred
+
+replaceAt :: Int -> a -> [a] -> [a]
+replaceAt i c = let (a,b) = splitAt i l in a++x:(drop 1 b)
+
+swapElems :: (Int, Int) -> [a] -> [a]
+swapElems (i,j) xs | i==j = xs
+                   | otherwise = replaceAt j (xs!!i) $ replaceAt i (xs!!j) xs
+
+knuthShuffle :: [a] -> IO [a]
+knuthShuffle xs =
+  liftM (foldr swapElems xs. zip [1..]) (mkRands (length xs))

Task/Knuth-shuffle/Haskell/knuth-shuffle-2.hs

@@ -0,0 +1,3 @@
+knuthShuffleProcess :: (Show a) => [a] -> IO ()
+knuthShuffleProcess =
+   (mapM_ print. reverse =<<). ap (fmap. (. zip [1..]). scanr swapElems) (mkRands. length)

Task/Knuth-shuffle/Haskell/knuth-shuffle-3.hs

@@ -0,0 +1,21 @@
+import Data.Array.ST
+import Data.STRef
+import Control.Monad
+import Control.Monad.ST
+import Control.Arrow
+import System.Random
+
+shuffle :: RandomGen g => [a] -> g -> ([a], g)
+shuffle list g = runST $ do
+    r <- newSTRef g
+    let rand range = liftM (randomR range) (readSTRef r) >>=
+            runKleisli (second (Kleisli $ writeSTRef r) >>> arr fst)
+    a <- newAry (1, len) list
+    forM_ [len, len - 1 .. 2] $ \n -> do
+        k <- rand (1, n)
+        liftM2 (,) (readArray a k) (readArray a n) >>=
+           runKleisli (Kleisli (writeArray a n) *** Kleisli (writeArray a k))
+    liftM2 (,) (getElems a) (readSTRef r)
+  where len = length list
+        newAry :: (Int, Int) -> [a] -> ST s (STArray s Int a)
+        newAry = newListArray

Task/Knuth-shuffle/Java/knuth-shuffle.java

@@ -0,0 +1,24 @@
+import java.util.Random;
+
+public static final Random gen = new Random();
+
+// version for array of ints
+public static void shuffle (int[] array) {
+    int n = array.length;
+    while (n > 1) {
+        int k = gen.nextInt(n--); //decrements after using the value
+        int temp = array[n];
+        array[n] = array[k];
+        array[k] = temp;
+    }
+}
+// version for array of references
+public static void shuffle (Object[] array) {
+    int n = array.length;
+    while (n > 1) {
+        int k = gen.nextInt(n--); //decrements after using the value
+        Object temp = array[n];
+        array[n] = array[k];
+        array[k] = temp;
+    }
+}

Task/Knuth-shuffle/JavaScript/knuth-shuffle.js

@@ -0,0 +1,28 @@
+function knuth_shuffle(a) {
+    var n = a.length,
+        r,
+        temp;
+    while (n > 1) {
+        r = Math.floor(n * Math.random());
+        n -= 1;
+        temp = a[n];
+        a[n] = a[r];
+        a[r] = temp;
+    }
+    return a;
+}
+
+var res, i, key;
+
+res = {
+    '1,2,3': 0, '1,3,2': 0,
+    '2,1,3': 0, '2,3,1': 0,
+    '3,1,2': 0, '3,2,1': 0
+};
+
+for (i = 0; i < 100000; i++) {
+    res[knuth_shuffle([1,2,3]).join(',')] += 1;
+}
+for (key in res) {
+    print(key + "\t" + res[key]);
+}

Task/Knuth-shuffle/Lua/knuth-shuffle.lua

@@ -0,0 +1,14 @@
+function table.shuffle(t)
+  local n = #t
+  while n > 1 do
+    local k = math.random(n)
+    t[n], t[k] = t[k], t[n]
+    n = n - 1
+  end
+
+  return t
+end
+math.randomseed( os.time() )
+a = {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}
+table.shuffle(a)
+for i,v in ipairs(a) do print(i,v) end

Task/Knuth-shuffle/PHP/knuth-shuffle.php

@@ -0,0 +1,18 @@
+//The Fisher-Yates original Method
+function yates_shuffle($arr){
+	$shuffled = Array();
+	while($arr){
+		$rnd = array_rand($arr);
+		$shuffled[] = $arr[$rnd];
+		array_splice($arr, $rnd, 1);
+	}
+	return $shuffled;
+}
+
+//The modern Durstenfeld-Knuth algorithm
+function knuth_shuffle(&$arr){
+	for($i=count($arr)-1;$i>0;$i--){
+		$rnd = mt_rand(0,$i);
+		list($arr[$i], $arr[$rnd]) = array($arr[$rnd], $arr[$i]);
+	}
+}

Task/Knuth-shuffle/Perl/knuth-shuffle.pl

@@ -0,0 +1,8 @@
+sub shuffle {
+  my @a = @_;
+  foreach my $n (1 .. $#a) {
+    my $k = int rand $n + 1;
+    $k == $n or @a[$k, $n] = @a[$n, $k];
+  }
+  return @a;
+}

Task/Knuth-shuffle/PicoLisp/knuth-shuffle.l

@@ -0,0 +1,7 @@
+(de shuffle (Lst)
+   (make
+      (for (N (length Lst) (gt0 N))
+         (setq Lst
+            (conc
+               (cut (rand 0 (dec 'N)) 'Lst)
+               (prog (link (car Lst)) (cdr Lst)) ) ) ) ) )

Task/Knuth-shuffle/Python/knuth-shuffle.py

@@ -0,0 +1,10 @@
+from random import randrange
+
+def knuth_shuffle(x):
+    for i in range(len(x)-1, 0, -1):
+        j = randrange(i + 1)
+        x[i], x[j] = x[j], x[i]
+
+x = list(range(10))
+knuth_shuffle(x)
+print("shuffled:", x)

Task/Knuth-shuffle/R/knuth-shuffle-1.r

@@ -0,0 +1,12 @@
+fisheryatesshuffle <- function(n)
+{
+  pool <- seq_len(n)
+  a <- c()
+  while(length(pool) > 0)
+  {
+     k <- sample.int(length(pool), 1)
+     a <- c(a, pool[k])
+     pool <- pool[-k]
+  }
+  a
+}

Task/Knuth-shuffle/R/knuth-shuffle-2.r

@@ -0,0 +1,21 @@
+fisheryatesknuthshuffle <- function(n)
+{
+   a <- seq_len(n)
+   while(n >=2)
+   {
+      k <- sample.int(n, 1)
+      if(k != n)
+      {
+         temp <- a[k]
+         a[k] <- a[n]
+         a[n] <- temp
+      }
+      n <- n - 1
+   }
+   a
+}
+
+#Example usage:
+fisheryatesshuffle(6)                # e.g. 1 3 6 2 4 5
+x <- c("foo", "bar", "baz", "quux")
+x[fisheryatesknuthshuffle(4)]        # e.g. "bar"  "baz"  "quux" "foo"

Task/Knuth-shuffle/REXX/knuth-shuffle.rexx

@@ -0,0 +1,37 @@
+/*REXX program shuffles a deck of playing cards using the Knuth shuffle.*/
+rank='ace duece trey 4 5 6 7 8 9 10 jack queen king'
+suit='club spade diamond heart'
+say '────────────────── getting a new deck out of the box...'
+deck.1='  color joker'                 /*good decks have a color joker, */
+deck.2='    b&w joker'                 /*∙∙∙ and a black & white joker. */
+cards=2                                /*now, two cards are in the deck.*/
+           do j     =1  for words(suit)
+                do k=1  for words(rank)
+                cards=cards+1
+                deck.cards=right(word(suit,j),7)  word(rank,k)
+                end  /*k*/
+           end       /*j*/
+
+call showDeck 'ace'                    /*inserts blank when ACE is found*/
+say '────────────────── shuffling' cards "cards..."
+
+   do s=cards  by -1  to 1;            rand=random(1,s)
+   if rand\==s  then do                /*swap two cards in the card deck*/
+                     _=deck.rand
+                     deck.rand=deck.s
+                     deck.s=_
+                     end
+   end   /*s*/
+
+call showDeck
+say '────────────────── ready to play schafkopf  (take out jokers first).'
+exit                                   /*stick a fork in it, we're done.*/
+
+/*──────────────────────────────────SHOWDECK subroutine─────────────────*/
+showDeck: parse arg break;    say
+      do m=1  for cards
+      if pos(break,deck.m)\==0  then say   /*blank, easier to read cards*/
+      say 'card' right(m,2) '───►' deck.m
+      end   /*m*/
+say
+return

Task/Knuth-shuffle/Ruby/knuth-shuffle-1.rb

@@ -0,0 +1,21 @@
+class Array
+  def knuth_shuffle!
+    j = length
+    i = 0
+    while j > 1
+      r = i + rand(j)
+      self[i], self[r] = self[r], self[i]
+      i += 1
+      j -= 1
+    end
+    self
+  end
+end
+
+r = Hash.new(0)
+100_000.times do |i|
+  a = [1,2,3].knuth_shuffle!
+  r[a] += 1
+end
+
+r.keys.sort.each {|a| puts "#{a.inspect} => #{r[a]}"}

Task/Knuth-shuffle/Ruby/knuth-shuffle-2.rb

@@ -0,0 +1,9 @@
+class Array
+  def knuth_shuffle!
+    (length - 1).downto(1) do |i|
+      j = rand(i + 1)
+      self[i], self[j] = self[j], self[i]
+    end
+    self
+  end
+end

Task/Knuth-shuffle/Scala/knuth-shuffle.scala

@@ -0,0 +1,9 @@
+def shuffle[T](a: Array[T]) = {
+  for (i <- 1 until a.size reverse) {
+    val j = util.Random nextInt (i + 1)
+    val t = a(i)
+    a(i) = a(j)
+    a(j) = t
+  }
+  a
+}

Task/Knuth-shuffle/Scheme/knuth-shuffle.ss

@@ -0,0 +1,10 @@
+(define (swap vec i j)
+  (let ([tmp (vector-ref vec i)])
+    (vector-set! vec i (vector-ref vec j))
+    (vector-set! vec j tmp)))
+
+(define (shuffle vec)
+  (for ((i (in-range (- (vector-length vec) 1) 0 -1)))
+    (let ((r (random i)))
+      (swap vec i r)))
+  vec)

Task/Knuth-shuffle/Smalltalk/knuth-shuffle-1.st

@@ -0,0 +1,22 @@
+"The selector swap:with: is documented, but it seems not
+ implemented (GNU Smalltalk version 3.0.4); so here it is an implementation"
+SequenceableCollection extend [
+  swap: i with: j [
+    |t|
+    t := self at: i.
+    self at: i put: (self at: j).
+    self at: j put: t.
+  ]
+].
+
+Object subclass: Shuffler [
+  Shuffler class >> Knuth: aSequenceableCollection [
+    |n k|
+    n := aSequenceableCollection size.
+    [ n > 1 ] whileTrue: [
+      k := Random between: 1 and: n.
+      aSequenceableCollection swap: n with: k.
+      n := n - 1
+    ]
+  ]
+].

Task/Knuth-shuffle/Smalltalk/knuth-shuffle-2.st

@@ -0,0 +1,6 @@
+"Test"
+|c|
+c := OrderedCollection new.
+c addAll: #( 1 2 3 4 5 6 7 8 9 ).
+Shuffler Knuth: c.
+c display.

Task/Knuth-shuffle/Tcl/knuth-shuffle-1.tcl

@@ -0,0 +1,17 @@
+proc knuth_shuffle lst {
+   set j [llength $lst]
+   for {set i 0} {$j > 1} {incr i;incr j -1} {
+       set r [expr {$i+int(rand()*$j)}]
+       set t [lindex $lst $i]
+       lset lst $i [lindex $lst $r]
+       lset lst $r $t
+   }
+   return $lst
+}
+
+% knuth_shuffle {1 2 3 4 5}
+2 1 3 5 4
+% knuth_shuffle {1 2 3 4 5}
+5 2 1 4 3
+% knuth_shuffle {tom dick harry peter paul mary}
+tom paul mary harry peter dick

Task/Knuth-shuffle/Tcl/knuth-shuffle-2.tcl

@@ -0,0 +1,11 @@
+% for {set i 0} {$i<100000} {incr i} {
+    foreach val [knuth_shuffle {1 2 3 4 5}] pos {pos0 pos1 pos2 pos3 pos4} {
+        incr tots($pos) $val
+    }
+}
+% parray tots
+tots(pos0) = 300006
+tots(pos1) = 300223
+tots(pos2) = 299701
+tots(pos3) = 299830
+tots(pos4) = 300240