PROGRAM BACKTRACKING;
  UNIT BACKTRACK: CLASS;
    HIDDEN SE,ELEM,TOP;
    VAR  ROOT:NODE,SEARCH:SE,FOUND,OPT:NODE,
	 NUMBER_OF_NODES,NUMBER_OF_LEAVES,NUMBER_OF_ANSWERS:INTEGER;

    UNIT NODE: COROUTINE(FATHER:NODE);
      VAR NSONS,LEVEL: INTEGER , DEADEND:BOOLEAN;
      UNIT VIRTUAL LEAF:  FUNCTION :BOOLEAN;
      END LEAF;
      UNIT VIRTUAL ANSWER :FUNCTION :BOOLEAN;
      END ANSWER;
      UNIT VIRTUAL LASTSON: FUNCTION : BOOLEAN;
      END LASTSON;
      UNIT VIRTUAL NEXTSON: FUNCTION : NODE;
      END NEXTSON;
      UNIT VIRTUAL EQUAL : FUNCTION (W:NODE):BOOLEAN;
      END EQUAL;
      UNIT VIRTUAL COST: FUNCTION :REAL;
      END COST;
    BEGIN
      IF FATHER =/= NONE
      THEN
	LEVEL:=FATHER.LEVEL+1
      ELSE
	LEVEL:=0
      FI;
   END NODE;

    UNIT OK: FUNCTION (V:NODE):BOOLEAN;
      VAR W:NODE;
    BEGIN
      IF V=NONE THEN RESULT:=FALSE; RETURN FI;
      RESULT:=TRUE; W:=V.FATHER;
      WHILE W =/= NONE
      DO
	IF V.EQUAL(W) THEN RESULT:=FALSE; RETURN FI;
	W:=W.FATHER
      OD
    END OK;

    UNIT PURGE: PROCEDURE (V:NODE);
      VAR W: NODE;
    BEGIN
      IF V=NONE THEN RETURN FI;
      DO
	W:=V.FATHER; KILL(V);
	IF W=NONE THEN RETURN FI;
	W.NSONS:=W.NSONS-1;
	IF W.NSONS =/= 0 THEN RETURN FI;
	V:=W
      OD;
    END PURGE;

    VAR TOP:ELEM;

    UNIT ELEM: CLASS (NEXT:ELEM, V:NODE);
    END ELEM;

    UNIT VIRTUAL INSERT: PROCEDURE(V:NODE);
    BEGIN
      TOP:=NEW ELEM(TOP,V);
    END INSERT;

    UNIT VIRTUAL DELETE: FUNCTION :NODE;
      VAR E:ELEM;
    BEGIN
      IF TOP =/= NONE
      THEN
	RESULT:=TOP.V;
	E:=TOP; TOP:=TOP.NEXT; KILL(E);
      FI;
    END DELETE;

    UNIT SE: COROUTINE ;
      VAR I:INTEGER,V,W:NODE;
    BEGIN
      RETURN; CALL INSERT(ROOT);
      DO
	V:=DELETE;
	IF V=NONE THEN EXIT FI;
	ATTACH(V);
	IF V.ANSWER
	THEN
	  NUMBER_OF_ANSWERS:=NUMBER_OF_ANSWERS+1;
	  FOUND:=V;
	  IF OPT=NONE ORIF V.COST < OPT.COST
	  THEN
	     OPT:=V
	  FI;
	  DETACH;
	  (* HERE THE USER OF BACKTRACK MAY UNDERTAKE SOME ACTIONS
	     ON THE ANSWER NODES. IF NOT NECESSARY DO ATTACH	  *)
	ELSE
	  IF V.DEADEND
	  THEN
	    NUMBER_OF_LEAVES:=NUMBER_OF_LEAVES+1;
	    CALL PURGE(V);
	  ELSE
	    DO
	      W:=V.NEXTSON; V.NSONS:=V.NSONS+1;
	      NUMBER_OF_NODES:=NUMBER_OF_NODES+1;
	      IF OK(W)
	      THEN
		W.DEADEND:=W.LEAF; CALL INSERT(W);
	      FI;
	      IF V.LASTSON THEN EXIT FI;
	    OD;
	  FI;
	FI;
      OD;
      FOUND:=NONE;
    END SE;


    UNIT KILLALL :PROCEDURE;
      VAR V:NODE;
    BEGIN
      DO
	V:=DELETE;
	IF V=NONE THEN RETURN FI;
	CALL PURGE(V);
      OD;
    END KILLALL;

  BEGIN
    SEARCH:=NEW SE;
    INNER;
    KILL(SEARCH); CALL KILLALL;
  END BACKTRACK;


