Правила форума
ВНИМАНИЕ!
Программа должна выполнять следующие действия:
• добавление нового ключа в таблицу с подсчетом сделанных при этом сравнений
• поиск заданного ключа в таблице с подсчетом сделанных при этом сравнений
• вывод текущего состояния таблицы на экран
• удаление заданного ключа из таблицы
Алгоритм удаления:
• вычислить хеш-функцию и организовать поиск удаляемого элемента в таблице
• если удаляемый элемент найден в ячейке таблицы, то эта ячейка либо становится пустой (если связанный с ней список пуст), либо в нее записывается значение из первого элемента списка с соответствующим изменением указателей
• если удаляемый элемент найден в списке, то производится его удаление с изменением указателей
После отладки программы необходимо выполнить ее для разных соотношений числа исходных ключей и размерности таблицы: взять 20 ключей и разместить их поочередно в таблице размерности 9, 17 и 23. Для каждого случая найти суммарное число сравнений, необходимое для размещения ключей и их поиска. Сделать вывод о влиянии размерности таблицы на эффективность поиска.
Все работает вроде верно, но когда сдавал преподу он мне сказал ввести ключ var а потом ввести ключ avr//и программа сразу вылетела...препод сказал что у мя чтото с процедурой добавления и проблема с указтелями....ни как не пойму что и как исправить..помогите пожалуйста.(
program Work3;
{$APPTYPE CONSOLE}
uses
SysUtils;
const hsize=15;
type PocketArr=record
Key:Integer;
Str:String;
end;
type Plist=^TList;
TList=record
elt:String;
npt:Plist;
end;
ListFL=record
First,Last:Plist;
Str:String;
end;
var HashTable:Array [0..hsize] of ListFL;
H, k, i: integer;
Cmp:Integer;
function AddToDList(var obj:ListFL; elt:String):Integer;
var Res:Integer;
PTemp: PList;
begin
Res:=0;
If obj.First=nil then
begin
New(PTemp);
pTemp^.elt:=elt;
obj.First:=PTemp;
obj.Last:=PTemp;
Res:=1;
end
else
begin
New(PTemp);
pTemp^.elt:=elt;
obj.Last^.npt:=Ptemp;
obj.Last:=pTemp;
end;
Result:=Res;
end;
procedure PrintList(obj:ListFL);
var PCurrent: PList;
begin
if obj.First<>nil then
begin
PCurrent:=obj.First;
while PCurrent<>nil do
begin
write(PCurrent^.elt,' ');
PCurrent:=PCurrent^.npt;
end;
end else Write('ãáâ® ');
end;
function FindList(str:String; obj:ListFL):Boolean;
var PCurrent: PList;
Res:Boolean;
begin
Res:=False;
if obj.First<>nil then
begin
PCurrent:=obj.First;
while PCurrent<>nil do
begin
Inc(cmp);
If PCurrent^.elt=Str then
begin
Res:=True;
break;
end;
PCurrent:=PCurrent^.npt;
end;
end else Res:=False;
Result:=Res;
end;
procedure PrintArrayList(obj: array of ListFL);
var i:Integer;
begin
for i:=0 to High(obj) do
begin
Write(i,': ');
Write(obj[i].Str,' ');
PrintList(HashTable[i]);
writeln;
end;
end;
Function Hash(str : string):Integer;
var Sum,i,Len,Res: Integer;
begin
Sum:=0;
Len:= Length(str);
for i := 1 to Len do Sum:=Sum+ord(str[i]);
Res:=Sum mod (High(HashTable)+1);
Result:=Res;
end;
function AddToHAsh(str: String; var arr: array of ListFL):Integer;
var hsh:Integer;
r:Boolean;
begin
hsh:=Hash(str);
Result:=hsh;
If arr[hsh].Str='' then arr[hsh].Str:=str //äîáàâëÿåì â êëþ÷
else begin
If arr[hsh].Str<>str then AddToDList(arr[hsh],str); //äîáàâëÿåì â ñïèñîê ñ èíäåêñîì hsh
end;
end;
function DelFromDList(str:String;var obj:ListFL):Integer;
var PCurt,Pprev:PList;
Res:Integer;
begin
PCurt:=obj.First;
while (PCurt<>nil) And (PCurt^.elt<>str) do
begin
Pprev:=PCurt;
PCurt:=PCurt^.npt;
end;
If PCurt<>nil then
begin
If obj.First=PCurt then
begin
obj.First:=PCurt^.npt;
Dispose(PCurt);
end else
begin
Pprev^.npt:=PCurt^.npt;
Dispose(PCurt);
end;
Res:=1;
end
else Res:=0;
Result:=Res;
end;
function DelFromHash(str: String; var arr: array of ListFL):Integer;
var hsh,res:Integer;
PTemp:PList;
begin
hsh:=Hash(str);
Res:=0;
If str=arr[hsh].Str then
begin
If arr[hsh].First=nil then arr[hsh].Str:=''
else begin
PTemp:=arr[hsh].First;
arr[hsh].First:=PTemp^.npt;
arr[hsh].Str:=PTemp^.elt;
Dispose(PTemp);
end;
Res:=1;
end else If DelFromDList(str,arr[hsh])=1 then Res:=1;
Result:=Res;
end;
function FindInHash(str: String; arr: array of ListFL):Integer;
var hsh,r:Integer;
begin
hsh:=Hash(str);
cmp:=0;
Inc(cmp);
If str=arr[hsh].Str then R:=hsh else
begin
If FindList(str,arr[hsh])=true then R:=hsh else R:=-1;
end;
writeln(cmp);
Result:=R;
end;
procedure ShowMenu;
begin
WriteLn('0: Add to hash table');
WriteLn('1: Del from hash table');
WriteLn('2: Find in hash table');
WriteLn('3: Print hash table');
WriteLn('4: Exit');
end;
procedure Command;
var num:Integer;
cmd: Char;
str: String;
begin
Write('Enter command: ');
ReadLn(cmd);
case cmd of
'0':
begin
str:='';
while str='' do
begin
Write('Enter String: ');
ReadLn(str);
end;
num:=AddToHAsh(str,HashTable);
If num=-1 then WriteLn('Add canceled') else WriteLn(num);
end;
'1':
begin
Write('Enter String: ');
ReadLn(str);
If DelFromHash(str,HashTable)=0 then WriteLn('Can`t find string') else WriteLn('Element Successfull deleted');
end;
'2':
begin
Write('Enter String: ');
ReadLn(str);
num:=FindInHash(str,HashTable);
If num=-1 then WriteLn('Can`t find string') else WriteLn('Element exsist and has key ',num);
end;
'3': PrintArrayList(HashTable);
'4': Exit;
end;
Command;
end;
begin
ShowMenu;
Command;
end.
Что за вспомогательный список? Что где конфликтует? Что неправильно добавляется? Ввел я var, потом ввел avr, потом выбрал "Print hash table" - не увидел, что где неправильно добавляется. Все добавилось и напечаталось: