Content added Content deleted

Inline

Revision as of 17:45, 28 November 2021

The Sattolo cycle is an algorithm for randomly shuffling an array in such a way that each element ends up in a new position.

Task

Implement the Sattolo cycle for an integer array (or, if possible, an array of any type).

Specification

Given an array items with indices ranging from 0 to last, the algorithm can be defined as follows (pseudo-code):

for i from last downto 1 do:
    let j = random integer in range 0  $\leq$  j < i
    swap items[i] with items[j]

Notes:

It modifies the input array in-place. If that is unreasonable in your programming language, you may amend the algorithm to return the shuffled items as a new array instead.
The algorithm can also be amended to iterate from left to right, if that is more convenient.
The only difference between this and the Knuth shuffle, is that $j$ is chosen from the range 0 $\leq$ j < i, rather than 0 $\leq$ j $\leq$ i. This is what ensures that every element ends up in a new position, as long as there are at least two elements.

Test cases

Input array	Possible output arrays
`[]`	`[]`
`[10]`	`[10]`
`[10, 20]`	`[20, 10]`
`[10, 20, 30]`	`[20, 30, 10]` `[30, 10, 20]`
`[11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22]`	39,916,800 possibilities. You'll know you have a correct one if it has the same elements as the input array, but none in their original place.

Related tasks

Knuth shuffle

Other tasks related to string operations:

Metrics

Counting

Remove/replace

Anagrams/Derangements/shuffling

Find/Search/Determine

Formatting

Song lyrics/poems/Mad Libs/phrases

Tokenize

Sequences

11l

Translation of: Python

<lang 11l>F sattolo_cycle(&items)

  L(i) (items.len-1 .. 1).step(-1)
     V j = random:(i)
     swap(&items[j], &items[i])

L 3

  V lst = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]
  sattolo_cycle(&lst)
  print(lst)</lang>

Output:

[7, 1, 4, 8, 9, 2, 5, 6, 10, 3]
[3, 8, 9, 2, 1, 5, 4, 10, 7, 6]
[2, 9, 7, 5, 1, 3, 8, 10, 6, 4]

ALGOL 68

Arrays in Algol 68 need not have a lower bound of 0, other than that, this implements the pseudo code. <lang algol68>BEGIN

   # reorders the elements of a using the Sattolo cycle              #
   # this operates on integer arrays, additional SATTOLO operators   #
   # could be defined for other types                                #
   # a is returned so we can write e.g. SATTOLO SATTOLO a to cycle   #
   # the elements twice                                              #
   OP SATTOLO = ( REF[]INT a )REF[]INT:
      BEGIN
           REF[]INT aa := a[ @ 0 ];
           FOR i FROM UPB aa BY -1 TO 1 DO
               INT j    = ENTIER ( next random * i );
               INT t    = aa[ i ];
               aa[ i ] := aa[ j ];
               aa[ j ] := t
           OD;
           a
      END # SATTOLO # ;
   [ 1 : 10 ]INT a := []INT( 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 )[ @ 1 ];
   TO 5 DO
       SATTOLO a;
       FOR i FROM LWB a TO UPB a DO print( ( " ", whole( a[ i ], -3 ) ) ) OD;
       print( ( newline ) )
   OD

END </lang>

Output:

   4   9   2   5   3   1   8  10   7   6
   6   2  10   7   5   3   4   8   9   1
   1   4   3   2  10   6   5   7   8   9
   5   7   1   9   6   4   8   2  10   3
   4  10   5   6   3   8   7   1   9   2

But swapping values by list is inefficient in a repeat. Also, if an AppleScript list is quite to very long, access to its items is very much faster if the list variable is referred to as a property belonging to something rather than simply as a variable. In addition to this, using the language's built-in some specifier to select an item at random from a list is so much faster than sending an Apple event to invoke the StandardAdditions' random number command that, for the current purpose, it can be over 100 times as fast to set up an index list of the same length and select indices at random from that!

