Открытое Хеширование

  • Автор темы wanty
  • Дата начала
W

wanty

#1
Возникла проблема с открытым хеширование, подскажите пожалуйста в чём ошибка? выводит постоянно только две похожие записи, больше двух не тянет почему-то.
delphi Код:

Код:
unit Unit1;
.
.
.
.
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Memo3: TMemo;
Button3: TButton;
Edit1: TEdit;
Label1: TLabel;
Memo2: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
HashK:Hash1;
Kstr,m:Integer;
zapp:String;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
zn:znach;
Znach:Elem;
K_si,i:Integer;
K:Integer;
pn:Boolean;

begin
hashk:=Hash1.Create;
memo3.Clear;
Kstr:=Memo1.Lines.Count;
m:=Kstr;
hashk.m:=m;
setlength(Hashk.T,m+1);
setlength(Hashk.T1,m+3);
for I:=0 to m do Hashk.T[I]:=nil;
For i:=1 to Kstr do begin //
zn.zap:=Memo1.Lines[i-1];
zapp:=zn.Zap;
K_si:=Length(zn.zap);
zn.kl:='';
HashK.Kl_Vid(zn.zap,K_si,zn.kl);
K:=HashK.OprCodKl(zn.kl);
Znach.Key:=k;
Znach.Zap:=Memo1.Lines[i-1];
Hashk.T1[i]:=Hashk.FormHtc(k,pn,zapp);
if Hashk.T1[i]^.zap='' then memo3.lines.add('------') else
memo3.lines.add(Hashk.T1[i]^.zap);
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var Kluch1,s:String;
k:Integer;
FindHTC:Pelem;
P : pPair;

begin
s:='';
memo2.Clear;
Kluch1:=edit1.text;
K:=Hashk.OprCodKl(Kluch1);
P:=hashk.T[hashk.Hash(K)];
while P <> nil do
if P^.ELE^.Key = K then begin 
FindHTC:=P^.ELE;
s:='"'+S+FindHtc^.Zap;
if P^.nxt<>nil then begin
repeat
P:=P^.NXT;
FindHtc:=P^.ELE;
S:=S+ '" '+FindHtc^.Zap+' "';
until P<>nil;
end;
memo2.lines.add('записи имеют вид: '+s);
Exit
end				else P:=P^.NXT;
FindHTC:=nil;
if FindHtc=nil then begin memo2.lines.add('Записи с ключём "'+Kluch1+'" нету в хеш- таблице');exit;end;

end;

end.






unit Unit2;

interface
type
Znach=record Kl:String; Zap:String; end;
Type pElem = ^Elem;
Elem = record Key : integer; Zap:string; end;
pPair = ^Pair;
Pair = record ELE : pElem;
NXT : pPair  end;
Hash1=class
T : array of pPair;
T1 : array of pElem;
Bi,m:Integer;
PP:integer;
Function OprCodkl(Kluch:string):Integer;
Procedure Kl_Vid(S:String;const K_si:Integer;Var Kluch:String);
function Hash(K : integer) : integer;
function FindHTC(K : integer) : pElem;
function FormHTC(K : integer; var pN : boolean;zapp:string) : pElem;
end;
implementation

{ Hash1 }

function Hash1.FindHTC(K: integer): pElem;
var P : pPair;
begin  P:=T[Hash(K)];
while P <> nil do
if P^.ELE^.Key = K then begin 
FindHTC:=P^.ELE;
Exit
end				else P:=P^.NXT;
FindHTC:=nil
end;

function Hash1.FormHTC(K: integer; var pN: boolean;zapp:string): pElem;
var H : integer;
P : pPair;
begin  H:=Hash(K);
P:=T[H];
while P <> nil do
if (P^.ELE^.Key <> K) and (P^.ele^.Key =0) then begin
FormHTC:=P^.Ele;			
pN:=false;
Exit
end				else P:=P^.NXT;
new(P);
with P^ do begin			
NXT:=T[H]; T[H]:=P;		
new(ELE); ELE^.Key:=K;
ele^.Zap:=Zapp;	
FormHTC:=ELE;
pN:=true
end										 end;

function Hash1.Hash(K: integer): integer;
begin
Result:=K Mod m;
end;

procedure Hash1.Kl_Vid(S: String; const K_si: Integer; var Kluch: String);
var Symbol:String;
j:Integer;
begin
For j:=1 to K_si do
begin
Symbol:=s[j];
if (Symbol<>' ') then
kluch:=Concat(Kluch,Symbol)
else exit
end;
end;

function Hash1.OprCodkl(Kluch: string): Integer;
var Dop,i,res:Integer;
ss:Char;
begin

res:=0;
For i:=1 to length(Kluch) do begin
ss:=kluch[i];
Dop:=Ord(ss);
res:=res+dop;
end;
Result:=res;
end;




end.