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

2016 Update

Browse source
This commit is contained in:
Tina Müller 2016-12-05 22:15:40 +01:00
parent 948b86eafa
commit dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
Download patch file Download diff file Expand all files Collapse all files

47
Task/Josephus-problem/REXX/josephus-problem-2.rexx
View file

@ -1,25 +1,26 @@
/*REXX program: Josephus problem: N men standing in a circle, every Kth kilt.*/
parse arg N K Z R . /*get the optional arguments from C.L. */
if N==',' | N=='' then N = 41 /*no #prisoners? Then use the default*/
if K==',' | K=='' then K = 3 /*no kill count? " " " " */
if Z==',' | Z=='' then Z = 0 /*no initial # ? " " " " */
if R==',' | R=='' then R = 1 /*no remaining#? " " " " */
$=; x=; do pop=Z for N; $=$ pop; end /*populate prisoner's circle (with a #)*/
c=0 /*initial prisoner count─off number. */
do remove=0; p=words($) /*keep removing until R are remaining*/
c=c+K /*bump the prisoner count-off by K. */
if c>p then do /* [↓] remove (kill) some prisoner(s)*/
do j=1 for words(x); $=delword($,word(x,j)+1-j,1)
if words($)==R then leave remove /*is the slaying done? */
end /*j*/
c=(c//p)//words($); x= /*adjust prisoner count-off and circle.*/
/*REXX program solves Josephus problem: N men standing in a circle, every Kth kilt.*/
/*N=men, K=kilt, Z=start, R=remaining. */
parse arg N K Z R . /*obtain optional arguments from the CL*/
if N=='' | N=="," then N = 41 /*Not specified? Then use the default.*/
if K=='' | K=="," then K = 3 /* " " " " " " */
if Z=='' | Z=="," then Z = 0 /* " " " " " " */
if R=='' | R=="," then R = 1 /* " " " " " " */
$=; x=; do pop=Z for N; $=$ pop; end /*pop*/ /*populate prisoner's circle (with a #)*/
c=0 /*initial prisoner count─off number. */
do remove=0 by 0; p=words($) /*keep removing until R are remaining*/
c=c+K /*bump the prisoner count-off by K. */
if c>p then do /* [↓] remove (kill) some prisoner(s)*/
do j=1 for words(x); $=delword($, word(x, j) + 1 - j, 1)
if words($)==R then leave remove /*is the slaying done?*/
end /*j*/
c=(c//p) // words($); x= /*adjust prisoner count-off and circle.*/
end
if c\==0 then x=x c /*the list of prisoners to be removed. */
end /*remove*/ /*remove 'til R prisoners are left.*/
if c\==0 then x=x c /*the list of prisoners to be removed. */
end /*remove*/ /*remove 'til R prisoners are left.*/
say 'removing every ' th(K) " prisoner out of " N ' (starting at' Z") with ",
R ' survivor's(R)","; say 'leaving prisoner's(R)':' $
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────subroutines───────────────────────────────*/
s: if arg(1)==1 then return arg(3); return word(arg(2) 's',1)
th: parse arg y; return y||word('th st nd rd',1+y//10*(y//100%10\==1)*(y//10<4))
say 'removing every ' th(K) " prisoner out of " N ' (starting at' Z") with ",
R ' survivor's(R)", leaving prisoner"s(R)':' $
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
s: if arg(1)==1 then return arg(3); return word( arg(2) 's', 1)
th: y=arg(1); return y || word('th st nd rd', 1+ y // 10 * (y//100%10\==1) * (y//10<4))