(******************************************************)
(* This program is describe in Hough and Ruskey,      *)
(* "An efficient implementation of the Eades, Hickey, *)
(* Read combination generation algorithm, J. Comb.    *)
(* Math. and Comb. Computing, 4 (1988) 79-86.         *)
(******************************************************)

program EHR ( input, output );

const
  
  MAX = 100;

  left = +1;   forw = +1;
  riht = -1;   back = -1;


type
  
  Moves = (TUP,TUQ,TDP,TDQ,PQ,QP,PP,QQ,
           ULP,ULQ,LUP,LUQ,INIT,FINI);

  StackElement = record
                   spec : boolean;
                   side : (lower,upper);
                   p    : integer;
                   nm   : Moves;    {The next move}
                 end;


var

  n,k   : integer;
  Count : integer;
  x     : array [1..MAX] of 0..1;      {The bitstring}
  p1    : array [1..MAX] of integer;  
  stk   : array [1..MAX] of StackElement;


procedure WriteCombination;
var i : integer;
begin
  Count := Count + 1;
  write( Count:5,':' );
  for i := n downto 1 do write( x[i]:2 );
  writeln;
end {of WriteCombination};


procedure Move ( n, dir : integer );
begin
  x[p1[n]] := 0;
  p1[n] := p1[n] + dir;
  x[p1[n]] := 1;  
  WriteCombination;
end {of Move1};


procedure xInit ( dir, level : integer );
begin
  with stk[level] do begin
     if dir = forw then begin
        nm := INIT;  spec := true;  side := upper;
     end else {dir = back} begin
        nm := FINI;  spec := false;  side := lower;
     end;
     p := 1;
  end {with};
end {of xInit};


procedure Next ( n, k, level, dir : integer );
begin
   with stk[level] do begin
      if k = 1 then begin
         Move( 1, -dir );
      end else
      if k = n-1 then begin
         if dir = forw then if p1[1] = 2 then p := 1;
         if dir = back then if p1[k] = k then p := k;
         Move( p, -dir );  p := p + dir; 
      end else
      case nm of
       INIT: 
           if dir = forw then begin
             if p1[k-2] = k-2 then begin
                Move( k-1, riht );
                spec := true;  side := upper;  nm := PQ;
             end else begin
                if p1[1] = n-k+1 then xInit( forw, level+1 );
                Next( n-2, k-2, level+1, forw );
             end;
           end else {dir = back} begin
             Next( n-2, k-2, level+1, back );
           end;
       FINI: 
           if dir = forw then begin
             Next( n-2, k, level+1, forw );
           end else {dir = back} begin
             if p1[1] = n-k-1 then begin
                Move( k, left );
                nm := LUQ;  spec := false;  side := lower;
             end else begin
                if p1[k] = k then xInit( back, level+1 );
                Next( n-2, k, level+1, back );
             end;
           end;
       PP: begin
             Next( n-4, k-2, level+1, -dir );
             if (dir = back) and (p1[k-2] = k-2) then begin 
                nm := PQ; spec := true;
             end else
               if x[n-4] = 0 then nm := LUP
               else begin nm := TDP; p := k-2; end; 
           end;
       QQ: if dir = forw then begin
             if p1[1] = n-k-1 then begin
                Move( k, riht );  nm := FINI;
                stk[level+1].p := 1;
             end else begin
                Next( n-4, k-2, level+1, back );
                if x[n-4] = 1 then nm := LUQ else nm := TDQ;
             end;
           end else {dir = back} begin 
             Next( n-4, k-2, level+1, forw );
             if x[n-4] = 1 then nm := LUQ else nm := TDQ;
           end;
       PQ: begin
             Move( k-1, riht );
             if x[n-4] = 1 then nm := ULQ else nm := TDQ;
           end;
       QP: begin
             Move( k-1, left ); 
             if (dir = forw) and spec then begin 
                nm := PP; spec := false; 
             end else 
                if x[n-4] = 1 then begin nm := TDP; p := k-2; end
                else nm := ULP;
           end;
      ULQ: begin
             Move( k, riht );
             if x[n-3] = 0 then nm := TUQ else 
             if spec then nm := QP else nm := QQ;
             side := lower;
           end;
      LUQ: begin
             Move( k, left );
             if x[n-3] = 0 then nm := TUQ else nm := QP;
             side := upper;
           end;
      ULP: if (dir = back) and spec then begin
             Move( k-1, left );
             nm := INIT;
           end else begin
             Move( k, riht );
             if x[n-3] = 1 then nm := TUP else nm := PP;
             side := lower;
           end;
      LUP: begin
             Move( k, left );
             if x[n-3] = 1 then nm := TUP else nm := PQ;
             side := upper;
           end;
      TUQ: begin
             Move( k-1, left );
             if x[n-3] = 1 then
                if spec then nm := QP else 
                if side = upper then nm := QP else nm := QQ; 
           end;
      TDQ: begin 
             Move( k-1, riht );
             if p1[k-1] = p1[k-2] + 1 then 
               if side = upper then nm := ULQ else nm := LUQ;
           end;
      TUP: begin
             Move( p, riht );  
             if p = k-2 then begin
                if side = upper then nm := PQ else nm := PP; 
             end else p := p + 1;
           end;
      TDP: begin
             Move( p, left );  
             if x[p1[p]-2] = 0 then begin
                if side = upper then nm := ULP else nm := LUP;
             end else p := p - 1;
           end;   
      end {case};
   end {with};
end {of Next};


procedure Initialize;
var i : integer;
begin
  for i := 1 to n-k do x[i] := 0;
  for i := 1 to k do begin
     x[n-k+i] := 1;  p1[i] := n-k+i;
  end;
  Count := 0;
end {of Initialize};


procedure G ( n, k : integer );
var i : integer;
begin
  if k = 1 then begin
     for i := 1 to n-1 do Move( 1, riht );
  end else
  if k = n-1 then begin
     for i := 1 to n-1 do Move( i, riht );
  end else begin
     G( n-2, k-2 );
     Move( k-1, riht );
     with stk[1] do begin
        spec := true;  side := upper;  nm := PQ;
     end;
     xInit( back, 2 );
     repeat Next( n, k, 1, forw );
     until (p1[k] = n-1) and (p1[1] = n-k-1) and (p1[k-1] = n-3);
     Move( k, riht );
     G( n-2, k ); 
  end;
end {of G};


begin
  write( 'Enter n and k: ' );  readln( n, k );
  Initialize;
  WriteCombination;
  G( n, k );
end.