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

64 lines
2.6 KiB
Plaintext

*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;