1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:

{******************************************************************************}
{                                                                              }
{                    Skiplist - Version 1.0 (2004-11-22)                       }
{                                                                              }
{                   Copyright (c) 2004 Alexander Schimpf                       }
{                                                                              }
{                              www.hitstec.de                                  }
{                             info@hitstec.de                                  }
{                                                                              }
{******************************************************************************}
unit Skiplist;

interface

uses Classes, Windows, Sysutils, Math, Simplelist;

type
  PSLKnoten = ^TSLKnoten;
  TSLKnoten = record
   Key,Pos: Integer;
   Next: TSimplelist;
   Data: Pointer;
  end;
  TSkiplist = class
  private
   Length,Niveau: Integer;
   procedure setKntData(var pslKnt: PSLKnoten; iKey: Integer; pData: Pointer);
   procedure freeKntData(var pslKnt: PSLKnoten);
   procedure adjustNiveau(var pslKnt: PSLKnoten);
  protected
   Head,Tail: PSLKnoten;
   UpdateList,PushList: TSimplelist;
   function compare(Item1, Item2: Integer): Integer; virtual;
   function compareKnt(Item1: Integer; Item2: PSLKnoten): Integer; virtual;
   function getLabel(Item: Integer): String; virtual;
  public
   CurrentKnt: PSLKnoten;
   property Height: Integer read Niveau;
   constructor Create;
   destructor Destroy; override;
   function insertItem(iKey: Integer; pData: Pointer): Boolean;
   function searchItem(iKey: Integer): Boolean;
   function deleteItem(iKey: Integer): Boolean;
   procedure deleteItems(iKeyFrom,iKeyTo: Integer);
   function emptyList: Boolean;
   function print(iNiveau: Integer=0): String;
   procedure Enumeration;
   function hasElements: Boolean;
  end;

implementation

constructor TSkiplist.Create;
begin
 inherited Create;
 Length:=0;
 Niveau:=0;

 new(Head);
 Head.Next:=TSimplelist.Create;
 Head.Data:=nil;

 new(Tail);
 Tail.Next:=nil;
 Tail.Data:=nil;

 Head.Next.setKtn(0,Tail);

 PushList:=TSimplelist.Create;
 PushList.setKtn(0,Head);

 UpdateList:=TSimplelist.Create;
 CurrentKnt:=Head;
end;

destructor TSkiplist.Destroy;
var pslTmp: PSLKnoten;
begin
 FreeAndNil(UpdateList);
 FreeAndNil(PushList);
 CurrentKnt:=Head.Next.getKtn(0);
 while CurrentKnt<>Tail do begin
  pslTmp:=CurrentKnt;
  CurrentKnt:=CurrentKnt.Next.getKtn(0);
  freeKntData(pslTmp);
 end;
 freeKntData(Tail);
 freeKntData(Head);
 inherited Destroy;
end;

procedure TSkiplist.setKntData(var pslKnt: PSLKnoten; iKey: Integer; pData: Pointer);
begin
 { vorher die Length erhöhen, um bei Pos keine 0 zu bekommen; kritisch bei ln(0) in
   adjustNiveau }
 Inc(Length);
 with pslKnt^ do begin
  Key:=iKey;
  Pos:=Length;
  Next:=TSimplelist.Create;
  Data:=pData;
 end;
end;

procedure TSkiplist.freeKntData(var pslKnt: PSLKnoten);
begin
 FreeAndNil(pslKnt.Next);
 Dispose(pslKnt.Data);
 Dispose(pslKnt);
 pslKnt:=nil;
end;

