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

June 2018 Update

Browse source
This commit is contained in:
Ingy döt Net 2018-06-22 20:57:24 +00:00
parent ba8067c3b7
commit 22f33d4004
5278 changed files with 84726 additions and 14379 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -2,7 +2,7 @@
parse arg things .; if things=='' then things=10
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.*/
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*/
@ -16,7 +16,7 @@ decks: procedure expose !.; parse arg x,y,,$ @. /* X things taken Y at
.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
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
@ -24,15 +24,15 @@ decks: procedure expose !.; parse arg x,y,,$ @. /* X things taken Y at
do k=1 for qm; if @.k==q then iterate q
end /*k*/
@.?=q; call .decks ? + 1
end /*q*/
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*/
swops: parse arg z; do u=1; parse var z t .; if \datatype(t, 'W') 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?*/
end /*h*/
z=reverse( subword(z, 1, t) ) subword(z, t + 1)
end /*u*/