Data update

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

@@ -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.adb

@@ -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.adb

@@ -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/AutoIt/knuth-shuffle.au3

@@ -0,0 +1,25 @@
+Dim $a[10]
+ConsoleWrite('array before permutation:' & @CRLF)
+For $i = 0 To 9
+	$a[$i] = Random(20,100,1)
+	ConsoleWrite($a[$i] & ' ')
+Next
+ConsoleWrite(@CRLF)
+
+_Permute($a)
+ConsoleWrite('array after permutation:' & @CRLF)
+For $i = 0 To UBound($a) -1
+	ConsoleWrite($a[$i] & ' ')
+Next
+ConsoleWrite(@CRLF)
+
+
+Func _Permute(ByRef $array)
+	Local $random, $tmp
+	For $i = UBound($array) -1 To 0 Step -1
+		$random = Random(0,$i,1)
+		$tmp = $array[$random]
+		$array[$random] = $array[$i]
+		$array[$i] = $tmp
+	Next
+EndFunc

Task/Knuth-shuffle/COBOL/knuth-shuffle.cob

@@ -0,0 +1,29 @@
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. knuth-shuffle.
+
+       DATA DIVISION.
+       LOCAL-STORAGE SECTION.
+       01  i                       PIC 9(8).
+       01  j                       PIC 9(8).
+
+       01  temp                    PIC 9(8).
+
+       LINKAGE SECTION.
+       78  Table-Len               VALUE 10.
+       01  ttable-area.
+           03  ttable              PIC 9(8) OCCURS Table-Len TIMES.
+
+       PROCEDURE DIVISION USING ttable-area.
+           MOVE FUNCTION RANDOM(FUNCTION CURRENT-DATE (11:6)) TO i
+
+           PERFORM VARYING i FROM Table-Len BY -1 UNTIL i = 0
+               COMPUTE j =
+                   FUNCTION MOD(FUNCTION RANDOM * 10000, Table-Len) + 1
+
+               MOVE ttable (i) TO temp
+               MOVE ttable (j) TO ttable (i)
+               MOVE temp TO ttable (j)
+           END-PERFORM
+
+           GOBACK
+           .

Task/Knuth-shuffle/EasyLang/knuth-shuffle.easy

@@ -1,9 +1,9 @@
 proc shuffle &a[] .
    for i = len a[] downto 2
-      r = random i
+      r = random 1 i
       swap a[r] a[i]
    .
 .
-arr[] = [ 1 2 3 ]
+arr[] = [ 1 2 3 4 ]
 shuffle arr[]
 print arr[]

Task/Knuth-shuffle/Euphoria/knuth-shuffle.eu

@@ -0,0 +1,23 @@
+sequence cards
+cards = repeat(0,52)
+integer card,temp
+
+puts(1,"Before:\n")
+for i = 1 to 52 do
+    cards[i] = i
+    printf(1,"%d ",cards[i])
+end for
+
+for i = 52 to 1 by -1 do
+    card = rand(i)
+    if card != i then
+        temp = cards[card]
+        cards[card] = cards[i]
+        cards[i] = temp
+    end if
+end for
+
+puts(1,"\nAfter:\n")
+for i = 1 to 52 do
+    printf(1,"%d ",cards[i])
+end for

Task/Knuth-shuffle/Pluto/knuth-shuffle.pluto

@@ -0,0 +1,15 @@
+local fmt = require "fmt"
+
+local function knuth_shuffle(a)
+    for i = #a, 2, -1 do
+        local j = math.random(i)
+        a[i], a[j] = a[j], a[i]
+    end
+end
+
+local tests = { {}, {10}, {10, 20}, {10, 20, 30}, {10, 20, 30, 40} }
+for tests as a  do
+    local b = a:clone()
+    knuth_shuffle(a)
+    print($"{fmt.swrite(b)} -> {fmt.swrite(a)}")
+end

Task/Knuth-shuffle/PowerShell/knuth-shuffle-1.ps1

@@ -0,0 +1,2 @@
+$A = 1, 2, 3, 4, 5
+Get-Random $A -Count $A.Count

Task/Knuth-shuffle/PowerShell/knuth-shuffle-2.ps1

@@ -0,0 +1,9 @@
+function shuffle ($a) {
+    $c = $a.Clone()  # make copy to avoid clobbering $a
+    1..($c.Length - 1) | ForEach-Object {
+        $i = Get-Random -Minimum $_ -Maximum $c.Length
+        $c[$_-1],$c[$i] = $c[$i],$c[$_-1]
+        $c[$_-1]  # return newly-shuffled value
+    }
+    $c[-1]  # last value
+}

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

@@ -1,23 +1,22 @@
-/*REXX program shuffles a deck of playing cards (with jokers)  using the  Knuth shuffle.*/
-rank= 'A 2 3 4 5 6 7 8 9 10 J Q K'               /*pips  of the various playing cards.  */
-suit= '♣♠♦♥'                                     /*suit   "  "     "       "      "     */
-parse arg seed .                                 /*obtain optional argument from the CL.*/
-if datatype(seed,'W')  then call random ,,seed   /*maybe use for  RANDOM  repeatability.*/
-say '══════════════════ getting a new deck out of the box ···'
-@.1= 'highJoker'                                 /*good decks have a color joker, and a */
-@.2= 'lowJoker'                                  /*            ··· black & white joker. */
-cards=2                                          /*now, there're 2 cards are in the deck*/
-               do j     =1  for length(suit)
-                    do k=1  for  words(rank);      cards=cards + 1
-                    @.cards=substr(suit, j, 1)word(rank, k)
-                    end  /*k*/
-               end       /*j*/
-call show
-say;      say '══════════════════ shuffling' cards "cards ···"
-     do s=cards  by -1  to 2;  ?=random(1,s);  parse value  @.?  @.s   with   @.s  @.?
-                                                 /*  [↑]  swap two cards in the deck.   */
-     end   /*s*/
-call show
-exit                                             /*stick a fork in it,  we're all done. */
-/*──────────────────────────────────────────────────────────────────────────────────────*/
-show: _=;      do m=1  for cards;   _=_ @.m;   end  /*m*/;         say _;           return
+-- 31 Mar 2026
+include Setting
+
+say 'KNUTH SHUFFLE'
+say version
+say
+call MakeSt 'stem.','N',52,'A'
+call ShowSt 'stem.','a card deck...',,3
+call ShuffleSt
+call ShowSt 'stem.','shuffled!',,3
+exit
+
+ShuffleSt:
+procedure expose stem.
+-- Fisher-Yates shuffle cf Durstenfeld-Knuth
+do i=stem.0 by -1 to 2
+   j=Random(1,i); t=stem.i; stem.i=stem.j; stem.j=t
+end i
+return 0
+
+-- ShowSt; ShuffleSt (generic); MakeSt
+include Math

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

@@ -1,27 +1,23 @@
-/*REXX program shuffles a deck of playing cards (with jokers)  using the  Knuth shuffle.*/
-rank = 'ace deuce trey 4 5 6 7 8 9 10 jack queen king'         /*use pip names for cards*/
-suit = 'club spade diamond heart'                              /* "  suit  "    "    "  */
-say '══════════════════ getting a new deck out of the box ···'
-@.1= '  color joker'                             /*good decks have a color joker, and a */
-@.2= '    b&w joker'                             /*            ··· black & white joker. */
-cards=2                                          /*now, there're 2 cards are in the deck*/
-          do j     =1  for words(suit)
-               do k=1  for words(rank);       cards=cards+1    /*bump the card counter. */
-               @.cards=right(word(suit,j),7)  word(rank,k)     /*assign a card name.    */
-               end  /*k*/
-          end       /*j*/
+/* REXX ---------------------------------------------------------------
+* 05.01.2014 Walter Pachl
+*            borrow one improvement from version 1
+* 06.01.2014 removed    -"-  (many tests cost more than few "swaps")
+*--------------------------------------------------------------------*/
+Call random ,,123456                   /* seed for random            */
+Do i=1 To 10; a.i=i; End;              /* fill array                 */
+Call show 'In',10                      /* show start                 */
+do i = 10 To 2 By -1                   /* shuffle                    */
+  j=random(i-1)+1;
+  h=right(i,2) right(j,2)
+  Parse Value a.i a.j With a.j a.i     /* a.i <-> a.j                */
+  Call show h,i                        /* show intermediate states   */
+  end;
+Call show 'Out',10                     /* show fomaö state           */
+Exit
 
-call show 'ace'                                  /*inserts blank when an  ACE  is found.*/
-say;  say '══════════════════ shuffling' cards "cards ···"
-
-          do s=cards  by -1  to 2;   ?=random(1,s);   _=@.?;   @.?=@.s;    @.s=_
-          end   /*s*/                            /* [↑]  swap two cards in the deck.    */
-call show
-exit                                             /*stick a fork in it,  we're all done. */
-/*──────────────────────────────────────────────────────────────────────────────────────*/
-show: parse arg break;    say                    /*get separator card, show blank line. */
-        do m=1  for cards                        /* [↓]  traipse through the card deck. */
-        if pos(break,@.m)\==0  then say          /*show a blank to read cards easier.   */
-        say 'card'  right(m, 2)    '───►'   @.m  /*display a particular card from deck. */
-        end   /*m*/
-return
+show: Procedure Expose a.
+Parse Arg txt,n
+ol=left(txt,6);
+Do k=1 To n; ol=ol right(a.k,2); End
+Say ol
+Return

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