procedure TSkiplist.adjustNiveau(var pslKnt: PSLKnoten);
var iPos,iNiv,k,iPowered: Integer; rlTmp: Real; pslTmp,pslNext: PSLKnoten;
begin
 iPos:=pslKnt^.Pos;
 { ungerade Zahlen sind auf jeden Fall keine Vielfachen von 2 }
 if (not Odd(iPos)) then begin
  rlTmp:=ln(iPos)/ln(2); //Logarithmus von iPos zur Basis 2
  if rlTmp>Niveau then begin
   iNiv:=Floor(rlTmp);
   if iNiv=rlTmp then begin //true: rlTmp ist ganzzahlig
    Niveau:=iNiv;
    { Head und UpdateList werden in der Höhe (um eins) vergrößert }
    Head.Next.setKtn(Niveau,Tail);
    UpdateList.setKtn(Niveau,Head);
   end;
  end;
 end;

 iPowered:=1;
 for k:=0 to Niveau do begin
  { Im Niveau 0 soll auf jeden Fall operiert werden }
  if k>0 then begin
   iPowered:=iPowered*2; //iPowered=2^k
   if not ((iPos mod iPowered)=0) then break; //true: iPos kein Vielfaches von iPowered
  end;
  { Pre und Next aus UpdateList }
  pslTmp:=UpdateList.getKtn(k);
  pslNext:=pslTmp.Next.getKtn(k);
  { Update des einzufügenden Knotens }
  pslKnt.Next.setKtn(k,pslNext);
  { Update von Next }
  pslTmp.Next.setKtn(k,pslKnt);
  { Update von PushList }
  if pslNext=Tail then PushList.setKtn(k,pslKnt);
 end;
end;

function TSkiplist.insertItem(iKey: Integer; pData: Pointer): Boolean;
var pslNeu: PSLKnoten;
begin
 { Suche nach dem Knoten, füge bei Mißerfolg einen neuen ein }
 Result:=not searchItem(iKey);
 if Result then begin
  new(pslNeu);
  setKntData(pslNeu,iKey,pData);
  adjustNiveau(pslNeu);
  CurrentKnt:=pslNeu;
 end;
end;

function TSkiplist.searchItem(iKey: Integer): Boolean;
var iNiveauTmp,i: Integer; pslNext: PSLKnoten;
begin
 Result:=false;
 UpdateList.Clear;
 UpdateList.setKtn(Niveau,Head);

 if compareKnt(iKey,PushList.getKtn(0))>0 then begin
  { entspricht pushTail bei insertItem }
  for i:=Niveau downto 0 do UpdateList.setKtn(i,PushList.getKtn(i));
  CurrentKnt:=Tail;
 end else if compareKnt(iKey,Head.Next.getKtn(0))<0 then begin
  { entspricht pushHead bei insertItem }
  for i:=Niveau downto 0 do UpdateList.setKtn(i,Head);
  CurrentKnt:=Head.Next.getKtn(0);
 end else begin
  CurrentKnt:=Head;
  iNiveauTmp:=Niveau;

  while true do begin
   pslNext:=CurrentKnt.Next.getKtn(iNiveauTmp);
   if compareKnt(iKey,pslNext)<0 then begin
    UpdateList.setKtn(iNiveauTmp,CurrentKnt);
    if iNiveauTmp=0 then begin //true: Knoten wurde nicht gefunden
     CurrentKnt:=pslNext;
     break;
    end;
    Dec(iNiveauTmp);
   end else if compareKnt(iKey,pslNext)>0 then begin
    CurrentKnt:=pslNext;
   end else begin
    { Knoten wurde gefunden }
    CurrentKnt:=pslNext;
    Result:=true;
    break;
   end;
  end;

 end;
end;

function getKntNiveau(iPos: Integer): Integer;
{ Errechnet aus der Position eines Knotens seine eigentlich Höhe-1; die Variable
  Knt.Next.Count kann dazu nicht verwendet werden, da Next nach der
  Expansionsstrategie funktioniert }
var iPow: Integer;
begin
 Result:=0;
 iPow:=2;
 while (iPos mod iPow)=0 do begin
  iPow:=iPow*2;
  Inc(Result);
 end;
end;

function TSkiplist.deleteItem(iKey: Integer): Boolean;
var pslPred,pslNext: PSLKnoten; k: Integer;
begin
 { Suche nach dem Knoten und lösche ihn bei Erfolg }
 Result:=not searchItem(iKey);
 if not Result then begin
  pslNext:=Head;
  for k:=getKntNiveau(CurrentKnt.Pos) downto 0 do begin
   { Ermittle Pred und Next von Knoten(iKey) }
   pslPred:=UpdateList.getKtn(k);
   { pslPred ist nil falls die Suche schon in einem höheren Niveau aufhört }
   if pslPred=nil then begin
    pslPred:=UpdateList.getKtn(k+1);
    while pslPred.Next.getKtn(k)<>CurrentKnt do pslPred:=pslPred.Next.getKtn(k);
    UpdateList.setKtn(k,pslPred);
   end;
   pslNext:=CurrentKnt.Next.getKtn(k);
   { Lösche Knoten durch Umsetzen von Next }
   pslPred.Next.setKtn(k,pslNext);
  end;
  { Speicher freigeben }
  freeKntData(CurrentKnt);
  Dec(Length);
  CurrentKnt:=pslNext;
 end;
