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

[Гость]

Интереснее (и полезнее) врубиться, где ошибка в старых исходниках, вместо того, чтобы новые писать. Охота за ошибками весьма увлекательна, зачем лишать себя такого интересного занятия?

[*оля*]

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

procedure  Udalenie ( x: string; var A: TABL ); 
var  nomerSegm: integer; 	ukaz,ud: ^zapis;  
begin 
nomerSegm:= h(x);   
if  A[nomerSegm] <> nil  then  begin 
if A[nomerSegm] ^.element = x  then 	 
A[nomerSegm]:= A[nomerSegm] ^.next 	  
else   begin 	
ukaz:= A[nomerSegm];
ud:=ukaz^.next;  
while  (ukaz^.next <> nil )  do 
	if  ud^.element = x  then 
	begin
		 ukaz^.next := ud^.next; 
		 dispose(ud); exit;
	end
	else   begin 
	    ukaz:= ukaz^.next ;
	    ud:=ud^.next; 
	       end;
end 
end 
end; 			

.

и все равно не то(((

Добавлено через 9 мин.
если при ошибке выводит в строчке слова ненужные: "элемент добавлен, такой элемент уже записан...."
так может это не в процедуре удаления, а в процедуре добавления ошибка?

[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.

[*оля*]

поступаю так же,как и в тот раз: ввожу элементы. Если использовать Crt, то картинка получается такая же, как и в тот раз

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

 
0:ррр 
1:
2:
3:
4:ороро 
5:
6:оро 
7:
8:ро 
9:

 

далее ввожу еще один элемент "про" и таблица сбивается:

 

0:ррр 
1:
2:
3:
4:ороро 
5:
6:оро 
7:про 
8:㳮￿9:

в общем, если дальше вводить, он две в одну строчку почему-то вводит:

8:ролл 㳮￿9:пр

всегда с 8ой и 9ой строчкой проблемы.

Сообщение отредактировано: *оля* - 16.11.2010 14:29

[volvo]

Издеваешься? Я просил ТОЧНУЮ последовательность!!! Точную, понимаешь? В каком порядке ты вводишь все эти элементы? При вводе в произвольном порядке (картинка - такая же, как и у тебя вверху) ввожу "про" - сбоя НЕТ!!! Этот элемент корректно заносится в 7 строку таблицы... Что я делаю не так? В общем, давай закончим на этом обсуждать мифологию, надоело. Уточняй номер сборки PascalABC.NET, какой у тебя установлен .NET, собственно, и ТОЧНУЮ ПОСЛЕДОВАТЕЛЬНОСТЬ действий - в студию. Пока всего вышеперечисленного не будет - я больше здесь не отвечаю.

[TarasBer]

Так что насчёт автоматического тестирования (см пост 15)?