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


Новичок
*

Группа: Пользователи
Сообщений: 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 килобайт ) Кол-во скачиваний: 539


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

Сообщений в этой теме


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

 





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