PROGRAM      some_coins_in_a_fountain;  {         "alle Lösungen"
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
HMO ludens, Warendorf, 27.6.1988, ein Beispiel für  BACKTRACKING.

Teilmengenproblem: Gegeben sind N Münzen mit den Münzwerten
p1 , p2 , .. , pN  und ein Betrag B. Gesucht sind alle Möglichkeiten,
den Betrag B mit möglichst wenig Münzen auszuzahlen. Bei dieser
Übungsaufgabe können die Daten eingegeben werden. }

CONST  Nmax          =  50;         { vorgesehen für maximal 50 Münzen }
       auswahlanfang =  0;
       auswahlende   =  1;
TYPE   vektortyp     =  ARRAY [0..Nmax] OF Integer;
       inhaltstyp    =  RECORD      { Typ für einen Listeneintrag }
                          vektor: vektortyp;
                          anzahl: Integer
                        END;
{$I stackadt.pas}
VAR    pvektor       :  ARRAY [1..Nmax] OF Integer; { Werte }
       vektor        :  vektortyp;
       N             :  Integer;    { Anzahl der Münzen }
       B             :  Integer;    { Zielbetrag }
       i             :  Integer;
       akt_optimum   :  Integer;
       loesungen     :  stacktyp;
       eintrag       :  inhaltstyp;

  { T }
  PROCEDURE try (stufe: Integer; vektor: vektortyp);
  VAR wahl,anzahl,wert: Integer;

    { T.1 }
    PROCEDURE vektor_bewerten;
    VAR j: Integer;
    BEGIN
      anzahl:=0; wert:=0;
      FOR j:=1 TO vektor[0]
      DO BEGIN anzahl:=anzahl+vektor[j]; 
               wert:=wert+vektor[j]*pvektor[j] END
    END;

    { T.2 }
    FUNCTION vollstaendig: Boolean;
    BEGIN  vollstaendig := (vektor[0]=N)  END;

    { T.3 }
    FUNCTION neues_optimum: Boolean;
    BEGIN  neues_optimum := (wert=B) AND (anzahl<=akt_optimum)  END;

    { T.4 }
    FUNCTION lebend: Boolean;
    BEGIN  lebend := (anzahl<=akt_optimum) AND (wert<=B)  END;

    { T.5 }
    PROCEDURE loesung_speichern;
    VAR eintrag: inhaltstyp;
    BEGIN
      akt_optimum:=anzahl;
      eintrag.vektor:=v; eintrag.anzahl:=anzahl;
      push_stack(loesungen,eintrag)
    END;

  BEGIN { T }
    FOR wahl:=auswahlanfang TO auswahlende DO
    BEGIN
      vektor[0]:=stufe;        { Stelligkeit setzen }
      vektor[stufe]:=wahl;     { Auswahl wahl für Objekt stufe treffen }
      vektor_bewerten;         { Anzahl der Münzen, Münzwert berechnen }
      IF vollstaendig
        THEN BEGIN  IF neues_optimum THEN  loesung_speichern   END
        ELSE BEGIN  IF lebend        THEN  try(stufe+1,vektor) END
    END
  END;

  PROCEDURE ein (was: String; unten,oben: Integer; VAR wert: Integer);
  VAR s: String[10];
      c: Integer;
  BEGIN
    REPEAT
      write(was);
      readln(s); IF s='' THEN s:='x';
      val(s,wert,c);
    UNTIL (c=0) AND (wert>=unten) AND (wert<=oben)
  END;

BEGIN
  { Überschrift, kurze Hinweise, Eingabe der Daten }
  Writeln; Writeln('BACKTRACKING :  Teilmengenproblem');
           Writeln('---------------------------------');
  Writeln('Gegeben sind N=',n,' Münzen mit beliebigen Werten.');
  Writeln('und ein Zielbetrag B. Gesucht sind alle Möglichkeiten den');
  Writeln('Betrag B mit möglichst wenig Münzen auszuzahlen.'); Writeln;
  ein('Anzahl Münzen  N = ',1,50,N);
  ein('Zielwert       B = ',0,Maxint,B);
  FOR i:=1 TO N DO
  BEGIN write(i:2,'-'); ein('Wert        P = ',0,Maxint,pvektor[i]) END;
  { Initialisierung, Lösungssuche }
  create_stack(loesungen); { Liste für Lösungen initialisieren }
  vektor[0]:=0;            { Start mit 0-stelligem Vektor }
  akt_optimum:=N+1;        { Ergebnis N+1 1 Münzen bedeutet keine Lösung }
  try(1,vektor);           { rekursive Lösungssuche }
  { Ausgabe der Lösungen }
  writeln;
  IF akt_optimum>N
    THEN writeln('keine Lösung !')
    ELSE BEGIN
      WHILE NOT empty_stack(loesungen)
      DO BEGIN
        top_stack(loesungen,eintrag); pop_stack(loesungen);
        IF eintrag.anzahl=akt_optimum
        THEN BEGIN
          FOR i:=1 TO N DO
            IF eintrag.vektor[i]=0 THEN Write('-':6)
                                   ELSE Write(pvektor[i]:6);
          Writeln;
        END
      END
    END
END.