A-M baby

Task/Josephus-problem/REXX/josephus-problem-1.rexx

@@ -0,0 +1,30 @@
+/* REXX **************************************************************
+* 15.11.2012 Walter Pachl - my own solution
+* 16.11.2012 Walter Pachl generalized n prisoners + w killing distance
+*                         and s=number of survivors
+**********************************************************************/
+dead.=0                                /* nobody's dead yet          */
+n=41                                   /* number of alive prisoners  */
+nn=n                                   /* wrap around boundary       */
+w=3                                    /* killing count              */
+s=1                                    /* nuber of survivors         */
+p=-1                                   /* start here                 */
+killed=''                              /* output of killings         */
+Do until n=s                           /* until one alive prisoner   */
+  found=0                              /* start looking              */
+  Do Until found=w                     /* until we have the third    */
+    p=p+1                              /* next position              */
+    If p=nn Then p=0                   /* wrap around                */
+    If dead.p=0 Then                   /* a prisoner who is alive    */
+      found=found+1                    /* increment found count      */
+    End
+  dead.p=1
+  n=n-1                                /* shoot the one on this pos. */
+  killed=killed p                      /* add to output              */
+  End                                  /* End of main loop           */
+Say 'killed:'subword(killed,1,20)      /* output killing sequence    */
+Say '       'subword(killed,21)        /* output killing sequence    */
+Say 'Survivor(s):'                     /* show                       */
+Do i=0 To 40                           /* look for the surviving p's */
+  If dead.i=0 Then Say i               /* found one                  */
+  End

Task/Josephus-problem/REXX/josephus-problem-2.rexx

@@ -0,0 +1,25 @@
+/*REXX pgm, Josephus problem: N men standing in a circle, every Kth kilt*/
+parse arg N K Z R .                    /*get optional arguments.        */
+if N==',' | N==''   then  N = 41       /*no #prisoners? Then use 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 the prisoner's circle.*/
+c=0                                    /*initial prisoner count-off num.*/
+    do remove=0;   p=words($)          /*keep removing until R are left.*/
+    c=c+K                              /*bump prisoner  count-off  by K.*/
+    if c>p then do                     /*   [↓] remove some prisoner(s).*/
+                  do j=1  for words(x);   $=delword($,word(x,j)+1-j,1)
+                  if words($)==R  then leave remove  /*slaying done yet?*/
+                  end   /*j*/
+                c=(c//p)//words($); x= /*adjust prisoner count-off &list*/
+                end
+    if c\==0  then x=x c               /*list of prisoners to be removed*/
+    end   /*remove*/                   /*remove 'til  R  prisoners 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 done.*/
+/*──────────────────────────────────subroutines──────────────────────────*/
+s:  if arg(1)==1  then return arg(3);   return word(arg(2) 's',1)
+th: arg y; return y||word('th st nd rd', 1+y//10*(y//100%10\==1)*(y//10<4))