home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / sonderh1 / dmp2.pas < prev    next >
Pascal/Delphi Source File  |  1986-10-12  |  12KB  |  276 lines
  1. PROGRAM beispiel2 (input, output);
  2. { Dieses Programm demonstriert den Gebrauch von Zeigern anhand einer
  3.   dynamischen, doppelt verketteten Liste. Je nach Kommando wird ein
  4.   Element numerisch eingefuegt, geloescht oder gesucht und ausgegeben. Durch
  5.   explizite Angabe der Datenstruktur, der Ein- und Ausgabe sowie Vergleichs-
  6.   funktionen ist das Programm leicht reellen Anwendungen anpassbar gehalten.  }
  7.  
  8. CONST maxkey = 100;                     { oberer Grenzwert fuer Sortierung }
  9.       minkey = 0;                         { unterer Grenzwert fuer Sortierung }
  10.  
  11. TYPE key = integer;                                { Typ des Schluesselwortes }
  12.  
  13.      information = RECORD                  { Deklaration des Datenteils eines }
  14.                      stichwort : key;      { Eintrags,in der Praxis komplexer,}
  15.                      daten : Char;         { hier jedoch einfach gehalten     }
  16.                    END;
  17.  
  18.      zeiger = ^datensatz;
  19.      datensatz = RECORD             { Deklaration des gesamten Listeneintrags }
  20.                    info: information;               { Informations-/Datenteil }
  21.                    last,                          { Zeiger auf den Vorgaenger }
  22.                    next: zeiger                   { Zeiger auf den Nachfolger }
  23.                  END;
  24.  
  25. VAR frei,                 { Anker der Freiliste, enthaelt geloeschte Elemente }
  26.     liste : zeiger;                                    { Anker der Datenliste }
  27.     stichwort : key;
  28.     befehl : char;
  29.     neuinfo : information;
  30.  
  31. {-----------------------------------------------------------------------------}
  32.  
  33. PROCEDURE init (VAR liste : zeiger);
  34. { Initialiesieren einer neue Liste mit den beiden Grenzeintraegen.            }
  35.  
  36. VAR ende : zeiger;
  37.  
  38. BEGIN
  39.   New (liste);                                           { erstes und letztes }
  40.   New (ende);                                             { Element erzeugen. }
  41.   liste^.info.stichwort := minkey;             { untere und obere Schluessel- }
  42.   ende^.info.stichwort := maxkey;                         { grenze eintragen. }
  43.   liste^.last := nil;                         { 'liste' hat keinen Vorgaenger }
  44.   liste^.next := ende;                           { und 'ende' als Nachfolger. }
  45.   ende^.last := liste;                    { 'ende' hat 'liste' als Vorgaenger }
  46.   ende^.next := nil;                                 { und keinen Nachfolger. }
  47. END; {init}
  48.  
  49. {-----------------------------------------------------------------------------}
  50.  
  51. PROCEDURE info_lesen (sw : key; VAR neuinfo : information);
  52. { Diese Prozedur speichert das eingegebene Stichwort 'sw' in das Stich-
  53.   wortfeld des Datensatzes und liesst die restlichen Daten ein.
  54.   Sie ist entsprechend der Form des Typs 'information' in der Praxis zu
  55.   aendern.                                                                    }
  56.  
  57. BEGIN
  58.   neuinfo.stichwort := sw;
  59.   Write ('Daten (ein Zeichen): ');
  60.   ReadLn (neuinfo.daten);
  61. END; {info_lesen}
  62.  
  63. {-----------------------------------------------------------------------------}
  64.  
  65. PROCEDURE info_schreiben (elem : information);
  66. { Vergleiche 'info_lesen'. }
  67.  
  68. BEGIN
  69.   WriteLn (elem.stichwort:5, '   ', elem.daten);
  70. END; {info_schreiben}
  71.  
  72. {-----------------------------------------------------------------------------}
  73.  
  74. FUNCTION gleich (sw1, sw2 : key) : Boolean;
  75. { Die Funktion ueberprueft die 'Gleichheit' zweier Schluesselwoerter, sie
  76.   kann entsprechend der Anwendung angepasst werden: z.B. koennten gewisse
  77.   Toleranzen, oder bei Zeichenketten Aehnlichkeit bzw. 'Wildcards' zugelassen
  78.   werden.                                                                     }
  79.  
  80. BEGIN
  81.   gleich := (sw1 = sw2);
  82. END; {gleich}
  83.  
  84. {-----------------------------------------------------------------------------}
  85.  
  86. FUNCTION groesser (sw1, sw2 : key) : Boolean;
  87. { Die Funktion ueberpruerft, ob der Schluessel 'sw1' groesser ist als der
  88.   Schluessel 'sw2'. Normalerweise sind hier keine Anpassungen noetig.         }
  89.  
  90. BEGIN
  91.   groesser := (sw1 > sw2);
  92. END; {groesser}
  93.  
  94. {-----------------------------------------------------------------------------}
  95.  
  96. PROCEDURE key_lesen (VAR sw : key);
  97. { Hier wird fuer die Operationen Einfuegen, Loeschen etc. der Suchschluessel
  98.   eingelesen und auf Gueltigkeit geprueft.                                    }
  99.  
  100. VAR key_ok : Boolean;
  101.  
  102. BEGIN
  103.   key_ok := False;
  104.   REPEAT
  105.     Write (' Schluessel (', minkey, '-', maxkey, '):');
  106.     ReadLn (sw);
  107.     IF (groesser (sw, minkey))
  108.     AND (NOT (groesser (sw, maxkey) OR gleich (sw, maxkey))) THEN
  109.       key_ok := True;
  110.   UNTIL key_ok;
  111. END; {key_lesen}
  112.  
  113. {-----------------------------------------------------------------------------}
  114.  
  115. PROCEDURE explicit_dispose (speicher : zeiger);
  116. { Diese Prozedur reiht den Speicherplatz eines Listenelements in die Liste
  117.   der wiederzubelegenden Speicherplaetze ein. Als Parameter wird ein Zeiger
  118.   auf den freizugebenden Speicherplatz benoetigt. Desweiteren muss eine
  119.   Liste 'frei' existieren, die vom gleichen Typ ist.                          }
  120.  
  121. BEGIN
  122.   speicher^.next := frei;   { alten Anfang der Freiliste in Zeigerfeld des
  123.                               freigegebenen Elements eintragen.               }
  124.   frei := speicher;         { freigegebenes Element ist neuer Anfang der
  125.                               Freiliste.                                      }
  126. END; {explicit_dispose}
  127.  
  128. {-----------------------------------------------------------------------------}
  129.  
  130. PROCEDURE explicit_new (VAR speicher : zeiger);
  131. { Diese Prozedur ist aequivalent zu der Standardprozedur 'new', benutzt je-
  132.   doch die mit der Prozedur 'explizit_dispose' in die Freiliste eingereihten
  133.   Speicherplaetze.                                                            }
  134.  
  135. BEGIN
  136.   IF frei = nil THEN              { Freiliste ist noch leer, also mit 'new()' }
  137.     new(speicher)                 { neuen Speicherplatz aus Heap entnehmen.   }
  138.   ELSE
  139.     BEGIN
  140.       speicher := frei;             { andernfalls Speicherplatz aus Freiliste }
  141.       frei := frei^.next;           { entnehmen und aus Freiliste entfernen.  }
  142.     END;
  143. END; {explicit_new}
  144.  
  145. {-----------------------------------------------------------------------------}
  146.  
  147. PROCEDURE suche (liste : zeiger;                     { zu durchsuchende Liste }
  148.                     sw : key;                       { zu suchender Schluessel }
  149.                  VAR last,                { Ergebnisse: Zeiger auf Vorgaenger }
  150.                      elem,                {                "    "  gesuchten  }
  151.                      next : zeiger);      {                "    "  Nachfolger }
  152.  
  153.  
  154. BEGIN
  155.   elem := liste;                       { vom Anfang der Liste aus durchsuchen }
  156.  
  157.   { Solange zum Nachfolger gehen, wie Suchschluessel groesser als gespeicher-
  158.     ter Schluessel ist. Da 'maxkey' im mit 'init' erzeugten, letzten Element
  159.     der Liste als Schluessel nicht erlaubt ist, braucht das Ende der Liste
  160.     (elem = nil) nicht geprueft werden:                                       }
  161.   WHILE groesser (sw, elem^.info.stichwort) DO
  162.     elem := elem^.next;                               { zum Nachfolger gehen. }
  163.  
  164.   last := elem^.last;                             { Vorgaenger zurueck geben. }
  165.   IF gleich(sw, elem^.info.stichwort) THEN   { Wenn gefunden, dann Nachfolger }
  166.     next := elem^.next               { des gefundenen Elements zurueck geben. }
  167.   ELSE
  168.     BEGIN                      { Sonst ist das Element, bei dem die Suche ab- }
  169.       next := elem;            { gebrochen wurde, als Nachfolger zu ueberge-  }
  170.       elem := nil;             { ben und in 'elem' zu vermerken, dass nichts  }
  171.     END;                       { gefunden wurde.                              }
  172. END; {suche}
  173.  
  174. {-----------------------------------------------------------------------------}
  175.  
  176. PROCEDURE einfuegen (VAR liste : zeiger; neukey : key);
  177. { Diese Prozedur generiert einen neuen Speicherplatz, liest die neue Infor-
  178.   mation, sucht die Position, an die der neue Eintrag gehoert und fuegt ihn
  179.   ein.                                                                        }
  180.  
  181. VAR neuelem, vorg, elem, nachf : zeiger;
  182.  
  183. BEGIN
  184.   suche (liste, neukey, vorg, elem, nachf);
  185.   IF elem = nil THEN                         { Eintrag noch nicht vorhanden ! }
  186.     BEGIN
  187.       explicit_new (neuelem);                         { Speicher reservieren. }
  188.       info_lesen (neukey, neuelem^.info);   { Schluessel mit Daten verbinden. }
  189.       neuelem^.next := nachf;                       { In beiden Richtungen in }
  190.       neuelem^.last := vorg;                        { die Liste einketten.    }
  191.       vorg^.next := neuelem;
  192.       nachf^.last := neuelem;
  193.     END
  194.   ELSE
  195.     WriteLn ('*** Eintrag schon vorhanden ! ***');
  196. END; {einfuegen}
  197.  
  198. {-----------------------------------------------------------------------------}
  199.  
  200. PROCEDURE ausgeben (liste : zeiger);
  201. { Die Liste wird wg. des Grenzeintrages ab dem Nachfolger von 'liste' ausge-
  202.   geben.                                                                      }
  203.  
  204. BEGIN
  205.   liste := liste^.next;                            { Grenzeintrag uebergehen. }
  206.   WHILE liste^.info.stichwort <> maxkey DO
  207.     BEGIN
  208.       info_schreiben(liste^.info);                    { gebe Information aus. }
  209.       liste := liste^.next                            { betrachte Nachfolger. }
  210.     END;
  211.   WriteLn;
  212. END; {ausgeben}
  213.  
  214. {-----------------------------------------------------------------------------}
  215.  
  216. PROCEDURE suchen (VAR liste : zeiger; sw : key);
  217. { Diese Prozedur sucht das Stichwort 'sw' und gibt, wenn ein Eintrag gefunden
  218.   wird, den kompletten Datensatz aus.                                         }
  219.  
  220. VAR vorg, nachf, elem: zeiger;
  221.  
  222. BEGIN
  223.   suche (liste, sw, vorg, elem, nachf);
  224.   IF elem = nil THEN
  225.     WriteLn ('*** Eintrag nicht vorhanden ! ***')
  226.   ELSE
  227.     BEGIN
  228.       WriteLn ('Eintrag vorhanden: ');
  229.       info_schreiben (elem^.info);
  230.     END;
  231.   WriteLn;
  232. END; {suchen}
  233.  
  234. {-----------------------------------------------------------------------------}
  235.  
  236. PROCEDURE loeschen (VAR liste : zeiger; sw : key);
  237. { Diese Prozedur loescht das Element mit dem Schluessel 'sw' aus 'liste'. }
  238.  
  239. VAR vorg, elem, nachf : zeiger;
  240.  
  241. BEGIN
  242.   suche (liste, sw, vorg, elem, nachf);
  243.   IF elem <> nil THEN
  244.     BEGIN
  245.       vorg^.next := nachf;               { In beide Richtungen zu loeschendes }
  246.       nachf^.last := vorg;               { Element uebergehen und in          }
  247.       explicit_dispose (elem);           { Freiliste einreihen.               }
  248.     END;
  249. END; {loeschen}
  250.  
  251. {-----------------------------------------------------------------------------}
  252.  
  253. BEGIN {beispiel2}
  254.   WriteLn ('*** dynamische Liste II ***');
  255.   init (liste);                                        { Liste initialisieren }
  256.   frei := nil;                                           { Freiliste ist leer }
  257.   REPEAT
  258.     WriteLn;
  259.     WriteLn ('(+) einfuegen  (-) loeschen  (?) suchen  (!) listen  (#) Ende');
  260.     Write ('>'); ReadLn (befehl); WriteLn;
  261.     IF befehl IN ['+','-','?','!'] THEN
  262.       CASE befehl OF
  263.         '!': ausgeben (liste);
  264.       ELSE
  265.         BEGIN
  266.           key_lesen (stichwort);
  267.           CASE befehl OF
  268.             '+': einfuegen(liste, stichwort);
  269.             '-': loeschen(liste, stichwort);
  270.             '?': suchen(liste, stichwort);
  271.           END;
  272.         END;
  273.       END; {CASE}
  274.   UNTIL befehl='#';
  275. END.
  276.