PROGRAM  heap_anwendung_4;{
~~~~~~~~~~~~~~~~~~~~~~~~~~~
Anwendungsbeispiel "Branch & Bound, Überdeckungsproblem",
HMO, Warendorf, Juni 1988 / Dez. 1994

Ein klassisches Überdeckungsproblem: Gegeben sind n Münzen mit den Münzwerten
p1, p2, .. , pn  und ein Betrag b. Gesucht ist eine Möglichkeit, den Be-
trag b mit möglichst wenig Münzen auszuzahlen.}

CONST    nmax        = 30;           {max. Dimension des dynamischen Problems}
TYPE     vorrat      = ARRAY [1..nmax] OF Integer;
         tupel       = ARRAY [0..nmax] OF Integer;

CONST    n_heap      = 500;          {max. Heapgröße}
TYPE     inhalt_heap = RECORD        {Inhalt der Heapknoten incl. Bewertung}
                         wert: Integer;
                         tup : tupel
                       END;

FUNCTION kleinergleich (b,a: inhalt_heap): Boolean;
BEGIN    kleinergleich:=(b.wert<=a.wert)  END;

FUNCTION groessergleich (b,a: inhalt_heap): Boolean;
BEGIN    groessergleich:=(b.wert>=a.wert)  END;

{$I HPADT.PAS}

CONST    unendlich   = Maxint;       {"unendlicher" Wert}
VAR      loesung     : inhalt_heap;  {Lösungstupel für Endergebnis}
         n           : Integer;      {aktuelle Dimension des Problems}
         b           : Integer;      {Begrenzungswert}
         p           : vorrat;       {Vorrat an Objekten}
         i           : Integer;

FUNCTION fbnd (VAR tup: tupel): Integer;
{Boundfunktion; global: "p" mit den Werten der Objekte, Zielwert "b",
 Dimension "n" und Unendlich-Wert "unendlich" ! In "tup[0]" die Stelligkeit.}
VAR i,w,s: Integer;
BEGIN
  w:=0; s:=0;
  FOR i:=1 TO tup[0] DO BEGIN w:=w+tup[i]; s:=s+tup[i]*p[i] END;
  IF s>b
    THEN fbnd:=unendlich
    ELSE BEGIN
      FOR i:=tup[0]+1 TO n DO s:=s+p[i];
      IF s<b THEN  fbnd:=unendlich  ELSE  fbnd:=w
    END
END;

FUNCTION f (VAR tup: tupel): Integer;
{Zielfunktion; im Rückgriff auf die Boundfunktion}
BEGIN  f:=fbnd(tup)  END;

{1}
PROCEDURE loesung_ausgeben (VAR p: vorrat; VAR l: inhalt_heap);
{Die Lösung des Problems wird ausgegeben. }
VAR i: Byte; w: Integer;
BEGIN
  w:=f(l.tup);
  IF w=unendlich
  THEN Writeln(' ':10,'keine Lösung !')
  ELSE BEGIN
    FOR i:=1 TO l.tup[0] DO
      IF l.tup[i]=0 THEN Write(' -  ') ELSE Write(p[i],'  ' );
    Writeln; Writeln('Wert: ',w)
  END
END;

{2}
PROCEDURE branch_and_bound (VAR vorl_opt: inhalt_heap);
{Der eigentliche Algorithmus Branch & Bound wird hier auf ein Minimum-
 Problem in Standardform angewandt.}
CONST auswahlanfang = 0;
      auswahlende   = 1;
VAR   heap          : heap_typ;
      knoten, sohn  : inhalt_heap;
      wahl          : Integer;
BEGIN
  create_heap(heap,min_heap);       {Heap erzeugen}
  knoten.tup[0]:=0;                 {Startknoten Stelligkeit 0}
  knoten.wert:=unendlich;           {Startknoten Boundwert unendlich}
  vorl_opt:=knoten;                 {Startknoten als vorl.Optimum}
  in_heap(heap,knoten);             {Startknoten in den Heap}
  WHILE NOT empty_heap(heap) DO     {Solange Heap nicht leer}
  BEGIN
    best_heap(heap,knoten);         {hole besten Knoten}
    delbest_heap(heap);             {lösche besten Knoten im Heap}
    FOR wahl:=auswahlanfang TO auswahlende DO
    BEGIN                           {bei Bitvekt. anfang=0, ende=1}
      sohn:=knoten;                 {Sohn beerbt den Vater}
      sohn.tup[0]:=sohn.tup[0]+1;   {Sohn hat eine Komponente mehr}
      sohn.tup[sohn.tup[0]]:=wahl;  {neue Komponente wird 0/1-Sohn}
      sohn.wert:=fbnd(sohn.tup);    {Boundwert des Sohns bestimmen}
      IF sohn.wert<vorl_opt.wert    {lebt der Sohn noch ?}
      THEN
        IF sohn.tup[0]=n            {ist der Sohn ein Endknoten ?}
        THEN BEGIN
          vorl_opt:=sohn;           {neues Optimum gefunden}
          clean_heap(heap,vorl_opt) {Heap aufräumen mit Optimalwert}
        END
        ELSE in_heap(heap,sohn)     {der Sohn bleibt leben, in den Heap}
    END {FOR ..}
  END {WHILE ..}
END;

BEGIN
  Writeln('BEISPIEL 4 zum ADT HEAP :  Überdeckungsproblem mit B & B');
  Writeln('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');
  Writeln('Gegeben sind  N  Münzen mit den Werten p1, p2, .. , pn und ein');
  Writeln('Betrag  B. Gesucht ist eine Möglichkeit den Betrag  B  mit mög-');
  Writeln('lichst wenig Münzen auszuzahlen.');
  Writeln;
  Write('Anzahl Objekte  N : '); readln(n);
  Write('Zielwert  B       : '); readln(b);
  FOR i:=1 TO n DO
  BEGIN Write('Vorrat[',i:2,']        : '); readln(p[i]) END;
  Writeln;
  branch_and_bound (loesung);
  loesung_ausgeben (p,loesung)
END.