UNIT BESTSEARCH: BACKTRACK CLASS;
  (*  BESTSEARCH USES A PRIORITY QUEUE FOR NODES.
      QUEUE IS ORGANIZED AS A HEAP IN THE ARRAY A.
      THE FIRST ELEMENT A(1) IS THE LEAST ONE. *)
  HIDDEN A,B,X,K,M,I,J;
  VAR A,B:ARRAYOF EX_NODE,   X : EX_NODE, K,M,I,J:INTEGER;
    (*M- CURRENT ARRAY A LENTGTH
      K- CURRENT HEAP LENGTH
      B- SRATCH ARRAY *)

  UNIT	EX_NODE : NODE CLASS;
    UNIT VIRTUAL  LESS : FUNCTION (X: EX_NODE) : BOOLEAN;
    END  LESS;
  END EX_NODE;

  UNIT VIRTUAL DELETE: FUNCTION :EX_NODE;

    BEGIN
      IF K=0 THEN RETURN FI;
      RESULT:=A(1); X:=A(K); K:=K-1;
      IF K=0
      THEN
	KILL(A); RETURN
      FI;
      IF K*2<M
      THEN
	ARRAY B DIM (1: M DIV 2);
	FOR I:=1 TO K DO B(I):=A(I) OD;
	KILL(A); M:=M DIV 2; A:=B
      FI;
      I:=1; J:=2;
      WHILE J <= K
      DO
	IF J+1 <= K ANDIF A(J+1).LESS( A(J))
	THEN
	  J:=J+1
	FI;
	IF X.LESS( A(J)) THEN EXIT FI;
	A(I):=A(J); I:=J;  J:=2*I
      OD;
      A(I):=X
    END DELETE;


  UNIT VIRTUAL INSERT : PROCEDURE(X: EX_NODE);
   BEGIN
     IF K=0
     THEN
       ARRAY A DIM (1:2); M:=2;
     FI;
     IF K=M
     THEN
       ARRAY B DIM(1:2*M); FOR I:=1 TO M DO B(I):=A(I) OD;
       KILL(A); M:=2*M; A:=B;
     FI;
     K,J:=K+1;
     IF K=1 THEN A(1):=X; RETURN; FI;
     I:= J DIV 2;
     WHILE I>=1
     DO
       IF A(I).LESS( X ) THEN EXIT FI;
       A(J):=A(I); J:=I; I:= J DIV 2
     OD;
     A(J):=X
   END INSERT;

   BEGIN
     INNER;
     CALL KILLALL;
   END BESTSEARCH;



  VAR N,Q:INTEGER,H1,H2,H3:CHAR;
   (* Q - BOAT CAPACITY, N- NUMBER OF CANNIBALS, N- NUMBER OF MISSIONARIES *)

