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

[*оля*]

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

*оля*

Во-первых ,у меня к тебе вопрос: чем ЭТО компилируется? Просто чтоб знать...

А во-вторых - в чем ошибка. Вот в этом:

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;

Ну, и назови мне причину по которой это ВООБЩЕ когда-нибудь вернет что-нибудь, кроме False. Последняя строка функции выполнится в любом случае. Или перенеси MEMBER := False в самое начало функции, или выходи из нее принудительно, как только сделала присвоение MEMBER := True...

P.S. Не, первый вариант хуже, пользуйся вторым. Зачем бежать дальше по таблице, если уже известно, что X там присутствует...

[*оля*]

ой, да, точно, последняя строчка всегда выполняется, спасибо большое!

хм, правда я исправила, теперь сама по себе она работает, но почему-то все равно сообщение не выдает, а просто выходит из программы.

  if  not  MEMBER (x, A ) then writeln (' элемент не существует')
else writeln('элемент  существует');

.

можно так писать?

и после выполнения процедуры просмотра тоже программа закрывается(((

p.s: PascalABC.net

Сообщение отредактировано: *оля* - 8.11.2010 22:19

[volvo]

p.s: PascalABC.net

С этого надо было начинать...

PascalABC.NET неправильно обрабатывает цикл

  while  current <> nil  do 
    if  current^.element = x   then  MEMBER:=true 
    else  current:= current^.next;

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

Добавлено через 5 мин.
Блин... Что-то я торможу уже, спать надо больше, наверное. Он просто неправильно записан. Вот так нужно делать:

  while  current <> nil  do
  begin
    if  current^.element = x   then  MEMBER:=true;
    current:= current^.next;
  end;

А все знаешь почему? Ты откуда этот алгоритм переписывала? Из Ахо? Там же return используется, то есть, как только current^.element = x, функция сразу заканчивается. А в твоем варианте - она просто бегает по циклу вхолостую: если элемент else не отрабатывает, с этим же значением current идет новая итерация, соответственно опять ничего не меняется. Все, зациклились...

[*оля*]

что-то из лекций писала, что-то так) видимо, что так писала, там и ошибки)

да, так работает все теперь!) почти все...
спасибо огромное, Вы всегда помогаете!) с этого сайта узнаю больше, чем с занятий в университете, спасибо)

[*оля*]

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

единственное, что я заметила, что не хватает dispose, а ошибку не могу найти.
заранее спасибо)

[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 со сборщиком мусора, так что не особо критично.

[*оля*]

Во-вторых, у тебя будет вылет за границы массива в процедуре Print:
Почему до B, когда тип описан как TABL = array[0..B-1] of ^celltype; ?

да, это исправила уже, только забыла отредактировать сообщение, но все равно спасибо.

а насчет той ошибки, исправила, но все равно, работает, работает, а потом перестает. обычно перестает работать, если я ввожу элементы, чтобы в строчке было больше 2х, потом удаляю несколько, потом ввожу один снова, потом снова удаляю....и так еще раз 10...и все, не работает(

Сообщение отредактировано: *оля* - 15.11.2010 17:28

[TarasBer]

А где в процедуре Delete вызов Dispose?

> if MEMBER ( x, A ) = true then

Не надо так писать, ты травмируешь этим мою психику, пиши

if MEMBER ( x, A ) then

Добавлено через 1 мин.
Или в ABC.NET отменили Dispose? Типа само уберётся. Тогда это хреновая среда для обучения.

Добавлено через 12 мин.
Переписал на D7 (исправив озвученные в этой теме ошибки), 10 раз добавил и удалил слово abacaba, всё работает.

[*оля*]

ну так работает, да.
но преподаватель ее всегда минут 10 мучает и в конце концов она перестает работать.

[TarasBer]

Наверное, из-за отсутствия Dispose память кончается, не знаю.
Я-то переписал удаление так:

procedure  DELETE ( x: string; var A: TABL ); 
var
  bucket: integer;
  current, tmp: pcelltype;
  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
          tmp := Current^.Next;
          current^.next := current^.next^.next;
          Dispose(tmp);
          { удаление х из списка }
          f:= false { останов }
        end else   { x пока не найден }
          current:= current^.next
    end
  end
end; 		
	

(И вообще, надо не 10 минут руками программу мучать, если уж на то пошло, а автоматически тестировать.)
Упс, русские буквы не так скопировались.

Сообщение отредактировано: TarasBer - 15.11.2010 17:59

[volvo]

обычно перестает работать, если я ввожу элементы, чтобы в строчке было больше 2х, потом удаляю несколько, потом ввожу один снова, потом снова удаляю....и так еще раз 10...и все, не работает(

Лог программы (что и в каком порядке вводишь, чтобы воспроизвести ошибку) - в студию.

[*оля*]

например так:
ввод: 20 слов
далее удаляю слова: ролл, рор, пп (т.е. те, что в одной строчке) и получаю что-то непонятное:

Сообщение отредактировано: *оля* - 15.11.2010 18:19

[volvo]

далее удаляю слова: ролл, рор, пп (т.е. те, что в одной строчке) и

все, как и должно быть, все слова из этой строки один за одним удаляются без проблем, сбоев не наблюдаю. Может, ты чего-то там еще изменяла? Присоединила бы исходник полностью (в виде PAS-файла)

[Гость]

Напиши тело программы вот так:

BEGIN

assign(input, 'hash.txt');
reset(input);

MAKENULL ( A);
Menu_1;
close(input);
end.

Создай файл hash.txt, напиши в нём что-то такое:

Код

0
abc
0
acb
0
bca
0
bac
0
aaa
0
abb
0
bab
2
bac
2
bac
2
bac
3
3
3
3
3
3
3
3
3
4

Найди, какое содержимое файла вызывает глюки и пришли его сюда.

[*оля*]

все, как и должно быть, все слова из этой строки один за одним удаляются без проблем, сбоев не наблюдаю. Может, ты чего-то там еще изменяла? Присоединила бы исходник полностью (в виде PAS-файла)

там почти то же самое, что в первом сообщении, только названия переменных другие)

 Program1.pas ( 3.35 килобайт ) Кол-во скачиваний: 406

[Гость]

Ну так что с автоматическим тестом?
Я вот написал, как это можно организовать.


Кстати, я забыл, надо ещё вместо

if A[bucket] ^.element = x  then 	{ x в первой ячейке }
      A[bucket]:= A[bucket] ^.next 	{ удаление х из списка }

написать

if A[bucket] ^.element = x  then begin 	{ x в первой ячейке }
      tmp := A[bucket];
      A[bucket]:= A[bucket] ^.next 	{ удаление х из списка }
      Dispose(tmp);
end

[dron4ik]

У мя есть нормальная хеш таблица...могу скинуть.

Добавлено через 1 мин.
посмотри там их даже несколько..

[*оля*]

Кстати, я забыл, надо ещё вместо

if A[bucket] ^.element = x  then 	{ x в первой ячейке }
      A[bucket]:= A[bucket] ^.next 	{ удаление х из списка }

написать

if A[bucket] ^.element = x  then begin 	{ x в первой ячейке }
      tmp := A[bucket];
      A[bucket]:= A[bucket] ^.next 	{ удаление х из списка }
      Dispose(tmp);
end

в прикрепленном файле это уже исправили)


dron4ik, спасибо, правда без исходного текста мне эти программы не помогут.
Хотелось бы найти ошибку))

Сообщение отредактировано: *оля* - 15.11.2010 22:02

[dron4ik]

там же есть все исходники в прикрепленном файле или ты все таки хочешь сама сделать своё?)