Версия для печати темы

Автор: Jabbson 23.05.2010 23:54

Добрый день.

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

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

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

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

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

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;

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;

Автор: volvo 24.05.2010 0:25

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); {вызываю функцию добавления записи к списку}

Автор: Jabbson 24.05.2010 19:21

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

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

Автор: Jabbson 25.05.2010 1:18

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

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

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.

Автор: volvo 25.05.2010 2:29

Вот:

      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;

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 25.05.2010 3:04

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

Автор: volvo 25.05.2010 15:00

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;

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;

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

Автор: Jabbson 25.05.2010 19:30

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

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

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