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

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

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

 
 Ответить  Открыть новую тему 
> Cтруктура данных для построения предметного указателя (через связанные списки).
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 11
Пол: Мужской
Реальное имя: Арсений

Репутация: -  0  +


Добрый день.

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

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

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

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

Есть объявления типа:
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 там.


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

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


Эскизы прикрепленных изображений
Прикрепленное изображение
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






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

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 и данные. Как это делать - я уже неоднократно показывал, читай на форуме. И почему это надо делать - тоже объяснял...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

Группа: Пользователи
Сообщений: 11
Пол: Мужской
Реальное имя: Арсений

Репутация: -  0  +


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

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

Сообщение отредактировано: Jabbson -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Новичок
*

Группа: Пользователи
Сообщений: 11
Пол: Мужской
Реальное имя: Арсений

Репутация: -  0  +


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

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

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 килобайт ) Кол-во скачиваний: 511


Сообщение отредактировано: Jabbson -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Гость






Вот:
Цитата
      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;


Ну, а более подробно, если хочешь, напишу завтра. Чтобы проверять, надо иметь компилятор под рукой, у меня сейчас его нету...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Новичок
*

Группа: Пользователи
Сообщений: 11
Пол: Мужской
Реальное имя: Арсений

Репутация: -  0  +


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

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

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

Сообщение отредактировано: Jabbson -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Гость






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


Новичок
*

Группа: Пользователи
Сообщений: 11
Пол: Мужской
Реальное имя: Арсений

Репутация: -  0  +


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

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

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


чтобы можно было обрабатывать и слова, написанные с маленькой буквы.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 



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