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

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

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

> хеш-таблица, построение, просмотр
сообщение
Сообщение #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 
 К началу страницы 
+ Ответить 

Сообщений в этой теме
*оля*   хеш-таблица   9.11.2010 0:47
volvo   *оля* Во-первых ,у меня к тебе вопрос: чем ЭТО ко…   9.11.2010 1:06
*оля*   ой, да, точно, последняя строчка всегда выполняетс…   9.11.2010 1:27
volvo   С этого надо было начинать... PascalABC.NET непра…   9.11.2010 3:28
*оля*   что-то из лекций писала, что-то так) видимо, что т…   9.11.2010 3:47
*оля*   казалось, что процедура удаления работает, но оказ…   15.11.2010 20:23
volvo   Ну, смотри, у тебя (по сравнению с авторским алгор…   15.11.2010 20:51
*оля*   Во-вторых, у тебя будет вылет за границы массива…   15.11.2010 21:21
TarasBer   А где в процедуре Delete вызов Dispose? > if …   15.11.2010 21:40
*оля*   ну так работает, да. но преподаватель ее всегда ми…   15.11.2010 21:56
TarasBer   Наверное, из-за отсутствия Dispose память кончаетс…   15.11.2010 21:58
volvo   Лог программы (что и в каком порядке вводишь, чтоб…   15.11.2010 21:59
*оля*   например так: ввод: 20 слов далее удаляю слова: ро…   15.11.2010 22:18
volvo   все, как и должно быть, все слова из этой строки о…   15.11.2010 22:57
*оля*   все, как и должно быть, все слова из этой строки …   15.11.2010 23:13
Гость   Напиши тело программы вот так: BEGIN assign(inp…   15.11.2010 23:03
Гость   Ну так что с автоматическим тестом? Я вот написал,…   16.11.2010 0:49
*оля*   Кстати, я забыл, надо ещё вместо [code=pas] if …   16.11.2010 1:59
dron4ik   У мя есть нормальная хеш таблица...могу скинуть. …   16.11.2010 1:47
dron4ik   там же есть все исходники в прикрепленном файле :b…   16.11.2010 2:17
Гость   Интереснее (и полезнее) врубиться, где ошибка в ст…   16.11.2010 2:50
*оля*   да, хотелось бы эту программу доделать по возможно…   16.11.2010 3:35
volvo   Ну вот не могу я заставить программу вылетать, и в…   16.11.2010 5:05
*оля*   поступаю так же,как и в тот раз: ввожу элементы. Е…   16.11.2010 14:25
volvo   Издеваешься? Я просил ТОЧНУЮ последовательность…   16.11.2010 15:02
TarasBer   Так что насчёт автоматического тестирования (см по…   16.11.2010 15:37


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

 





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