Cтруктура данных для построения предметного указателя (через связанные списки). Опции

[Jabbson]

Добрый день.

Задание следующее:
Разработать структуру данных для построения предметного указателя.
Осуществить поиск, сортировку, редактирование.

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

{СЛОВО} {СТРАНИЦЫ, ГДЕ ЭТО СЛОВО ВСТЕРЧАЕТСЯ}

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

Есть объявления типа:

type
 
page_mas = array [1..10] of word; {массив слов, одно и то же слово} 
                                  {может встречаться на 10 страницах}
 
LINK_REC = ^REC;           {указатель на запись со словом}
REC = record                   
    SLOVO:       string[15]; {Слово}
    PAGE:        page_mas;  {страницы на которых слово встречается}
    NEXT:        LINK_REC;   {указатель на следующую запись со слово}
    end;
 
LET = record
    CAPITAL:     char;         {Буква, на которую слово начинается}
    FIRST:       LINK_REC;    {указатель на первое слово на эту букву}
    end;
 
lett_mas = array [1..27] of LET; {массив из записей с буквами алфавита}

Что я делаю дальше.

Заполняю массив за записей с буквами собственно теми самыми буквами:

for x:=65 to 90 do
  begin
    letters[x-64].capital:=chr(x); letters[x-64].first:=nil;
  end;

