! Enumerate all feasible nonempty subsets of a partially ordered set.
 A subset is feasible if for every task j in the subset,
 all predecessors of j are also in the subset;
! This implements the algorithm on page 445 of:
  Schrage, L. and K. Baker(1978),"Dynamic Programming Solution 
 of Sequencing Problems with Precedence Constraints", Operations Research,
 vol. 26, no. 3, pp. 444-449;
! Keywords: Dynamic programming, Enumeration, Partial ordered set, Subset enumeration;
SETS:
 TASK: PREDEND, TASKRDR, M, NSUCC;
 PLIST: PREDLIST;
ENDSETS
DATA:
! Case 1;
! The network:
    1   ---> 2 --> 3 -------> 4
     \ \       \ /          /
      \   \   /  \         /
       \    5      6  --> 7
        \     \         /
         \       \   /
           8  ---> 9;

 TASK = 1..9;    ! Set of Tasks;
 PLIST = 1..12;  ! Set/list of prededessors;
! The list of predecessors for each task;
 PREDLIST =
  1    ! 2;
  2, 5 ! 3;
  3, 7 ! 4;
  1    ! 5;
  2    ! 6;
  6, 9 ! 7;
  1    ! 8; 
  5, 8;! 9;
! Pointers into PREDLIST of end point
  of predecessors for each task;
 PREDEND =
  0  ! 1; 
  1  ! 2;
  3  ! 3;
  5  ! 4;
  6  ! 5;
  7  ! 6;
  9  ! 7;
  10 ! 8;
  12;! 9;

! Case 2;
! A smaller set with no precedence constraints;
! TASK = 1..4;
! PLIST = 1..1; ! PREDEND = 0 0 0 0;
ENDDATA
PROCEDURE ADJNSUCC:
 ! Adjust number of successors count of predecessors of task kk,
   increasing NSUCC(), (case DELTA = 1) if task kk is added, or
   decreasing NSUCC(), (case DELTA = -1) if task kk is removed
   from the current set;
 LSTPRD = PREDEND(kk);
 jj = 0;
 @IFC( kk #GT# 1: jj = PREDEND(kk-1));
 @WHILE( jj #LT# LSTPRD:
   jj = jj + 1;
   jp = PREDLIST( jj);
   NSUCC( jp) = NSUCC( jp) + DELTA;
        );
ENDPROCEDURE

CALC:
 NTASK = @SIZE( TASK);  ! Number of tasks;
! Construct an ordering, TASKRDR() of the tasks so that for any j,
all its predecessors appear earlier;
 @FOR( TASK( j):
   NSUCC(j) = 0; ! No task has any successors in the set;
      );
 DELTA = 1; ! Count number of successors of each task;
 @FOR( TASK( j):
   kk = j;
   ADJNSUCC;
      );
 ! Find all tasks with no successors, use M(i) as a stack;
 NUMZ = 0;
 @FOR( TASK( j):
    @IFC( NSUCC(j) #EQ# 0:
      NUMZ = NUMZ + 1;
      M( NUMZ) = j;
        );
      );
 ! Now fill TASKRDR() from the top down;
 @WRITE(' A sequence in which all predecessors of j appear earlier than j.',@NEWLINE(1));
 NXTPOS = NTASK;
 @FOR( TASK( j):
   kk = M( NUMZ); ! Take a task off stack;
   NUMZ = NUMZ - 1; ! One less task on stack;
   TASKRDR( NXTPOS) = kk; ! Put kk next from rear;
   @WRITE(' TASKRDR(',NXTPOS,')= ', kk, @NEWLINE(1));
   NXTPOS = NXTPOS - 1;
 ! Decrement successor counts of predecessors of kk;
   LSTPRD = PREDEND(kk);
   jj = 0;
   @IFC( kk #GT# 1: jj = PREDEND(kk-1));
    @WHILE( jj #LT# LSTPRD:
     jj = jj + 1;
     jp = PREDLIST( jj);
     NSUCC( jp) = NSUCC( jp) -1;
     @IFC( NSUCC(jp) #EQ# 0: ! If successor count hits 0...;
       NUMZ = NUMZ + 1; 
       M( NUMZ) = jp;  ! put it on the stack;
         );
        );
     );

 ! Now almost ready to enumerate feasible subsets;
 @FOR( TASK( j):
   M(j) = 0;     ! No tasks are members, we start with empty set;
   NSUCC(j) = 0; ! No task has any successors in the set;
      );

 ! Loop to enumerate all feasible subsets satisfying
   precedence constraints;
  @WRITE(' A listing of all feasible subsets.',@NEWLINE(1));
  NSUBSETS = 0; ! Number subsets so far;
  LOZ = 0;  ! Lower bound -1 on location of first M(i) = 0;
  MORE = 1; ! MORE = 0 when we have enumerated all subsets;
  @WHILE( MORE:
    ! Find smallest i, such that M(i) = 0;
     ZFRST = 0; ! Location of first M(i) = 0;
     ii = LOZ;
     @WHILE( ZFRST #EQ# 0 #AND# ii #LT# NTASK:
       ii = ii + 1;
       @IFC( M( TASKRDR( ii)) #EQ# 0:
         ZFRST = ii;
            );
            );

  ! If ZFRST = 0, it means all the M(i) = 1;
   @IFC( ZFRST #EQ# 0:
      MORE = 0;  ! We found no lowest task with M(i) = 0;
     @ELSE
      kk = TASKRDR( ZFRST); ! We found a lowest M(i) = 0;
      M( kk) = 1;  ! Make it a member of current set;
      LOZ = ZFRST; ! Adjust lower bound -1 of lowest M(i) = 0;
      DELTA = 1; ! Increment ...;
      ADJNSUCC;  ! successor counts of predecessors of kk;

  ! Drop any j lower than ZFRST if it has no successors k with M(k) = 1;
     DELTA = -1;
     ii = ZFRST;
     @WHILE( ii #GT# 1:
       ii = ii - 1;
       kk = TASKRDR( ii);
       @IFC( NSUCC( kk) #EQ# 0:
         M(kk) = 0;  ! Drop kk from the set;
         LOZ = ii-1; ! Adjust lower bound-1 of location of first M(i) = 0;
         ADJNSUCC; ! Decrement successor counts of predecessor of kk;
          );
          );
    NSUBSETS = NSUBSETS + 1;
    @WRITE(' Current set(', NSUBSETS,')= ');
    @FOR( TASK(i) | M( TASKRDR(i)) #EQ# 1:
      @WRITE( ' ', TASKRDR(i));
         );
       @WRITE( @NEWLINE(1));
       );     
        ); ! @WHILE( MORE ;
ENDCALC