end;

procedure TSkiplist.deleteItems(iKeyFrom,iKeyTo: Integer);
var pslNext: PSLKnoten;
begin
 if iKeyFrom=iKeyTo then deleteItem(iKeyFrom)
 else if (compare(iKeyFrom,iKeyTo)<0) and (compareKnt(iKeyTo,PSLKnoten(Head.Next.getKtn(0)))>=0) and (compareKnt(iKeyFrom,PushList.getKtn(0))<=0) then begin
  { Suche nach iKeyFrom, dann iNextKey das 1. zu löschende Element, das größte
    Element, das unterhalb des zu löschenden Intervalls liegt oder das kleinste
    Element, das sich oberhalb des Intervalls befindet }
  searchItem(iKeyFrom);
  pslNext:=CurrentKnt; 

  while compareKnt(iKeyTo,pslNext)>=0 do begin
   deleteItem(pslNext.Key);
   pslNext:=CurrentKnt; //CurrentKnt ist gerade der Nachfolger des gelöschten Knt
  end;

 end;
end;

function TSkiplist.emptyList: Boolean;
begin
 Result:=(Length=0);
end;

function TSkiplist.print(iNiveau: Integer=0): String;
begin
 Result:='[';
 CurrentKnt:=Head.Next.getKtn(iNiveau);
 while CurrentKnt<>Tail do begin
  Result:=Result+getLabel(CurrentKnt^.Key)+',';
  CurrentKnt:=CurrentKnt.Next.getKtn(iNiveau);
 end;
 if not emptyList then Result:=Copy(Result,1,System.Length(Result)-1);
 Result:=Result+']';
end;

procedure TSkiplist.Enumeration;
begin
 CurrentKnt:=Head;
end;

function TSkiplist.hasElements: Boolean;
begin
 CurrentKnt:=CurrentKnt.Next.getKtn(0);
 Result:=CurrentKnt<>Tail;
end;

function TSkiplist.compare(Item1,Item2: Integer): Integer;
begin
 Result:=Item1-Item2;
end;

function TSkiplist.compareKnt(Item1: Integer; Item2: PSLKnoten): Integer;
begin
 if Item2=Tail then Result:=-1
 else if Item2=Head then Result:=1
 else Result:=compare(Item1,Item2.Key);
end;

function TSkiplist.getLabel(Item: Integer): String;
begin
 Result:=IntToStr(Item);
end;

end.					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:

{******************************************************************************}
{                                                                              }
{                   Simplelist - Version 1.0 (2004-11-22)                      }
{                                                                              }
{                   Copyright (c) 2004 Alexander Schimpf                       }
{                                                                              }
{                              www.hitstec.de                                  }
{                             info@hitstec.de                                  }
{                                                                              }
{******************************************************************************}
unit Simplelist;

interface

type
  TArOfPoint = Array of Pointer;
  TSimplelist = class
  protected
   Pointers: TArOfPoint;
  public
   constructor Create;
   destructor Destroy; override;
   function getKtn(iPos: Integer): Pointer;
   procedure setKtn(iPos: Integer; pData: Pointer);
   procedure Clear;
   function Count: Integer;
  end;

implementation

constructor TSimplelist.Create;
begin
 inherited Create;
 SetLength(Pointers,0);
end;

destructor TSimplelist.Destroy;
begin
 Clear;
 inherited Destroy;
end;

function TSimplelist.getKtn(iPos: Integer): Pointer;
begin
 if iPos<Length(Pointers) then Result:=Pointers[iPos]
 else Result:=nil;
end;

procedure TSimplelist.setKtn(iPos: Integer; pData: Pointer);
begin
 // Expansionsstrategie
 if iPos>=Length(Pointers) then SetLength(Pointers,2*iPos+1);
 Pointers[iPos]:=pData;
end;

procedure TSimplelist.Clear;
begin
 SetLength(Pointers,0);
end;

function TSimplelist.Count: Integer;
begin
 Result:=Length(Pointers);
end;

end.