Data commit

Task/Power-set/PL-I/power-set.pli

@@ -0,0 +1,66 @@
+*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;