BEGIN
  DO
    WRITE(" NUMBER OF PERSONS ");
    WRITE(" (IF END OF SESSION WRITE 0) =");
    READLN(N);
    IF N=0 THEN EXIT FI;
    WRITE(" BOAT CAPACITY=");
    READLN(Q);

    PREF BESTSEARCH BLOCK
    VAR M,C:INTEGER;
      (* M- NUMBER OF MISSIONARIES, C- NUMBER OF CANNIBALS ON THE BOAT *)

      UNIT STATE: EX_NODE CLASS(ML,CL:INTEGER);
      VAR MR,CR:INTEGER, LEFT:BOOLEAN;

	 (* ML- NUMBER OF MISSIONARIES ON THE LEFT BANK OF THE RIVER
	    MR- NUMBER OF MISSIONARIES ON THE RIGHT BANK OF THE RIVER
	    CL- NUMBER OF CANNIBALS ON THE LEFT BANK OF THE RIVER
	    CR- NUMBER OF CANNIBALS ON THE RIGHT BANK OF THE RIVER
	    LEFT- TRUE IFF THE BOAT IS ON THE LEFT BANK OF THE RIVER *)

      UNIT VIRTUAL ANSWER: FUNCTION: BOOLEAN;
      BEGIN
	RESULT:=ML=0 AND CL=0
      END ANSWER;

      UNIT VIRTUAL LEAF: FUNCTION : BOOLEAN;
      BEGIN
	IF  ML<0 ORIF MR<0 ORIF CL<0 ORIF CR<0 ORIF
	    ML>N ORIF MR>N ORIF CL>N ORIF CR>N ORIF
	    ML<CL AND ML>0 ORIF MR<CR AND MR>0
	THEN
	  RESULT:=TRUE
	FI
      END LEAF;


      UNIT VIRTUAL LASTSON: FUNCTION :BOOLEAN;
      BEGIN
	IF C=0 AND M=Q
	THEN
	  RESULT:=TRUE; M:=0; C:=0;
	FI;
      END;

      UNIT VIRTUAL NEXTSON : FUNCTION :STATE;
      BEGIN
	C:=C+1;
	IF M=0
	THEN
	  IF C>Q
	  THEN
	    C:=0; M:=1
	  FI
	ELSE
	  IF M<C ORIF M+C>Q
	  THEN
	    C:=0; M:=M+1;
	  FI
	FI;
	IF LEFT
	THEN
	  IF C+M<Q
	  THEN
	    RESULT:=NONE
	  ELSE
	    RESULT:=NEW STATE(THIS STATE,ML-M,CL-C)
	  FI
	ELSE
	  RESULT:=NEW STATE(THIS STATE,ML+M,CL+C)
	FI;
      END NEXTSON;

      UNIT VIRTUAL EQUAL: FUNCTION(S:STATE):BOOLEAN;
      BEGIN
	RESULT:=LEFT=S.LEFT AND ML=S.ML AND CL=S.CL;
      END EQUAL;

      UNIT VIRTUAL COST: FUNCTION :REAL;
      BEGIN
	RESULT:=LEVEL
      END COST;

      UNIT VIRTUAL LESS: FUNCTION (S:STATE): BOOLEAN;
      BEGIN
	RESULT:=ML+CL<S.ML+S.CL
      END LESS;



    BEGIN
      LEFT:=LEVEL MOD 2 = 0;
      MR:=N-ML; CR:=N-CL;
      RETURN;
      DO
	IF BOOL1 THEN CALL DISPLAY(THIS STATE) FI;
	DETACH;
      OD;
    END STATE;


    UNIT DISPLAY: PROCEDURE(V:STATE);
      VAR J,I:INTEGER, W:STATE,AT: ARRAYOF STATE;
    BEGIN
      IF V=NONE THEN WRITELN(" NO MORE SOLUTIONS"); RETURN FI;
      I:=V.LEVEL;
      ARRAY AT DIM (0:I);
      W:=V;
      FOR J:=I DOWNTO 0
      DO
	AT(J):=W; W:=W.FATHER
      OD;
      WRITELN("MOVE NUMBER    LEFT SIDE  DIRECTION   RIGHT SIDE");
      FOR J:=0 TO I
      DO
	WRITE(J); WRITE("     ");
	W:=AT(J);
	WRITE(W.ML,W.CL,"      ");
	IF W.LEFT
	THEN
	  WRITE("->");
	ELSE
	  WRITE("<-");
	FI;
	WRITELN("    ",W.MR,W.CR);
      OD;
      KILL(AT);
    END DISPLAY;

  VAR BOOL1:BOOLEAN;

  BEGIN
      ROOT:=NEW STATE(NONE,N,N);
      WRITE("DO YOU WANT TO OPTIMIZE ");
      WRITELN("OR TO PRINT ALL THE SOLUTIONS ?");
      WRITELN(" (ANSWER OPT OR ALL)");
      READLN(H1,H2,H3);
      IF H1='O' AND H2='P' AND H3='T'
      THEN
	DO
	  ATTACH(SEARCH);
	  IF FOUND=NONE THEN EXIT FI;
	  IF OPT =/= NONE ANDIF OPT.COST<FOUND.COST
	  THEN
	    EXIT
	  FI;
	OD;
	IF OPT =/= NONE
	THEN
	  CALL DISPLAY(OPT);
	  WRITELN("NUMBER OF NODES=",NUMBER_OF_NODES);
	  WRITELN("NUMBER OF LEAVES=",NUMBER_OF_LEAVES);
	  WRITELN("NUMBER OF ANSWERS=",NUMBER_OF_ANSWERS);
	ELSE
	  WRITELN("NO SOLUTIONS");
	  WRITELN("NUMBER OF NODES=",NUMBER_OF_NODES);
	  WRITELN("NUMBER OF LEAVES=",NUMBER_OF_LEAVES);
	FI;
      ELSE
	IF H1='A' AND H2='L' AND H3='L'
	THEN
	  WRITELN("DO YOU WANT TO PRINT PARTIAL RESULTS?");
	  READLN(H1,H2,H3);
	  IF H1='Y' AND H2='E' AND H3='S'
	  THEN
	    BOOL1:=TRUE
	  FI;
	  DO
	    ATTACH(SEARCH);
	    CALL DISPLAY(FOUND);
	    WRITELN("NUMBER OF NODES=",NUMBER_OF_NODES);
	    WRITELN("NUMBER OF LEAVES=",NUMBER_OF_LEAVES);
	    WRITELN("NUMBER OF ANSWERS=",NUMBER_OF_ANSWERS);
	    IF FOUND=NONE THEN EXIT FI;
	    WRITELN("DO YOU WANT TO CONTINUE?");
	    READ(H1,H2);
	    IF H1=/='Y' ORIF H2=/='E' THEN EXIT FI;
	    READLN(H3);
	    IF H3=/='S' THEN EXIT FI;
	  OD;
	ELSE
	  EXIT
	FI
      FI;
    END;
   OD;

 END;

END