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