<lang applescript>on sattoloShuffle(theList) -- In-place shuffle.

   -- Script object to which list variables can "belong".
   script o
       property lst : theList as list -- Original list.
       property indices : my lst's items -- Shallow copy.
   end script
   
   -- Populate the copy with indices. (No need to bother with the first.)
   set listLength to (count o's lst)
   repeat with i from 2 to listLength
       set item i of o's indices to i
   end repeat
   -- Repeatedly lose the first item in the index list and select an index at random from what's left.
   repeat with i from 1 to listLength - 1
       set o's indices to rest of o's indices
       set j to some item of o's indices
       set temp to item i of o's lst
       set item i of o's lst to item j of o's lst
       set item j of o's lst to temp
   end repeat
   return -- Return nothing (ie. not the result of the last action above).

end sattoloShuffle

-- Task demo: local output, astid, aList set output to {} set astid to AppleScript's text item delimiters set AppleScript's text item delimiters to ", " repeat with aList in {{}, {10}, {10, 20}, {10, 20, 30}, {11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22}}

   set end of output to "Before: {" & aList & "}"
   sattoloShuffle(aList)
   set end of output to "After:  {" & aList & "}"

end repeat set AppleScript's text item delimiters to linefeed set output to output as text set AppleScript's text item delimiters to astid return output</lang>

Output:

Before: {}
After:  {}
Before: {10}
After:  {10}
Before: {10, 20}
After:  {20, 10}
Before: {10, 20, 30}
After:  {20, 30, 10}
Before: {11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22}
After:  {21, 22, 15, 11, 17, 12, 19, 16, 18, 14, 13, 20}

ARM Assembly

Works with: as version Raspberry Pi

/* ARM assembly Raspberry PI */ /* program sattolo.s */

/************************************/ /* Constantes */ /************************************/ .equ STDOUT, 1 @ Linux output console .equ EXIT, 1 @ Linux syscall .equ WRITE, 4 @ Linux syscall /*********************************/ /* Initialized data */ /*********************************/ .data sMessResult: .ascii "Value : " sMessValeur: .fill 11, 1, ' ' @ size => 11 szCarriageReturn: .asciz "\n"

.align 4 iGraine: .int 123456 .equ NBELEMENTS, 9 TableNumber: .int 4,6,7,10,11,15,22,30,35

/*********************************/ /* UnInitialized data */ /*********************************/ .bss /*********************************/ /* code section */ /*********************************/ .text .global main main: @ entry of program

   ldr r0,iAdrTableNumber                      @ address number table
   mov r1,#NBELEMENTS                          @ number of élements 
   bl satShuffle
   ldr r2,iAdrTableNumber
   mov r3,#0

1: @ loop display table ldr r0,[r2,r3,lsl #2]

   ldr r1,iAdrsMessValeur                      @ display value
   bl conversion10                             @ call function
   ldr r0,iAdrsMessResult
   bl affichageMess                            @ display message
   add r3,#1
   cmp r3,#NBELEMENTS - 1
   ble 1b

   ldr r0,iAdrszCarriageReturn
   bl affichageMess   
   /*    2e shuffle             */
   ldr r0,iAdrTableNumber                     @ address number table
   mov r1,#NBELEMENTS                         @ number of élements 
   bl satShuffle
   ldr r2,iAdrTableNumber
   mov r3,#0

2: @ loop display table

   ldr r0,[r2,r3,lsl #2]
   ldr r1,iAdrsMessValeur                     @ display value
   bl conversion10                            @ call function
   ldr r0,iAdrsMessResult
   bl affichageMess                           @ display message
   add r3,#1
   cmp r3,#NBELEMENTS - 1
   ble 2b

100: @ standard end of the program

   mov r0, #0                                 @ return code
   mov r7, #EXIT                              @ request to exit program
   svc #0                                     @ perform the system call

iAdrsMessValeur: .int sMessValeur iAdrszCarriageReturn: .int szCarriageReturn iAdrsMessResult: .int sMessResult iAdrTableNumber: .int TableNumber

/******************************************************************/ /* Sattolo Shuffle */ /******************************************************************/ /* r0 contains the address of table */ /* r1 contains the number of elements */ satShuffle:

   push {r2-r6,lr}                                    @ save registers
   mov r5,r0                                          @ save table address
   mov r2,#1                                          @ start index
   mov r4,r1                                          @ last index + 1

1:

   sub r1,r2,#1                                       @ index - 1
   mov r0,r1                                          @ generate aleas
   bl genereraleas
   ldr r3,[r5,r1,lsl #2]                              @ swap number on the table
   ldr r6,[r5,r0,lsl #2]
   str r6,[r5,r1,lsl #2]
   str r3,[r5,r0,lsl #2]
   add r2,#1                                           @ next number
   cmp r2,r4                                           @ end ?
   ble 1b                                              @ no -> loop

100:

   pop {r2-r6,lr}
   bx lr                                               @ return

/******************************************************************/ /* display text with size calculation */ /******************************************************************/ /* r0 contains the address of the message */ affichageMess:

   push {r0,r1,r2,r7,lr}                          @ save  registres
   mov r2,#0                                      @ counter length

1: @ loop length calculation

   ldrb r1,[r0,r2]                                @ read octet start position + index 
   cmp r1,#0                                      @ if 0 its over 
   addne r2,r2,#1                                 @ else add 1 in the length 
   bne 1b                                         @ and loop 
                                                  @ so here r2 contains the length of the message 
   mov r1,r0                                      @ address message in r1 
   mov r0,#STDOUT                                 @ code to write to the standard output Linux 
   mov r7, #WRITE                                 @ code call system "write" 
   svc #0                                         @ call systeme 
   pop {r0,r1,r2,r7,lr}                           @ restaur des  2 registres */ 
   bx lr                                          @ return

/******************************************************************/ /* Converting a register to a decimal unsigned */ /******************************************************************/ /* r0 contains value and r1 address area */ /* r0 return size of result (no zero final in area) */ /* area size => 11 bytes */ .equ LGZONECAL, 10 conversion10:

   push {r1-r4,lr}                                 @ save registers 
   mov r3,r1
   mov r2,#LGZONECAL

1: @ start loop

   bl divisionpar10U                               @unsigned  r0 <- dividende. quotient ->r0 reste -> r1
   add r1,#48                                      @ digit
   strb r1,[r3,r2]                                 @ store digit on area
   cmp r0,#0                                       @ stop if quotient = 0 
   subne r2,#1                                     @ else previous position
   bne 1b	                                    @ and loop
                                                   @ and move digit from left of area
   mov r4,#0

2:

   ldrb r1,[r3,r2]
   strb r1,[r3,r4]
   add r2,#1
   add r4,#1
   cmp r2,#LGZONECAL
   ble 2b
                                                   @ and move spaces in end on area
   mov r0,r4                                       @ result length 
   mov r1,#' '                                     @ space

3:

   strb r1,[r3,r4]                                 @ store space in area
   add r4,#1                                       @ next position
   cmp r4,#LGZONECAL
   ble 3b                                          @ loop if r4 <= area size

100:

   pop {r1-r4,lr}                                  @ restaur registres 
   bx lr                                           @return

/***************************************************/ /* division par 10 unsigned */ /***************************************************/ /* r0 dividende */ /* r0 quotient */ /* r1 remainder */ divisionpar10U:

   push {r2,r3,r4, lr}
   mov r4,r0                                       @ save value
   //mov r3,#0xCCCD                                @ r3 <- magic_number lower  raspberry 3
   //movt r3,#0xCCCC                               @ r3 <- magic_number higter raspberry 3
   ldr r3,iMagicNumber                             @ r3 <- magic_number    raspberry 1 2
   umull r1, r2, r3, r0                            @ r1<- Lower32Bits(r1*r0) r2<- Upper32Bits(r1*r0) 
   mov r0, r2, LSR #3                              @ r2 <- r2 >> shift 3
   add r2,r0,r0, lsl #2                            @ r2 <- r0 * 5 
   sub r1,r4,r2, lsl #1                            @ r1 <- r4 - (r2 * 2)  = r4 - (r0 * 10)
   pop {r2,r3,r4,lr}
   bx lr                                           @ leave function

iMagicNumber: .int 0xCCCCCCCD /***************************************************/ /* Generation random number */ /***************************************************/ /* r0 contains limit */ genereraleas:

   push {r1-r4,lr}                                  @ save registers 
   ldr r4,iAdriGraine
   ldr r2,[r4]
   ldr r3,iNbDep1
   mul r2,r3,r2
   ldr r3,iNbDep1
   add r2,r2,r3
   str r2,[r4]                                      @ maj de la graine pour l appel suivant 
   cmp r0,#0
   beq 100f
   mov r1,r0                                        @ divisor
   mov r0,r2                                        @ dividende
   bl division
   mov r0,r3                                        @ résult = remainder

100: @ end function

   pop {r1-r4,lr}                                   @ restaur registers
   bx lr                                            @ return

/*****************************************************/ iAdriGraine: .int iGraine iNbDep1: .int 0x343FD iNbDep2: .int 0x269EC3 /***************************************************/ /* integer division unsigned */ /***************************************************/ division:

   /* r0 contains dividend */
   /* r1 contains divisor */
   /* r2 returns quotient */
   /* r3 returns remainder */
   push {r4, lr}
   mov r2, #0                                         @ init quotient
   mov r3, #0                                         @ init remainder
   mov r4, #32                                        @ init counter bits
   b 2f

1: @ loop

   movs r0, r0, LSL #1                                @ r0 <- r0 << 1 updating cpsr (sets C if 31st bit of r0 was 1)
   adc r3, r3, r3                                     @ r3 <- r3 + r3 + C. This is equivalent to r3 ? (r3 << 1) + C 
   cmp r3, r1                                         @ compute r3 - r1 and update cpsr 
   subhs r3, r3, r1                                   @ if r3 >= r1 (C=1) then r3 <- r3 - r1 
   adc r2, r2, r2                                     @ r2 <- r2 + r2 + C. This is equivalent to r2 <- (r2 << 1) + C

2:

   subs r4, r4, #1                                    @ r4 <- r4 - 1 
   bpl 1b                                             @ if r4 >= 0 (N=0) then loop
   pop {r4, lr}
   bx lr

</lang>

Arturo

<lang rebol>cycle: function [arr][

   if 2 > size arr -> return arr
   lastIndex: (size arr)-1
   result: new arr
   loop lastIndex..1 'i [
       j: random 0 i-1

       tmp: result\[i]
       set result i result\[j]
       set result j tmp
   ]
   return result

]

lists: [

   []
   [10]
   [10 20]
   [10 20 30]
   [11 12 13 14 15 16 17 18 19 20 21 22]

]

loop lists 'l ->

   print [l "->" cycle l]</lang>

Output:

[] -> [] 
[10] -> [10] 
[10 20] -> [20 10] 
[10 20 30] -> [20 30 10] 
[11 12 13 14 15 16 17 18 19 20 21 22] -> [14 11 18 17 12 20 16 19 21 22 15 13]

AutoHotkey

<lang AutoHotkey>loop 3 {

   testCases:= [[]
               ,[10]
               ,[10, 20]
               ,[10, 20, 30]
               ,[11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22]]

   for n, items in testCases
   {
       Sattolo_cycle(items)
       res := "["
       for m, v in items
           res .= v ", "
       result .= Trim(res, ", ") "]`n"
   }
   result .= "`n"

} MsgBox % result return

Sattolo_cycle(ByRef items){

   i := items.Count()
   while (i>1)
   {
       Random, j, 1, i-1
       swap(items, i, j)
       i--
   }

}

swap(ByRef items, i, j){

   temp := items[i]
   items[i] := items[j]
   items[j] := temp

}</lang>

Output:

[]
[10]
[20, 10]
[20, 30, 10]
[21, 15, 22, 17, 11, 12, 13, 14, 16, 18, 20, 19]

[]
[10]
[20, 10]
[20, 30, 10]
[18, 13, 20, 17, 19, 15, 21, 16, 14, 22, 12, 11]

[]
[10]
[20, 10]
[30, 10, 20]
[21, 17, 14, 12, 13, 11, 16, 22, 15, 18, 20, 19]

BaCon

<lang bacon>OPTION BASE 1

SUB Swap_Array(array[], total)

   FOR i = total DOWNTO 1
       j = RANDOM(i-1)+1
       SWAP array[i], array[j]
   NEXT
   PRINT COIL$(total, STR$(array[_]))

ENDSUB

DECLARE demo1[] = { } Swap_Array(demo1, UBOUND(demo1))

DECLARE demo2[] = { 10 } Swap_Array(demo2, UBOUND(demo2))

DECLARE demo3[] = { 10, 20 } Swap_Array(demo3, UBOUND(demo3))

DECLARE demo4[] = { 10, 20, 30 } Swap_Array(demo4, UBOUND(demo4))

DECLARE demo5[] = { 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22 } Swap_Array(demo5, UBOUND(demo5))</lang>

Output:

...<empty line>...
10
20 10
20 30 10
16 19 15 21 14 22 11 20 13 17 18 12

C

This is generic to the extreme, although the function is technically being fed strings, it can handle any type, as shown in the outputs below :

Interactive and without hardcoded inputs

include<stdlib.h>
include<stdio.h>
include<time.h>

void sattoloCycle(void** arr,int count){ int i,j; void* temp;

if(count<2) return; for(i=count-1;i>=1;i--){ j = rand()%i; temp = arr[j]; arr[j] = arr[i]; arr[i] = temp; } }

int main(int argC,char* argV[]) { int i;

if(argC==1) printf("Usage : %s <array elements separated by a space each>",argV[0]); else{

               srand((unsigned)time(NULL));

sattoloCycle((void*)(argV + 1),argC-1);

for(i=1;i<argC;i++) printf("%s ",argV[i]); } return 0; } </lang> Output:

C:\rosettaCode>sattoloCycle.exe ""

C:\rosettaCode>sattoloCycle.exe 10
10
C:\rosettaCode>sattoloCycle.exe 10 20
20 10
C:\rosettaCode>sattoloCycle.exe 10 20 30
30 10 20
C:\rosettaCode>sattoloCycle.exe 11 12 13 14 15 16 17 18 19 20 21 22
16 17 11 12 13 20 22 14 15 21 18 19
C:\rosettaCode>sattoloCycle.exe s a t t o l o C y c l e
l o s a t c e t o l C y
C:\rosettaCode>sattoloCycle.exe 1 2.3 4.2 1 3 e r q t 2 1 oo 2.1 eds
1 2.1 2.3 q r eds 1 e 3 t 1 2 oo 4.2
C:\rosettaCode>sattoloCycle.exe totally mixed up random string ( 1 2.3 2 ) which will get even more { a 2 q.1 } mixed up.
mixed q.1 a 1 up ) 2 even { will ( } 2 more totally random get which string up. 2.3 mixed

Non Interactive and with hardcoded inputs

Same code but with hardcoded integer arrays as in the task to show that the function can handle any type. <lang C>

include<stdlib.h>
include<stdio.h>
include<time.h>

void sattoloCycle(void** arr,int count){ int i,j; void* temp;

if(count<2) return; for(i=count-1;i>=1;i--){ j = rand()%i; temp = arr[j]; arr[j] = arr[i]; arr[i] = temp; } }

int main() { int i;

int a[] = {}; int b[] = {10}; int c[] = {10, 20}; int d[] = {10, 20, 30}; int e[] = {11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22};

srand((unsigned)time(NULL)); sattoloCycle((void*)a,0);

printf("\nShuffled a = "); for(i=0;i<0;i++) printf("%d ",a[i]);

sattoloCycle((void*)b,1);

printf("\nShuffled b = "); for(i=0;i<1;i++) printf("%d ",b[i]);

sattoloCycle((void*)c,2);

printf("\nShuffled c = "); for(i=0;i<2;i++) printf("%d ",c[i]);

sattoloCycle((void*)d,3);

printf("\nShuffled d = "); for(i=0;i<3;i++) printf("%d ",d[i]);

sattoloCycle((void*)e,12);

printf("\nShuffled e = "); for(i=0;i<12;i++) printf("%d ",e[i]);

return 0; } </lang> Output:

Shuffled a =
Shuffled b = 10
Shuffled c = 20 10
Shuffled d = 20 30 10
Shuffled e = 13 18 14 20 17 15 21 19 16 12 22 11

C#

<lang csharp>private static readonly Random Rand = new Random();

void sattoloCycle<T>(IList<T> items) {

   for (var i = items.Count; i-- > 1;) {
       int j = Rand.Next(i);
       var tmp = items[i];
       items[i] = items[j];
       items[j] = tmp;
   }

}</lang>

C++

include <ctime>
include <string>
include <iostream>
include <algorithm>

class cycle{ public:

   template <class T>
   void cy( T* a, int len ) {
       int i, j;
       show( "original: ", a, len );
       std::srand( unsigned( time( 0 ) ) );

       for( int i = len - 1; i > 0; i-- ) {
           do {
               j = std::rand() % i;
           } while( j >= i );
           std::swap( a[i], a[j] );
       }

       show( "  cycled: ", a, len ); std::cout << "\n";
   }

private:

   template <class T>
   void show( std::string s, T* a, int len ) {
       std::cout << s;
       for( int i = 0; i < len; i++ ) {
           std::cout << a[i] << " ";
       }
       std::cout << "\n";
   }

}; int main( int argc, char* argv[] ) {

   std::string d0[] = { "" },
               d1[] = { "10" },
               d2[] = { "10", "20" };
   int         d3[] = { 10, 20, 30 },
               d4[] = { 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22 };
   cycle c;
   c.cy( d0, sizeof( d0 ) / sizeof( d0[0] ) );
   c.cy( d1, sizeof( d1 ) / sizeof( d1[0] ) );
   c.cy( d2, sizeof( d2 ) / sizeof( d2[0] ) );
   c.cy( d3, sizeof( d3 ) / sizeof( d3[0] ) );
   c.cy( d4, sizeof( d4 ) / sizeof( d4[0] ) );

   return 0;

} </lang>

Output:

original:
  cycled:

original: 10
  cycled: 10

original: 10 20
  cycled: 20 10

original: 10 20 30
  cycled: 30 10 20

original: 11 12 13 14 15 16 17 18 19 20 21 22
  cycled: 13 17 14 22 11 18 20 12 21 19 15 16

D

<lang D>import std.stdio;

void main() {

   auto items = [0,1,2,3,4,5];
   sattoloCycle(items);
   items.writeln;

}

/// The Sattolo cycle is an algorithm for randomly shuffling an array in such a way that each element ends up in a new position. void sattoloCycle(R)(R items) {

   import std.algorithm : swapAt;
   import std.random : uniform;

   for (int i=items.length; i-- > 1;) {
       int j = uniform(0, i);
       items.swapAt(i, j);
   }

}

unittest {

   import std.range : lockstep;
   auto o = ['a', 'b', 'c', 'd', 'e'];

   auto s = o.dup;
   sattoloCycle(s);
   foreach (a, b; lockstep(o, s)) {
       assert(a != b, "An element stayed in place unexpectedly.");
   }

}</lang>

Output:

Several runs shown

[2, 4, 1, 5, 3, 0]
[3, 0, 4, 5, 1, 2]
[3, 5, 4, 1, 0, 2]
[5, 4, 3, 0, 2, 1]

EasyLang

<lang>func sattolo_cycle . a[] .

 for i = len a[] - 1 downto 1
   r = random i
   swap a[r] a[i]
 .

. arr[] = [ 1 2 3 ] call sattolo_cycle arr[] print arr[] </lang>

F#

<lang fsharp> let rnd=System.Random() let sottolo(n:int[])=let rec fN g=match g with -1|0->() |_->let e=rnd.Next(g-1) in let l=n.[g] in n.[g]<-n.[e]; n.[e]<-l; fN (g-1) in fN((Array.length n)-1) [[||];[|10|];[|10;20|];[|10;20;30|];[|11..22|]]|>List.iter(fun n->printf "%A->" n; sottolo n; printfn "%A" n) </lang>

Output:

[||]->[||]
[|10|]->[|10|]
[|10; 20|]->[|20; 10|]
[|10; 20; 30|]->[|20; 30; 10|]
[|11; 12; 13; 14; 15; 16; 17; 18; 19; 20; 21; 22|]->[|17; 20; 16; 15; 18; 11; 14; 21; 12; 13; 22; 19|]

Factor

<lang factor>USING: arrays io kernel literals math math.ranges prettyprint random sequences ; IN: rosetta-code.sattolo-cycle

(sattolo) ( seq -- seq' )

   dup dup length 1 - 1 [a,b]
   [ dup iota random rot exchange ] with each ;

sattolo ( seq -- seq/seq' )

   dup length 1 > [ (sattolo) ] when ;

{

   { }
   { 10 }
   { 10 20 }
   { 10 20 30 }
   $[ 11 22 [a,b] >array ]

} [

   [ "original: " write .         ]
   [ "cycled:   " write sattolo . ] bi nl

] each</lang>

Output:

original: { }
cycled:   { }

original: { 10 }
cycled:   { 10 }

original: { 10 20 }
cycled:   { 20 10 }

original: { 10 20 30 }
cycled:   { 30 10 20 }

original: { 11 12 13 14 15 16 17 18 19 20 21 22 }
cycled:   { 16 19 20 13 17 18 22 14 21 15 11 12 }

Free Pascal

<lang pascal>program sattolocycle; {$ifdef fpc}{$mode delphi}{$endif} uses math; var

 a:Array of cardinal;
 i,j:integer;
 t:cardinal;

begin

 randomize;
 a:=[0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19];
 i := length(a);
 while i > 0 do
 begin
   dec(i);
   j :=randomrange(0,i); //Low() is always 0
   t:=a[i];a[i]:=a[j];a[j]:=t;
   write(a[i]:4);
 end;

end.</lang>

Output in Free Pascal:
  2  14  12  13   0   1  15   9   7   6   3  18  10   4  16   5  19   8  11  17
Note output in Delphi differs because of different PRNG algorithms

Note someone changed this and now it is incorrect.

FreeBASIC

<lang freebasic>' version 22-10-2016 ' compile with: fbc -s console ' for boundry checks on array's compile with: fbc -s console -exx

' sort from lower bound to the highter bound ' array's can have subscript range from -2147483648 to +2147483647

Sub sattolo_cycle(a() As Long)

   Dim As Long lb = LBound(a)
   Dim As ULong n = UBound(a) - lb +1
   Dim As ULong i, j

   Randomize Timer

   For i = n -1 To 1 Step -1
       j =Fix(Rnd * (i))       ' 0 <= j < i
       Swap a(lb + i), a(lb + j)
   Next

End Sub

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

Dim As Long i, array(1 To 52)

For i = 1 To 52 : array(i) = i : Next

Print "Starting array from 1 to 52" For i = 1 To 52

   Print Using " ###";array(i);

Next : Print : Print

sattolo_cycle(array())

Print "After Sattolo_Cycle" For i = 1 To 52

   Print Using " ###";array(i);

Next : Print : Print

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

Output:

Starting array from 1 to 52
   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36  37  38  39  40  41  42  43  44  45  46  47  48  49  50  51  52

After Sattolo_Cycle
  40  48   7  25  32  17  44   4   8  13  18  47   5  29  10  20  49  39  11  51   3  21  46   2  38  16  28  37  12  50   1   9  52  19  22  30  36  27  45  15  24  23  33  41  14  31  43  26  35  34  42   6

Go

<lang go> package main

import ( "math/rand" "fmt" )

func main() { list := []int{1, 2, 3, 4, 5, 6, 7, 8, 9, 10} for i := 1; i <= 10; i++ { sattoloCycle(list) fmt.Println(list) } }

func sattoloCycle(list []int) { for x := len(list) -1; x > 0; x-- { j := rand.Intn(x) list[x], list[j] = list[j], list[x] } } </lang>

Output:

[4 5 1 7 3 9 10 2 8 6]
[7 9 5 1 2 3 4 8 6 10]
[2 3 9 4 6 8 7 1 10 5]
[6 2 10 1 8 4 5 9 7 3]
[8 3 7 2 10 1 6 4 9 5]
[7 5 1 4 9 2 3 10 6 8]
[6 8 3 10 2 4 7 1 5 9]
[1 6 8 7 9 5 4 2 3 10]
[9 5 10 6 2 8 1 7 4 3]
[7 3 1 10 4 2 8 6 5 9]

Haskell

<lang haskell>import Control.Monad ((>=>), (>>=), forM_) import Control.Monad.Primitive import qualified Data.Vector as V import qualified Data.Vector.Mutable as M import System.Random.MWC

type MutVec m a = M.MVector (PrimState m) a

-- Perform an in-place shuffle of the vector, making it a single random cyclic -- permutation of its initial value. The vector is also returned for -- convenience. cyclicPermM :: PrimMonad m => Gen (PrimState m) -> MutVec m a -> m (MutVec m a) cyclicPermM rand vec = forM_ [1..M.length vec-1] upd >> return vec

 where upd i = uniformR (0, i-1) rand >>= M.swap vec i

-- Return a vector that is a single random cyclic permutation of the argument. cyclicPerm :: PrimMonad m => Gen (PrimState m) -> V.Vector a -> m (V.Vector a) cyclicPerm rand = V.thaw >=> cyclicPermM rand >=> V.unsafeFreeze

test :: Show a => [a] -> IO () test xs = do

 let orig = V.fromList xs
 cyc <- withSystemRandom . asGenIO $ \rand -> cyclicPerm rand orig
 putStrLn $ "original: " ++ show orig
 putStrLn $ "  cycled: " ++ show cyc

main :: IO () main = do

 test ([] :: [()])
 test [10 :: Int]
 test [10, 20 :: Int]
 test [10, 20, 30 :: Int]
 test [11..22 :: Int]
 -- Also works for other types.
 test "abcdef"</lang>

Output:

$ ./sattolo 
original: []
  cycled: []
original: [10]
  cycled: [10]
original: [10,20]
  cycled: [20,10]
original: [10,20,30]
  cycled: [20,30,10]
original: [11,12,13,14,15,16,17,18,19,20,21,22]
  cycled: [13,14,16,11,17,20,18,21,22,15,19,12]
original: "abcdef"
  cycled: "cfeabd"

J

The key "feature" of this algorithm is that it cannot generate some legal random permutations. For example, given a two element list, it will always reverse that list.

Implementation:

<lang J>sattolo=:3 :0

 for_i.}:i.-#y do.
   j=.?i
   y=. (<i,j) C. y
 end.
 y

) </lang>

Example use:

<lang J> sattolo

  sattolo ,10

10

  sattolo 10 20

20 10

  sattolo 10 20 30

30 10 20

  sattolo 11+i.12

19 18 15 21 12 17 22 16 20 13 11 14</lang>

Java

<lang Java>private static final Random rng = new Random();

void sattoloCycle(Object[] items) {

   for (int i = items.length-1; i > 0; i--) {
       int j = rng.nextInt(i);
       Object tmp = items[i];
       items[i] = items[j];
       items[j] = tmp;
   }

}</lang>

JavaScript

<lang JavaScript>function sattoloCycle(items) {

   for (var i = items.length-1; i > 0; i--) {
       var j = Math.floor(Math.random() * i);
       var tmp = items[i];
       items[i] = items[j];
       items[j] = tmp;
   }

}</lang>

Jsish

<lang javascript>/* Sattolo cycle array shuffle, in Jsish */ function sattoloCycle(items:array):void {

   for (var i = items.length-1; i > 0; i--) {
       var j = Math.floor(Math.random() * i);
       var tmp = items[i];
       items[i] = items[j];
       items[j] = tmp;
   }

}

if (Interp.conf('unitTest')) {

   Math.srand(0);
   for (var a of [[], [10], [10,20], [10,20,30], [11,12,13,14,15,16,17,18,19,20,21,22]]) {

a;

       sattoloCycle(a);

a;

}

/*

!EXPECTSTART!

a ==> [] a ==> [] a ==> [ 10 ] a ==> [ 10 ] a ==> [ 10, 20 ] a ==> [ 20, 10 ] a ==> [ 10, 20, 30 ] a ==> [ 30, 10, 20 ] a ==> [ 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22 ] a ==> [ 22, 11, 17, 15, 12, 14, 19, 13, 21, 18, 16, 20 ]

!EXPECTEND!

/</lang>

Output:

prompt$ jsish -u sattoloCycle.jsi
[PASS] sattoloCycle.jsi

jq

Works with: jq

Works with gojq, the Go implementation of jq

Neither the C nor the Go implementations of jq has a built-in PRNG, but both are designed with the Unix toolset philosophy in mind, so in this entry we will use an external source of randomness rather than one of the PRNGs defined in jq as at RC.

Specifically, we will use /dev/urandom like so:

< /dev/urandom tr -cd '0-9' | fold -w 1 | jq -RMnrc -f program.jq

where program.jq is the following program: <lang jq># Output: a stream of prn in range(0;$n) where $n is . and $n > 1 def prns:

 . as $n
 | (($n-1)|tostring|length) as $w
 # Output: a prn in range(0;$n) 
 | def prn:
     [limit($w; inputs)] | join("") | tonumber
     | if . < $n then . else prn end;
 repeat(prn);

Output: a prn in range(0;$n) where $n is .,
b

def prn:

 if . == 1 then 0
 else . as $n
 | (($n-1)|tostring|length) as $w
 | [limit($w; inputs)] | join("") | tonumber
 | if . < $n then . else ($n | prn) end
 end;

def sattoloCycle:

 length as $n
 | if $n ==0 then [] 
   elif $n == 1 then empty   # a Sattolo cycle is not possible
   else {i: $n, a: .}
   | until(.i ==  1;         # n.b.
       .i += -1
       | (.i | prn) as $j    # this line distinguishes the Sattolo cycle from the Knuth shuffle
       | .a[.i] as $t
       | .a[.i] = .a[$j]
       | .a[$j] = $t)
   | .a 
   end;

def task:

 [],
 [10,20],
 [10,20,30],
 [range(11;23)]
 | sattoloCycle;

task</lang>

Output:

[]
[20,10]
[20,30,10]
[17,13,14,15,20,21,19,16,18,22,12,11]

Julia

Works with: Julia version 0.6

<lang julia>function sattolocycle!(arr::Array, last::Int=length(arr))

   for i in last:-1:2
       j = rand(1:i-1)
       arr[i], arr[j] = arr[j], arr[i]
   end
   return arr

end

@show sattolocycle!([]) @show sattolocycle!([10]) @show sattolocycle!([10, 20, 30]) @show sattolocycle!([11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22])</lang>

Output:

sattolocycle!([]) = Any[]
sattolocycle!([10]) = [10]
sattolocycle!([10, 20, 30]) = [30, 10, 20]
sattolocycle!([11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22]) = [19, 20, 15, 11, 17, 18, 21, 22, 13, 16, 12, 14]

Kotlin

<lang scala>// version 1.0.6

fun <T> sattolo(items: Array<T>) {

   for (i in items.size - 1 downTo 1) {
       val j = (Math.random() * i).toInt()
       val t = items[i]
       items[i] = items[j]
       items[j] = t
   }

}

fun main(args: Array<String>) {

   val items = arrayOf(11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22)
   println(items.joinToString())
   sattolo(items)
   println(items.joinToString())

}</lang> Sample output:

Output:

11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22
22, 11, 19, 12, 21, 14, 18, 20, 17, 16, 13, 15

Lua

<lang Lua>function sattolo (items)

   local j
   for i = #items, 2, -1 do
       j = math.random(i - 1)
       items[i], items[j] = items[j], items[i]
   end

end

math.randomseed(os.time()) local testCases = {

   {},
   {10},
   {10, 20},
   {10, 20, 30},
   {11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22}

} for _, array in pairs(testCases) do

   sattolo(array)
   print("[" .. table.concat(array, ", ") .. "]")

end</lang>

Output:

[]
[10]
[20, 10]
[30, 10, 20]
[15, 17, 22, 18, 16, 19, 21, 11, 12, 13, 20, 14]

Modula-2

<lang modula2>MODULE SattoloCycle; FROM FormatString IMPORT FormatString; FROM RandomNumbers IMPORT Randomize,Random; FROM Terminal IMPORT WriteString,WriteLn,ReadChar;

PROCEDURE SwapInt(VAR a,b : INTEGER); VAR t : INTEGER; BEGIN

   t := a;
   a := b;
   b := t;

END SwapInt;

TYPE

   ARR = ARRAY[0..5] OF INTEGER;

VAR

   buf : ARRAY[0..63] OF CHAR;
   items : ARR;
   i,j : INTEGER;

BEGIN

   Randomize(0);
   items := ARR{0,1,2,3,4,5};

   FOR i:=0 TO HIGH(items) DO
       j := Random(0,i);
       SwapInt(items[i], items[j]);
   END;

   FOR i:=0 TO HIGH(items) DO
       FormatString(" %i", buf, items[i]);
       WriteString(buf)
   END;

   ReadChar

END SattoloCycle.</lang>

Nim

Translation of: C

<lang nim>import random

proc sattoloCycle[T](a: var openArray[T]) =

 for i in countdown(a.high, 1):
   let j = rand(int.high) mod i
   swap a[j], a[i]

var a: seq[int] = @[] var b: seq[int] = @[10] var c: seq[int] = @[10, 20] var d: seq[int] = @[10, 20, 30] var e: seq[int] = @[11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22]

randomize()

a.sattoloCycle() echo "Shuffled a = ", $a

b.sattoloCycle() echo "\nShuffled b = ", $b

c.sattoloCycle() echo "\nShuffled c = ", $c

d.sattoloCycle() echo "\nShuffled d = ", $d

e.sattoloCycle() echo "\nShuffled e = ", $e</lang>

Output:

Shuffled a = @[]

Shuffled b = @[10]

Shuffled c = @[20, 10]

Shuffled d = @[20, 30, 10]

Shuffled e = @[20, 21, 14, 17, 13, 18, 12, 22, 11, 15, 16, 19]

Objeck

Translation of: Objeck

<lang objeck>class Sattolo {

 function : Main(args : String[]) ~ Nil {
   array := [1, 2, 3, 4, 5, 6, 7, 8, 9, 10];
   SattoloCycle(array);
   array->ToString()->PrintLine();
 }

 function : SattoloCycle(items : Int[]) ~ Nil {
   each(i : items) {
     j := (Float->Random() * 100.0)->As(Int) % items->Size();
     tmp := items[i];
     items[i] := items[j];
     items[j] := tmp;
   };
 }

} </lang>

Output:

[9,8,4,5,10,1,2,6,3,7]

Objective-C

<lang objc>#import <Foundation/Foundation.h>

@interface NSMutableArray (SattoloCycle) - (void)sattoloCycle; @end @implementation NSMutableArray (SattoloCycle) - (void)sattoloCycle {

 for (NSUInteger i = self.count-1; i > 0; i--) {
   NSUInteger j = arc4random_uniform(i);
   [self exchangeObjectAtIndex:i withObjectAtIndex:j];
 }

} @end</lang>

OCaml

<lang ocaml>let sattolo_cycle arr =

 for i = Array.length arr - 1 downto 1 do
   let j = Random.int i in
   let temp = arr.(i) in
   arr.(i) <- arr.(j);
   arr.(j) <- temp
 done</lang>

Perl

<lang perl>@a = 0..30;

printf "%2d ", $_ for @a; print "\n"; sattolo_cycle(\@a); printf "%2d ", $_ for @a; print "\n";

sub sattolo_cycle {

   my($array) = @_;
   for $i (reverse 0 .. -1+@$array) {
       my $j = int rand $i;
       @$array[$j, $i] = @$array[$i, $j];
   }

}</lang>

Output:

 0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30
18  5  9 25  3 23 12  2 26 21 16  4 11 15 20  1 27 10 29  7  6 28 24  8 13 17 19  0 14 30 22

Phix

sequence cards = tagset(52)
puts(1,"Before: ")      ?cards
for i=52 to 2 by -1 do
    integer r = rand(i-1)
    {cards[r],cards[i]} = {cards[i],cards[r]}
end for
puts(1,"After:  ")      ?cards
for i=1 to 52 do
    if cards[i]=i then ?9/0 end if
end for
if sort(cards)!=tagset(52) then ?9/0 end if
puts(1,"Sorted: ")      ?sort(cards)

Output:

Before: {1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52}
After:  {51,47,8,9,20,5,43,21,12,2,7,19,4,32,10,23,30,29,31,38,13,44,41,26,42,15,34,46,27,33,40,18,24,17,28,48,3,45,11,22,39,1,35,49,36,14,6,25,50,16,52,37}
Sorted: {1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52}

PHP

<lang PHP>function sattoloCycle($items) {

  for ($i = 0; $i < count($items); $i++) {
       $j = floor((mt_rand() / mt_getrandmax()) * $i);
       $tmp = $items[$i];
       $items[$i] = $items[$j];
       $items[$j] = $tmp;
   } 
   return $items;

} </lang>

PicoLisp

<lang PicoLisp>(seed (in "/dev/urandom" (rd 8)))

(de sattolo (Lst)

  (for (N (length Lst) (>= N 2) (dec N))
     (let I (rand 1 (dec N))
        (xchg (nth Lst N) (nth Lst I)) ) ) )

(let L (range 1 15)

  (println 'before L)
  (sattolo L)
  (println 'after L) )</lang>

Output:

before (1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)
after (4 1 12 6 2 13 9 11 8 5 3 14 7 15 10)

Python

<lang python> >>> from random import randrange >>> def sattoloCycle(items): for i in range(len(items) - 1, 0, -1): j = randrange(i) # 0 <= j <= i-1 items[j], items[i] = items[i], items[j]

>>> # Tests >>> for _ in range(10): lst = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10] sattoloCycle(lst) print(lst)

[5, 8, 1, 2, 6, 4, 3, 9, 10, 7] [5, 9, 8, 10, 4, 3, 6, 2, 1, 7] [10, 5, 8, 3, 9, 1, 4, 2, 6, 7] [10, 5, 2, 6, 9, 7, 8, 3, 1, 4] [7, 4, 8, 5, 10, 3, 2, 9, 1, 6] [2, 3, 10, 9, 4, 5, 8, 1, 7, 6] [5, 7, 4, 6, 2, 9, 3, 10, 8, 1] [3, 10, 7, 2, 9, 5, 8, 4, 1, 6] [2, 6, 5, 3, 9, 8, 10, 7, 1, 4] [3, 6, 2, 5, 10, 4, 1, 9, 7, 8] >>> </lang>

Quackery

See Knuth shuffle#Quackery for notes re. the "in-place-ness" of this code.

<lang Quackery> [ temp put

   2dup swap
   temp share swap peek
   temp share rot peek
   dip 
     [ swap
       temp take 
       swap poke 
       temp put ]  
   swap 
   temp take 
   swap poke ]                 is [exch]  ( n n [ --> [ )

 [ dup size 1 - times
     [ i 1+ dup random
       rot [exch] ] ]         is sattolo (     [ --> [ )</lang>

Output:

Testing in the Quackery shell. (REPL)

/O> ' [ 10 11 12 13 14 15 16 17 18 19 ] 
... 10 times [ sattolo dup echo cr ]
... 
[ 15 17 10 11 13 14 19 18 16 12 ]
[ 19 10 15 16 14 17 11 12 18 13 ]
[ 12 13 14 11 10 18 19 15 16 17 ]
[ 18 19 15 16 17 13 10 12 14 11 ]
[ 15 11 16 12 19 17 18 13 10 14 ]
[ 11 13 15 17 14 10 12 19 16 18 ]
[ 10 17 12 18 11 13 14 16 15 19 ]
[ 19 18 16 15 17 12 13 10 14 11 ]
[ 16 19 15 12 18 10 14 11 17 13 ]
[ 14 17 16 11 10 15 13 18 12 19 ]

Stack: [ 14 17 16 11 10 15 13 18 12 19 ] 

/O> 10 times [ sattolo dup echo cr ]
... 
[ 11 13 10 16 18 19 14 12 15 17 ]
[ 17 11 19 13 10 15 18 16 12 14 ]
[ 18 13 15 17 16 12 14 19 11 10 ]
[ 10 19 12 18 13 11 16 17 14 15 ]
[ 15 10 14 16 18 13 12 19 17 11 ]
[ 10 14 12 17 19 18 13 16 11 15 ]
[ 15 19 13 12 17 10 11 14 18 16 ]
[ 17 11 12 15 18 13 10 16 14 19 ]
[ 12 10 18 14 11 16 13 19 17 15 ]
[ 14 16 17 18 12 11 19 15 13 10 ]

Stack: [ 14 16 17 18 12 11 19 15 13 10 ]

R

Basically identical to https://rosettacode.org/wiki/Knuth_shuffle#Short_version We've only changed an i to an i-1, changed the function names, and added the [11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22] test. <lang r>sattolo<-function(vec) {

 last<-length(vec)
 if(last<2){return(vec)}
 else for(i in last:2)
 {
   j<-sample(1:(i-1),1)
   vec[c(i,j)]<-vec[c(j,i)]
 }
 vec

}

Demonstration:

sattolo(integer(0)) sattolo(c(10)) replicate(10,sattolo(c(10,20))) replicate(10,sattolo(c(10,20,30))) sattolo(c(11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22)) sattolo(c("Also","works","for","strings"))</lang>

Output:

> sattolo(integer(0))
integer(0)
> sattolo(c(10))
[1] 10
> replicate(10,sattolo(c(10,20)))
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,]   20   20   20   20   20   20   20   20   20    20
[2,]   10   10   10   10   10   10   10   10   10    10
> replicate(10,sattolo(c(10,20,30)))
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,]   30   30   20   20   30   20   20   20   20    20
[2,]   10   10   30   30   10   30   30   30   30    30
[3,]   20   20   10   10   20   10   10   10   10    10
> sattolo(c(11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22))
 [1] 12 13 15 16 20 11 22 17 14 21 18 19
> sattolo(c("Also","works","for","strings"))
[1] "strings" "for"     "Also"    "works"

Racket

<lang racket>#lang racket

although the shuffle is in-place, returning the shuffled vector makes testing a little easier

(define (sattolo-shuffle v)

 (for ((i (in-range (sub1 (vector-length v)) 0 -1)))
   (define j (random i))
   (define tmp (vector-ref v i))
   (vector-set! v i (vector-ref v j))
   (vector-set! v j tmp))
 v)

(define (derangement-of? A B #:strict? (strict? #t))

 (match* (A B)
   [('() '()) #t]
   [((list a) (list a)) #:when strict? #t]
   [((list a _ ...) (list a _ ...)) #f]
   [((list _ as ...) (list _ bs ...))
    (derangement-of? as bs #:strict? #t)]
   [((vector as ...) (vector bs ...))
    (derangement-of? as bs #:strict? strict?)]))

(module+ test

 (require rackunit)

 (check-equal? (sattolo-shuffle (vector)) #())
 (check-equal? (sattolo-shuffle (vector 10)) #(10))
 (check-equal? (sattolo-shuffle (vector 'inky)) #(inky))

 (define v′ (sattolo-shuffle (vector 11 12 13 14 15 16 17 18 19 20 21)))

 v′
 
 (check-true (derangement-of? #(11 12 13 14 15 16 17 18 19 20 21) v′)))</lang>

Output:

'#(21 19 12 11 18 17 14 16 15 13 20)

Raku

(formerly Perl 6)

This modifies the array passed as argument, in-place.

<lang perl6>sub sattolo-cycle (@array) {

   for reverse 1 .. @array.end -> $i {
       my $j = (^$i).pick;
       @array[$j, $i] = @array[$i, $j];
   }

}

my @a = flat 'A' .. 'Z', 'a' .. 'z';

say @a; sattolo-cycle(@a); say @a;</lang>

Sample output:

[A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i j k l m n o p q r s t u v w x y z]
[r G w g W Z D X M f Q A c i H Y J F s z m v x P b U j n q I N e O L o C d u a K S V l y R T B k t h p E]

REXX

version 1

This REXX example uses a zero-based array; (to match the pseudo-code).

The array elements values can be of any type (even mixed): integer, floating point, characters, ···

The values of the array elements are specified via the command line (C.L.). <lang rexx>/*REXX program implements and displays a Sattolo shuffle for an array (of any type).*/ parse arg a; say 'original:' space(a) /*obtain args from the CL; display 'em.*/

 do x=0  for words(a);  @.x= word(a, x+1);  end /*assign all elements to the @. array. */
                                                /* [↑]  build an array of given items. */
      do #=x-1  by -1  to 1;  j= random(0, #-1) /*get a random integer between 0 & #-1.*/
      parse value @.#  @.j    with    @.j  @.#  /*swap two array elements, J is random.*/
      end   /*j*/                               /* [↑]  shuffle @ via Sattolo algorithm*/

$= /* [↓] build a list of shuffled items.*/

      do k=0  for x;   $= $  @.k;   end  /*k*/  /*append the next element in the array.*/

say ' Sattolo:' strip($) /*stick a fork in it, we're all done. */</lang>

output when using the input of: [a null]

original: 
 Sattolo:

output when using the input of: 10

original: 10
 Sattolo: 10

output when using the input of: 10 20

original: 10 20 
 Sattolo: 20 10

output when using the input of: 10 20 30

original: 10 20 30
 Sattolo: 20 30 10

output when using the input of: 11 12 13 14 15 16 17 18 19 20 21 22

original: 11 12 13 14 15 16 17 18 19 20 21 22
 Sattolo: 15 14 17 19 18 12 22 13 20 21 11 16

output when using the input of: -1 0 00 oNe 2.7 /\ [] +6e1 ~~~

original: -1 0 00 one 2.7 /\ [] +6e1 ~~~
 Sattolo: /\ 00 +6e1 0 ~~~ oNe -1 2.7 []

version 2

<lang rexx>/* REXX */ n=25 Do i=0 To n

 a.i=i
 b.i=i
 End

Call show ' pre' Do i=n to 1 By -1

 j=random(0,i-1)
 Parse Value a.i a.j With a.j a.i
 End

Call show 'post' Do i=0 To n

 If a.i=b.i Then
   Say i a.i '=' b.i
 End

Exit Show: ol=arg(1) Do i=0 To n

 ol=ol right(a.i,2)
 End

Say ol Return</lang>

Output:

 pre  0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
post  3  4  8 18 14 21 20 13 10  1 25  7  2 24 12 23  5 11  6 22 16 19  9  0 15 17

Ring

Project : Sattolo cycle

a = "123456789abcdefghijklmnopqrstuvwxyz" n = len(a) sit = list(n)

for i = 1 to n

   sit[i] = substr(a, i, 1)

next showsit() for i = n to 1 step -1

   j = floor(i * random(9)/10) + 1
   h = sit[i]
   sit[i] = sit[j]
   sit[j] = h

next showsit()

func showsit

    for i = 1 to n
        see sit[i] + " "
    next 
    see nl

</lang> Output:

1 2 3 4 5 6 7 8 9 a b c d e f g h i j k l m n o p q r s t u v w x y z 
i v 3 c 7 x 6 5 4 n a b r t e f g 2 8 u m o p w q l j h 9 s d y k z 1

Ruby

<lang ruby> > class Array > def sattolo_cycle! > (length - 1).downto(1) do |i|

j = rand(i)

> self[i], self[j] = self[j], self[i] > end > self > end > end => :sattolo_cycle!

> # Tests > 10.times do

p [1, 2, 3, 4, 5, 6, 7, 8, 9, 10].sattolo_cycle!

> end [10, 6, 9, 7, 8, 1, 3, 2, 5, 4] [3, 7, 5, 10, 4, 8, 1, 2, 6, 9] [10, 3, 4, 8, 9, 7, 1, 5, 6, 2] [8, 7, 4, 2, 6, 9, 1, 5, 10, 3] [2, 7, 5, 10, 8, 3, 6, 9, 4, 1] [2, 10, 8, 6, 1, 3, 5, 9, 7, 4] [8, 5, 6, 1, 4, 9, 2, 10, 7, 3] [5, 4, 10, 7, 2, 1, 8, 9, 3, 6] [9, 8, 4, 2, 6, 1, 5, 10, 3, 7] [9, 4, 2, 7, 6, 1, 10, 3, 8, 5] => 10</lang>

Run BASIC

<lang Runbasic>a$ = "123456789abcdefghijklmnopqrstuvwxyz" n = len(a$) dim sit$(n) ' hold area to string global n

for i = 1 to n ' put string in array

   sit$(i) = mid$(a$,i,1)

next i

call shoSit ' show before change

for i = n to 1 step -1

   j		= int(i * rnd(1)) + 1
   h$		= sit$(i)
   sit$(i)	= sit$(j)
   sit$(j)	= h$

next i

call shoSit ' show after change end

sub shoSit

   for i = 1 to n
      print sit$(i);" ";
   next i
   print

end sub

</lang>

Output:
1 2 3 4 5 6 7 8 9 a b c d e f g h i j k l m n o p q r s t u v w x y z
d c 5 e v 3 n 7 8 h r p 2 y j l s x q 6 f 9 o a u i w 4 1 m g z t k b

Scala

<lang Scala>def shuffle[T](a: Array[T]): Array[T] = {

 scala.util.Random.shuffle(a)
 a

}</lang>

SequenceL

<lang sequenceL> import <Utilities/Random.sl>; import <Utilities/Sequence.sl>;

sattolo(x(1), seed) := shuffle(x, seedRandom(seed), size(x));

shuffle(x(1), RG, n) := let next := getRandom(RG); in x when n <= 1 else shuffle(swap(x, n, next.Value mod (n - 1) + 1), next.Generator, n - 1);

swap(list(1), i(0), j(0)) := swapHelper(list, i, j, list[i], list[j]); swapHelper(list(1), i(0), j(0), vali(0), valj(0)) := setElementAt(setElementAt(list, i, valj), j, vali);

</lang>

Sidef

Modifies the array in-place: <lang ruby>func sattolo_cycle(arr) {

   for i in (arr.len ^.. 1) {
       arr.swap(i, i.irand)
   }

}</lang>

Smalltalk

Works with: GNU Smalltalk

<lang Smalltalk>SequenceableCollection extend [

   sattoloCycle
       [1 to: self size-1 do:
           [:a || b |
           b := Random between: a+1 and: self size.
           self swap: a with: b]]

]</lang> Modifies the collection in-place. Collections that don't support that, like strings, will throw an exception.

Use example: <lang Smalltalk>st> #() copy sattoloCycle () st> #(10) copy sattoloCycle (10 ) st> #(10 20) copy sattoloCycle (20 10 ) st> #(10 20 30) copy sattoloCycle (30 10 20 ) st> #(10 20 30) copy sattoloCycle (20 30 10 ) st> #(11 12 13 14 15 16 17 18 19 20 21 22) copy sattoloCycle (22 13 17 18 14 12 15 21 16 11 20 19 ) st> 'Sattolo cycle' asArray sattoloCycle asString 'yocS talcelto'</lang>

Swift

<lang swift>extension Array {

 public mutating func satalloShuffle() {
   for i in stride(from: index(before: endIndex), through: 1, by: -1) {
     swapAt(i, .random(in: 0..<i))
   }
 }

 public func satalloShuffled() -> [Element] {
   var arr = Array(self)

   arr.satalloShuffle()

   return arr
 }

}

let testCases = [

 [],
 [10, 20],
 [10, 20, 30],
 [11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22]

]

for testCase in testCases {

 let shuffled = testCase.satalloShuffled()

 guard zip(testCase, shuffled).allSatisfy(!=) else {
   fatalError("satallo shuffle failed")
 }

 print("\(testCase) shuffled = \(shuffled)")

}</lang>

Output:

[] shuffled = []
[10, 20] shuffled = [20, 10]
[10, 20, 30] shuffled = [20, 30, 10]
[11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22] shuffled = [20, 22, 17, 12, 19, 14, 15, 13, 21, 16, 11, 18]

TypeScript

<lang TypeScript>function sattoloCycle<T>(items: Array<T>): void {

   for (let i = items.length; i -= 1;) {
       const j = Math.floor(Math.random() * i);
       const tmp = items[i];
       items[i] = items[j];
       items[j] = tmp;
   }

}</lang>

VBA

<lang vb>Private Sub Sattolo(Optional ByRef a As Variant)

   Dim t As Variant, i As Integer
   If Not IsMissing(a) Then
       For i = UBound(a) To lbound(a)+1 Step -1
           j = Int((UBound(a) - 1 - LBound(a) + 1) * Rnd + LBound(a))
           t = a(i)
           a(i) = a(j)
           a(j) = t
       Next i
   End If

End Sub Public Sub program()

   Dim b As Variant, c As Variant, d As Variant, e As Variant
   Randomize
   'imagine an empty array on this line
   b = [{10}]
   c = [{10, 20}]
   d = [{10, 20, 30}]
   e = [{11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22}]
   f = [{"This ", "is ", "a ", "test"}]
   Debug.Print "Before:"
   Sattolo 'feeding an empty array ;)
   Debug.Print "After: "
   Debug.Print "Before:";
   For Each i In b: Debug.Print i;: Next i: Debug.Print
   Sattolo b
   Debug.Print "After: ";
   For Each i In b: Debug.Print i;: Next i: Debug.Print
   Debug.Print "Before:";
   For Each i In c: Debug.Print i;: Next i: Debug.Print
   Sattolo c
   Debug.Print "After: ";
   For Each i In c: Debug.Print i;: Next i: Debug.Print
   Debug.Print "Before:";
   For Each i In d: Debug.Print i;: Next i: Debug.Print
   Sattolo d
   Debug.Print "After: ";
   For Each i In d: Debug.Print i;: Next i: Debug.Print
   Debug.Print "Before:";
   For Each i In e: Debug.Print i;: Next i: Debug.Print
   Sattolo e
   Debug.Print "After: ";
   For Each i In e: Debug.Print i;: Next i: Debug.Print
   Debug.Print "Before:";
   For Each i In f: Debug.Print i;: Next i: Debug.Print
   Sattolo f
   Debug.Print "After: ";
   For Each i In f: Debug.Print i;: Next i: Debug.Print

End Sub

</lang>

Output:

Before:

After: Before: 10 After: 10 Before: 10 20 After: 20 10 Before: 10 20 30 After: 20 10 30 Before: 11 12 13 14 15 16 17 18 19 20 21 22 After: 16 18 19 17 12 20 22 14 11 13 15 21 Before:This is a test After: testa is This

Wren

<lang ecmascript>import "random" for Random

var rand = Random.new()

var sattolo = Fn.new { |items|

   var count = items.count
   if (count < 2) return
   for (i in count-1..1) {
       var j = rand.int(i)
       var t = items[i]
       items[i] = items[j]
       items[j] = t
   }

}

var tests = [[], [10], [10, 20], [10, 20, 30], [11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22],

   ["a", "b", "c", "d", "e"], ["fgh", "ijk", "lmn", "opq", "rst", "uvw", "xyz"] ]

for (test in tests) {

   System.print("Original: %(test)")
   sattolo.call(test)
   System.print("Sattolo : %(test)\n")

}</lang>

Output:

Original: []
Sattolo : []

Original: [10]
Sattolo : [10]

Original: [10, 20]
Sattolo : [20, 10]

Original: [10, 20, 30]
Sattolo : [20, 30, 10]

Original: [11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22]
Sattolo : [21, 22, 19, 15, 13, 12, 11, 14, 20, 16, 18, 17]

Original: [a, b, c, d, e]
Sattolo : [b, e, d, a, c]

Original: [fgh, ijk, lmn, opq, rst, uvw, xyz]
Sattolo : [xyz, opq, rst, fgh, ijk, lmn, uvw]

Yabasic

<lang Yabasic>sub sattolo$(l$)

   local i, j, items$(1), n, t$
   
   n = token(l$, items$(), ",")
   
   for i = n to 2 step -1
       j = int(ran(i - 1)) + 1
       t$ = items$(i)
       items$(i) = items$(j)
       items$(j) = t$
   next

   t$ = ""
   for i = 1 to n
   	t$ = t$ + items$(i) + ","
   next
   return left$(t$, len(t$) - 1)

end sub

data "", "10", "10,20", "10,20,30", "11,12,13,14,15,16,17,18,19,20,21,22"

for n = 1 to 5

   read item$ : print "[", sattolo$(item$), "]"

next</lang>

zkl

<lang zkl>fcn sattoloCycle(list){ // in place

  foreach i in ([list.len()-1 .. 1,-1]){
     list.swap(i,(0).random(i));  # 0 <= j < i
  }
  list

}</lang> <lang zkl>sattoloCycle([0..9].walk().copy()).println(); sattoloCycle("this is a test".split()).println();</lang>

Output:

L(6,3,8,2,5,7,1,0,9,4)
L("test","this","is","a")