хеш-таблица, построение, просмотр Опции

[*оля*]

почему-то если хочешь записать повторно элемент, то не работает, хотя должен выводить сообщение, что такой элемент уже записан. И задача на наличие элемента, связанная с этой процедурой(MAKENULL), тоже не работает.
помогите пожалуйста найти ошибку.

 
uses Crt;
const  B = 30; 
type  
celltype = record 
element: string[255];
next: ^celltype
end; 
TABL = array[0..B-1]  of  ^celltype;

var
End_Menu: boolean;
ch: char;
x: string[255];
A: TABL;

Function  h ( x: string ): 0..B-1;
var   i, sum: integer; 
begin 
sum:= 0; 
for  i:= 1  to  length(x)  do 
sum:= sum + ord( x[i] ); 
h:= sum  mod  B ;
end; 				{ h } 


procedure  MAKENULL ( var A: TABL ); 
var   i: integer; 
begin 
for  i:= 0  to  B - 1  do 
A[i]:= nil 
end; 			


function  MEMBER ( x: string; var A: TABL ): boolean; 
var   current: ^celltype; 
begin 
current:= A[h(x)]; 
{ начальное значение current равно заголовку сегмента, 
которому принадлежит элемент х } 
while  current <> nil  do 
if  current^.element = x   then  MEMBER:=true 
else  current:= current^.next; 
MEMBER:=false		 { элемент х не найден } 
end; 			

procedure  INSERT ( x: string; var A: TABL ); 
var   bucket: integer; 	{ для номера сегмента } 
oldheader: ^celltype; 
begin 
if  not MEMBER(x, A)  then  begin 
bucket:= h(x); 
oldheader:= A[bucket]; 
new( A[bucket] ); 
A[bucket] ^.element:= x; 
A[bucket] ^.next:= oldheader ;
writeln('элемент добавлен');
end 
else writeln ('такой элемент уже записан');
end; 			


procedure  DELETE ( x: string; var A: TABL ); 
var  bucket: integer; 	current: ^celltype;  f: boolean;
begin 
bucket:= h(x);   f:= true;
if  A[bucket] <> nil  then  begin 
if A[bucket] ^.element = x  then 	{ x в первой ячейке } 
A[bucket]:= A[bucket] ^.next 	{ удаление х из списка } 
else   begin 	{ x находится не в первой ячейке } 
current:= A[bucket];  
{ current указывает на предыдущую ячейку } 
while  (current^.next <> nil ) and  f  do 
	if  current^.next^.element = x  then  begin 
		current^.next := current^.next^.next;  
		{ удаление х из списка } 
		f:= false { останов } 	end 
	else   { x пока не найден }  current:= current^.next 
end 
end 
end; 			


procedure PRINT;
var
i: integer;
current: ^celltype;
begin
for i:=0 to B do
begin
writeln;
write (i,':');
if A[i]<>nil then current:=A[i];
while current<>nil do
begin
write(current^.element, '  ');
current:=current^.next;
end;
end;
end;

Procedure Menu_1;
begin
clrscr;
End_Menu:=False;
repeat
writeln;
writeln;
Writeln('***********************************************');
writeln( '*****************Главное меню******************');
Writeln('***********************************************');
writeln('                                               ');
writeln('         выберите вид работы:                  ');
writeln('        0- вставка элемента                    ');
writeln('        1- Проверка на существование элемента  ');
writeln('        2- удаление элемента                   ');
writeln('        3- просмотреть все элементы            ');
writeln('        4- выход                              ');
writeln('***********************************************');

readln(ch);
Case ch of
'0': begin
writeln('введите эелемент для записи');
readln(x);
INSERT ( x, A ); 

end;
'1':
begin
writeln('введите элемент для поиска');
readln(x);
if  MEMBER ( x, A ) = true then writeln (' элемент существует')
else writeln('элемент не существует');
end;
'2': begin
writeln('введите элемент для удаления');
readln(x);
DELETE ( x, A ); 
writeln('элемент удален');
   end;
'3': begin   Print;  end;
'4': begin End_menu:=true;clrscr; Writeln('работа завершена, закройте программу!'); end;
end;
until End_Menu;
clrscr;
end;

BEGIN

MAKENULL ( A);
Menu_1;
end.

 

.

[volvo]

Ну, смотри, у тебя (по сравнению с авторским алгоритмом) по-другому реализована процедура Delete. У Ахо она вот такая:

procedure Delete(x: string; var A: TABL);
var
  bucket: integer;
  current: ^celltype;
begin
  bucket:= h(x);
  if A[bucket] <> nil then
  begin
    if A[bucket]^.element = x then { x в первой ячейке }
      A[bucket] := A[bucket] ^.next { удаление х из списка }
    else
    begin { x находится не в первой ячейке }
      current := A[bucket];
      { current указывает на предыдущую ячейку }
      while current^.next <> nil do
        if current^.next^.element = x then
        begin
          current^.next := current^.next^.next; { удаление х из списка }
          exit; { останов - выходим из процедуры }
        end
        else current:= current^.next; { x пока не найден }
    end; { else }
  end; { if <> nil }
end; { Delete }

Вроде бы у тебя с F логика та же самая, но мало ли

Во-вторых, у тебя будет вылет за границы массива в процедуре Print:

for i:=0 to B do
begin

Почему до B, когда тип описан как TABL = array[0..B-1] of ^celltype; ?

Добавлено через 1 мин.

единственное, что я заметила, что не хватает dispose

PascalABC.NET со сборщиком мусора, так что не особо критично.