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