После этого он представляет собой следующее:
letters: (('A', nil), ('B', nil), ('C', nil)...('Z', nil).

После этого я перехожу к непосредственно заполнению и вот тут у меня возникает проблема.

Выглядит начало примерно так:

clrscr;
 
writeln('MENU:');
writeln;
writeln('1 - ADD');
writeln('2 - SEARCH');
readln(menu);
 
case menu of
1:begin
  clrscr;
 
  {считываю новое слово в запись z}
  write('new word: '); 
  read(z.slovo);
 
  {вычисляю номер буквы алфавита и в будущем ячейки массива букв}
  let_num:=ord(z.slovo[1])-64; 
 
  {заполняю массив страниц}
  write('How many pages contain this word: ');
  readln (pag_num);
 
  for i:=1 to pag_num do
    begin
      write('Page number: ');
      readln(page);
      z.page[i]:= page;
    end;
 
  z.next:=nil;
 
  Add(LR,z); {вызываю функцию добавления записи к списку}
 
  end;
end;
until menu=3;

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

* Найти по let_num в массиве lett_mas ячейку с буквой, на которую начинается слово.
* Если ячейка^.first = nil, то создать новую ссылку на запись, положить туда значение z и сделать чтобы ячейка^.first теперь сслылалась на это место.
* Если же ячейка^.first <> nil, то идти по этому списку до тех пор пока не дойдем до конца и вставить наше z там.


Конечное видение примерно как на приложенной картинке.

Заранее спасибо.

[volvo]

Заполняю массив за записей с буквами собственно теми самыми буквами:

Не надо делать лишнюю работу. Индексом массива может быть не только целое число, а любой перечислимый тип. Итого:

Type
  Letters = 'A' .. 'Z';
  lett_mas = array [Letters] of LinkRec;
Var
  Lists: lett_mass;

...
  for X := 'A' to 'Z' do Lists[X] := nil;

Что тебе это дает? А очень просто: по первой букве слова ты моментально переходишь к нужному списку. То есть, чтобы закончить твой код, приведенный внизу, достаточно:

Procedure Add(var L: LinkRec; R: Rec);
var p: LinkRec;
begin
  new(p);
  p^ := R; { <-- Заносим данные в динамически выделенную память }

  if L = nil then L := p { Самый первый элемент списка }
  else begin
    {
      Уже не самый первый - надо "пробежаться" по списку до конца
      и "подклеить" туда новый элемент. Вместо этого можно в массиве
      Lists хранить не только начало, но и конец списка, и без "пробегания"
      по списку сразу прилепить новый элемент туда, куда нужно...
    }
    while L^.next <> nil do L := L^.next;
    L^.next := p;
  end;
end;

{ ... }

  {считываю новое слово в запись z}
  write('new word: '); read(z.slovo);

  {заполняю массив страниц}
  write('How many pages contain this word: '); readln (pag_num);
  for i:=1 to pag_num do
  begin
    write('Page number: '); readln(page);
    z.page[i]:= page;
  end;
  z.next := nil;

  Add(Lists[z.slovo[1]], z); {вызываю функцию добавления записи к списку}

Идея понятна? Продолжай. Только внимательно прочти то, что написано здесь:
Как не надо писать программы
Особенно это касается навешивания рюшечек до окончания разработки алгоритма. Ты потом на разберешься, что и куда. Сначала сделай логику (сколько же раз можно говорить одно и то же. Но ведь не слышите же!!! Или не хотите слышать?), ПОТОМ будешь делать "красивости". Красивая программа, которая глючит - никому не нужна.

А вообще, по-хорошему, надо разделить указатель next и данные. Как это делать - я уже неоднократно показывал, читай на форуме. И почему это надо делать - тоже объяснял...

[Jabbson]

volvo, огромное Вам спасибо. Вы всегда очень быстро и по существу отвечаете.

С "рюшечками" будем бороться, простите Бога ради, первый курс только, все придет со временем.

Сообщение отредактировано: Jabbson - 24.05.2010 16:32

[Jabbson]

Конечный результат программы у меня выглядит следующим образом:

очень хотел бы услышать Ваши комментарии.

uses crt;

type

page_mas = array [1..10] of word;

LINKREC = ^REC;
REC = record
    SLOVO:       string[15];
    PAGE:        page_mas;
    NEXT:        LINKREC;
    end;

Letters = 'A' .. 'Z';
lett_mas = array [Letters] of LinkRec;

var
lists:           lett_mas;
empty_pagemas:   page_mas;
menu,pag_num,i:  integer;
x:               char;
l_nach:          linkrec;
page:            byte;
z:               rec;

(*------------Procedura sortirovki massiva cifr---------*)
procedure BUB(var Z:page_mas; const N:integer);
var
A   :   Integer;
B   :   Integer;
Tmp :   Integer;

begin
  for A:=1 to N-1 do
  for B:=1 to N-A do
  if Z[B]>=Z[B+1] then begin
    Tmp:=Z[B];
    Z[B]:=Z[B+1];
    Z[B+1]:=Tmp;
  end;
end;
(*END---------Procedura sortirovki massiva cifr---------*)
(*------------Procedura dobavleniya novogo slova--------*)
Procedure Add(var L: LinkRec; R: Rec);
var p: LinkRec;
begin
  l_nach:=nil;
  if L<>nil then l_nach:=L;
  new(p);
  p^ := R; { <-- Заносим данные в динамически выделенную память }

  if L = nil then L := p { Самый первый элемент списка }
  else begin
  while L^.next <> nil do L := L^.next;
  L^.next := p;
  end;
  if l_nach<>nil then L:=l_nach;
end;
(*END---------Procedura dobavleniya novogo slova--------*)
(*------------Procedura EDIT-a --------*)
procedure EditByWord(L:LinkRec; R:Rec);
var
PM: page_mas;
b:  string;

begin
  for i:=1 to 10 do PM[i]:=0;

  while L^.slovo <> R.slovo do L:= L^.next;
  write('What is to be changed? (W)ord/(P)ages? ');readln(X);

  if X='W' then begin
    write('New word: ');readln(b);
    L^.slovo:=b;
  end;

  if X='P' then begin
    write('How many pages contain this word (UP TO 10): '); readln(pag_num);

    for i:=1 to pag_num do begin
      write('Page number: '); readln(page);
      PM[i]:= page;
      end;

    BUB(PM,10);

  L^.Page:=PM;
end;
end;
(*END---------Procedura EDIT-a --------*)
(*------------Procedura poiska --------*)
procedure SearchByWord(L:LinkRec; R:Rec);
begin
  while L^.slovo <> R.slovo do L:= L^.next;
  write('PAGES: ');
  for i:= 1 to 10 do if L^.Page[i] > 0 then write(L^.Page[i],' ');
  writeln;
  readkey;
end;
(*END---------Procedura poiska --------*)
(*------------Procedura poiska2--------*)
procedure SearchByPage(L:LinkRec; P:word);
begin
  for i:= 1 to 10 do if L^.Page[i] = P then write(L^.slovo, ' ');
  repeat
    L:=L^.next;
    for i:= 1 to 10 do if L^.Page[i] = P then write(L^.slovo, ' ');
  until L^.next=nil;
end;
(*END---------Procedura poiska2--------*)
(*------------Procedura sortirovki-----*)
procedure Sort(L:LinkRec);
var
tmp,rab:LinkRec;
tmps:string;
tmpm:page_mas;

begin
  new(tmp);
  rab:=L;

  while rab<>nil do begin
    tmp:=rab^.next;
    while tmp<>nil do begin
      if tmp^.slovo<rab^.slovo then begin
        tmps:=tmp^.slovo;tmpm:=tmp^.page;
        tmp^.slovo:=rab^.slovo;tmp^.page:=rab^.page;
        rab^.slovo:=tmps;rab^.page:=tmpm;
      end;
      tmp:=tmp^.next
    end;
    rab:=rab^.next
  end;
end;
(*END---------Procedura sortirovki-----*)
(*------------Procedura pechati--------*)
procedure Print(L:LinkRec);
begin
  writeln('WORD: ', L^.slovo); write('PAGES: ');
  for i:= 1 to 10 do if L^.Page[i]>0 then write(L^.Page[i], ' ');writeln;

  if L^.next <>nil then repeat
  L:=L^.next;
  writeln('WORD: ', L^.slovo); write('PAGES: ');
  for i:= 1 to 10 do if L^.Page[i]>0 then write(L^.Page[i], ' '); writeln;
  until L^.next=nil;
end;
(*END---------Procedura pechati--------*)

{Osnovnaya programma}
begin
clrscr;

for X := 'A' to 'Z' do Lists[X] := nil;

repeat
clrscr;

writeln('MENU:');writeln;
writeln('1 - ADD');
writeln('2 - EDIT ENTRY');
writeln('3 - SEARCH FOR ENTRY');
writeln('4 - SORT LIST ALPHABETICALLY');
writeln('5 - PRINT');writeln;
writeln('0 - EXIT');writeln;
write('MENU = ');

repeat
readln(menu);
until menu in [1,2,3,4,5,0];

case menu of
(*---------------1------------------*)
1:begin{1}
  clrscr;
  z.slovo:='';z.page:=empty_pagemas;z.next:=nil;

  write('New word (UP TO 15): '); readln(z.slovo);

  {zapolnyaem massiv stranic}
  write('How many pages contain this word (UP TO 10): '); readln(pag_num);

  for i:=1 to pag_num do begin
      write('Page number: '); readln(page);
      z.page[i]:= page;
      end;
      BUB(z.page,10);

  Add(Lists[z.slovo[1]],z);

  end;{1}
(*---------------1------------------*)
(*---------------2------------------*)
2:begin{2}
  clrscr;
  write('Edit entry: '); readln(z.slovo);
  EditByWord(Lists[z.slovo[1]],z);
  end;{2}
(*---------------2------------------*)
(*---------------3------------------*)
3:begin{3}
clrscr;
writeln('1 - Search by word');
writeln('2 - Search by page');writeln;
write('MENU = ');readln(menu);
case menu of
 1:begin
   clrscr;
   write('Word lookup: '); readln(z.slovo);
   SearchByWord(Lists[z.slovo[1]],z);
   end;
 2:begin
   clrscr;
   write('Page number lookup: '); readln(page);
   write('WORDS: ');
   for X:='A' to 'Z' do SearchByPage(Lists[X],page);
   writeln;readkey;
   end;
end;
end;{3}
(*---------------3------------------*)
4:begin{4}
  clrscr;
  write('SORTING:....');
  for X:='A' to 'Z' do Sort(Lists[X]);
  writeln('....DONE');
  readkey;
  end;{4}
(*---------------4------------------*)
(*---------------5------------------*)
5:begin{5}
  clrscr;
  writeln('1 - PRINT EVERYTHING');
  writeln('2 - PRINT BY  LETTER');writeln;
  write('MENU = ');readln(menu);
  clrscr;
  case menu of
  1:for X:='A' to 'Z' do if Lists[X]<>nil then Print(Lists[X]);
  2:begin
    write('Letter: ');
    readln(X);writeln;

    if Lists[X]<>nil then Print(Lists[X]);
    end;
  end;
  readkey;
  end;{5}
(*---------------5------------------*)
end;{case}

until menu=0;
end.

Прилагаю исходник и исполняемый файл:  SIAOD.rar ( 7.17 килобайт ) Кол-во скачиваний: 341


Сообщение отредактировано: Jabbson - 24.05.2010 21:23

[volvo]

Вот:

      if tmp^.slovo<rab^.slovo then begin
        tmps:=tmp^.slovo;tmpm:=tmp^.page;
        tmp^.slovo:=rab^.slovo;tmp^.page:=rab^.page;
        rab^.slovo:=tmps;rab^.page:=tmpm;
      end;

Это как раз та причина, по которой я и говорил, что надо отделить данные от дополнительной информации (которой является указатель next)... А насколько все было бы проще, если б ты сделал так:

LINKREC = ^REC;

TData =
  record
    SLOVO:       string[15];
    PAGE:        page_mas;
  end;
 
REC = record
    Data: TData;
    NEXT: LINKREC;
end;

?
Тогда сортировка выглядела бы так:

var R: TData;
{ ... }
  while rab<>nil do begin
    tmp:=rab^.next;
    while tmp<>nil do begin
      if tmp^.data.slovo<rab^.data.slovo then
      begin
        R := tmp^.data; tmp^.data := rab^.data; rab^.data := R; { <--- Проще, правда? }
      end;
      tmp:=tmp^.next
    end;
    rab:=rab^.next
  end;

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

[Jabbson]

Был бы премногоблагодарен.

{ <--- Проще, правда? }

а вот это действительно здОрово.

Сообщение отредактировано: Jabbson - 25.05.2010 0:22

[volvo]

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

(*------------Procedura poiska2--------*)
procedure SearchByPage(L:LinkRec; P:word);
begin
  for i:= 1 to 10 do if L^.Page[i] = P then write(L^.slovo, ' '); { <--- Вот в этом самом месте }
  repeat
    L:=L^.next;
    for i:= 1 to 10 do if L^.Page[i] = P then write(L^.slovo, ' ');
  until L^.next=nil;
end;

обратиться к L^.Page для незаполненного элемента массива, получишь вылет. За разыменование нулевого указателя... Перед тем, как начинать обработку списка, убедись, что он не пуст... Либо просто перепиши эту процедуру:

procedure SearchByPage(L:LinkRec; P:word);
var i: integer; { <--- В цикле лучше использовать локальную переменную ... }
begin
  while L <> nil do
  begin
    for i:= 1 to 10 do if L^.Page[i] = P then write(L^.slovo, ' ');
    L := L^.next;
  end;
end;

, теперь даже если список пуст - ошибки не будет... Внимательней с такими вещами.

Аналогичным образом я бы переделал и процедуру Print, там тоже никому не нужное дублирование кода.

P.S. Еще одно предупреждение, о котором прямо говорит Free Pascal при компиляции твоего кода - это то, что ты не инициализировал массив empty_pagemas. Не надо так делать... Тебе же будет спокойнее, если он будет инициализирован нулями. Потому что это - потенциальное место для ошибки. Представь себе, ты хочешь добавить еще функционал к данной программе, и все, что у тебя написано сейчас, оформляешь, как отдельную процедуру. Приплыли... Как процедура это работать не будет. Именно потому, что empty_pagemas не был инициализирован нулями (локальные переменные не обнуляются, только глобальные).

Как же иногда не хватает возможности сделать так:

   empty_pagemas: constant page_mas := (others => 0);

в Паскале, чтоб не заниматься инициализацией в RunTime, а сделать это еще во время компиляции...

[Jabbson]

Большое спасибо за Вашу помощь.

Еще пришло в голову, что отдавая слово в процедуру Add, было бы разумнее отдавать её так:

Add(Lists[upcase(z.slovo[1])],z);

чтобы можно было обрабатывать и слова, написанные с маленькой буквы.