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

September 2017 Update

Browse source
This commit is contained in:
Ingy döt Net 2017-09-23 10:01:46 +02:00
parent bba7bfd280
commit ba8067c3b7
14570 changed files with 153136 additions and 63871 deletions
Download patch file Download diff file Expand all files Collapse all files

75
Task/Topswops/REXX/topswops.rexx
View file

@ -1,41 +1,38 @@
/*REXX pgm gens N decks of numbered cards and finds the maximum "swops".*/
parse arg things .; if things=='' then things=10; thingsX= things>9
/*REXX program generates N decks of numbered cards and finds the maximum "swops". */
parse arg things .; if things=='' then things=10
do n=1 for things; #=deckSets(n,n) /*create "decks".*/
mx= n\==1 /*handle case of a one-card deck.*/
do i=1 for #
mx=max(mx,swops(!.i))
end /*i*/
say '──────── maximum swops for a deck of' right(n,2) ' cards is' right(mx,4)
do n=1 for things; #=decks(n, n) /*create a (things) number of "decks". */
mx= n\==1 /*handle the case of a one-card deck.*/
do i=1 for #; p=swops(!.i) /*compute the SWOPS for this iteration.*/
if p>mx then mx=p /*This a new maximum? Use a new max. */
end /*i*/
say '──────── maximum swops for a deck of' right(n,2) ' cards is' right(mx,4)
end /*n*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────DECKSETS subroutine─────────────────*/
deckSets: procedure expose !. /*X things taken Y at a time.*/
parse arg x,y,,$ @.; #=0; call .deckset 1 /*set $ & @. to null.*/
return # /*return # permutations (decks).*/
.deckset: procedure expose @. x y $ # !.; parse arg ?
if ?>y then do; _=@.1; do j=2 to y; _=_ @.j; end /*j*/; #=#+1; !.#=_
end
else do
?m=?-1 /*used in the FOR for faster DO.*/
if ?==1 then qs=2 /*¬ use 1-swops that start with 1*/
else do
qs=1
if @.1==? then qs=2 /*skip 1-swops: 3 x 1 x */
end
do q=qs to x /*build permutation recursively. */
do k=1 for ?m; if @.k==q then iterate q; end /*k*/
@.?=q; call .deckset(?+1)
end /*q*/
end
return
/*──────────────────────────────────SWOPS subroutine────────────────────*/
swops: parse arg z; do _=1; t=word(z,1)
if word(z,t)==1 then return _
if thingsX then do h=10 to things
z=changestr(h,z,d2x(h))
end /*h*/
z=reverse(subword(z,1,t)) subword(z,t+1)
if thingsX then do d=10 to things
z=changestr(d2x(d),z,d)
end /*_*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
decks: procedure expose !.; parse arg x,y,,$ @. /* X things taken Y at a time. */
#=0; call .decks 1 /* [↑] initialize $ & @. to null.*/
return # /*return number of permutations (decks)*/
.decks: procedure expose !. @. x y $ #; parse arg ?
if ?>y then do; _=@.1; do j=2 for y-1; _=_ @.j; end /*j*/; #=#+1; !.#=_
end
else do; qm=?-1
if ?==1 then qs=2 /*don't use 1-swops that start with 1 */
else if @.1==? then qs=2 /*skip the 1-swops: 3 x 1 x ···*/
else qs=1
do q=qs to x /*build the permutations recursively. */
do k=1 for qm; if @.k==q then iterate q
end /*k*/
@.?=q; call .decks ? + 1
end /*q*/
end
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
swops: parse arg z; do u=1; parse var z t .; if length(t)==2 then t=x2d(t)
if word(z, t)==1 then return u /*found unity at T. */
do h=10 to things; if pos(h, z)==0 then iterate
z=changestr(h, z, d2x(h) ) /* [↑] any H's in Z ? */
/* [↑] hexify decimal H */
end /*h*/
z=reverse(subword(z, 1, t)) subword(z, t+1)
end /*u*/