is-Logo

Dynamische Datenobjekte
Rekursive zeigerverkettete Liste - Quellcode (Auszug)

S. Spolwig

[Home | Algorithmen]

Page down

Der nachfolgende Programmausschnitt zeigt eine (klassische) Deklaration des Listentyps und einige Operationen.

UNIT DLISTEN_1;
(* ******************************************************************** *)
(*                                                                      *)
(* M O D U L     : DLISTEN_1                                            *)
(* -------------------------------------------------------------------- *)
(* Version       : 1.56                              vom: 04-OKT-94     *)
(*                                                                      *)
(* Autor         : S. Spolwig                                           *)
(* Funktion      : Allgemeines dynamisches Listenmodul zur Verwaltung   *)
(*                 beliebiger Datenobjekte. Die Objekte muessen         *)
(*                 importiert und dem Typ TDaten   übergeben werden.    *)
(*                 Zum Bewegen in der Liste ist intern eine Listenmarke *)
(*                 mitgeführt, die die jeweils aktuelle Listenposition  *)
(*                 bezeichnet.                                          *)
(*                                                                      *)
(* Voraussetzung : Der Elementtyp ist importiert.                       *)
(*                                                                      *)
(* Compiler      : MSDOS / TURBO Pascal V. 6.0 / KICK - PASCAL 2.12     *)
(* ******************************************************************** *)
INTERFACE
(* ========================== Export ================================== *)
{USES	  (* import:   *)}
type
   TDaten = string[30] ;     (* muss importiert werden *)
   Telementzeiger  = ^Telemente;
   Telemente = record
		daten     : TDaten;
		naechster : Telementzeiger;
	       end;
   TListen  = record
		liste, 			          (* zeigt auf die Liste  *)
		aktueller : Telementzeiger;	  (* nur zum Durchlaufen, *)
		lilaenge  : integer;		  (* zeigt auf das ak. El.*)
	      end;

IMPLEMENTATION
(* ==================================================================== *)
procedure initialisieren {(var li : TListen)};
(* -------------------------------------------------------------------- *)
(* Effekt : li ist initialisiert. Listenlaenge ist 0; (Liste ist leer)  *)
(* -------------------------------------------------------------------- *)
begin
   with li do
   begin
     liste    := NIL;
     aktueller:= NIL;
     lilaenge := 0;
   end;
end;
function ist_leer {(var li : TListen) : boolean} ;
(* -------------------------------------------------------------------- *)
(*  Voraus: Die Liste ist initialisiert.                                *)
(*  Effekt: True, wenn die Liste leer ist.                              *)
(* -------------------------------------------------------------------- *)
begin
   ist_leer := false;
   with li do
   begin
      if liste = NIL
      then ist_leer := true;
   end; (* with li *)
end;
procedure first {(var li : TListen)};
(* -------------------------------------------------------------------- *)
(*  Zweck  : Listenmarke auf das 1. Element setzen                      *)
(*  Vorauss: Die Liste ist initialisiert und nicht leer                 *)
(*  Effekt : Aktuelle Position ist das erste Elment                     *)
(*           Wenn die Liste leer ist, geschieht nichts                  *)
(* -------------------------------------------------------------------- *)
begin
   if not ist_leer(li)
   then
     with li do
     begin
       aktueller := liste;
     end; (* with li *)
end;
procedure next {(var li : TListen)};
(* -------------------------------------------------------------------- *)
(*  Zweck  : Die Listenmarke auf das naechste Element setzen            *)
(*  Vorauss: Die Liste ist nicht leer                                   *)
(*  Effekt : Die Marke steht auf der neuen aktuellen Position           *)
(*           Wenn die Liste leer ist, geschieht nichts                  *)
(* -------------------------------------------------------------------- *)
begin
   if not ist_leer(li)
   then
      with li do
      begin
        aktueller := aktueller^.naechster
      end; (* with li *)
end;
procedure last {(var li : TListen)};
(* -------------------------------------------------------------------- *)
(*  Zweck  : Listenmarke auf das Ende der Liste setzen                  *)
(*  Vorauss: Die Liste ist nicht leer.                                  *)
(*  Effekt : Letztes vorhandenes Element ist aktuelle Position          *)
(* -------------------------------------------------------------------- *)
begin
   first(li);
   with li do
   begin
     while aktueller^.naechster <> nil do
     begin
       next(li);
     end;
   end; (* with li *)
