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

[*оля*]

почему-то если хочешь записать повторно элемент, то не работает, хотя должен выводить сообщение, что такой элемент уже записан. И задача на наличие элемента, связанная с этой процедурой(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]

Ну вот не могу я заставить программу вылетать, и все тут... до 200 слов вводил, удалял по 15 раз каждую из строк хеш-таблицы, начинал заполнять снова, опять удалял, НЕ ВЫЛЕТАЕТ. Запускал и из оболочки, и "Без связи с оболочкой".

В самой программе тоже есть несколько моментов, которые я бы исправил:
1) у тебя в одном месте тип данных описан как string[255], а в другом - как string. Если в Турбо Паскале это одно и то же, то в PascalABC.NET это совсем не так. Поменяй везде на shortstring. Несоответствие типов может тоже привести к проблеме.
2) сбой может быть связан с тем, что в процедуре Print значение Current не всегда определено. В частности, при обработке первой строки таблицы, там может оказаться любой мусор, из-за чего программа может и вылететь (сама переменная Current описана локально, значит - не инициализируется nil-ом)
3) как всегда - мое любимое изменение в программе: переменные должны иметь минимальное время жизни, то есть, описывать их желательно как можно ниже по тексту. Поэтому я бы в Print тоже передавал массив, а описание самого массива A перенес бы ниже.
4) ну, и косметическое изменение цикла Repeat/Until в Menu_1, избавляемся от лишней переменной.

В общем, под спойлером - моя программа, которую я гонял больше 4-х часов (удаление делать не стал, попробуй погонять эту программу, НИЧЕГО в ней не изменяя, ни единого символа). Сбой воспроизвести не удалось ни при каких условиях. Приводи ТОЧНУЮ ПОСЛЕДОВАТЕЛЬНОСТЬ действий для того, чтоб увидеть, наконец, этот сбой.

Спойлер (Показать/Скрыть)

const  B = 10;
type
     celltype = 
     record
          element: shortstring;
          next: ^celltype
     end;
     TABL = array[0 .. B-1]  of  ^celltype;

Function  h(x: shortstring ): 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 := Low(A) to High(A) do A[ i ] := nil
end;

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

procedure INSERT(x: shortstring; 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: shortstring; 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;
end; { Delete }

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

var
  x: shortstring;
  A: TABL;

procedure Menu_1;
var ch: char;
begin
     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
                    write('введите эелемент для записи'); readln(x);
                    INSERT(x, A);
               end;
               
               '1':
               begin
                    write('введите элемент для поиска'); readln(x);
                    if MEMBER(x, A) then writeln(' элемент существует')
                    else writeln('элемент не существует');
               end;
               
               '2':
               begin
                    write('введите элемент для удаления'); readln(x);
                    DELETE(x, A); 
                    writeln('элемент удален');
               end;
               
               '3': Print(A);
               '4': Writeln('работа завершена, закройте программу!');
          end;
     until ch = '4';
end;

begin
     MAKENULL(A);
     Menu_1;
end.