IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

2 страниц V  1 2 >  
 Ответить  Открыть новую тему 
> хеш-таблица, построение, просмотр
сообщение
Сообщение #1


Пионер
**

Группа: Пользователи
Сообщений: 125
Пол: Женский

Репутация: -  1  +


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


.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






*оля*

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

А во-вторых - в чем ошибка. Вот в этом:
Цитата
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 там присутствует...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Пионер
**

Группа: Пользователи
Сообщений: 125
Пол: Женский

Репутация: -  1  +


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

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

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

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

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

p.s: PascalABC.net

Сообщение отредактировано: *оля* -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






Цитата
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;


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


Пионер
**

Группа: Пользователи
Сообщений: 125
Пол: Женский

Репутация: -  1  +


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

да, так работает все теперь!) почти все...
спасибо огромное, Вы всегда помогаете!) с этого сайта узнаю больше, чем с занятий в университете, спасибо)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Пионер
**

Группа: Пользователи
Сообщений: 125
Пол: Женский

Репутация: -  1  +


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

единственное, что я заметила, что не хватает dispose, а ошибку не могу найти.
заранее спасибо)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Гость






Ну, смотри, у тебя (по сравнению с авторским алгоритмом) по-другому реализована процедура 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 логика та же самая, но мало ли smile.gif

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

Добавлено через 1 мин.
Цитата
единственное, что я заметила, что не хватает dispose
PascalABC.NET со сборщиком мусора, так что не особо критично.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Пионер
**

Группа: Пользователи
Сообщений: 125
Пол: Женский

Репутация: -  1  +


Цитата(volvo @ 15.11.2010 17:51) *


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


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

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

Сообщение отредактировано: *оля* -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Злостный любитель
*****

Группа: Пользователи
Сообщений: 1 755
Пол: Мужской

Репутация: -  62  +


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

> if MEMBER ( x, A ) = true then

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

if MEMBER ( x, A ) then

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

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


--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Пионер
**

Группа: Пользователи
Сообщений: 125
Пол: Женский

Репутация: -  1  +


ну так работает, да.
но преподаватель ее всегда минут 10 мучает и в конце концов она перестает работать.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Злостный любитель
*****

Группа: Пользователи
Сообщений: 1 755
Пол: Мужской

Репутация: -  62  +


Наверное, из-за отсутствия 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 -


--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Гость






Цитата
обычно перестает работать, если я ввожу элементы, чтобы в строчке было больше 2х, потом удаляю несколько, потом ввожу один снова, потом снова удаляю....и так еще раз 10...и все, не работает(
Лог программы (что и в каком порядке вводишь, чтобы воспроизвести ошибку) - в студию.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Пионер
**

Группа: Пользователи
Сообщений: 125
Пол: Женский

Репутация: -  1  +


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

Сообщение отредактировано: *оля* -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Гость






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


Гость






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


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

Найди, какое содержимое файла вызывает глюки и пришли его сюда.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #16


Пионер
**

Группа: Пользователи
Сообщений: 125
Пол: Женский

Репутация: -  1  +


Цитата(volvo @ 15.11.2010 19:57) *

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



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

Прикрепленный файл  Program1.pas ( 3.35 килобайт ) Кол-во скачиваний: 502
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #17


Гость






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


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

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

 К началу страницы 
+ Ответить 
сообщение
Сообщение #18


Бывалый
****

Группа: Пользователи
Сообщений: 318
Пол: Мужской

Репутация: -  0  +


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

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


Прикрепленные файлы
Прикрепленный файл  _____4.rar ( 123.54 килобайт ) Кол-во скачиваний: 205
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #19


Пионер
**

Группа: Пользователи
Сообщений: 125
Пол: Женский

Репутация: -  1  +


Цитата(Гость @ 15.11.2010 21:49) *


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

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, спасибо, правда без исходного текста мне эти программы не помогут.
Хотелось бы найти ошибку))

Сообщение отредактировано: *оля* -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #20


Бывалый
****

Группа: Пользователи
Сообщений: 318
Пол: Мужской

Репутация: -  0  +


там же есть все исходники в прикрепленном файле blink.gif или ты все таки хочешь сама сделать своё?)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

2 страниц V  1 2 >
 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 29.03.2024 4:08
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name