2016 Update
This commit is contained in:
Tina Müller
parent
948b86eafa
commit
dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
|
|
@ -1,33 +1,32 @@
|
|||
/*REXX program generates all permutations of N different objects. */
|
||||
/*REXX program generates and displays all permutations of N different objects. */
|
||||
parse arg things bunch inbetweenChars names
|
||||
|
||||
/* inbetweenChars (optional) defaults to a [null]. */
|
||||
/* names (optional) defaults to digits (and letters). */
|
||||
/* inbetweenChars (optional) defaults to a [null]. */
|
||||
/* names (optional) defaults to digits (and letters).*/
|
||||
|
||||
call permSets things, bunch, inbetweenChars, names
|
||||
exit /*stick a fork in it, we're done.*/
|
||||
/*──────────────────────────────────P subroutine (Pick one)─────────────*/
|
||||
p: return word(arg(1),1)
|
||||
/*──────────────────────────────────PERMSETS subroutine─────────────────*/
|
||||
permSets: procedure; parse arg x,y,between,uSyms /*X things Y at a time.*/
|
||||
@.=; sep= /*X can't be > length(@0abcs). */
|
||||
@abc = 'abcdefghijklmnopqrstuvwxyz'; @abcU=@abc; upper @abcU
|
||||
@abcS = @abcU || @abc; @0abcS=123456789 || @abcS
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
p: return word(arg(1),1) /*P function (Pick first arg of many).*/
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
permSets: procedure; parse arg x,y,between,uSyms /*X things taken Y at a time. */
|
||||
@.=; sep= /*X can't be > length(@0abcs). */
|
||||
@abc = 'abcdefghijklmnopqrstuvwxyz'; @abcU=@abc; upper @abcU
|
||||
@abcS = @abcU || @abc; @0abcS=123456789 || @abcS
|
||||
|
||||
do k=1 for x /*build a list of (perm) symbols.*/
|
||||
_=p(word(uSyms,k) p(substr(@0abcS,k,1) k)) /*get|generate a symbol.*/
|
||||
if length(_)\==1 then sep='_' /*if not 1st char, then use sep.*/
|
||||
$.k=_ /*append it to the symbol list. */
|
||||
end /*k*/
|
||||
do k=1 for x /*build a list of permutation symbols. */
|
||||
_=p(word(uSyms,k) p(substr(@0abcS,k,1) k)) /*get or generate a symbol.*/
|
||||
if length(_)\==1 then sep='_' /*if not 1st character, then use sep. */
|
||||
$.k=_ /*append the character to symbol list. */
|
||||
end /*k*/
|
||||
|
||||
if between=='' then between=sep /*use the appropriate separator. */
|
||||
call .permset 1 /*start with the first permuation*/
|
||||
return
|
||||
/*──────────────────────────────────.PERMSET subroutine─────────────────*/
|
||||
.permset: procedure expose $. @. between x y; parse arg ?
|
||||
if ?>y then do; _=@.1; do j=2 to y; _=_||between||@.j; end; say _; end
|
||||
else do q=1 for x /*build permutation recursively. */
|
||||
do k=1 for ?-1; if @.k==$.q then iterate q; end /*k*/
|
||||
@.?=$.q; call .permset ?+1
|
||||
end /*q*/
|
||||
return
|
||||
if between=='' then between=sep /*use the appropriate separator chars. */
|
||||
call .permset 1 /*start with the first permuation. */
|
||||
return
|
||||
.permset: procedure expose $. @. between x y; parse arg ?
|
||||
if ?>y then do; _=@.1; do j=2 to y; _=_ || between || @.j; end; say _; end
|
||||
else do q=1 for x /*build the permutation recursively. */
|
||||
do k=1 for ?-1; if @.k==$.q then iterate q; end /*k*/
|
||||
@.?=$.q; call .permset ?+1
|
||||
end /*q*/
|
||||
return
|
||||
|
|
|
|||
|
|
@ -1,22 +1,16 @@
|
|||
/*REXX program shows permutations of N number of objects (1,2,3, ...).*/
|
||||
parse arg n .; if n=='' then n=3 /*Not specified? Assume default.*/
|
||||
/*populate the first permutation.*/
|
||||
do pop=1 for n; @.pop=pop ; end; call tell n
|
||||
|
||||
do while nextperm(n,0); call tell n; end
|
||||
exit /*stick a fork in it, we're done.*/
|
||||
/*──────────────────────────────────NEXTPERM subroutine─────────────────*/
|
||||
nextperm: procedure expose @.; parse arg n,i; nm=n-1
|
||||
|
||||
do k=nm by -1 for nm; kp=k+1
|
||||
if @.k<@.kp then do; i=k; leave; end
|
||||
end /*k*/
|
||||
|
||||
do j=i+1 while j<n; parse value @.j @.n with @.n @.j; n=n-1; end
|
||||
|
||||
if i==0 then return 0
|
||||
do j=i+1 while @.j<@.i; end
|
||||
parse value @.j @.i with @.i @.j
|
||||
return 1
|
||||
/*──────────────────────────────────TELL subroutine─────────────────────*/
|
||||
tell: procedure expose @.; _=; do j=1 for arg(1);_=_ @.j;end; say _;return
|
||||
/*REXX program displays permutations of N number of objects (1, 2, 3, ···). */
|
||||
parse arg n .; if n=='' | n=="," then n=3 /*Not specified? Then use the default.*/
|
||||
/* [↓] populate the first permutation.*/
|
||||
do pop=1 for n; @.pop=pop ; end /*pop */; call tell n
|
||||
do while nPerm(n, 0); call tell n; end /*while*/
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
nPerm: procedure expose @.; parse arg n,i; nm=n-1
|
||||
do k=nm by -1 for nm; kp=k+1; if @.k<@.kp then do; i=k; leave; end; end /*k*/
|
||||
do j=i+1 while j<n; parse value @.j @.n with @.n @.j; n=n-1; end /*j*/
|
||||
if i==0 then return 0
|
||||
do m=i+1 while @.m<@.i; end /*m*/
|
||||
parse value @.m @.i with @.i @.m
|
||||
return 1
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
tell: procedure expose @.; _=; do j=1 for arg(1); _=_ @.j; end; say _; return
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue