aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

3
Task/Permutations/00-META.yaml Normal file
View file

@ -0,0 +1,3 @@
---
from: http://rosettacode.org/wiki/Permutations
note: Discrete math

12
Task/Permutations/00-TASK.txt Normal file
View file

@ -0,0 +1,12 @@
;Task:
Write a program that generates all   [[wp:Permutation|permutations]]   of   '''n'''   different objects.   (Practically numerals!)
;Related tasks:
*   [[Find the missing permutation]]
*   [[Permutations/Derangements]]
{{Template:Combinations and permutations}}
<br><br>

5
Task/Permutations/11l/permutations.11l Normal file
View file

@ -0,0 +1,5 @@
V a = [1, 2, 3]
L
print(a)
I !a.next_permutation()
L.break

61
Task/Permutations/360-Assembly/permutations.360 Normal file
View file

@ -0,0 +1,61 @@
* Permutations 26/10/2015
PERMUTE CSECT
USING PERMUTE,R15 set base register
LA R9,TMP-A n=hbound(a)
SR R10,R10 nn=0
LOOP LA R10,1(R10) nn=nn+1
LA R11,PG pgi=@pg
LA R6,1 i=1
LOOPI1 CR R6,R9 do i=1 to n
BH ELOOPI1
LA R2,A-1(R6) @a(i)
MVC 0(1,R11),0(R2) output a(i)
LA R11,1(R11) pgi=pgi+1
LA R6,1(R6) i=i+1
B LOOPI1
ELOOPI1 XPRNT PG,80
LR R6,R9 i=n
LOOPUIM BCTR R6,0 i=i-1
LTR R6,R6 until i=0
BE ELOOPUIM
LA R2,A-1(R6) @a(i)
LA R3,A(R6) @a(i+1)
CLC 0(1,R2),0(R3) or until a(i)<a(i+1)
BNL LOOPUIM
ELOOPUIM LR R7,R6 j=i
LA R7,1(R7) j=i+1
LR R8,R9 k=n
LOOPWJ CR R7,R8 do while j<k
BNL ELOOPWJ
LA R2,A-1(R7) r2=@a(j)
LA R3,A-1(R8) r3=@a(k)
MVC TMP,0(R2) tmp=a(j)
MVC 0(1,R2),0(R3) a(j)=a(k)
MVC 0(1,R3),TMP a(k)=tmp
LA R7,1(R7) j=j+1
BCTR R8,0 k=k-1
B LOOPWJ
ELOOPWJ LTR R6,R6 if i>0
BNP ILE0
LR R7,R6 j=i
LA R7,1(R7) j=i+1
LOOPWA LA R2,A-1(R7) @a(j)
LA R3,A-1(R6) @a(i)
CLC 0(1,R2),0(R3) do while a(j)<a(i)
BNL AJGEAI
LA R7,1(R7) j=j+1
B LOOPWA
AJGEAI LA R2,A-1(R7) r2=@a(j)
LA R3,A-1(R6) r3=@a(i)
MVC TMP,0(R2) tmp=a(j)
MVC 0(1,R2),0(R3) a(j)=a(i)
MVC 0(1,R3),TMP a(i)=tmp
ILE0 LTR R6,R6 until i<>0
BNE LOOP
XR R15,R15 set return code
BR R14 return to caller
A DC C'ABCD' <== input
TMP DS C temp for swap
PG DC CL80' ' buffer
YREGS
END PERMUTE

150
Task/Permutations/AArch64-Assembly/permutations.aarch64 Normal file
View file

@ -0,0 +1,150 @@
/* ARM assembly AARCH64 Raspberry PI 3B */
/* program permutation64.s */
/*******************************************/
/* Constantes file */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeConstantesARM64.inc"
/*********************************/
/* Initialized data */
/*********************************/
.data
sMessResult: .asciz "Value : @\n"
sMessCounter: .asciz "Permutations = @ \n"
szCarriageReturn: .asciz "\n"
.align 4
TableNumber: .quad 1,2,3
.equ NBELEMENTS, (. - TableNumber) / 8
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
sZoneConv: .skip 24
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: //entry of program
ldr x0,qAdrTableNumber //address number table
mov x1,NBELEMENTS //number of élements
mov x10,0 //counter
bl heapIteratif
mov x0,x10 //display counter
ldr x1,qAdrsZoneConv //
bl conversion10S //décimal conversion
ldr x0,qAdrsMessCounter
ldr x1,qAdrsZoneConv //insert conversion
bl strInsertAtCharInc
bl affichageMess //display message
100: //standard end of the program
mov x0,0 //return code
mov x8,EXIT //request to exit program
svc 0 //perform the system call
qAdrszCarriageReturn: .quad szCarriageReturn
qAdrsMessResult: .quad sMessResult
qAdrTableNumber: .quad TableNumber
qAdrsMessCounter: .quad sMessCounter
/******************************************************************/
/* permutation by heap iteratif (wikipedia) */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the eléments number */
heapIteratif:
stp x2,lr,[sp,-16]! // save registers
stp x3,x4,[sp,-16]! // save registers
stp x5,x6,[sp,-16]! // save registers
stp x7,fp,[sp,-16]! // save registers
tst x1,1 // odd ?
add x2,x1,1
csel x2,x2,x1,ne // the stack must be a multiple of 16
lsl x7,x2,3 // 8 bytes by count
sub sp,sp,x7
mov fp,sp
mov x3,#0
mov x4,#0 // index
1: // init area counter
str x4,[fp,x3,lsl 3]
add x3,x3,#1
cmp x3,x1
blt 1b
bl displayTable
add x10,x10,#1
mov x3,#0 // index
2:
ldr x4,[fp,x3,lsl 3] // load count [i]
cmp x4,x3 // compare with i
bge 5f
tst x3,#1 // even ?
bne 3f
ldr x5,[x0] // yes load value A[0]
ldr x6,[x0,x3,lsl 3] // and swap with value A[i]
str x6,[x0]
str x5,[x0,x3,lsl 3]
b 4f
3:
ldr x5,[x0,x4,lsl 3] // load value A[count[i]]
ldr x6,[x0,x3,lsl 3] // and swap with value A[i]
str x6,[x0,x4,lsl 3]
str x5,[x0,x3,lsl 3]
4:
bl displayTable
add x10,x10,1
add x4,x4,1 // increment count i
str x4,[fp,x3,lsl 3] // and store on stack
mov x3,0 // raz index
b 2b // and loop
5:
mov x4,0 // raz count [i]
str x4,[fp,x3,lsl 3]
add x3,x3,1 // increment index
cmp x3,x1 // end ?
blt 2b // no -> loop
add sp,sp,x7 // stack alignement
100:
ldp x7,fp,[sp],16 // restaur 2 registers
ldp x5,x6,[sp],16 // restaur 2 registers
ldp x3,x4,[sp],16 // restaur 2 registers
ldp x2,lr,[sp],16 // restaur 2 registers
ret // return to address lr x30
/******************************************************************/
/* Display table elements */
/******************************************************************/
/* x0 contains the address of table */
displayTable:
stp x1,lr,[sp,-16]! // save registers
stp x2,x3,[sp,-16]! // save registers
mov x2,x0 // table address
mov x3,#0
1: // loop display table
ldr x0,[x2,x3,lsl 3]
ldr x1,qAdrsZoneConv
bl conversion10S // décimal conversion
ldr x0,qAdrsMessResult
ldr x1,qAdrsZoneConv // insert conversion
bl strInsertAtCharInc
bl affichageMess // display message
add x3,x3,1
cmp x3,NBELEMENTS - 1
ble 1b
ldr x0,qAdrszCarriageReturn
bl affichageMess
mov x0,x2
100:
ldp x2,x3,[sp],16 // restaur 2 registers
ldp x1,lr,[sp],16 // restaur 2 registers
ret // return to address lr x30
qAdrsZoneConv: .quad sZoneConv
/********************************************************/
/* File Include fonctions */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"

100
Task/Permutations/ABAP/permutations.abap Normal file
View file

@ -0,0 +1,100 @@
data: lv_flag type c,
lv_number type i,
lt_numbers type table of i.
append 1 to lt_numbers.
append 2 to lt_numbers.
append 3 to lt_numbers.
do.
perform permute using lt_numbers changing lv_flag.
if lv_flag = 'X'.
exit.
endif.
loop at lt_numbers into lv_number.
write (1) lv_number no-gap left-justified.
if sy-tabix <> '3'.
write ', '.
endif.
endloop.
skip.
enddo.
" Permutation function - this is used to permute:
" Can be used for an unbounded size set.
form permute using iv_set like lt_numbers
changing ev_last type c.
data: lv_len type i,
lv_first type i,
lv_third type i,
lv_count type i,
lv_temp type i,
lv_temp_2 type i,
lv_second type i,
lv_changed type c,
lv_perm type i.
describe table iv_set lines lv_len.
lv_perm = lv_len - 1.
lv_changed = ' '.
" Loop backwards through the table, attempting to find elements which
" can be permuted. If we find one, break out of the table and set the
" flag indicating a switch.
do.
if lv_perm <= 0.
exit.
endif.
" Read the elements.
read table iv_set index lv_perm into lv_first.
add 1 to lv_perm.
read table iv_set index lv_perm into lv_second.
subtract 1 from lv_perm.
if lv_first < lv_second.
lv_changed = 'X'.
exit.
endif.
subtract 1 from lv_perm.
enddo.
" Last permutation.
if lv_changed <> 'X'.
ev_last = 'X'.
exit.
endif.
" Swap tail decresing to get a tail increasing.
lv_count = lv_perm + 1.
do.
lv_first = lv_len + lv_perm - lv_count + 1.
if lv_count >= lv_first.
exit.
endif.
read table iv_set index lv_count into lv_temp.
read table iv_set index lv_first into lv_temp_2.
modify iv_set index lv_count from lv_temp_2.
modify iv_set index lv_first from lv_temp.
add 1 to lv_count.
enddo.
lv_count = lv_len - 1.
do.
if lv_count <= lv_perm.
exit.
endif.
read table iv_set index lv_count into lv_first.
read table iv_set index lv_perm into lv_second.
read table iv_set index lv_len into lv_third.
if ( lv_first < lv_third ) and ( lv_first > lv_second ).
lv_len = lv_count.
endif.
subtract 1 from lv_count.
enddo.
read table iv_set index lv_perm into lv_temp.
read table iv_set index lv_len into lv_temp_2.
modify iv_set index lv_perm from lv_temp_2.
modify iv_set index lv_len from lv_temp.
endform.

33
Task/Permutations/ALGOL-68/permutations-1.alg Normal file
View file

@ -0,0 +1,33 @@
# -*- coding: utf-8 -*- #
COMMENT REQUIRED BY "prelude_permutations.a68"
MODE PERMDATA = ~;
PROVIDES:
# PERMDATA*=~* #
# perm*=~ list* #
END COMMENT
MODE PERMDATALIST = REF[]PERMDATA;
MODE PERMDATALISTYIELD = PROC(PERMDATALIST)VOID;
# Generate permutations of the input data list of data list #
PROC perm gen permutations = (PERMDATALIST data list, PERMDATALISTYIELD yield)VOID: (
# Warning: this routine does not correctly handle duplicate elements #
IF LWB data list = UPB data list THEN
yield(data list)
ELSE
FOR elem FROM LWB data list TO UPB data list DO
PERMDATA first = data list[elem];
data list[LWB data list+1:elem] := data list[:elem-1];
data list[LWB data list] := first;
# FOR PERMDATALIST next data list IN # perm gen permutations(data list[LWB data list+1:] # ) DO #,
## (PERMDATALIST next)VOID:(
yield(data list)
# OD #));
data list[:elem-1] := data list[LWB data list+1:elem];
data list[elem] := first
OD
FI
);
SKIP

24
Task/Permutations/ALGOL-68/permutations-2.alg Normal file
View file

@ -0,0 +1,24 @@
#!/usr/bin/a68g --script #
# -*- coding: utf-8 -*- #
CO REQUIRED BY "prelude_permutations.a68" CO
MODE PERMDATA = INT;
#PROVIDES:#
# PERM*=INT* #
# perm *=int list *#
PR READ "prelude_permutations.a68" PR;
main:(
FLEX[0]PERMDATA test case := (1, 22, 333, 44444);
INT upb data list = UPB test case;
FORMAT
data fmt := $g(0)$,
data list fmt := $"("n(upb data list-1)(f(data fmt)", ")f(data fmt)")"$;
# FOR DATALIST permutation IN # perm gen permutations(test case#) DO (#,
## (PERMDATALIST permutation)VOID:(
printf((data list fmt, permutation, $l$))
# OD #))
)

7
Task/Permutations/APL/permutations.apl Normal file
View file

