Help needed with Pointers/Lists
The Lurker
i am in need of sample code that shows how to add/move/delete/sort a
linked list. and if it is not a lot of extra trouble how to do the same
with a double linked list.
thanks in advance
please email to the address below of post a reply to the group for me and
other to see and use.
--
___ ______ ___________________
\ \ / /\ \ / /|__ __|__ __|
\ \ /\ / / \ \ / / | | | |
\ \/ \/ / \ \/ / __| |__ | |
\___/\___/ \____/ |_______| |_|
West Virginia Institute of Technology
bmcc...@olie.wvitcoe.wvnet.edu
Brian McClure
Amateur Radio Call: N8PQI
Roger Kurrat
>please help, i am having difficulty in getting linked listes to work right.
>i am in need of sample code that shows how to add/move/delete/sort a
>linked list.
Hi,
I have written a unit which implements a linked list object.
Look at the source to see how to add,delete,find,... entries.
The object also implements a very fast sorting algorithm which
(after my benchmarks) is faster than then well known quicksort.
Roger
------- unit fastsort ------------------------
Unit FastSort;
{ Das Modul braucht eine asymetrische Sortierfunktion, }
{ welche beim Init-Aufruf angegeben werden muss. }
{ Die Funktion muss mit $F+ compilliert werden !!! }
{ Init definiert die Sortierfunktion. }
{ Wenn ListeLoesche=true ist, loescht Init eine evtl. }
{ vorhandene Liste. Sonst wird der Listenzeiger auf }
{ den Anfang der Liste zurueckgesetzt. }
{ Clear loescht eine vorhandene Liste. }
{ Reset setzt den Listenzeiger auf den Anfang der Liste }
{ Add fuegt ein zu sortierendes Element in die Liste }
{ Get holt ein Element von der Liste }
{ GetIDX holt das Element IDX von der Liste }
{ Delete loescht einen Eintrag aus der Liste, angegeben }
{ durch den Index }
{ Change tauscht den Eintrag (Index) aus }
{ Count gibt die Anzahl an Eintraegen }
{ Find sucht einen eintrag und gibt den index zurueck }
{ wenn nicht gefunden ist sorterror=true }
{ sortieren sortiert die Liste }
{ empty wirt true, wenn die Liste leer ist }
{ Es darf nur der Type SortObject benutzt werden !!! }
{ Variablen dieses Typs muessen mit NEW (Variable,StartUp) }
{ erzeugt werden !!! }
{ Variablen muessen mit DISPOSE (Variable,clear) geloescht }
{ werden. }
{ eg. }
{ .... }
{ var liste : SortObject; }
{ s : string; }
{ begin }
{ new(liste,startup); }
{ liste^.add(s,sizeof(s)); }
{ dispose(liste,clear); }
{ end. }
INTERFACE
Type SortRelation = Function (var x,y):boolean;
type SortObjectListe = ^SortObjectKopf;
SortObjectKopf = record
inhalt : pointer;
size : word;
rest : SortObjectListe;
end;
SortObjectListen= record
anfang, aktuell, ende : SortObjectListe;
end;
Type SortObject = ^SortObjects;
SortObjects = object
SortError : boolean;
RelationDa : boolean;
less : SortRelation;
SortList : SortObjectListen;
constructor StartUp;
procedure init (relation:SortRelation; ListeLoeschen:boolean);
procedure sort;
procedure add (var v; size:word);
procedure get (var v);
Procedure GetIDX (idx:word; var v);
procedure delete (idx:word);
procedure change (idx:word; var v; size:word);
function empty:boolean;
function GetIndexPointer (idx:word):SortObjectListe;
function Count:word;
destructor clear;
Function Find (var V):word;
procedure Reset;
procedure insert (idx:word; var v; size:word);
end;
Function SortDummy (var x,y):boolean;
IMPLEMENTATION
const reserve = 4000;
{$F+}
Function SortDummy;
begin SortDummy:=false end;
{$F-}
procedure anhaengen (var l:SortObjectListen; p:SortObjectListe);
begin
if l.anfang=nil
then begin l.anfang:=p; l.ende:=p end
else begin l.ende^.rest:=p; l.ende:=p end;
end;
procedure append (l1,l2:SortObjectListen; var l:SortObjectListen);
begin
if l1.anfang=nil then l:=l2 else
if l2.anfang=nil then l:=l1
else begin
l.anfang:=l1.anfang;
l1.ende^.rest:=l2.anfang;
l.ende:=l2.ende;
end;
end;
constructor SortObjects.StartUp;
begin
SortError:=false;
RelationDa:=false;
SortList.Anfang:=nil;
init (SortDummy,false);
end;
procedure SortObjects.sort;
procedure MachMitte (var l:SortObjectListen; var M:SortObjectListe);
var p : SortObjectListe;
w : boolean;
begin
w:=true;
p:=l.anfang; m:=p;
while p<>nil do begin
p:=p^.rest; w:=not w;
if w and (p<>nil) then m:=m^.rest;
end;
end;
procedure sortieren (var l:SortObjectListen);
var l1,l2 : SortObjectListen;
mitte : SortObjectListe;
begin
if (l.anfang<>nil) and (l.anfang^.rest<>nil)
then begin
if l.anfang^.rest^.rest<>nil then begin
MachMitte (l,mitte);
l1.anfang:=l.anfang; l1.ende:=mitte;
l2.anfang:=mitte^.rest; l2.ende:=l.ende;
l1.ende^.rest:=nil;
sortieren (l1); sortieren (l2);
l.anfang:=nil;
while (l1.anfang<>nil) and (l2.anfang<>nil) do begin
if less(l1.anfang^.inhalt^,l2.anfang^.inhalt^)
then begin anhaengen (l,l1.anfang); l1.anfang:=l1.anfang^.rest end
else begin anhaengen (l,l2.anfang); l2.anfang:=l2.anfang^.rest end;
end;
if l1.anfang=nil then append (l,l2,l) else append (l,l1,l);
l.ende^.rest:=nil;
end
else begin
if less (l.ende^.inhalt^,l.anfang^.inhalt^) then begin
l.ende^.rest:=l.anfang; l.anfang:=l.ende;
l.ende:=l.anfang^.rest; l.ende^.rest:=nil;
end;
end;
end; {if}
end; {sort}
begin {sortieren}
if not RelationDa then exit;
sortieren (sortlist); sortlist.aktuell:=sortlist.anfang;
end;
destructor SortObjects.clear;
var p : SortObjectListe;
begin
while sortlist.anfang<>nil do begin
p:=sortlist.anfang;
sortlist.anfang:=sortlist.anfang^.rest;
freemem (p^.inhalt,p^.size);
freemem(p,sizeof(p^));
end;
sortlist.aktuell:=nil;
sorterror:=false;
end;
procedure SortObjects.Reset;
begin
sortlist.aktuell:=sortlist.anfang;
sorterror:=false;
end;
procedure SortObjects.init;
begin
less:=relation;
RelationDa:=true;
if ListeLoeschen
then clear
else reset;
sorterror:=false;
end;
procedure SortObjects.add;
var p : SortObjectListe;
begin
if not RelationDa then exit;
if maxavail>reserve+sizeof(p^)+size
then begin
getmem (p,sizeof(p^));
getmem (p^.inhalt,size);
end else begin sorterror:=true; exit end;
move (v,p^.inhalt^,size);
p^.size:=size;
p^.rest:=nil;
anhaengen (sortlist,p);
end;
procedure SortObjects.get;
begin
if not RelationDa then exit;
if sortlist.aktuell<>nil then begin
move (sortlist.aktuell^.inhalt^,v,sortlist.aktuell^.size);
sortlist.aktuell:=sortlist.aktuell^.rest;
sorterror:=false;
end else sorterror:=true;
end;
procedure SortObjects.GetIDX;
var sol : SortObjectListe;
begin
sol:=GetIndexPointer(idx);
if sol<>nil then move (sol^.inhalt^,v,sol^.size)
else sorterror:=true;
end;
procedure SortObjects.Insert;
var p : SortObjectListe;
sol : SortObjectListe;
begin
if not RelationDa then exit;
if maxavail>reserve+sizeof(p^)+size
then begin
getmem (p,sizeof(p^));
getmem (p^.inhalt,size);
end else begin sorterror:=true; exit end;
move (v,p^.inhalt^,size);
p^.size:=size;
p^.rest:=nil;
if idx<=1 then begin
p^.rest:=sortlist.anfang;
sortlist.anfang:=p;
end
else begin
sol:=GetIndexPointer(idx-1);
if sol=nil then anhaengen (sortlist,p)
else begin
p^.rest:=sol^.rest;
sol^.rest:=p;
end;
end;
Sortlist.aktuell:=sortlist.anfang;
end;
Function SortObjects.Find;
var idx : word;
begin
sorterror:=true;
Find:=0; idx:=1;
sortlist.aktuell:=sortlist.anfang;
if not RelationDa then exit;
while sortlist.aktuell<>nil do begin
if less(sortlist.aktuell^.inhalt^,v) then begin
inc(idx);
sortlist.aktuell:=sortlist.aktuell^.rest;
end
else begin
if less(V,sortlist.aktuell^.inhalt^) then begin
{ gesuchte Variable ist nicht vorhanden }
Find:=idx;
exit;
end
else begin
{ gefunden }
sorterror:=false;
Find:=idx;
exit;
end
end;
end;
end;
Function SortObjects.GetIndexPointer;
Var p : SortObjectListe;
i : word;
begin
p:=sortlist.anfang;
i:=idx-1;
while (p<>nil) and (i>0) do begin p:=p^.rest; dec(i) end;
GetIndexPointer:=p;
end;
procedure SortObjects.delete;
var p,p0 : SortObjectListe;
begin
if idx>1 then p0:=GetIndexPointer (idx-1) else p0:=nil;
p:=GetIndexPointer (idx);
if p=nil then exit;
if idx=1 then sortlist.anfang:=p^.rest;
if p=sortlist.ende then sortlist.ende:=p0;
if p0<>nil then p0^.rest:=p^.rest;
freemem (p^.inhalt,p^.size);
freemem(p,sizeof(p^));
Sortlist.aktuell:=sortlist.anfang;
end;
procedure SortObjects.change;
var p : SortObjectListe;
begin
p:=GetIndexPointer (idx);
if p=nil then exit;
if p^.size=size then move (v,p^.inhalt^,size)
else begin
freemem (p^.inhalt,p^.size);
getmem (p^.inhalt,size);
move (v,p^.inhalt^,size);
p^.size:=size;
end;
end;
function SortObjects.empty;
begin
empty:=sortlist.aktuell=nil;
end;
function SortObjects.Count;
var p : SortObjectListe;
i : word;
begin
i:=0;
p:=sortlist.anfang;
while p<>nil do begin inc(i); p:=p^.rest end;
Count:=i;
end;
end.
----------- end of unit ----------------------------------