end;
procedure getdata {(var li : TListen; var da : TDaten)};
(* -------------------------------------------------------------------- *)
(*  Zweck : Zugriff auf das aktuelle Element zum Lesen des Inhalts      *)
(*  Voraus: Die Liste ist nicht leer.                                   *)
(* -------------------------------------------------------------------- *)
begin
   with li do
   begin
     da := aktueller^.daten
   end;
end;
procedure vorsetzen {(var li : TListen; da : TDaten)};
(* -------------------------------------------------------------------- *)
(*  Voraus: Die Liste initialisiert.                                    *)
(*  Effekt: Das neue Element ist an den Anfang der Liste gesetzt. Wenn  *)
(*          die Liste vorher leer war, ist das Element das erste.       *)
(*          Die Listenlaenge ist um eins erhoeht.                       *)
(* -------------------------------------------------------------------- *)
var neuptr : Telementzeiger;
begin
   with li do
   begin
      new(neuptr);
      with neuptr^ do
      begin
	daten     := da;
	naechster := liste;
      end;
      liste:= neuptr;
      aktueller := neuptr;
      inc(lilaenge);
   end; (* with li *)
end;
procedure anhaengen {(var li : TListen; na : TDaten)};
(* -------------------------------------------------------------------- *)
(*  Voraus: Die Liste initialisiert.                                    *)
(*  Effekt: Das neue Element ist ans Ende der Liste angehaengt. Wenn    *)
(*          die Liste vorher leer war, ist das Element das erste.       *)
(*          Die Listenlaenge ist um eins erhoeht.                       *)
(* -------------------------------------------------------------------- *)
var neuptr : Telementzeiger;
begin
   with li do
   begin
     if ist_leer(li)
     then vorsetzen(li,na)
     else
       begin
	 last(li);
	 new(neuptr);
	 with neuptr^ do
	 begin
	   daten := na;
	   naechster := NIL;
	 end;
	 aktueller^.naechster := neuptr;
	 aktueller := aktueller^.naechster;
	 inc(lilaenge);
       end;  (* else *)
   end;  (* with *)
end;
procedure vorne_loeschen {(var li : TListen)};
(* -------------------------------------------------------------------- *)
(*  Zweck : Das erste Element loeschen.                                 *)
(*  Voraus: Die Liste ist nicht leer.                                   *)
(*  Effekt: Das erste Element ist aus der Liste entfernt.               *)
(*          Die Listenlaenge ist um eins vermindert. Ist die Liste leer,*)
(*          geschieht nichts.                                           *)
(* -------------------------------------------------------------------- *)
var hilfptr : Telementzeiger;
begin
   if not ist_leer(li)
   then
      with li do
      begin
	first(li);
	hilfptr := liste;
	liste := hilfptr^.naechster ;
	dispose(hilfptr);
	aktueller := liste;
	dec(lilaenge);
      end;
end;
procedure entfernen {(var li : TListen)};
(* -------------------------------------------------------------------- *)
(*  Zweck : Das aktuelle Element aus der Liste entfernen.               *)
(*  Voraus: Die Liste ist nicht leer. Das aktuelle Element ist definiert*)
(*  Effekt: Das aktuelle Element ist. Die Listenlaenge ist um eins      *)
(*          vermindert.                                                 *)
(* -------------------------------------------------------------------- *)
var hilfptr : Telementzeiger;
begin
   if not ist_leer(li)
   then
    begin
       with li do
       begin
	 if lilaenge = 1			(* es gibt nur eins *)
	 then vorne_loeschen(li)
	 else					(* letztes Element *)
	   if (aktueller^.naechster = NIL) and (lilaenge > 1)
	   then hinten_loeschen(li)
	   else				(* mittendrin *)
	     begin
	     with aktueller^ do
	      begin
		hilfptr   := naechster;  (* zeiger auf naechstes Element *)
		daten     := hilfptr^.daten;	    (* umkopieren *)
		naechster := hilfptr^.naechster;  (* verketten *)
	      end;
	      dispose(hilfptr);                  (* und Folgeelement loe. *)
	      dec(lilaenge);
	     end; (* else mittendrin *)
         end;  (* with li *)
    end;  (* if not *)
end;  (* entfernen *)
END. (* Unit *)

©    20. November 2007    Siegfried Spolwig

Page top