Turbo Toolbox/Turbo_Toolbox.iso/sonderh1/dmp2.pas

Pascal/Delphi Source File | 1986-10-12 | 11.2 KB | 276 lines

PROGRAM beispiel2 (input, output);
{ Dieses Programm demonstriert den Gebrauch von Zeigern anhand einer
  dynamischen, doppelt verketteten Liste. Je nach Kommando wird ein
  Element numerisch eingefuegt, geloescht oder gesucht und ausgegeben. Durch
  explizite Angabe der Datenstruktur, der Ein- und Ausgabe sowie Vergleichs-
  funktionen ist das Programm leicht reellen Anwendungen anpassbar gehalten.  }

CONST maxkey = 100;                     { oberer Grenzwert fuer Sortierung }
      minkey = 0;                         { unterer Grenzwert fuer Sortierung }

TYPE key = integer;                                { Typ des Schluesselwortes }

     information = RECORD                  { Deklaration des Datenteils eines }
                     stichwort : key;      { Eintrags,in der Praxis komplexer,}
                     daten : Char;         { hier jedoch einfach gehalten     }
                   END;

     zeiger = ^datensatz;
     datensatz = RECORD             { Deklaration des gesamten Listeneintrags }
                   info: information;               { Informations-/Datenteil }
                   last,                          { Zeiger auf den Vorgaenger }
                   next: zeiger                   { Zeiger auf den Nachfolger }
                 END;

VAR frei,                 { Anker der Freiliste, enthaelt geloeschte Elemente }
    liste : zeiger;                                    { Anker der Datenliste }
    stichwort : key;
    befehl : char;
    neuinfo : information;

{-----------------------------------------------------------------------------}

PROCEDURE init (VAR liste : zeiger);
{ Initialiesieren einer neue Liste mit den beiden Grenzeintraegen.            }

VAR ende : zeiger;

BEGIN
  New (liste);                                           { erstes und letztes }
  New (ende);                                             { Element erzeugen. }
  liste^.info.stichwort := minkey;             { untere und obere Schluessel- }
  ende^.info.stichwort := maxkey;                         { grenze eintragen. }
  liste^.last := nil;                         { 'liste' hat keinen Vorgaenger }
  liste^.next := ende;                           { und 'ende' als Nachfolger. }
  ende^.last := liste;                    { 'ende' hat 'liste' als Vorgaenger }
  ende^.next := nil;                                 { und keinen Nachfolger. }
END; {init}

{-----------------------------------------------------------------------------}

PROCEDURE info_lesen (sw : key; VAR neuinfo : information);
{ Diese Prozedur speichert das eingegebene Stichwort 'sw' in das Stich-
  wortfeld des Datensatzes und liesst die restlichen Daten ein.
  Sie ist entsprechend der Form des Typs 'information' in der Praxis zu
  aendern.                                                                    }

BEGIN
  neuinfo.stichwort := sw;
  Write ('Daten (ein Zeichen): ');
  ReadLn (neuinfo.daten);
END; {info_lesen}

{-----------------------------------------------------------------------------}

PROCEDURE info_schreiben (elem : information);
{ Vergleiche 'info_lesen'. }

BEGIN
  WriteLn (elem.stichwort:5, '   ', elem.daten);
END; {info_schreiben}

{-----------------------------------------------------------------------------}

FUNCTION gleich (sw1, sw2 : key) : Boolean;
{ Die Funktion ueberprueft die 'Gleichheit' zweier Schluesselwoerter, sie
  kann entsprechend der Anwendung angepasst werden: z.B. koennten gewisse
  Toleranzen, oder bei Zeichenketten Aehnlichkeit bzw. 'Wildcards' zugelassen
  werden.                                                                     }

BEGIN
  gleich := (sw1 = sw2);
END; {gleich}

{-----------------------------------------------------------------------------}

FUNCTION groesser (sw1, sw2 : key) : Boolean;
{ Die Funktion ueberpruerft, ob der Schluessel 'sw1' groesser ist als der
  Schluessel 'sw2'. Normalerweise sind hier keine Anpassungen noetig.         }

BEGIN
  groesser := (sw1 > sw2);
END; {groesser}

{-----------------------------------------------------------------------------}

PROCEDURE key_lesen (VAR sw : key);
{ Hier wird fuer die Operationen Einfuegen, Loeschen etc. der Suchschluessel
  eingelesen und auf Gueltigkeit geprueft.                                    }

VAR key_ok : Boolean;

BEGIN
  key_ok := False;
  REPEAT
    Write (' Schluessel (', minkey, '-', maxkey, '):');
    ReadLn (sw);
    IF (groesser (sw, minkey))
    AND (NOT (groesser (sw, maxkey) OR gleich (sw, maxkey))) THEN
      key_ok := True;
  UNTIL key_ok;
END; {key_lesen}

{-----------------------------------------------------------------------------}

PROCEDURE explicit_dispose (speicher : zeiger);
{ Diese Prozedur reiht den Speicherplatz eines Listenelements in die Liste
  der wiederzubelegenden Speicherplaetze ein. Als Parameter wird ein Zeiger
  auf den freizugebenden Speicherplatz benoetigt. Desweiteren muss eine
  Liste 'frei' existieren, die vom gleichen Typ ist.                          }

BEGIN
  speicher^.next := frei;   { alten Anfang der Freiliste in Zeigerfeld des
                              freigegebenen Elements eintragen.               }
  frei := speicher;         { freigegebenes Element ist neuer Anfang der
                              Freiliste.                                      }
END; {explicit_dispose}

{-----------------------------------------------------------------------------}

PROCEDURE explicit_new (VAR speicher : zeiger);
{ Diese Prozedur ist aequivalent zu der Standardprozedur 'new', benutzt je-
  doch die mit der Prozedur 'explizit_dispose' in die Freiliste eingereihten
  Speicherplaetze.                                                            }

BEGIN
  IF frei = nil THEN              { Freiliste ist noch leer, also mit 'new()' }
    new(speicher)                 { neuen Speicherplatz aus Heap entnehmen.   }
  ELSE
    BEGIN
      speicher := frei;             { andernfalls Speicherplatz aus Freiliste }
      frei := frei^.next;           { entnehmen und aus Freiliste entfernen.  }
    END;
END; {explicit_new}

{-----------------------------------------------------------------------------}

PROCEDURE suche (liste : zeiger;                     { zu durchsuchende Liste }
                    sw : key;                       { zu suchender Schluessel }
                 VAR last,                { Ergebnisse: Zeiger auf Vorgaenger }
                     elem,                {                "    "  gesuchten  }
                     next : zeiger);      {                "    "  Nachfolger }


BEGIN
  elem := liste;                       { vom Anfang der Liste aus durchsuchen }

  { Solange zum Nachfolger gehen, wie Suchschluessel groesser als gespeicher-
    ter Schluessel ist. Da 'maxkey' im mit 'init' erzeugten, letzten Element
    der Liste als Schluessel nicht erlaubt ist, braucht das Ende der Liste
    (elem = nil) nicht geprueft werden:                                       }
  WHILE groesser (sw, elem^.info.stichwort) DO
    elem := elem^.next;                               { zum Nachfolger gehen. }

  last := elem^.last;                             { Vorgaenger zurueck geben. }
  IF gleich(sw, elem^.info.stichwort) THEN   { Wenn gefunden, dann Nachfolger }
    next := elem^.next               { des gefundenen Elements zurueck geben. }
  ELSE
    BEGIN                      { Sonst ist das Element, bei dem die Suche ab- }
      next := elem;            { gebrochen wurde, als Nachfolger zu ueberge-  }
      elem := nil;             { ben und in 'elem' zu vermerken, dass nichts  }
    END;                       { gefunden wurde.                              }
END; {suche}

{-----------------------------------------------------------------------------}

PROCEDURE einfuegen (VAR liste : zeiger; neukey : key);
{ Diese Prozedur generiert einen neuen Speicherplatz, liest die neue Infor-
  mation, sucht die Position, an die der neue Eintrag gehoert und fuegt ihn
  ein.                                                                        }

VAR neuelem, vorg, elem, nachf : zeiger;

BEGIN
  suche (liste, neukey, vorg, elem, nachf);
  IF elem = nil THEN                         { Eintrag noch nicht vorhanden ! }
    BEGIN
      explicit_new (neuelem);                         { Speicher reservieren. }
      info_lesen (neukey, neuelem^.info);   { Schluessel mit Daten verbinden. }
      neuelem^.next := nachf;                       { In beiden Richtungen in }
      neuelem^.last := vorg;                        { die Liste einketten.    }
      vorg^.next := neuelem;
      nachf^.last := neuelem;
    END
  ELSE
    WriteLn ('*** Eintrag schon vorhanden ! ***');
END; {einfuegen}

{-----------------------------------------------------------------------------}

PROCEDURE ausgeben (liste : zeiger);
{ Die Liste wird wg. des Grenzeintrages ab dem Nachfolger von 'liste' ausge-
  geben.                                                                      }

BEGIN
  liste := liste^.next;                            { Grenzeintrag uebergehen. }
  WHILE liste^.info.stichwort <> maxkey DO
    BEGIN
      info_schreiben(liste^.info);                    { gebe Information aus. }
      liste := liste^.next                            { betrachte Nachfolger. }
    END;
  WriteLn;
END; {ausgeben}

{-----------------------------------------------------------------------------}

PROCEDURE suchen (VAR liste : zeiger; sw : key);
{ Diese Prozedur sucht das Stichwort 'sw' und gibt, wenn ein Eintrag gefunden
  wird, den kompletten Datensatz aus.                                         }

VAR vorg, nachf, elem: zeiger;

BEGIN
  suche (liste, sw, vorg, elem, nachf);
  IF elem = nil THEN
    WriteLn ('*** Eintrag nicht vorhanden ! ***')
  ELSE
    BEGIN
      WriteLn ('Eintrag vorhanden: ');
      info_schreiben (elem^.info);
    END;
  WriteLn;
END; {suchen}

{-----------------------------------------------------------------------------}

PROCEDURE loeschen (VAR liste : zeiger; sw : key);
{ Diese Prozedur loescht das Element mit dem Schluessel 'sw' aus 'liste'. }

VAR vorg, elem, nachf : zeiger;

BEGIN
  suche (liste, sw, vorg, elem, nachf);
  IF elem <> nil THEN
    BEGIN
      vorg^.next := nachf;               { In beide Richtungen zu loeschendes }
      nachf^.last := vorg;               { Element uebergehen und in          }
      explicit_dispose (elem);           { Freiliste einreihen.               }
    END;
END; {loeschen}

{-----------------------------------------------------------------------------}

BEGIN {beispiel2}
  WriteLn ('*** dynamische Liste II ***');
  init (liste);                                        { Liste initialisieren }
  frei := nil;                                           { Freiliste ist leer }
  REPEAT
    WriteLn;
    WriteLn ('(+) einfuegen  (-) loeschen  (?) suchen  (!) listen  (#) Ende');
    Write ('>'); ReadLn (befehl); WriteLn;
    IF befehl IN ['+','-','?','!'] THEN
      CASE befehl OF
        '!': ausgeben (liste);
      ELSE
        BEGIN
          key_lesen (stichwort);
          CASE befehl OF
            '+': einfuegen(liste, stichwort);
            '-': loeschen(liste, stichwort);
            '?': suchen(liste, stichwort);
          END;
        END;
      END; {CASE}
  UNTIL befehl='#';
END.