@@ -1,23 +0,0 @@
-/* REXX ---------------------------------------------------------------
-* 05.01.2014 Walter Pachl
-*            borrow one improvement from version 1
-* 06.01.2014 removed    -"-  (many tests cost more than few "swaps")
-*--------------------------------------------------------------------*/
-Call random ,,123456                   /* seed for random            */
-Do i=1 To 10; a.i=i; End;              /* fill array                 */
-Call show 'In',10                      /* show start                 */
-do i = 10 To 2 By -1                   /* shuffle                    */
-  j=random(i-1)+1;
-  h=right(i,2) right(j,2)
-  Parse Value a.i a.j With a.j a.i     /* a.i <-> a.j                */
-  Call show h,i                        /* show intermediate states   */
-  end;
-Call show 'Out',10                     /* show fomaö state           */
-Exit
-
-show: Procedure Expose a.
-Parse Arg txt,n
-ol=left(txt,6);
-Do k=1 To n; ol=ol right(a.k,2); End
-Say ol
-Return

Task/Knuth-shuffle/Rebol/knuth-shuffle-1.rebol

@@ -0,0 +1,4 @@
+probe random []
+probe random [10]
+probe random [10 20]
+probe random [10 20 30]

Task/Knuth-shuffle/Rebol/knuth-shuffle-2.rebol

@@ -0,0 +1,48 @@
+Rebol [
+    title: "Rosetta code: Knuth shuffle"
+    file:  %Knuth_shuffle.r3
+    url:    https://rosettacode.org/wiki/Knuth_shuffle
+]
+fisher-yates: func [
+    "Fisher-Yates shuffle algorithm - randomly shuffles elements in a block"
+    ;Uses the modern variant that works backwards through the array
+    data [series!] "Input block to shuffle"
+    /local i j tmp ;; Local variables: i=current index, j=random index, tmp=swap variable
+][
+    ;; Make a copy of the input block and get its length
+    ;; This prevents modification of the original block
+    i: length? data: copy data
+
+    ;; Loop from the last element down to the second element
+    ;; We stop at 1 because there's no need to swap the first element with itself
+    while [i > 1] [
+        ;; Generate random index j from 1 to i (inclusive)
+        j: random i
+        ;; Previous version tried to avoid self-swap as an optimization
+        ;; but actually it is faster to avoid it!
+
+        ;; Three-step swap using path notation for direct block access
+        ;; Step 1: Store element at random position j in temporary variable
+        tmp: data/:j
+
+        ;; Step 2: Move current element (at position i) to random position j
+        data/:j: data/:i
+
+        ;; Step 3: Move stored element to current position i
+        ;; Using :tmp to get the value (word evaluation)
+        data/:i: :tmp
+
+        ;; Move to previous element (working backwards through the block)
+        i: i - 1
+    ]
+
+    ;; Return the shuffled block
+    data
+]
+
+random/seed 0 ;; to get consistent results
+
+probe fisher-yates []
+probe fisher-yates [10]
+probe fisher-yates [10 20]
+probe fisher-yates [10 20 30]

Task/Knuth-shuffle/V-(Vlang)/knuth-shuffle.v

@@ -1,9 +1,9 @@
 import rand
 import rand.seed
 
-fn shuffle(mut arr []int) {
+fn shuffle(mut arr []int)! {
     for i := arr.len - 1; i >= 0; i-- {
-        j := rand.intn(i + 1)
+        j := rand.intn(i + 1)!
         arr[i], arr[j] = arr[j], arr[i]
     }
     println('After Shuffle: $arr')
@@ -14,7 +14,7 @@ fn main() {
     rand.seed(seed_array)
     mut arr := [6, 9, 1, 4]
     println('Input: $arr')
-    shuffle(mut arr)
-    shuffle(mut arr)
+    shuffle(mut arr)!
+    shuffle(mut arr)!
     println('Output: $arr')
 }

Task/Knuth-shuffle/VBScript/knuth-shuffle-1.vbs

@@ -0,0 +1,19 @@
+function shuffle( a )
+	dim i
+	dim r
+	randomize timer
+	for i = lbound( a ) to ubound( a )
+		r = int( rnd * ( ubound( a ) + 1 )  )
+		if r <> i then
+			swap a(i), a(r)
+		end if
+	next
+	shuffle = a
+end function
+
+sub swap( byref a, byref b )
+	dim tmp
+	tmp = a
+	a = b
+	b = tmp
+end sub

Task/Knuth-shuffle/VBScript/knuth-shuffle-2.vbs

@@ -0,0 +1,14 @@
+dim a
+a = array( 1,2,3,4,5,6,7,8,9)
+wscript.echo "before: ", join( a, ", " )
+shuffle a
+wscript.echo "after: ", join( a, ", " )
+shuffle a
+wscript.echo "after: ", join( a, ", " )
+wscript.echo "--"
+a = array( now(), "cow", 123, true, sin(1), 16.4 )
+wscript.echo "before: ", join( a, ", " )
+shuffle a
+wscript.echo "after: ", join( a, ", " )
+shuffle a
+wscript.echo "after: ", join( a, ", " )