Data commit

Task/Josephus-problem/PL-I/josephus-problem.pli

@@ -0,0 +1,63 @@
+*process or(!) source attributes xref;
+ joseph: Proc Options(main);
+ /* 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
+ * 03.05.2013 Walter Pachl Translated From REXX Version 1
+ **********************************************************************/
+ Dcl dead(0:100) Bit(1);
+ Dcl (n,nn,w,s,p,found) Bin Fixed(15);
+ Dcl pp Pic'99';
+ Dcl killed Char(300) Var Init('killed: '); /* output of killings     */
+ Dcl survived Char(300) Var Init('Survivor(s): ');
+ dead='';                               /* nobody's dead yet          */
+ n=41;                                  /* number of alive prisoners  */
+ nn=n;                                  /* wrap around boundary       */
+ w=3;                                   /* killing count              */
+ s=1;                                   /* number of survivors         */
+ p=-1;                                  /* start here                 */
+ 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) Then                   /* a prisoner who is alive    */
+       found=found+1;                   /* increment found count      */
+     End;
+   dead(p)='1'b;                        /* shoot the one on this pos. */
+   n=n-1;
+   pp=p;
+   killed=killed!!' '!!pp;              /* add to output              */
+   End;                                 /* End of main loop           */
+ Call o(killed);
+ Do i=0 To nn-1;                        /* look for the surviving p's */
+   If ^dead(i) Then Do;                 /* found one                  */
+     pp=i;
+     survived=survived!!' '!!pp;
+     End;
+   End;
+ Call o(survived);
+
+ o: Proc(s);
+ /*********************************************************************
+ * Formatted Output of given string:
+ * xxxxxxxxxx xxx xx xx xxx ---
+ *         xx xxx xxx
+ *         xxxxx xxx
+ *********************************************************************/
+ Dcl s Char(*) Var;
+ Dcl p Bin Fixed(15);
+ Dcl ll Bin Fixed(15) Init(72);
+ Do While(length(s)>ll);
+   Do p=ll+1 To 10 By -1;
+     If substr(s,p,1)=' ' Then
+       Leave;
+     End;
+   Put Edit(left(s,p))(Skip,a);
+   s=repeat(' ',8)!!substr(s,p+1);
+   End;
+ Put Edit(s)(Skip,a);
+ End;
+
+ End;