Data Update

Task/Power-set/REXX/power-set.rexx

@@ -1,32 +1,53 @@
 /*REXX program  displays a  power set;  items may be  anything  (but can't have blanks).*/
-parse arg S                                      /*allow the user specify optional set. */
-if S=''  then S= 'one two three four'            /*Not specified?  Then use the default.*/
-@= '{}'                                          /*start process with a null power set. */
-N= words(S);     do chunk=1  for N               /*traipse through the items in the set.*/
-                 @=@  combN(N, chunk)            /*take  N  items, a  CHUNK  at a time. */
-                 end    /*chunk*/
-w= length(2**N)                                  /*the number of items in the power set.*/
-                 do k=1  for words(@)            /* [↓]  show combinations,  1 per line.*/
-                 say right(k, w)     word(@, k)  /*display a single combination to term.*/
-                 end    /*k*/
-exit 0                                           /*stick a fork in it,  we're all done. */
-/*──────────────────────────────────────────────────────────────────────────────────────*/
-combN:  procedure expose S;  parse arg x,y;      base= x + 1;             bbase= base - y
-        !.= 0
-                         do p=1  for y;          !.p= p
-                         end      /*p*/
-        $=                                                         /* [↓] build powerset*/
-                         do j=1;                 L=
-                            do d=1  for y;       L= L','word(S, !.d)
-                            end   /*d*/
-                         $= $  '{'strip(L, "L", ',')"}";                  !.y= !.y + 1
-                         if !.y==base  then  if .combU(y - 1)  then leave
-                         end      /*j*/
-        return strip($)                          /*return with a partial power set chunk*/
-/*──────────────────────────────────────────────────────────────────────────────────────*/
-.combU: procedure expose !. y bbase;        parse arg d;           if d==0  then return 1
-        p= !.d
-                  do u=d  to y;   !.u= p + 1;     if !.u==bbase+u  then return .combU(u-1)
-                  p= !.u                                           /*             ↑     */
-                  end   /*u*/                                      /*recurse──►───┘     */
-        return 0
+Parse Arg text                                   /*allow the user specify optional set. */
+If text='' Then                                  /*Not specified?  Then use the default.*/
+  text='one two three four'
+n=words(text)
+psi=0
+Do k=0 To n               /* loops from 0 to n elements of a set      */
+  cc=comb(n,k)            /* returns the combinations of 1 through k  */
+  Do while pos('/',cc)>0        /* as long as there is a combination  */
+    Parse Var cc elist '/' cc   /* get i from comb's result string    */
+    psl=''                      /* initialize the list of words       */
+    psi=psi+1                   /* index of this set                  */
+    Do While elist<>''          /* loop through elements              */
+      parse var elist e elist   /* get an element (a digit)           */
+      psl=psl','word(text,e)    /* add corresponding test word to set */
+      End
+    psl=substr(psl,2)           /* get rid of leading comma           */
+    Say right(psi,2) '{'psl'}'  /* show this element of the power set */
+    End
+  End
+Exit
+comb: Procedure
+/***********************************************************************
+* Returns the combinations of size digits out of things digits
+* e.g. comb(4,2) -> ' 1 2/1 3/1 4/2 3/2 4/3 4/'
+                      1 2/  1 3/  1 4/  2 3/  2 4/  3 4 /
+***********************************************************************/
+Parse Arg things,size
+n=2**things-1
+list=''
+Do u=1 To n
+  co=combinations(u)
+  If co>'' Then
+    list=list '/' combinations(u)
+  End
+Return substr(space(list),2) '/'    /* remove leading / */
+
+combinations: Procedure Expose things size
+  Parse Arg u
+  nc=0
+  bu=x2b(d2x(u))
+  bu1=space(translate(bu,' ',0),0)
+  If length(bu1)=size Then Do
+    ub=reverse(bu)
+    res=''
+    Do i=1 To things
+      c=i
+      If substr(ub,i,1)=1 Then res=res i
+      End
+    Return res
+    End
+  Else
+    Return ''