67 lines
1.8 KiB
Plaintext
67 lines
1.8 KiB
Plaintext
*process source attributes xref or(!);
|
|
/*--------------------------------------------------------------------
|
|
* 06.01.2014 Walter Pachl translated from REXX
|
|
*-------------------------------------------------------------------*/
|
|
powerset: Proc Options(main);
|
|
Dcl (hbound,index,left,substr) Builtin;
|
|
Dcl sysprint Print;
|
|
Dcl s(4) Char(5) Var Init('one','two','three','four');
|
|
Dcl ps Char(1000) Var;
|
|
Dcl (n,chunk,p) Bin Fixed(31);
|
|
n=hbound(s); /* number of items in the list. */
|
|
ps='{} '; /* start with a null power set. */
|
|
Do chunk=1 To n; /* loop through the ... . */
|
|
ps=ps!!combn(chunk); /* a CHUNK at a time. */
|
|
End;
|
|
Do While(ps>'');
|
|
p=index(ps,' ');
|
|
Put Edit(left(ps,p-1))(Skip,a);
|
|
ps=substr(ps,p+1);
|
|
End;
|
|
|
|
combn: Proc(y) Returns(Char(1000) Var);
|
|
/*--------------------------------------------------------------------
|
|
* returns the list of subsets with y elements of set s
|
|
*-------------------------------------------------------------------*/
|
|
Dcl (y,base,bbase,ym,p,j,d,u) Bin Fixed(31);
|
|
Dcl (z,l) Char(1000) Var Init('');
|
|
Dcl a(20) Bin Fixed(31) Init((20)0);
|
|
Dcl i Bin Fixed(31);
|
|
base=hbound(s)+1;
|
|
bbase=base-y;
|
|
ym=y-1;
|
|
Do p=1 To y;
|
|
a(p)=p;
|
|
End;
|
|
Do j=1 By 1;
|
|
l='';
|
|
Do d=1 To y;
|
|
u=a(d);
|
|
l=l!!','!!s(u);
|
|
End;
|
|
z=z!!'{'!!substr(l,2)!!'} ';
|
|
a(y)=a(y)+1;
|
|
If a(y)=base Then
|
|
If combu(ym) Then
|
|
Leave;
|
|
End;
|
|
/* Put Edit('combn',y,z)(Skip,a,f(2),x(1),a); */
|
|
Return(z);
|
|
|
|
combu: Proc(d) Recursive Returns(Bin Fixed(31));
|
|
Dcl (d,u) Bin Fixed(31);
|
|
If d=0 Then
|
|
Return(1);
|
|
p=a(d);
|
|
Do u=d To y;
|
|
a(u)=p+1;
|
|
If a(u)=bbase+u Then
|
|
Return(combu(u-1));
|
|
p=a(u);
|
|
End;
|
|
Return(0);
|
|
End;
|
|
End;
|
|
|
|
End;
|