@ -0,0 +1,7 @@
⍝ Builtin version, takes a vector:
⎕CY'dfns'
perms←{↓⍵[pmat ≢⍵]} ⍝ pmat always gives lexicographically ordered permutations.
⍝ Recursive fast implementation, courtesy of dzaima from The APL Orchard:
dpmat←{1=⍵:,⊂,0 ⋄ (⊃,/)¨(⍳⍵)⌽¨⊂(⊂(!⍵-1)⍴⍵-1),⍨∇⍵-1}
perms2←{↓⍵[1+⍉↑dpmat ≢⍵]}

143
Task/Permutations/ARM-Assembly/permutations.arm Normal file
View file

@ -0,0 +1,143 @@
/* ARM assembly Raspberry PI */
/* program permutation.s */
/* REMARK 1 : this program use routines in a include file
see task Include a file language arm assembly
for the routine affichageMess conversion10
see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes */
/************************************/
.include "../constantes.inc"
/*********************************/
/* Initialized data */
/*********************************/
.data
sMessResult: .asciz "Value : @ \n"
sMessCounter: .asciz "Permutations = @ \n"
szCarriageReturn: .asciz "\n"
.align 4
TableNumber: .int 1,2,3
.equ NBELEMENTS, (. - TableNumber) / 4
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
sZoneConv: .skip 24
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: @ entry of program
ldr r0,iAdrTableNumber @ address number table
mov r1,#NBELEMENTS @ number of élements
mov r10,#0 @ counter
bl heapIteratif
mov r0,r10 @ display counter
ldr r1,iAdrsZoneConv @
bl conversion10S @ décimal conversion
ldr r0,iAdrsMessCounter
ldr r1,iAdrsZoneConv @ insert conversion
bl strInsertAtCharInc
bl affichageMess @ display message
100: @ standard end of the program
mov r0, #0 @ return code
mov r7, #EXIT @ request to exit program
svc #0 @ perform the system call
iAdrszCarriageReturn: .int szCarriageReturn
iAdrsMessResult: .int sMessResult
iAdrTableNumber: .int TableNumber
iAdrsMessCounter: .int sMessCounter
/******************************************************************/
/* permutation by heap iteratif (wikipedia) */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the eléments number */
heapIteratif:
push {r3-r9,lr} @ save registers
lsl r9,r1,#2 @ four bytes by count
sub sp,sp,r9
mov fp,sp
mov r3,#0
mov r4,#0 @ index
1: @ init area counter
str r4,[fp,r3,lsl #2]
add r3,r3,#1
cmp r3,r1
blt 1b
bl displayTable
add r10,r10,#1
mov r3,#0 @ index
2:
ldr r4,[fp,r3,lsl #2] @ load count [i]
cmp r4,r3 @ compare with i
bge 5f
tst r3,#1 @ even ?
bne 3f
ldr r5,[r0] @ yes load value A[0]
ldr r6,[r0,r3,lsl #2] @ and swap with value A[i]
str r6,[r0]
str r5,[r0,r3,lsl #2]
b 4f
3:
ldr r5,[r0,r4,lsl #2] @ load value A[count[i]]
ldr r6,[r0,r3,lsl #2] @ and swap with value A[i]
str r6,[r0,r4,lsl #2]
str r5,[r0,r3,lsl #2]
4:
bl displayTable
add r10,r10,#1
add r4,r4,#1 @ increment count i
str r4,[fp,r3,lsl #2] @ and store on stack
mov r3,#0 @ raz index
b 2b @ and loop
5:
mov r4,#0 @ raz count [i]
str r4,[fp,r3,lsl #2]
add r3,r3,#1 @ increment index
cmp r3,r1 @ end ?
blt 2b @ no -> loop
add sp,sp,r9 @ stack alignement
100:
pop {r3-r9,lr}
bx lr @ return
/******************************************************************/
/* Display table elements */
/******************************************************************/
/* r0 contains the address of table */
displayTable:
push {r0-r3,lr} @ save registers
mov r2,r0 @ table address
mov r3,#0
1: @ loop display table
ldr r0,[r2,r3,lsl #2]
ldr r1,iAdrsZoneConv @
bl conversion10S @ décimal conversion
ldr r0,iAdrsMessResult
ldr r1,iAdrsZoneConv @ insert conversion
bl strInsertAtCharInc
bl affichageMess @ display message
add r3,#1
cmp r3,#NBELEMENTS - 1
ble 1b
ldr r0,iAdrszCarriageReturn
bl affichageMess
mov r0,r2
100:
pop {r0-r3,lr}
bx lr
iAdrsZoneConv: .int sZoneConv
/***************************************************/
/* ROUTINES INCLUDE */
/***************************************************/
.include "../affichage.inc"

46
Task/Permutations/AWK/permutations.awk Normal file
View file

@ -0,0 +1,46 @@
# syntax: GAWK -f PERMUTATIONS.AWK [-v sep=x] [word]
#
# examples:
# REM all permutations on one line
# GAWK -f PERMUTATIONS.AWK
#
# REM all permutations on a separate line
# GAWK -f PERMUTATIONS.AWK -v sep="\n"
#
# REM use a different word
# GAWK -f PERMUTATIONS.AWK Gwen
#
# REM command used for RosettaCode output
# GAWK -f PERMUTATIONS.AWK -v sep="\n" Gwen
#
BEGIN {
sep = (sep == "") ? " " : substr(sep,1,1)
str = (ARGC == 1) ? "abc" : ARGV[1]
printf("%s%s",str,sep)
leng = length(str)
for (i=1; i<=leng; i++) {
arr[i-1] = substr(str,i,1)
}
ana_permute(0)
exit(0)
}
function ana_permute(pos, i,j,str) {
if (leng - pos < 2) { return }
for (i=pos; i<leng-1; i++) {
ana_permute(pos+1)
ana_rotate(pos)
for (j=0; j<=leng-1; j++) {
printf("%s",arr[j])
}
printf(sep)
}
ana_permute(pos+1)
ana_rotate(pos)
}
function ana_rotate(pos, c,i) {
c = arr[pos]
for (i=pos; i<leng-1; i++) {
arr[i] = arr[i+1]
}
arr[leng-1] = c
}

60
Task/Permutations/Action-/permutations.action Normal file
View file

@ -0,0 +1,60 @@
PROC PrintArray(BYTE ARRAY a BYTE len)
BYTE i
FOR i=0 TO len-1
DO
PrintB(a(i))
OD
Print(" ")
RETURN
BYTE FUNC NextPermutation(BYTE ARRAY a BYTE len)
BYTE i,j,k,tmp
i=len-1
WHILE i>0 AND a(i-1)>a(i)
DO
i==-1
OD
j=i
k=len-1
WHILE j<k
DO
tmp=a(j) a(j)=a(k) a(k)=tmp
j==+1 k==-1
OD
IF i=0 THEN
RETURN (0)
FI
j=i
WHILE a(j)<a(i-1)
DO
j==+1
OD
tmp=a(i-1) a(i-1)=a(j) a(j)=tmp
RETURN (1)
PROC Main()
DEFINE len="5"
BYTE ARRAY a(len)
BYTE RMARGIN=$53,oldRMARGIN
BYTE i
oldRMARGIN=RMARGIN
RMARGIN=37 ;change right margin on the screen
FOR i=0 TO len-1
DO
a(i)=i
OD
DO
PrintArray(a,len)
UNTIL NextPermutation(a,len)=0
OD
RMARGIN=oldRMARGIN ;restore right margin on the screen
RETURN

9
Task/Permutations/Ada/permutations-1.ada Normal file
View file

@ -0,0 +1,9 @@
generic
N: positive;
package Generic_Perm is
subtype Element is Positive range 1 .. N;
type Permutation is array(Element) of Element;
procedure Set_To_First(P: out Permutation; Is_Last: out Boolean);
procedure Go_To_Next(P: in out Permutation; Is_Last: out Boolean);
end Generic_Perm;

71
Task/Permutations/Ada/permutations-2.ada Normal file
View file

@ -0,0 +1,71 @@
package body Generic_Perm is
procedure Set_To_First(P: out Permutation; Is_Last: out Boolean) is
begin
for I in P'Range loop
P (I) := I;
end loop;
Is_Last := P'Length = 1;
-- if P has a single element, the fist permutation is the last one
end Set_To_First;
procedure Go_To_Next(P: in out Permutation; Is_Last: out Boolean) is
procedure Swap (A, B : in out Integer) is
C : Integer := A;
begin
A := B;
B := C;
end Swap;
I, J, K : Element;
begin
-- find longest tail decreasing sequence
-- after the loop, this sequence is I+1 .. n,
-- and the ith element will be exchanged later
-- with some element of the tail
Is_Last := True;
I := N - 1;
loop
if P (I) < P (I+1)
then
Is_Last := False;
exit;
end if;
-- next instruction will raise an exception if I = 1, so
-- exit now (this is the last permutation)
exit when I = 1;
I := I - 1;
end loop;
-- if all the elements of the permutation are in
-- decreasing order, this is the last one
if Is_Last then
return;
end if;
-- sort the tail, i.e. reverse it, since it is in decreasing order
J := I + 1;
K := N;
while J < K loop
Swap (P (J), P (K));
J := J + 1;
K := K - 1;
end loop;
-- find lowest element in the tail greater than the ith element
J := N;
while P (J) > P (I) loop
J := J - 1;
end loop;
J := J + 1;
-- exchange them
-- this will give the next permutation in lexicographic order,
-- since every element from ith to the last is minimum
Swap (P (I), P (J));
end Go_To_Next;
end Generic_Perm;

30
Task/Permutations/Ada/permutations-3.ada Normal file
View file

@ -0,0 +1,30 @@
with Ada.Text_IO, Ada.Command_Line, Generic_Perm;
procedure Print_Perms is
package CML renames Ada.Command_Line;
package TIO renames Ada.Text_IO;
begin
declare
package Perms is new Generic_Perm(Positive'Value(CML.Argument(1)));
P : Perms.Permutation;
Done : Boolean := False;
procedure Print(P: Perms.Permutation) is
begin
for I in P'Range loop
TIO.Put (Perms.Element'Image (P (I)));
end loop;
TIO.New_Line;
end Print;
begin
Perms.Set_To_First(P, Done);
loop
Print(P);
exit when Done;
Perms.Go_To_Next(P, Done);
end loop;
end;
exception
when Constraint_Error
=> TIO.Put_Line ("*** Error: enter one numerical argument n with n >= 1");
end Print_Perms;

24
Task/Permutations/Aime/permutations.aime Normal file
View file

@ -0,0 +1,24 @@
void
f1(record r, ...)
{
if (~r) {
for (text s in r) {
r.delete(s);
rcall(f1, -2, 0, -1, s);
r[s] = 0;
}
} else {
ocall(o_, -2, 1, -1, " ", ",");
o_newline();
}
}
main(...)
{
record r;
ocall(r_put, -2, 1, -1, r, 0);
f1(r);
0;
}

35
Task/Permutations/Amazing-Hopper/permutations.hopper Normal file
View file

@ -0,0 +1,35 @@
/* hopper-JAMBO - a flavour of Amazing Hopper! */
#include <jambo.h>
Main
leng=0
Void(lista)
Set("la realidad","escapa","a los sentidos"), Apnd list(lista)
Length(lista), Move to(leng)
Toksep(" ")
Printnl( lista )
Set(1) Gosub(Permutar)
End-Return
Subrutines
Define( Permutar, pos )
If ( Sub(leng, pos) Isgeq(1) )
i=pos
Loop if( Less( i, leng ) )
Plusone(pos), Gosub(Permutar)
Set( pos ), Gosub(Rotate)
Printnl( lista )
++i
Back
Plusone(pos), Gosub(Permutar)
Set( pos ), Gosub(Rotate)
End If
Return
Define ( Rotate, pos )
c=0, [pos] Get(lista), Move to(c)
[ Plusone(pos): leng ] Cget(lista)
[ pos: Minusone(leng) ] Cput(lista)
Set(c), [ leng ] Cput(lista)
Return

87
Task/Permutations/AppleScript/permutations-1.applescript Normal file
View file

@ -0,0 +1,87 @@
----------------------- PERMUTATIONS -----------------------
-- permutations :: [a] -> [[a]]
on permutations(xs)
script go
on |λ|(xs)
script h
on |λ|(x)
script ts
on |λ|(ys)
{{x} & ys}
end |λ|
end script
concatMap(ts, go's |λ|(|delete|(x, xs)))
end |λ|
end script
if {} ≠ xs then
concatMap(h, xs)
else
{{}}
end if
end |λ|
end script
go's |λ|(xs)
end permutations
--------------------------- TEST ---------------------------
on run
permutations({"aardvarks", "eat", "ants"})
end run
-------------------- GENERIC FUNCTIONS ---------------------
-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
set lst to {}
set lng to length of xs
tell mReturn(f)
repeat with i from 1 to lng
set lst to (lst & |λ|(contents of item i of xs, i, xs))
end repeat
end tell
return lst
end concatMap
-- delete :: a -> [a] -> [a]
on |delete|(x, xs)
if length of xs > 0 then
set {h, t} to uncons(xs)
if x = h then
t
else
{h} & |delete|(x, t)
end if
else
{}
end if
end |delete|
-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
if class of f is script then
f
else
script
property |λ| : f
end script
end if
end mReturn
-- uncons :: [a] -> Maybe (a, [a])
on uncons(xs)
if length of xs > 0 then
{item 1 of xs, rest of xs}
else
missing value
end if
end uncons

42
Task/Permutations/AppleScript/permutations-2.applescript Normal file
View file

@ -0,0 +1,42 @@
to DoPermutations(aList, n)
--> Heaps's algorithm (Permutation by interchanging pairs)
if n = 1 then
tell (a reference to PermList) to copy aList to its end
-- or: copy aList as text (for concatenated results)
else
repeat with i from 1 to n
DoPermutations(aList, n - 1)
if n mod 2 = 0 then -- n is even
tell aList to set [item i, item n] to [item n, item i] -- swaps items i and n of aList
else
tell aList to set [item 1, item n] to [item n, item 1] -- swaps items 1 and n of aList
end if
end repeat
end if
return (a reference to PermList) as list
end DoPermutations
--> Example 1 (list of words)
set [SourceList, PermList] to [{"Good", "Johnny", "Be"}, {}]
DoPermutations(SourceList, SourceList's length)
--> result (value of PermList)
{{"Good", "Johnny", "Be"}, {"Johnny", "Good", "Be"}, {"Be", "Good", "Johnny"}, ¬
{"Good", "Be", "Johnny"}, {"Johnny", "Be", "Good"}, {"Be", "Johnny", "Good"}}
--> Example 2 (characters with concatenated results)
set [SourceList, PermList] to [{"X", "Y", "Z"}, {}]
DoPermutations(SourceList, SourceList's length)
--> result (value of PermList)
{"XYZ", "YXZ", "ZXY", "XZY", "YZX", "ZYX"}
--> Example 3 (Integers)
set [SourceList, Permlist] to [{1, 2, 3}, {}]
DoPermutations(SourceList, SourceList's length)
--> result (value of Permlist)
{{1, 2, 3}, {2, 1, 3}, {3, 1, 2}, {1, 3, 2}, {2, 3, 1}, {3, 2, 1}}
--> Example 4 (Integers with concatenated results)
set [SourceList, Permlist] to [{1, 2, 3}, {}]
DoPermutations(SourceList, SourceList's length)
--> result (value of Permlist)
{"123", "213", "312", "132", "231", "321"}

133
Task/Permutations/AppleScript/permutations-3.applescript Normal file
View file

@ -0,0 +1,133 @@
----------------------- PERMUTATIONS -----------------------
-- permutations :: [a] -> [[a]]
on permutations(xs)
script go
on |λ|(x, a)
script
on |λ|(ys)
script infix
on |λ|(n)
if ys ≠ {} then
take(n, ys) & {x} & drop(n, ys)
else
{x}
end if
end |λ|
end script
map(infix, enumFromTo(0, (length of ys)))
end |λ|
end script
concatMap(result, a)
end |λ|
end script
foldr(go, {{}}, xs)
end permutations
--------------------------- TEST ---------------------------
on run
permutations({1, 2, 3})
--> {{1, 2, 3}, {2, 1, 3}, {2, 3, 1}, {1, 3, 2}, {3, 1, 2}, {3, 2, 1}}
end run
------------------------- GENERIC --------------------------
-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
set lng to length of xs
set acc to {}
tell mReturn(f)
repeat with i from 1 to lng
set acc to acc & |λ|(item i of xs, i, xs)
end repeat
end tell
return acc
end concatMap
-- drop :: Int -> [a] -> [a]
on drop(n, xs)
if n < length of xs then
items (1 + n) thru -1 of xs
else
{}
end if
end drop
-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
if m ≤ n then
set lst to {}
repeat with i from m to n
set end of lst to i
end repeat
return lst
else
return {}
end if
end enumFromTo
-- foldr :: (a -> b -> b) -> b -> [a] -> b
on foldr(f, startValue, xs)
tell mReturn(f)
set v to startValue
set lng to length of xs
repeat with i from lng to 1 by -1
set v to |λ|(item i of xs, v, i, xs)
end repeat
return v
end tell
end foldr
-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
if class of f is script then
f
else
script
property |λ| : f
end script
end if
end mReturn
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
tell mReturn(f)
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to |λ|(item i of xs, i, xs)
end repeat
return lst
end tell
end map
-- min :: Ord a => a -> a -> a
on min(x, y)
if y < x then
y
else
x
end if
end min
-- take :: Int -> [a] -> [a]
-- take :: Int -> String -> String
on take(n, xs)
if 0 < n then
items 1 thru min(n, length of xs) of xs
else
{}
end if
end take

114
Task/Permutations/AppleScript/permutations-4.applescript Normal file
View file

@ -0,0 +1,114 @@
-- Translation of "Improved version of Heap's method (recursive)" found in
-- Robert Sedgewick's PDF document "Permutation Generation Methods"
-- <https://www.cs.princeton.edu/~rs/talks/perms.pdf>
on allPermutations(theList)
script o
-- Work list and precalculated indices for its last four items (assuming that many).
property workList : missing value --(Set to a copy of theList below.)
property r : (count theList)
property rMinus1 : r - 1
property rMinus2 : r - 2
property rMinus3 : r - 3
-- Output list and traversal index.
property output : {}
property p : 1
-- Recursive handler.
on prmt(l)
-- Is the range length covered by this recursion level even?
set rangeLenEven to ((r - l) mod 2 = 1)
-- Tail call elimination repeat. Gives way to hard-coding for the lowest three levels.
repeat with l from l to rMinus3
-- Recursively permute items (l + 1) thru r of the work list.
set lPlus1 to l + 1
prmt(lPlus1)
-- And again after swaps of item l with each of the items to its right
-- (if the range l to r is even) or with the rightmost item r - l times
-- (if the range length is odd). The "recursion" after the last swap will
-- instead be the next iteration of this tail call elimination repeat.
if (rangeLenEven) then
repeat with swapIdx from r to (lPlus1 + 1) by -1
tell my workList's item l
set my workList's item l to my workList's item swapIdx
set my workList's item swapIdx to it
end tell
prmt(lPlus1)
end repeat
set swapIdx to lPlus1
else
repeat (r - lPlus1) times
tell my workList's item l
set my workList's item l to my workList's item r
set my workList's item r to it
end tell
prmt(lPlus1)
end repeat
set swapIdx to r
end if
tell my workList's item l
set my workList's item l to my workList's item swapIdx
set my workList's item swapIdx to it
end tell
set rangeLenEven to (not rangeLenEven)
end repeat
-- Store a copy of the work list's current state.
set my output's item p to my workList's items
-- Then five more with the three rightmost items permuted.
set v1 to my workList's item rMinus2
set v2 to my workList's item rMinus1
set v3 to my workList's end
set my workList's item rMinus1 to v3
set my workList's item r to v2
set my output's item (p + 1) to my workList's items
set my workList's item rMinus2 to v2
set my workList's item r to v1
set my output's item (p + 2) to my workList's items
set my workList's item rMinus1 to v1
set my workList's item r to v3
set my output's item (p + 3) to my workList's items
set my workList's item rMinus2 to v3
set my workList's item r to v2
set my output's item (p + 4) to my workList's items
set my workList's item rMinus1 to v2
set my workList's item r to v1
set my output's item (p + 5) to my workList's items
set p to p + 6
end prmt
end script
if (o's r < 3) then
-- Fewer than three items in the input list.
copy theList to o's output's beginning
if (o's r is 2) then set o's output's end to theList's reverse
else
-- Otherwise prepare a list to hold (factorial of input list length) permutations …
copy theList to o's workList
set factorial to 2
repeat with i from 3 to o's r
set factorial to factorial * i
end repeat
set o's output to makeList(factorial, missing value)
-- … and call o's recursive handler.
o's prmt(1)
end if
return o's output
end allPermutations
on makeList(limit, filler)
if (limit < 1) then return {}
script o
property lst : {filler}
end script
set counter to 1
repeat until (counter + counter > limit)
set o's lst to o's lst & o's lst
set counter to counter + counter
end repeat
if (counter < limit) then set o's lst to o's lst & o's lst's items 1 thru (limit - counter)
return o's lst
end makeList
return allPermutations({1, 2, 3, 4})

1
Task/Permutations/AppleScript/permutations-5.applescript Normal file
View file

@ -0,0 +1 @@
{{1, 2, 3, 4}, {1, 2, 4, 3}, {1, 3, 4, 2}, {1, 3, 2, 4}, {1, 4, 2, 3}, {1, 4, 3, 2}, {2, 4, 3, 1}, {2, 4, 1, 3}, {2, 3, 1, 4}, {2, 3, 4, 1}, {2, 1, 4, 3}, {2, 1, 3, 4}, {3, 1, 2, 4}, {3, 1, 4, 2}, {3, 2, 4, 1}, {3, 2, 1, 4}, {3, 4, 1, 2}, {3, 4, 2, 1}, {4, 3, 2, 1}, {4, 3, 1, 2}, {4, 2, 1, 3}, {4, 2, 3, 1}, {4, 1, 3, 2}, {4, 1, 2, 3}}

1
Task/Permutations/Arturo/permutations.arturo Normal file
View file

@ -0,0 +1 @@
print permutate [1 2 3]

49
Task/Permutations/AutoHotkey/permutations-1.ahk Normal file
View file

@ -0,0 +1,49 @@
#NoEnv
StringCaseSense On
o := str := "Hello"
Loop
{
str := perm_next(str)
If !str
{
MsgBox % clipboard := o
break
}
o.= "`n" . str
}
perm_Next(str){
p := 0, sLen := StrLen(str)
Loop % sLen
{
If A_Index=1
continue
t := SubStr(str, sLen+1-A_Index, 1)
n := SubStr(str, sLen+2-A_Index, 1)
If ( t < n )
{
p := sLen+1-A_Index, pC := SubStr(str, p, 1)
break
}
}
If !p
return false
Loop
{
t := SubStr(str, sLen+1-A_Index, 1)
If ( t > pC )
{
n := sLen+1-A_Index, nC := SubStr(str, n, 1)
break
}
}
return SubStr(str, 1, p-1) . nC . Reverse(SubStr(str, p+1, n-p-1) . pC . SubStr(str, n+1))
}
Reverse(s){
Loop Parse, s
o := A_LoopField o
return o
}

33
Task/Permutations/AutoHotkey/permutations-2.ahk Normal file
View file

@ -0,0 +1,33 @@
P(n,k="",opt=0,delim="",str="") { ; generate all n choose k permutations lexicographically
;1..n = range, or delimited list, or string to parse
; to process with a different min index, pass a delimited list, e.g. "0`n1`n2"
;k = length of result
;opt 0 = no repetitions
;opt 1 = with repetitions
;opt 2 = run for 1..k
;opt 3 = run for 1..k with repetitions
;str = string to prepend (used internally)
;returns delimited string, error message, or (if k > n) a blank string
i:=0
If !InStr(n,"`n")
If n in 2,3,4,5,6,7,8,9
Loop, %n%
n := A_Index = 1 ? A_Index : n "`n" A_Index
Else
Loop, Parse, n, %delim%
n := A_Index = 1 ? A_LoopField : n "`n" A_LoopField
If (k = "")
RegExReplace(n,"`n","",k), k++
If k is not Digit
Return "k must be a digit."
If opt not in 0,1,2,3
Return "opt invalid."
If k = 0
Return str
Else
Loop, Parse, n, `n
If (!InStr(str,A_LoopField) || opt & 1)
s .= (!i++ ? (opt & 2 ? str "`n" : "") : "`n" )
. P(n,k-1,opt,delim,str . A_LoopField . delim)
Return s
}

1
Task/Permutations/AutoHotkey/permutations-3.ahk Normal file
View file

@ -0,0 +1 @@
MsgBox % P(3)

1
Task/Permutations/AutoHotkey/permutations-4.ahk Normal file
View file

@ -0,0 +1 @@
MsgBox % P("Hello",3)

1
Task/Permutations/AutoHotkey/permutations-5.ahk Normal file
View file

@ -0,0 +1 @@
MsgBox % P("2`n3`n4`n5",2,3)

1
Task/Permutations/AutoHotkey/permutations-6.ahk Normal file
View file

@ -0,0 +1 @@
MsgBox % P("11 a text ] u+z",3,0," ")

43
Task/Permutations/BASIC256/permutations.basic Normal file
View file

@ -0,0 +1,43 @@
arraybase 1
n = 4 : cont = 0
dim a(n)
dim c(n)
for j = 1 to n
a[j] = j
next j
do
for i = 1 to n
print a[i];
next
print " ";
i = n
cont += 1
if cont = 12 then
print
cont = 0
else
print " ";
end if
do
i -= 1
until (i = 0) or (a[i] < a[i+1])
j = i + 1
k = n
while j < k
tmp = a[j] : a[j] = a[k] : a[k] = tmp
j += 1
k -= 1
end while
if i > 0 then
j = i + 1
while a[j] < a[i]
j += 1
end while
tmp = a[j] : a[j] = a[i] : a[i] = tmp
end if
until i = 0
end

38
Task/Permutations/BBC-BASIC/permutations.basic Normal file
View file

@ -0,0 +1,38 @@
DIM List%(3)
List%() = 1, 2, 3, 4
FOR perm% = 1 TO 24
FOR i% = 0 TO DIM(List%(),1)
PRINT List%(i%);
NEXT
PRINT
PROC_NextPermutation(List%())
NEXT
END
DEF PROC_NextPermutation(A%())
LOCAL first, last, elementcount, pos
elementcount = DIM(A%(),1)
IF elementcount < 1 THEN ENDPROC
pos = elementcount-1
WHILE A%(pos) >= A%(pos+1)
pos -= 1
IF pos < 0 THEN
PROC_Permutation_Reverse(A%(), 0, elementcount)
ENDPROC
ENDIF
ENDWHILE
last = elementcount
WHILE A%(last) <= A%(pos)
last -= 1
ENDWHILE
SWAP A%(pos), A%(last)
PROC_Permutation_Reverse(A%(), pos+1, elementcount)
ENDPROC
DEF PROC_Permutation_Reverse(A%(), first, last)
WHILE first < last
SWAP A%(first), A%(last)
first += 1
last -= 1
ENDWHILE
ENDPROC

33
Task/Permutations/Batch-File/permutations.bat Normal file
View file

@ -0,0 +1,33 @@
@echo off
setlocal enabledelayedexpansion
set arr=ABCD
set /a n=4
:: echo !arr!
call :permu %n% arr
goto:eof
:permu num &arr
setlocal
if %1 equ 1 call echo(!%2! & exit /b
set /a "num=%1-1,n2=num-1"
set arr=!%2!
for /L %%c in (0,1,!n2!) do (
call:permu !num! arr
set /a n1="num&1"
if !n1! equ 0 (call:swapit !num! 0 arr) else (call:swapit !num! %%c arr)
)
call:permu !num! arr
endlocal & set %2=%arr%
exit /b
:swapit from to &arr
setlocal
set arr=!%3!
set temp1=!arr:~%~1,1!
set temp2=!arr:~%~2,1!
set arr=!arr:%temp1%=@!
set arr=!arr:%temp2%=%temp1%!
set arr=!arr:@=%temp2%!
:: echo %1 %2 !%~3! !arr!
endlocal & set %3=%arr%
exit /b

13
Task/Permutations/Bracmat/permutations.bracmat Normal file
View file

@ -0,0 +1,13 @@
( perm
= prefix List result original A Z
. !arg:(?.)
| !arg:(?prefix.?List:?original)
& :?result
& whl
' ( !List:%?A ?Z
& !result perm$(!prefix !A.!Z):?result
& !Z !A:~!original:?List
)
& !result
)
& out$(perm$(.a 2 "]" u+z);

40
Task/Permutations/C++/permutations.cpp Normal file
View file

@ -0,0 +1,40 @@
#include <algorithm>
#include <string>
#include <vector>
#include <iostream>
template<class T>
void print(const std::vector<T> &vec)
{
for (typename std::vector<T>::const_iterator i = vec.begin(); i != vec.end(); ++i)
{
std::cout << *i;
if ((i + 1) != vec.end())
std::cout << ",";
}
std::cout << std::endl;
}
int main()
{
//Permutations for strings
std::string example("Hello");
std::sort(example.begin(), example.end());
do {
std::cout << example << '\n';
} while (std::next_permutation(example.begin(), example.end()));
// And for vectors
std::vector<int> another;
another.push_back(1234);
another.push_back(4321);
another.push_back(1234);
another.push_back(9999);
std::sort(another.begin(), another.end());
do {
print(another);
} while (std::next_permutation(another.begin(), another.end()));
return 0;
}

9
Task/Permutations/C-sharp/permutations-1.cs Normal file
View file

@ -0,0 +1,9 @@
public static class Extension
{
public static IEnumerable<IEnumerable<T>> Permutations<T>(this IEnumerable<T> values) where T : IComparable<T>
{
if (values.Count() == 1)
return new[] { values };
return values.SelectMany(v => Permutations(values.Where(x => x.CompareTo(v) != 0)), (v, p) => p.Prepend(v));
}
}

1
Task/Permutations/C-sharp/permutations-2.cs Normal file
View file

@ -0,0 +1 @@
Enumerable.Range(0,5).Permutations()

31
Task/Permutations/C-sharp/permutations-3.cs Normal file
View file

@ -0,0 +1,31 @@
public class Permutations<T>
{
public static System.Collections.Generic.IEnumerable<T[]> AllFor(T[] array)
{
if (array == null || array.Length == 0)
{
yield return new T[0];
}
else
{
for (int pick = 0; pick < array.Length; ++pick)
{
T item = array[pick];
int i = -1;
T[] rest = System.Array.FindAll<T>(
array, delegate(T p) { return ++i != pick; }
);
foreach (T[] restPermuted in AllFor(rest))
{
i = -1;
yield return System.Array.ConvertAll<T, T>(
array,
delegate(T p) {
return ++i == 0 ? item : restPermuted[i - 1];
}
);
}
}
}
}
}

14
Task/Permutations/C-sharp/permutations-4.cs Normal file
View file

@ -0,0 +1,14 @@
namespace Permutations_On_RosettaCode
{
class Program
{
static void Main(string[] args)
{
string[] list = "a b c d".Split();
foreach (string[] permutation in Permutations<string>.AllFor(list))
{
System.Console.WriteLine(string.Join(" ", permutation));
}
}
}
}

28
Task/Permutations/C-sharp/permutations-5.cs Normal file
View file

@ -0,0 +1,28 @@
using System;
class Permutations
{
static int n = 4;
static int [] buf = new int [n];
static bool [] used = new bool [n];
static void Main()
{
for (int i = 0; i < n; i++) used [i] = false;
rec(0);
}
static void rec(int ind)
{
for (int i = 0; i < n; i++)
{
if (!used [i])
{
used [i] = true;
buf [ind] = i;
if (ind + 1 < n) rec(ind + 1);
else Console.WriteLine(string.Join(",", buf));
used [i] = false;
}
}
}
}

26
Task/Permutations/C-sharp/permutations-6.cs Normal file
View file

@ -0,0 +1,26 @@
using System;
class Permutations
{
static int n = 4;
static int [] buf = new int [n];
static int [] next = new int [n+1];
static void Main()
{
for (int i = 0; i < n; i++) next [i] = i + 1;
next[n] = 0;
rec(0);
}
static void rec(int ind)
{
for (int i = n; next[i] != n; i = next[i])
{
buf [ind] = next[i];
next[i]=next[next[i]];
if (ind < n - 1) rec(ind + 1);
else Console.WriteLine(string.Join(",", buf));
next[i] = buf [ind];
}
}
}

38
Task/Permutations/C-sharp/permutations-7.cs Normal file
View file

@ -0,0 +1,38 @@
// Always returns the same array which is the one passed to the function
public static IEnumerable<T[]> HeapsPermutations<T>(T[] array)
{
var state = new int[array.Length];
yield return array;
for (var i = 0; i < array.Length;)
{
if (state[i] < i)
{
var left = i % 2 == 0 ? 0 : state[i];
var temp = array[left];
array[left] = array[i];
array[i] = temp;
yield return array;
state[i]++;
i = 1;
}
else
{
state[i] = 0;
i++;
}
}
}
// Returns a different array for each permutation
public static IEnumerable<T[]> HeapsPermutationsWrapped<T>(IEnumerable<T> items)
{
var array = items.ToArray();
return HeapsPermutations(array).Select(mutating =>
{
var arr = new T[array.Length];
Array.Copy(mutating, arr, array.Length);
return arr;
});
}

54
Task/Permutations/C/permutations-1.c Normal file
View file

@ -0,0 +1,54 @@
#include <stdio.h>
int main (int argc, char *argv[]) {
//here we check arguments
if (argc < 2) {
printf("Enter an argument. Example 1234 or dcba:\n");
return 0;
}
//it calculates an array's length
int x;
for (x = 0; argv[1][x] != '\0'; x++);
//buble sort the array
int f, v, m;
for(f=0; f < x; f++) {
for(v = x-1; v > f; v-- ) {
if (argv[1][v-1] > argv[1][v]) {
m=argv[1][v-1];
argv[1][v-1]=argv[1][v];
argv[1][v]=m;
}
}
}
//it calculates a factorial to stop the algorithm
char a[x];
int k=0;
int fact=k+1;
while (k!=x) {
a[k]=argv[1][k];
k++;
fact = k*fact;
}
a[k]='\0';
//Main part: here we permutate
int i, j;
int y=0;
char c;
while (y != fact) {
printf("%s\n", a);
i=x-2;
while(a[i] > a[i+1] ) i--;
j=x-1;
while(a[j] < a[i] ) j--;
c=a[j];
a[j]=a[i];
a[i]=c;
i++;
for (j = x-1; j > i; i++, j--) {
c = a[i];
a[i] = a[j];
a[j] = c;
}
y++;
}
}

23
Task/Permutations/C/permutations-2.c Normal file
View file

@ -0,0 +1,23 @@
#include <stdio.h>
int main() {
char a[] = "4321"; //array
int i, j;
int f=24; //factorial
char c; //buffer
while (f--) {
printf("%s\n", a);
i=1;
while(a[i] > a[i-1]) i++;
j=0;
while(a[j] < a[i])j++;
c=a[j];
a[j]=a[i];
a[i]=c;
i--;
for (j = 0; j < i; i--, j++) {
c = a[i];
a[i] = a[j];
a[j] = c;
}
}
}

100
Task/Permutations/C/permutations-3.c Normal file
View file

@ -0,0 +1,100 @@
#include <stdio.h>
#include <stdlib.h>
/* print a list of ints */
int show(int *x, int len)
{
int i;
for (i = 0; i < len; i++)
printf("%d%c", x[i], i == len - 1 ? '\n' : ' ');
return 1;
}
/* next lexicographical permutation */
int next_lex_perm(int *a, int n) {
# define swap(i, j) {t = a[i]; a[i] = a[j]; a[j] = t;}
int k, l, t;
/* 1. Find the largest index k such that a[k] < a[k + 1]. If no such
index exists, the permutation is the last permutation. */
for (k = n - 1; k && a[k - 1] >= a[k]; k--);
if (!k--) return 0;
/* 2. Find the largest index l such that a[k] < a[l]. Since k + 1 is
such an index, l is well defined */
for (l = n - 1; a[l] <= a[k]; l--);
/* 3. Swap a[k] with a[l] */
swap(k, l);
/* 4. Reverse the sequence from a[k + 1] to the end */
for (k++, l = n - 1; l > k; l--, k++)
swap(k, l);
return 1;
# undef swap
}
void perm1(int *x, int n, int callback(int *, int))
{
do {
if (callback) callback(x, n);
} while (next_lex_perm(x, n));
}
/* Boothroyd method; exactly N! swaps, about as fast as it gets */
void boothroyd(int *x, int n, int nn, int callback(int *, int))
{
int c = 0, i, t;
while (1) {
if (n > 2) boothroyd(x, n - 1, nn, callback);
if (c >= n - 1) return;
i = (n & 1) ? 0 : c;
c++;
t = x[n - 1], x[n - 1] = x[i], x[i] = t;
if (callback) callback(x, nn);
}
}
/* entry for Boothroyd method */
void perm2(int *x, int n, int callback(int*, int))
{
if (callback) callback(x, n);
boothroyd(x, n, n, callback);
}
/* same as perm2, but flattened recursions into iterations */
void perm3(int *x, int n, int callback(int*, int))
{
/* calloc isn't strictly necessary, int c[32] would suffice
for most practical purposes */
int d, i, t, *c = calloc(n, sizeof(int));
/* curiously, with GCC 4.6.1 -O3, removing next line makes
it ~25% slower */
if (callback) callback(x, n);
for (d = 1; ; c[d]++) {
while (d > 1) c[--d] = 0;
while (c[d] >= d)
if (++d >= n) goto done;
t = x[ i = (d & 1) ? c[d] : 0 ], x[i] = x[d], x[d] = t;
if (callback) callback(x, n);
}
done: free(c);
}
#define N 4
int main()
{
int i, x[N];
for (i = 0; i < N; i++) x[i] = i + 1;
/* three different methods */
perm1(x, N, show);
perm2(x, N, show);
perm3(x, N, show);
return 0;
}

100
Task/Permutations/C/permutations-4.c Normal file
View file

@ -0,0 +1,100 @@
#include <stdio.h>
#include <stdlib.h>
/* print a list of ints */
int show(int *x, int len)
{
int i;
for (i = 0; i < len; i++)
printf("%d%c", x[i], i == len - 1 ? '\n' : ' ');
return 1;
}
/* next lexicographical permutation */
int next_lex_perm(int *a, int n) {
# define swap(i, j) {t = a[i]; a[i] = a[j]; a[j] = t;}
int k, l, t;
/* 1. Find the largest index k such that a[k] < a[k + 1]. If no such
index exists, the permutation is the last permutation. */
for (k = n - 1; k && a[k - 1] >= a[k]; k--);
if (!k--) return 0;
/* 2. Find the largest index l such that a[k] < a[l]. Since k + 1 is
such an index, l is well defined */
for (l = n - 1; a[l] <= a[k]; l--);
/* 3. Swap a[k] with a[l] */
swap(k, l);
/* 4. Reverse the sequence from a[k + 1] to the end */
for (k++, l = n - 1; l > k; l--, k++)
swap(k, l);
return 1;
# undef swap
}
void perm1(int *x, int n, int callback(int *, int))
{
do {
if (callback) callback(x, n);
} while (next_lex_perm(x, n));
}
/* Boothroyd method; exactly N! swaps, about as fast as it gets */
void boothroyd(int *x, int n, int nn, int callback(int *, int))
{
int c = 0, i, t;
while (1) {
if (n > 2) boothroyd(x, n - 1, nn, callback);
if (c >= n - 1) return;
i = (n & 1) ? 0 : c;
c++;
t = x[n - 1], x[n - 1] = x[i], x[i] = t;
if (callback) callback(x, nn);
}
}
/* entry for Boothroyd method */
void perm2(int *x, int n, int callback(int*, int))
{
if (callback) callback(x, n);
boothroyd(x, n, n, callback);
}
/* same as perm2, but flattened recursions into iterations */
void perm3(int *x, int n, int callback(int*, int))
{
/* calloc isn't strictly necessary, int c[32] would suffice
for most practical purposes */
int d, i, t, *c = calloc(n, sizeof(int));
/* curiously, with GCC 4.6.1 -O3, removing next line makes
it ~25% slower */
if (callback) callback(x, n);
for (d = 1; ; c[d]++) {
while (d > 1) c[--d] = 0;
while (c[d] >= d)
if (++d >= n) goto done;
t = x[ i = (d & 1) ? c[d] : 0 ], x[i] = x[d], x[d] = t;
if (callback) callback(x, n);
}
done: free(c);
}
#define N 4
int main()
{
int i, x[N];
for (i = 0; i < N; i++) x[i] = i + 1;
/* three different methods */
perm1(x, N, show);
perm2(x, N, show);
perm3(x, N, show);
return 0;
}

4
Task/Permutations/Clojure/permutations-1.clj Normal file
View file

@ -0,0 +1,4 @@
user=> (require 'clojure.contrib.combinatorics)
nil
user=> (clojure.contrib.combinatorics/permutations [1 2 3])
((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))

35
Task/Permutations/Clojure/permutations-2.clj Normal file
View file

@ -0,0 +1,35 @@
(defn- iter-perm [v]
(let [len (count v),
j (loop [i (- len 2)]
(cond (= i -1) nil
(< (v i) (v (inc i))) i
:else (recur (dec i))))]
(when j
(let [vj (v j),
l (loop [i (dec len)]
(if (< vj (v i)) i (recur (dec i))))]
(loop [v (assoc v j (v l) l vj), k (inc j), l (dec len)]
(if (< k l)
(recur (assoc v k (v l) l (v k)) (inc k) (dec l))
v))))))
(defn- vec-lex-permutations [v]
(when v (cons v (lazy-seq (vec-lex-permutations (iter-perm v))))))
(defn lex-permutations
"Fast lexicographic permutation generator for a sequence of numbers"
[c]
(lazy-seq
(let [vec-sorted (vec (sort c))]
(if (zero? (count vec-sorted))
(list [])
(vec-lex-permutations vec-sorted)))))
(defn permutations
"All the permutations of items, lexicographic by index"
[items]
(let [v (vec items)]
(map #(map v %) (lex-permutations (range (count v))))))
(println (permutations [1 2 3]))

18
Task/Permutations/CoffeeScript/permutations-1.coffee Normal file
View file

@ -0,0 +1,18 @@
# Returns a copy of an array with the element at a specific position
# removed from it.
arrayExcept = (arr, idx) ->
res = arr[0..]
res.splice idx, 1
res
# The actual function which returns the permutations of an array-like
# object (or a proper array).
permute = (arr) ->
arr = Array::slice.call arr, 0
return [[]] if arr.length == 0
permutations = (for value,idx in arr
[value].concat perm for perm in permute arrayExcept arr, idx)
# Flatten the array before returning it.
[].concat permutations...

7
Task/Permutations/CoffeeScript/permutations-2.coffee Normal file
View file

@ -0,0 +1,7 @@
coffee> console.log (permute "123").join "\n"
1,2,3
1,3,2
2,1,3
2,3,1
3,1,2
3,2,1

25
Task/Permutations/Commodore-BASIC/permutations.basic Normal file
View file

@ -0,0 +1,25 @@
100 INPUT "HOW MANY";N
110 DIM A(N-1):REM ARRAY TO PERMUTE
120 DIM K(N-1):REM HOW MANY ITEMS TO PERMUTE (ARRAY AS STACK)
130 DIM I(N-1):REM CURRENT POSITION IN LOOP (ARRAY AS STACK)
140 S=0:REM STACK POINTER
150 FOR I=0 TO N-1
160 : A(I)=I+1: REM INITIALIZE ARRAY TO 1..N
170 NEXT I
180 K(S)=N:S=S+1:GOSUB 200:REM PERMUTE(N)
190 END
200 IF K(S-1)>1 THEN 270
210 REM PRINT OUT THIS PERMUTATION
220 FOR I=0 TO N-1
230 : PRINT A(I);
240 NEXT I
250 PRINT
260 RETURN
270 K(S)=K(S-1)-1:S=S+1:GOSUB 200:S=S-1:REM PERMUTE(K-1)
280 I(S-1)=0:REM FOR I=0 TO K-2
290 IF I(S-1)>=K(S-1)-1 THEN 340
300 J=I(S-1):IF K(S-1) AND 1 THEN J=0:REM ELEMENT TO SWAP BASED ON PARITY OF K
310 T=A(J):A(J)=A(K(S-1)-1):A(K(S-1)-1)=T:REM SWAP
320 K(S)=K(S-1)-1:S=S+1:GOSUB 200:S=S-1:REM PERMUTE(K-1)
330 I(S-1)=I(S-1)+1:GOTO 290:REM NEXT I
340 RETURN

9
Task/Permutations/Common-Lisp/permutations-1.lisp Normal file
View file

@ -0,0 +1,9 @@
(defun permute (list)
(if list
(mapcan #'(lambda (x)
(mapcar #'(lambda (y) (cons x y))
(permute (remove x list))))
list)
'(()))) ; else
(print (permute '(A B Z)))

18
Task/Permutations/Common-Lisp/permutations-2.lisp Normal file
View file

@ -0,0 +1,18 @@
(defun next-perm (vec cmp) ; modify vector
(declare (type (simple-array * (*)) vec))
(macrolet ((el (i) `(aref vec ,i))
(cmp (i j) `(funcall cmp (el ,i) (el ,j))))
(loop with len = (1- (length vec))
for i from (1- len) downto 0
when (cmp i (1+ i)) do
(loop for k from len downto i
when (cmp i k) do
(rotatef (el i) (el k))
(setf k (1+ len))
(loop while (< (incf i) (decf k)) do
(rotatef (el i) (el k)))
(return-from next-perm vec)))))
;;; test code
(loop for a = "1234" then (next-perm a #'char<) while a do
(write-line a))

14
Task/Permutations/Common-Lisp/permutations-3.lisp Normal file
View file

@ -0,0 +1,14 @@
(defun heap-permutations (seq)
(let ((permutations nil))
(labels ((permute (seq k)
(if (= k 1)
(push seq permutations)
(progn
(permute seq (1- k))
(loop for i from 0 below (1- k) do
(if (evenp k)
(rotatef (elt seq i) (elt seq (1- k)))
(rotatef (elt seq 0) (elt seq (1- k))))
(permute seq (1- k)))))))
(permute seq (length seq))
permutations)))

68
Task/Permutations/Craft-Basic/permutations.basic Normal file
View file

@ -0,0 +1,68 @@
let n = 3
let i = n + 1
dim a[i]
for i = 1 to n
let a[i] = i
next i
do
for i = 1 to n
print a[i]
next i
print
let i = n
do
let i = i - 1
let b = i + 1
loopuntil (i = 0) or (a[i] < a[b])
let j = i + 1
let k = n
do
if j < k then
let t = a[j]
let a[j] = a[k]
let a[k] = t
let j = j + 1
let k = k - 1
endif
loop j < k
if i > 0 then
let j = i + 1
do
if a[j] < a[i] then
let j = j + 1
endif
loop a[j] < a[i]
let t = a[j]
let a[j] = a[i]
let a[i] = t
endif
loopuntil i = 0

1
Task/Permutations/Crystal/permutations.crystal Normal file
View file

@ -0,0 +1 @@
puts [1, 2, 3].permutations

7
Task/Permutations/Curry/permutations.curry Normal file
View file

@ -0,0 +1,7 @@
insert :: a -> [a] -> [a]
insert x xs = x : xs
insert x (y:ys) = y : insert x ys
permutation :: [a] -> [a]
permutation [] = []
permutation (x:xs) = insert x $ permutation xs

21
Task/Permutations/D/permutations-1.d Normal file
View file

@ -0,0 +1,21 @@
T[][] permutations(T)(T[] items) pure nothrow {
T[][] result;
void perms(T[] s, T[] prefix=[]) nothrow {
if (s.length)
foreach (immutable i, immutable c; s)
perms(s[0 .. i] ~ s[i+1 .. $], prefix ~ c);
else
result ~= prefix;
}
perms(items);
return result;
}
version (permutations1_main) {
void main() {
import std.stdio;
writefln("%(%s\n%)", [1, 2, 3].permutations);
}
}

88
Task/Permutations/D/permutations-2.d Normal file
View file

@ -0,0 +1,88 @@
import std.algorithm, std.conv, std.traits;
struct Permutations(bool doCopy=true, T) if (isMutable!T) {
private immutable size_t num;
private T[] items;
private uint[31] indexes;
private ulong tot;
this (T[] items) pure nothrow @safe @nogc
in {
static enum string L = indexes.length.text;
assert(items.length >= 0 && items.length <= indexes.length,
"Permutations: items.length must be >= 0 && < " ~ L);
} body {
static ulong factorial(in size_t n) pure nothrow @safe @nogc {
ulong result = 1;
foreach (immutable i; 2 .. n + 1)
result *= i;
return result;
}
this.num = items.length;
this.items = items;
foreach (immutable i; 0 .. cast(typeof(indexes[0]))this.num)
this.indexes[i] = i;
this.tot = factorial(this.num);
}
@property T[] front() pure nothrow @safe {
static if (doCopy) {
return items.dup;
} else
return items;
}
@property bool empty() const pure nothrow @safe @nogc {
return tot == 0;
}
@property size_t length() const pure nothrow @safe @nogc {
// Not cached to keep the function pure.
typeof(return) result = 1;
foreach (immutable x; 1 .. items.length + 1)
result *= x;
return result;
}
void popFront() pure nothrow @safe @nogc {
tot--;
if (tot > 0) {
size_t j = num - 2;
while (indexes[j] > indexes[j + 1])
j--;
size_t k = num - 1;
while (indexes[j] > indexes[k])
k--;
swap(indexes[k], indexes[j]);
swap(items[k], items[j]);
size_t r = num - 1;
size_t s = j + 1;
while (r > s) {
swap(indexes[s], indexes[r]);
swap(items[s], items[r]);
r--;
s++;
}
}
}
}
Permutations!(doCopy,T) permutations(bool doCopy=true, T)
(T[] items)
pure nothrow if (isMutable!T) {
return Permutations!(doCopy, T)(items);
}
version (permutations2_main) {
void main() {
import std.stdio, std.bigint;
alias B = BigInt;
foreach (p; [B(1), B(2), B(3)].permutations)
assert((p[0] + 1) > 0);
[1, 2, 3].permutations!false.writeln;
[B(1), B(2), B(3)].permutations!false.writeln;
}
}

8
Task/Permutations/D/permutations-3.d Normal file
View file

@ -0,0 +1,8 @@
void main() {
import std.stdio, std.algorithm;
auto items = [1, 2, 3];
do
items.writeln;
while (items.nextPermutation);
}

58
Task/Permutations/Delphi/permutations.delphi Normal file
View file

@ -0,0 +1,58 @@
program TestPermutations;
{$APPTYPE CONSOLE}
type
TItem = Integer; // declare ordinal type for array item
TArray = array[0..3] of TItem;
const
Source: TArray = (1, 2, 3, 4);
procedure Permutation(K: Integer; var A: TArray);
var
I, J: Integer;
Tmp: TItem;
begin
for I:= Low(A) + 1 to High(A) + 1 do begin
J:= K mod I;
Tmp:= A[J];
A[J]:= A[I - 1];
A[I - 1]:= Tmp;
K:= K div I;
end;
end;
var
A: TArray;
I, K, Count: Integer;
S, S1, S2: ShortString;
begin
Count:= 1;
I:= Length(A);
while I > 1 do begin
Count:= Count * I;
Dec(I);
end;
S:= '';
for K:= 0 to Count - 1 do begin
A:= Source;
Permutation(K, A);
S1:= '';
for I:= Low(A) to High(A) do begin
Str(A[I]:1, S2);
S1:= S1 + S2;
end;
S:= S + ' ' + S1;
if Length(S) > 40 then begin
Writeln(S);
S:= '';
end;
end;
if Length(S) > 0 then Writeln(S);
Readln;
end.

207
Task/Permutations/EDSAC-order-code/permutations.edsac Normal file
View file

@ -0,0 +1,207 @@
[Permutations task for Rosetta Code.]
[EDSAC program, Initial Orders 2.]
T51K P200F [G parameter: start address of subroutines]
T47K P100F [M parameter: start address of main routine]
[====================== G parameter: Subroutines =====================]
E25K TG GK
[Constants used in the subroutines]
[0] AF [add to address to make A order for that address]
[1] SF [add to address to make S order for that address]
[2] UF [(1) add to address to make U order for that address]
[(2) subtract from S order to make T order, same address]
[3] OF [add to A order to make T order, same address]
[-----------------------------------------------------------
Subroutine to initialize an array of n short (17-bit) words
to 0, 1, 2, ..., n-1 (in the address field).
Parameters: 4F = address of array; 5F = n = length of array.
Workspace: 0F, 1F.]
[4] A3F [plant return link as usual]
T19@
A4F [address of array]
A2@ [make U order for that address]
T1F [store U order in 1F]
A5F [load n = number of elements (in address field)]
S2F [make n-1]
[Start of loop; works backwards, n-1 to 0]
[11] UF [store array element in 0F]
A1F [make order to store element in array]
T15@ [plant that order in code]
AF [pick up element fron 0F]
[15] UF [(planted) store element in array]
S2F [dec to next element]
E11@ [loop if still >= 0]
TF [clear acc. before return]
[19] ZF [overwritten by jump back to caller]
[-------------------------------------------------------------------
Subroutine to get next permutation in lexicographic order.
Uses same 4-step algorithm as Wikipedia article "Permutations",
but notation in comments differs from that in Wikipedia.
Parameters: 4F = address of array; 5F = n = length of array.
0F is returned as 0 for success, < 0 if passed-in
permutation is the last.
Workspace: 0F, 1F.]
[20] A3F [plant return link as usual]
T103@
[Step 1: Find the largest index k such that a{k} > a{k-1}.
If no such index exists, the passed-in permutation is the last.]
A4F [load address of a{0}]
A@ [make A order for a{0}]
U1F [store as test for end of loop]
A5F [make A order for a{n}]
U96@ [plant in code below]
S2F [make A order for a{n-1}]
T43@ [plant in code below]
A4F [load address of a{0}]
A5F [make address of a{n}]
A1@ [make S order for a{n}]
T44@ [plant in code below]
[Start of loop for comparing a{k} with a{k-1}]
[33] TF [clear acc]
A43@ [load A order for a{k}]
S2F [make A order for a{k-1}]
S1F [tested all yet?]
G102@ [if yes, jump to failed (no more permutations)]
A1F [restore accumulator after test]
T43@ [plant updated A order]
A44@ [dec address in S order]
S2F
T44@
[43] SF [(planted) load a{k-1}]
[44] AF [(planted) subtract a{k}]
E33@ [loop back if a{k-1} > a{k}]
[Step 2: Find the largest index j >= k such that a{j} > a{k-1}.
Such an index j exists, because j = k is an instance.]
TF [clear acc]
A4F [load address of a{0}]
A5F [make address of a{n}]
A1@ [make S order for a{n}]
T1F [save as test for end of loop]
A44@ [load S order for a{k}]
T64@ [plant in code below]
A43@ [load A order for a{k-1}]
T63@ [plant in code below]
[Start of loop]
[55] TF [clear acc]
A64@ [load S order for a{j} (initially j = k)]
U75@ [plant in code below]
A2F [inc address (in effect inc j)]
S1F [test for end of array]
E66@ [jump out if so]
A1F [restore acc after test]
T64@ [update S order]
[63] AF [(planted) load a{k-1}]
[64] SF [(planted) subtract a{j}]
G55@ [loop back if a{j} still > a{k-1}]
[66]
[Step 3: Swap a{k-1} and a{j}]
TF [clear acc]
A63@ [load A order for a{k-1}]
U77@ [plant in code below, 2 places]
U94@
A3@ [make T order for a{k-1}]
T80@ [plant in code below]
A75@ [load S order for a{j}]
S2@ [make T order for a{j}]
T78@ [plant in code below]
[75] SF [(planted) load -a{j}]
TF [park -a{j} in 0F]
[77] AF [(planted) load a{k-1}]
[78] TF [(planted) store a{j}]
SF [load a{j} by subtracting -a{j}]
[80] TF [(planted) store in a{k-1}]
[Step 4: Now a{k}, ..., a{n-1} are in decreasing order.
Change to increasing order by repeated swapping.]
[81] A96@ [counting down from a{n} (exclusive end of array)]
S2F [make A order for a{n-1}]
U96@ [plant in code]
A3@ [make T order for a{n-1}]
T99@ [plant]
A94@ [counting up from a{k-1} (exclusive)]
A2F [make A order for a{k}]
U94@ [plant]
A3@ [make T order for a{k}]
U97@ [plant]
S99@ [swapped all yet?]
E101@ [if yes, jump to exit from subroutine]
[Swapping two array elements, initially a{k} and a{n-1}]
TF [clear acc]
[94] AF [(planted) load 1st element]
TF [park in 0F]
[96] AF [(planted) load 2nd element]
[97] TF [(planted) copy to 1st element]
AF [load old 1st element]
[99] TF [(planted) copy to 2nd element]
E81@ [always loop back]
[101] TF [done, return 0 in location 0F]
[102] TF [return status to caller in 0F; also clears acc]
[103] ZF [(planted) jump back to caller]
[==================== M parameter: Main routine ==================]
[Prints all 120 permutations of the letters in 'EDSAC'.]
E25K TM GK
[Constants used in the main routine]
[0] P900F [address of permutation array]
[1] P5F [number of elements in permutation (in address field)]
[Array of letters in 'EDSAC', in alphabetical order]
[2] AF CF DF EF SF
[7] O2@ [add to index to make O order for letter in array]
[8] P12F [permutations per printed line (in address field)]
[9] AF [add to address to make A order for that address]
[Teleprinter characters]
[10] K2048F [set letters mode]
[11] !F [space]
[12] @F [carriage return]
[13] &F [line feed]
[14] K4096F [null]
[Entry point, with acc = 0.]
[15] O10@ [set teleprinter to letters]
S8@ [intialize -ve count of permutations per line]
T7F [keep count in 7F]
A@ [pass address of permutation array in 4F]
T4F
A1@ [pass number of elements in 5F]
T5F
[22] A22@ [call subroutine to initialize permutation array]
G4G
[Loop: print current permutation, then get next (if any)]
[24] A4F [address]
A9@ [make A order]
T29@ [plant in code]
S5F [initialize -ve count of array elements]
[28] T6F [keep count in 6F]
[29] AF [(planted) load permutation element]
A7@ [make order to print letter from table]
T32@ [plant in code]
[32] OF [(planted) print letter from table]
A29@ [inc address in permutation array]
A2F
T29@
A6F [inc -ve count of array elements]
A2F
G28@ [loop till count becomes 0]
A7F [inc -ve count of perms per line]
A2F
E44@ [jump if end of line]
O11@ [else print a space]
G47@ [join common code]
[44] O12@ [print CR]
O13@ [print LF]
S8@
[47] T7F [update -ve count of permutations in line]
[48] A48@ [call subroutine for next permutation (if any)]
G20G
AF [test 0F: got a new permutation?]
E24@ [if so, loop to print it]
O14@ [no more, output null to flush teleprinter buffer]
ZF [halt program]
E15Z [define entry point]
PF [enter with acc = 0]
[end]

12
Task/Permutations/EasyLang/permutations.easy Normal file
View file

@ -0,0 +1,12 @@
proc permlist k . list[] .
for i = k to len list[]
swap list[i] list[k]
call permlist k + 1 list[]
swap list[k] list[i]
.
if k = len list[]
print list[]
.
.
l[] = [ 1 2 3 ]
call permlist 1 l[]

30
Task/Permutations/Ecstasy/permutations.ecstasy Normal file
View file

@ -0,0 +1,30 @@
/**
* Implements permutations without repetition.
*/
module Permutations {
static Int[][] permut(Int items) {
if (items <= 1) {
// with one item, there is a single permutation; otherwise there are no permutations
return items == 1 ? [[0]] : [];
}
// the "pattern" for all values but the first value in each permutation is
// derived from the permutations of the next smaller number of items
Int[][] pattern = permut(items - 1);
// build the list of all permutations for the specified number of items by iterating only
// the first digit
Int[][] result = new Int[][];
for (Int prefix : 0 ..< items) {
for (Int[] suffix : pattern) {
result.add(new Int[items](i -> i == 0 ? prefix : (prefix + suffix[i-1] + 1) % items));
}
}
return result;
}
void run() {
@Inject Console console;
console.print($"permut(3) = {permut(3)}");
}
}

47
Task/Permutations/Eiffel/permutations.e Normal file
View file

@ -0,0 +1,47 @@
class
APPLICATION
create
make
feature {NONE}
make
do
test := <<2, 5, 1>>
permute (test, 1)
end
test: ARRAY [INTEGER]
permute (a: ARRAY [INTEGER]; k: INTEGER)
-- All permutations of 'a'.
require
count_positive: a.count > 0
k_valid_index: k > 0
local
t: INTEGER
do
if k = a.count then
across
a as ar
loop
io.put_integer (ar.item)
end
io.new_line
else
across
k |..| a.count as c
loop
t := a [k]
a [k] := a [c.item]
a [c.item] := t
permute (a, k + 1)
t := a [k]
a [k] := a [c.item]
a [c.item] := t
end
end
end
end

8
Task/Permutations/Elixir/permutations.elixir Normal file
View file

@ -0,0 +1,8 @@
defmodule RC do
def permute([]), do: [[]]
def permute(list) do
for x <- list, y <- permute(list -- [x]), do: [x|y]
end
end
IO.inspect RC.permute([1, 2, 3])

5
Task/Permutations/Erlang/permutations-1.erl Normal file
View file

@ -0,0 +1,5 @@
-module(permute).
-export([permute/1]).
permute([]) -> [[]];
permute(L) -> [[X|Y] || X<-L, Y<-permute(L--[X])].

1
Task/Permutations/Erlang/permutations-2.erl Normal file
View file

@ -0,0 +1 @@
F = fun(L) -> G = fun(_, []) -> [[]]; (F, L) -> [[X|Y] || X<-L, Y<-F(F, L--[X])] end, G(G, L) end.

18
Task/Permutations/Erlang/permutations-3.erl Normal file
View file

@ -0,0 +1,18 @@
-module(permute).
-export([permute/1]).
permute([]) -> [[]];
permute(L) -> zipper(L, [], []).
% Use zipper to pick up first element of permutation
zipper([], _, Acc) -> lists:reverse(Acc);
zipper([H|T], R, Acc) ->
% place current member in front of all permutations
% of rest of set - both sides of zipper
prepend(H, permute(lists:reverse(R, T)),
% pass zipper state for continuation
T, [H|R], Acc).
prepend(_, [], T, R, Acc) -> zipper(T, R, Acc); % continue in zipper
prepend(X, [H|T], ZT, ZR, Acc) -> prepend(X, T, ZT, ZR, [[X|H]|Acc]).

1
Task/Permutations/Erlang/permutations-4.erl Normal file
View file

@ -0,0 +1 @@
main(_) -> io:fwrite("~p~n", [permute:permute([1,2,3])]).

48
Task/Permutations/Euphoria/permutations.euphoria Normal file
View file

@ -0,0 +1,48 @@
function reverse(sequence s, integer first, integer last)
object x
while first < last do
x = s[first]
s[first] = s[last]
s[last] = x
first += 1
last -= 1
end while
return s
end function
function nextPermutation(sequence s)
integer pos, last
object x
if length(s) < 1 then
return 0
end if
pos = length(s)-1
while compare(s[pos], s[pos+1]) >= 0 do
pos -= 1
if pos < 1 then
return -1
end if
end while
last = length(s)
while compare(s[last], s[pos]) <= 0 do
last -= 1
end while
x = s[pos]
s[pos] = s[last]
s[last] = x
return reverse(s, pos+1, length(s))
end function
object s
s = "abcd"
puts(1, s & '\t')
while 1 do
s = nextPermutation(s)
if atom(s) then
exit
end if
puts(1, s & '\t')
end while

20
Task/Permutations/F-Sharp/permutations-1.fs Normal file
View file

@ -0,0 +1,20 @@
let rec insert left x right = seq {
match right with
| [] -> yield left @ [x]
| head :: tail ->
yield left @ [x] @ right
yield! insert (left @ [head]) x tail
}
let rec perms permute =
seq {
match permute with
| [] -> yield []
| head :: tail -> yield! Seq.collect (insert [] head) (perms tail)
}
[<EntryPoint>]
let main argv =
perms (Seq.toList argv)
|> Seq.iter (fun x -> printf "%A\n" x)
0

5
Task/Permutations/F-Sharp/permutations-2.fs Normal file
View file

@ -0,0 +1,5 @@
let permutations xs =
let rec insert x = function
| [] -> [[x]]
| head :: tail -> (x :: (head :: tail)) :: (List.map (fun l -> head :: l) (insert x tail))
List.fold (fun s e -> List.collect (insert e) s) [[]] xs

33
Task/Permutations/Fortran/permutations-1.f Normal file
View file

@ -0,0 +1,33 @@
program permutations
implicit none
integer, parameter :: value_min = 1
integer, parameter :: value_max = 3
integer, parameter :: position_min = value_min
integer, parameter :: position_max = value_max
integer, dimension (position_min : position_max) :: permutation
call generate (position_min)
contains
recursive subroutine generate (position)
implicit none
integer, intent (in) :: position
integer :: value
if (position > position_max) then
write (*, *) permutation
else
do value = value_min, value_max
if (.not. any (permutation (: position - 1) == value)) then
permutation (position) = value
call generate (position + 1)
end if
end do
end if
end subroutine generate
end program permutations

27
Task/Permutations/Fortran/permutations-2.f Normal file
View file

@ -0,0 +1,27 @@
program allperm
implicit none
integer :: n, i
integer, allocatable :: a(:)
read *, n
allocate(a(n))
a = [ (i, i = 1, n) ]
call perm(1)
deallocate(a)
contains
recursive subroutine perm(i)
integer :: i, j, t
if (i == n) then
print *, a
else
do j = i, n
t = a(i)
a(i) = a(j)
a(j) = t
call perm(i + 1)
t = a(i)
a(i) = a(j)
a(j) = t
end do
end if
end subroutine
end program

361
Task/Permutations/Fortran/permutations-3.f Normal file
View file

@ -0,0 +1,361 @@
program testing_permutation_algorithms
implicit none
integer :: nmax
integer, dimension(:),allocatable :: ida
logical :: mtc
logical :: even
integer :: i
integer(8) :: ic
integer :: clock_rate, clock_max, t1, t2
real(8) :: dt
integer :: pos_min, pos_max
!
!
! Beginning:
!
write(*,*) 'INPUT N:'
read *, nmax
write(*,*) 'N =', nmax
allocate ( ida(1:nmax) )
!
!
! (1) Starting:
!
do i = 1, nmax
ida(i) = i
enddo
!
ic = 0
call system_clock ( t1, clock_rate, clock_max )
!
mtc = .false.
!
do
call subnexper ( nmax, ida, mtc, even )
!
! 1) counting the number of permutatations
!
ic = ic + 1
!
! 2) writing out the result:
!
! do i = 1, nmax
! write (100,"(i3,',')",advance = "no") ida(i)
! enddo
! write(100,*)
!
! repeat if not being finished yet, otherwise exit.
!
if (mtc) then
cycle
else
exit
endif
!
enddo
!
call system_clock ( t2, clock_rate, clock_max )
dt = ( dble(t2) - dble(t1) )/ dble(clock_rate)
!
! Finishing (1)
!
write(*,*) "1) subnexper:"
write(*,*) 'Total permutations :', ic
write(*,*) 'Total time elapsed :', dt
!
!
! (2) Starting:
!
do i = 1, nmax
ida(i) = i
enddo
!
pos_min = 1
pos_max = nmax
!
ic = 0
call system_clock ( t1, clock_rate, clock_max )
!
call generate ( pos_min )
!
call system_clock ( t2, clock_rate, clock_max )
dt = ( dble(t2) - dble(t1) )/ dble(clock_rate)
!
! Finishing (2)
!
write(*,*) "2) generate:"
write(*,*) 'Total permutations :', ic
write(*,*) 'Total time elapsed :', dt
!
!
! (3) Starting:
!
do i = 1, nmax
ida(i) = i
enddo
!
ic = 0
call system_clock ( t1, clock_rate, clock_max )
!
i = 1
call perm ( i )
!
call system_clock ( t2, clock_rate, clock_max )
dt = ( dble(t2) - dble(t1) )/ dble(clock_rate)
!
! Finishing (3)
!
write(*,*) "3) perm:"
write(*,*) 'Total permutations :', ic
write(*,*) 'Total time elapsed :', dt
!
!
! (4) Starting:
!
do i = 1, nmax
ida(i) = i
enddo
!
ic = 0
call system_clock ( t1, clock_rate, clock_max )
!
do
!
! 1) counting the number of permutatations
!
ic = ic + 1
!
! 2) writing out the result:
!
! do i = 1, nmax
! write (100,"(i3,',')",advance = "no") ida(i)
! enddo
! write(100,*)
!
! repeat if not being finished yet, otherwise exit.
!
if ( nextp(nmax,ida) ) then
cycle
else
exit
endif
!
enddo
!
call system_clock ( t2, clock_rate, clock_max )
dt = ( dble(t2) - dble(t1) )/ dble(clock_rate)
!
! Finishing (4)
!
write(*,*) "4) nextp:"
write(*,*) 'Total permutations :', ic
write(*,*) 'Total time elapsed :', dt
!
!
! What's else?
! ...
!
!==
deallocate(ida)
!
stop
!==
contains
!==
! Modified version of SUBROUTINE NEXPER from the book of
! Albert Nijenhuis and Herbert S. Wilf, "Combinatorial
! Algorithms For Computers and Calculators", 2nd Ed, p.59.
!
subroutine subnexper ( n, a, mtc, even )
implicit none
integer,intent(in) :: n
integer,dimension(n),intent(inout) :: a
logical,intent(inout) :: mtc, even
!
! local varialbes:
!
integer,save :: nm3
integer :: ia, i, s, d, i1, l, j, m
!
if (mtc) goto 10
nm3 = n-3
do i = 1,n
a(i) = i
enddo
mtc = .true.
5 even = .true.
if ( n .eq. 1 ) goto 8
6 if ( a(n) .ne. 1 .or. a(1) .ne. 2+mod(n,2) ) return
if ( n .le. 3 ) goto 8
do i = 1,nm3
if( a(i+1) .ne. a(i)+1 ) return
enddo
8 mtc = .false.
return
10 if ( n .eq. 1 ) goto 27
if( .not. even ) goto 20
ia = a(1)
a(1) = a(2)
a(2) = ia
even = .false.
goto 6
20 s = 0
do i1 = 2,n
ia = a(i1)
i = i1-1
d = 0
do j = 1,i
if ( a(j) .gt. ia ) d = d+1
enddo
s = d+s
if ( d .ne. i*mod(s,2) ) goto 35
enddo
27 a(1) = 0
goto 8
35 m = mod(s+1,2)*(n+1)
do j = 1,i
if(isign(1,a(j)-ia) .eq. isign(1,a(j)-m)) cycle
m = a(j)
l = j
enddo
a(l) = ia
a(i1) = m
even = .true.
return
end subroutine
!=====
!
! http://rosettacode.org/wiki/Permutations#Fortran
!
recursive subroutine generate (pos)
implicit none
integer,intent(in) :: pos
integer :: val
if (pos > pos_max) then
!
! 1) counting the number of permutatations
!
ic = ic + 1
!
! 2) writing out the result:
!
! write (*,*) permutation
!
else
do val = 1, nmax
if (.not. any (ida( : pos-1) == val)) then
ida(pos) = val
call generate (pos + 1)
endif
enddo
endif
end subroutine
!=====
!
! http://rosettacode.org/wiki/Permutations#Fortran
!
recursive subroutine perm (i)
implicit none
integer,intent(inout) :: i
!
integer :: j, t, ip1
!
if (i == nmax) then
!
! 1) couting the number of permutatations
!
ic = ic + 1
!
! 2) writing out the result:
!
! write (*,*) a
!
else
ip1 = i+1
do j = i, nmax
t = ida(i)
ida(i) = ida(j)
ida(j) = t
call perm ( ip1 )
t = ida(i)
ida(i) = ida(j)
ida(j) = t
enddo
endif
return
end subroutine
!=====
!
! http://rosettacode.org/wiki/Permutations#Fortran
!
function nextp ( n, a )
logical :: nextp
integer,intent(in) :: n
integer,dimension(n),intent(inout) :: a
!
! local variables:
!
integer i,j,k,t
!
i = n-1
10 if ( a(i) .lt. a(i+1) ) goto 20
i = i-1
if ( i .eq. 0 ) goto 20
goto 10
20 j = i+1
k = n
30 t = a(j)
a(j) = a(k)
a(k) = t
j = j+1
k = k-1
if ( j .lt. k ) goto 30
j = i
if (j .ne. 0 ) goto 40
!
nextp = .false.
!
return
!
40 j = j+1
if ( a(j) .lt. a(i) ) goto 40
t = a(i)
a(i) = a(j)
a(j) = t
!
nextp = .true.
!
return
end function
!=====
!
! What's else ?
! ...
!=====
end program

41
Task/Permutations/Fortran/permutations-4.f Normal file
View file

@ -0,0 +1,41 @@
program nptest
integer n,i,a
logical nextp
external nextp
parameter(n=4)
dimension a(n)
do i=1,n
a(i)=i
enddo
10 print *,(a(i),i=1,n)
if(nextp(n,a)) go to 10
end
function nextp(n,a)
integer n,a,i,j,k,t
logical nextp
dimension a(n)
i=n-1
10 if(a(i).lt.a(i+1)) go to 20
i=i-1
if(i.eq.0) go to 20
go to 10
20 j=i+1
k=n
30 t=a(j)
a(j)=a(k)
a(k)=t
j=j+1
k=k-1
if(j.lt.k) go to 30
j=i
if(j.ne.0) go to 40
nextp=.false.
return
40 j=j+1
if(a(j).lt.a(i)) go to 40
t=a(i)
a(i)=a(j)
a(j)=t
nextp=.true.
end

52
Task/Permutations/FreeBASIC/permutations.basic Normal file
View file

@ -0,0 +1,52 @@
' version 07-04-2017
' compile with: fbc -s console
' Heap's algorithm non-recursive
Sub perms(n As Long)
Dim As ULong i, j, count = 1
Dim As ULong a(0 To n -1), c(0 To n -1)
For j = 0 To n -1
a(j) = j +1
Print a(j);
Next
Print " ";
i = 0
While i < n
If c(i) < i Then
If (i And 1) = 0 Then
Swap a(0), a(i)
Else
Swap a(c(i)), a(i)
End If
For j = 0 To n -1
Print a(j);
Next
count += 1
If count = 12 Then
Print
count = 0
Else
Print " ";
End If
c(i) += 1
i = 0
Else
c(i) = 0
i += 1
End If
Wend
End Sub
' ------=< MAIN >=------
perms(4)
' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End

2
Task/Permutations/Frink/permutations.frink Normal file
View file

@ -0,0 +1,2 @@
a = [1,2,3,4]
println[formatTable[a.lexicographicPermute[]]]

6
Task/Permutations/GAP/permutations-1.gap Normal file
View file

@ -0,0 +1,6 @@
gap>List(SymmetricGroup(4), p -> Permuted([1 .. 4], p));
perms(4);
[ [ 1, 2, 3, 4 ], [ 4, 2, 3, 1 ], [ 2, 4, 3, 1 ], [ 3, 2, 4, 1 ], [ 1, 4, 3, 2 ], [ 4, 1, 3, 2 ], [ 2, 1, 3, 4 ],
[ 3, 1, 4, 2 ], [ 1, 3, 4, 2 ], [ 4, 3, 1, 2 ], [ 2, 3, 1, 4 ], [ 3, 4, 1, 2 ], [ 1, 2, 4, 3 ], [ 4, 2, 1, 3 ],
[ 2, 4, 1, 3 ], [ 3, 2, 1, 4 ], [ 1, 4, 2, 3 ], [ 4, 1, 2, 3 ], [ 2, 1, 4, 3 ], [ 3, 1, 2, 4 ], [ 1, 3, 2, 4 ],
[ 4, 3, 2, 1 ], [ 2, 3, 4, 1 ], [ 3, 4, 2, 1 ] ]

4
Task/Permutations/GAP/permutations-2.gap Normal file
View file

@ -0,0 +1,4 @@
# All arrangements of 4 elements in 1 .. 4
Arrangements([1 .. 4], 4);
# All permutations of 1 .. 4
PermutationsList([1 .. 4]);

44
Task/Permutations/GAP/permutations-3.gap Normal file
View file

@ -0,0 +1,44 @@
NextPermutation := function(a)
local i, j, k, n, t;
n := Length(a);
i := n - 1;
while i > 0 and a[i] > a[i + 1] do
i := i - 1;
od;
j := i + 1;
k := n;
while j < k do
t := a[j];
a[j] := a[k];
a[k] := t;
j := j + 1;
k := k - 1;
od;
if i = 0 then
return false;
else
j := i + 1;
while a[j] < a[i] do
j := j + 1;
od;
t := a[i];
a[i] := a[j];
a[j] := t;
return true;
fi;
end;
Permutations := function(n)
local a, L;
a := List([1 .. n], x -> x);
L := [ ];
repeat
Add(L, ShallowCopy(a));
until not NextPermutation(a);
return L;
end;
Permutations(3);
[ [ 1, 2, 3 ], [ 1, 3, 2 ],
[ 2, 1, 3 ], [ 2, 3, 1 ],
[ 3, 1, 2 ], [ 3, 2, 1 ] ]

7
Task/Permutations/Glee/permutations-1.glee Normal file
View file

@ -0,0 +1,7 @@
$$ n !! k dyadic: Permutations for k out of n elements (in this case k = n)
$$ #s monadic: number of elements in s
$$ ,, monadic: expose with space-lf separators
$$ s[n] index n of s
'Hello' 123 7.9 '•'=>s;
s[s# !! (s#)],,

24
Task/Permutations/Glee/permutations-2.glee Normal file
View file

@ -0,0 +1,24 @@
Hello 123 7.9 •
Hello 123 • 7.9
Hello 7.9 123 •
Hello 7.9 • 123
Hello • 123 7.9
Hello • 7.9 123
123 Hello 7.9 •
123 Hello • 7.9
123 7.9 Hello •
123 7.9 • Hello
123 • Hello 7.9
123 • 7.9 Hello
7.9 Hello 123 •
7.9 Hello • 123
7.9 123 Hello •
7.9 123 • Hello
7.9 • Hello 123
7.9 • 123 Hello
• Hello 123 7.9
• Hello 7.9 123
• 123 Hello 7.9
• 123 7.9 Hello
• 7.9 Hello 123
• 7.9 123 Hello

52
Task/Permutations/Go/permutations-1.go Normal file
View file

@ -0,0 +1,52 @@
package main
import "fmt"
func main() {
demoPerm(3)
}
func demoPerm(n int) {
// create a set to permute. for demo, use the integers 1..n.
s := make([]int, n)
for i := range s {
s[i] = i + 1
}
// permute them, calling a function for each permutation.
// for demo, function just prints the permutation.
permute(s, func(p []int) { fmt.Println(p) })
}
// permute function. takes a set to permute and a function
// to call for each generated permutation.
func permute(s []int, emit func([]int)) {
if len(s) == 0 {
emit(s)
return
}
// Steinhaus, implemented with a recursive closure.
// arg is number of positions left to permute.
// pass in len(s) to start generation.
// on each call, weave element at pp through the elements 0..np-2,
// then restore array to the way it was.
var rc func(int)
rc = func(np int) {
if np == 1 {
emit(s)
return
}
np1 := np - 1
pp := len(s) - np1
// weave
rc(np1)
for i := pp; i > 0; i-- {
s[i], s[i-1] = s[i-1], s[i]
rc(np1)
}
// restore
w := s[0]
copy(s, s[1:pp+1])
s[pp] = w
}
rc(len(s))
}

29
Task/Permutations/Go/permutations-2.go Normal file
View file

@ -0,0 +1,29 @@
package main
import "fmt"
func main() {
var a = []int{1, 2, 3}
fmt.Println(a)
var n = len(a) - 1
var i, j int
for c := 1; c < 6; c++ { // 3! = 6:
i = n - 1
j = n
for a[i] > a[i+1] {
i--
}
for a[j] < a[i] {
j--
}
a[i], a[j] = a[j], a[i]
j = n
i += 1
for i < j {
a[i], a[j] = a[j], a[i]
i++
j--
}
fmt.Println(a)
}
}

1
Task/Permutations/Groovy/permutations-1.groovy Normal file
View file

@ -0,0 +1 @@
def makePermutations = { l -> l.permutations() }

4
Task/Permutations/Groovy/permutations-2.groovy Normal file
View file

@ -0,0 +1,4 @@
def list = ['Crosby', 'Stills', 'Nash', 'Young']
def permutations = makePermutations(list)
assert permutations.size() == (1..<(list.size()+1)).inject(1) { prod, i -> prod*i }
permutations.each { println it }

3
Task/Permutations/Haskell/permutations-1.hs Normal file
View file

@ -0,0 +1,3 @@
import Data.List (permutations)
main = mapM_ print (permutations [1,2,3])

5
Task/Permutations/Haskell/permutations-2.hs Normal file
View file

@ -0,0 +1,5 @@
import Data.List (delete)
permutations :: Eq a => [a] -> [[a]]
permutations [] = [[]]
permutations xs = [ x:ys | x <- xs, ys <- permutations (delete x xs)]

5
Task/Permutations/Haskell/permutations-3.hs Normal file
View file

@ -0,0 +1,5 @@
permutations :: [a] -> [[a]]
permutations [] = [[]]
permutations xs = [ y:zs | (y,ys) <- select xs, zs <- permutations ys]
where select [] = []
select (x:xs) = (x,xs) : [ (y,x:ys) | (y,ys) <- select xs ]

5
Task/Permutations/Haskell/permutations-4.hs Normal file
View file

@ -0,0 +1,5 @@
permutations :: [a] -> [[a]]
permutations = foldr (concatMap . insertEverywhere) [[]]
where insertEverywhere :: a -> [a] -> [[a]]
insertEverywhere x [] = [[x]]
insertEverywhere x l@(y:ys) = (x:l) : map (y:) (insertEverywhere x ys)

14
Task/Permutations/Haskell/permutations-5.hs Normal file
View file

@ -0,0 +1,14 @@
import Data.Bifunctor (second)
permutations :: [a] -> [[a]]
permutations =
let ins x xs n = uncurry (<>) $ second (x :) (splitAt n xs)
in foldr
( \x a ->
a >>= (fmap . ins x)
<*> (enumFromTo 0 . length)
)
[[]]
main :: IO ()
main = print $ permutations [1, 2, 3]

26
Task/Permutations/IS-BASIC/permutations.basic Normal file
View file

@ -0,0 +1,26 @@
100 PROGRAM "Permutat.bas"
110 LET N=4 ! Number of elements
120 NUMERIC T(1 TO N)
130 FOR I=1 TO N
140 LET T(I)=I
150 NEXT
160 LET S=0
170 CALL PERM(N)
180 PRINT "Number of permutations:";S
190 END
200 DEF PERM(I)
210 NUMERIC J,X
220 IF I=1 THEN
230 FOR X=1 TO N
240 PRINT T(X);
250 NEXT
260 PRINT :LET S=S+1
270 ELSE
280 CALL PERM(I-1)
290 FOR J=1 TO I-1
300 LET C=T(J):LET T(J)=T(I):LET T(I)=C
310 CALL PERM(I-1)
320 LET C=T(J):LET T(J)=T(I):LET T(I)=C
330 NEXT
340 END IF
350 END DEF

8
Task/Permutations/Icon/permutations.icon Normal file
View file

@ -0,0 +1,8 @@
procedure main(A)
every p := permute(A) do every writes((!p||" ")|"\n")
end
procedure permute(A)
if *A <= 1 then return A
suspend [(A[1]<->A[i := 1 to *A])] ||| permute(A[2:0])
end

1
Task/Permutations/J/permutations-1.j Normal file
View file

@ -0,0 +1 @@
perms=: A.&i.~ !

10
Task/Permutations/J/permutations-2.j Normal file
View file

@ -0,0 +1,10 @@
perms 2
0 1
1 0
({~ perms@#)&.;: 'some random text'
some random text
some text random
random some text
random text some
text some random
text random some

83
Task/Permutations/Java/permutations-1.java Normal file
View file

@ -0,0 +1,83 @@
public class PermutationGenerator {
private int[] array;
private int firstNum;
private boolean firstReady = false;
public PermutationGenerator(int n, int firstNum_) {
if (n < 1) {
throw new IllegalArgumentException("The n must be min. 1");
}
firstNum = firstNum_;
array = new int[n];
reset();
}
public void reset() {
for (int i = 0; i < array.length; i++) {
array[i] = i + firstNum;
}
firstReady = false;
}
public boolean hasMore() {
boolean end = firstReady;
for (int i = 1; i < array.length; i++) {
end = end && array[i] < array[i-1];
}
return !end;
}
public int[] getNext() {
if (!firstReady) {
firstReady = true;
return array;
}
int temp;
int j = array.length - 2;
int k = array.length - 1;
// Find largest index j with a[j] < a[j+1]
for (;array[j] > array[j+1]; j--);
// Find index k such that a[k] is smallest integer
// greater than a[j] to the right of a[j]
for (;array[j] > array[k]; k--);
// Interchange a[j] and a[k]
temp = array[k];
array[k] = array[j];
array[j] = temp;
// Put tail end of permutation after jth position in increasing order
int r = array.length - 1;
int s = j + 1;
while (r > s) {
temp = array[s];
array[s++] = array[r];
array[r--] = temp;
}
return array;
} // getNext()
// For testing of the PermutationGenerator class
public static void main(String[] args) {
PermutationGenerator pg = new PermutationGenerator(3, 1);
while (pg.hasMore()) {
int[] temp = pg.getNext();
for (int i = 0; i < temp.length; i++) {
System.out.print(temp[i] + " ");
}
System.out.println();
}
}
} // class

5
Task/Permutations/Java/permutations-2.java Normal file
View file

@ -0,0 +1,5 @@
public class Permutations {
public static void main(String[] args) {
System.out.println(Utils.Permutations(Utils.mRange(1, 3)));
}
}

23
Task/Permutations/JavaScript/permutations-1.js Normal file
View file

@ -0,0 +1,23 @@
<html><head><title>Permutations</title></head>
<body><pre id="result"></pre>
<script type="text/javascript">
var d = document.getElementById('result');
function perm(list, ret)
{
if (list.length == 0) {
var row = document.createTextNode(ret.join(' ') + '\n');
d.appendChild(row);
return;
}
for (var i = 0; i < list.length; i++) {
var x = list.splice(i, 1);
ret.push(x);
perm(list, ret);
ret.pop();
list.splice(i, 0, x);
}
}
perm([1, 2, 'A', 4], []);
</script></body></html>

12
Task/Permutations/JavaScript/permutations-2.js Normal file
View file

@ -0,0 +1,12 @@
function perm(a) {
if (a.length < 2) return [a];
var c, d, b = [];
for (c = 0; c < a.length; c++) {
var e = a.splice(c, 1),
f = perm(a);
for (d = 0; d < f.length; d++) b.push([e].concat(f[d]));
a.splice(c, 0, e[0])
} return b
}
console.log(perm(['Aardvarks', 'eat', 'ants']).join("\n"));

Some files were not shown because too many files have changed in this diff Show more