Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- program AISD_LAB2;
- uses
- System.SysUtils;
- const
- SegmentCount = 10;
- type
- PPages = ^PagesListElem;
- PagesListElem = record
- PageValue: Word;
- NextPage: PPages;
- end;
- PTerm = ^TermListElem;
- TermListElem = record
- TermValue: String;
- Subterm: PTerm;
- Pages: PPages;
- NextTerm: PTerm;
- end;
- PHeader = ^PSegmentListHeader;
- PSegmentListHeader = record
- FirstTerm: PTerm;
- end;
- THashTable = array [0..SegmentCount-1] of PHeader;
- var
- Choice: Integer;
- NewTerm: PTerm;
- TermValue: String;
- HashTable: THashTable;
- procedure OutputMainMenu;
- begin
- Writeln('--------------------------------------------------------');
- Writeln('1. Просмотреть предметный указатель по алфавиту');
- Writeln('2. Просмотреть предметный указатель по номерам страниц');
- Writeln('3. Добавить термин');
- Writeln('4. Редактировать термин');
- Writeln('5. Удалить термин');
- Writeln('6. Поиск терминов по подтермину');
- Writeln('7. Поиск подтермина по термину');
- Writeln('8. Выход');
- Writeln('--------------------------------------------------------');
- Writeln('Выберите желаемое действие:');
- end;
- procedure OutputEditTermMenu;
- begin
- Writeln('--------------------------------------------------------');
- Writeln('1. Добавить подтермин');
- Writeln('2. Редактировать подтермин');
- Writeln('3. Удалить подтермин');
- Writeln('4. Добавить номер страницы');
- Writeln('5. Удалить номер страницы');
- Writeln('6. Завершить');
- Writeln('--------------------------------------------------------');
- Writeln('Выберите желаемое действие:');
- end;
- function InputChoice(Min, Max: Integer): Integer;
- var
- Num: Integer;
- IsCorrect: Boolean;
- begin
- repeat
- IsCorrect := True;
- try
- Readln(Num);
- except
- Writeln('Некорректный ввод! Попробуйте еще:');
- IsCorrect := False;
- end;
- if IsCorrect and ((Num < Min) or (Num > Max)) then
- begin
- Writeln('Некорректный ввод! Попробуйте еще:');
- IsCorrect := False;
- end;
- until IsCorrect;
- InputChoice := Num;
- end;
- procedure CreateHashTable(var HashTable: THashTable);
- var
- I: Integer;
- begin
- for I := Low(HashTable) to High(HashTable) do
- begin
- New(HashTable[I]);
- HashTable[I]^.FirstTerm := nil;
- end;
- end;
- function HasTermListThisTerm (Header: PHeader; NewTermValue: String): Boolean;
- var
- HasThisTerm: Boolean;
- Head: PTerm;
- begin
- HasThisTerm := False;
- if Header^.FirstTerm <> nil then
- begin
- Head := Header^.FirstTerm;
- repeat
- if Head^.TermValue = NewTermValue then
- begin
- HasThisTerm := True;
- Break;
- end;
- Head := Head^.NextTerm;
- until Head = nil;
- if HasThisTerm then
- Writeln('Такой термин найден!');
- end;
- HasTermListThisTerm := HasThisTerm;
- end;
- function GetHashValue(NewTermValue: String): Integer;
- var
- I, Temp: Integer;
- begin
- Temp := 0;
- for I := Low(NewTermValue) to High(NewTermValue) do
- begin
- Temp := Temp + Ord(NewTermValue[I]);
- end;
- GetHashValue := Temp mod SegmentCount;
- end;
- function HasThisTerm(HashTable: THashTable; NewTermValue: String): Boolean;
- begin
- HasThisTerm := HasTermListThisTerm (HashTable[GetHashValue(NewTermValue)], NewTermValue);
- end;
- function CreateNewTerm(Value: String): PTerm;
- var
- NewTerm: PTerm;
- begin
- New(NewTerm);
- NewTerm^.TermValue := Value;
- NewTerm^.Subterm := nil;
- NewTerm^.Pages := nil;
- NewTerm^.NextTerm := nil;
- CreateNewTerm := NewTerm;
- end;
- procedure AddTermToHashTable(Header: PHeader; Term: PTerm);
- var
- Head: PTerm;
- begin
- if Header^.FirstTerm <> nil then
- begin
- Head := Header^.FirstTerm;
- while Head^.NextTerm <> nil do
- Head := Head^.NextTerm;
- Head^.NextTerm := Term;
- end
- else
- Header^.FirstTerm := Term;
- end;
- procedure AddTerm(NewTerm: PTerm);
- begin
- AddTermToHashTable(HashTable[GetHashValue(NewTerm^.TermValue)], NewTerm);
- Writeln('Термин добавлен успешно!');
- end;
- function CreateSubterm(Value: String): PTerm;
- var
- NewSubterm: PTerm;
- begin
- New(NewSubterm);
- NewSubterm^.TermValue := Value;
- NewSubterm^.Subterm := nil;
- NewSubterm^.Pages := nil;
- NewSubterm^.NextTerm := nil;
- CreateSubterm := NewSubterm;
- end;
- function HasSubtermListThisSubterm(Term: PTerm; NewSubtermValue: String): Boolean;
- var
- Curr: PTerm;
- HasThisSubterm: Boolean;
- begin
- HasThisSubterm := False;
- Curr := Term^.Subterm;
- if Curr <> nil then
- begin
- repeat
- if Curr^.TermValue = NewSubtermValue then
- begin
- HasThisSubterm := True;
- Break;
- end;
- Curr := Curr^.NextTerm;
- until Curr = nil;
- end;
- HasSubtermListThisSubterm := HasThisSubterm;
- end;
- procedure DeleteSubterm(NewTerm: PTerm);
- var
- Curr, Temp: PTerm;
- DelSubtermValue: String;
- begin
- Writeln('Введите подтермин: ');
- Readln(DelSubtermValue);
- if HasSubtermListThisSubterm(NewTerm, DelSubtermValue) then
- begin
- Curr := NewTerm^.Subterm;
- if Curr^.TermValue = DelSubtermValue then
- begin
- Temp := Curr;
- NewTerm^.Subterm := Curr^.NextTerm;
- Dispose(Temp);
- end
- else
- begin
- Temp := Curr^.NextTerm;
- while Temp^.TermValue <> DelSubtermValue do
- begin
- Curr := Temp;
- Temp := Temp^.NextTerm;
- end;
- Curr^.NextTerm := Temp^.NextTerm;
- Dispose(Temp);
- end;
- Writeln('Подтермин удален успешно!')
- end
- else
- Writeln('Подтермин не найден!');
- end;
- function CreatePage(PageValue: Word): PPages;
- var
- Page: PPages;
- begin
- New(Page);
- Page^.PageValue := PageValue;
- Page^.NextPage := nil;
- CreatePage := Page;
- end;
- procedure AddPage(NewTerm: PTerm);
- var
- Page: Word;
- Curr, Temp: PPages;
- begin
- Writeln('Введите страницу с термином:');
- Page := InputChoice(0, 65000);
- if NewTerm^.Pages = nil then
- begin
- NewTerm^.Pages := CreatePage(Page);
- Writeln('Страница добавлена успешно!');
- end
- else
- begin
- Curr := NewTerm^.Pages;
- if Page <= Curr^.PageValue then
- begin
- if Curr^.PageValue = Page then
- begin
- Writeln('Такая страница уже указана!');
- Exit;
- end
- else
- begin
- Temp := CreatePage(Page);
- Temp^.NextPage := Curr;
- NewTerm^.Pages := Temp;
- end;
- end
- else
- begin
- while (Curr^.NextPage <> nil) and (Curr^.NextPage^.PageValue <= Page) do
- begin
- if Curr^.NextPage^.PageValue = Page then
- begin
- Writeln('Такая страница уже указана!');
- Exit;
- end;
- Curr := Curr^.NextPage;
- end;
- if Curr^.NextPage = nil then
- Curr^.NextPage := CreatePage(Page)
- else
- begin
- Temp := CreatePage(Page);
- Temp^.NextPage := Curr^.NextPage;
- Curr^.NextPage := Temp;
- end;
- end;
- Writeln('Страница добавлена успешно!');
- end;
- end;
- procedure DeletePage(NewTerm: PTerm);
- var
- Page: Word;
- Curr, Temp: PPages;
- begin
- Writeln('Введите страницу с термином:');
- Page := InputChoice(0, 65000);
- if NewTerm^.Pages = nil then
- begin
- Writeln('Термин не указан ни на одной из страниц!');
- Exit;
- end
- else
- begin
- Curr := NewTerm^.Pages;
- if Curr^.PageValue = Page then
- begin
- NewTerm^.Pages := Curr^.NextPage;
- Dispose(Curr);
- Writeln('Удаление страницы успешно!');
- end
- else
- begin
- while (Curr^.NextPage <> nil) and (Curr^.NextPage^.PageValue <> Page) do
- Curr := Curr^.NextPage;
- if (Curr^.NextPage <> nil) and (Curr^.NextPage^.PageValue = Page) then
- begin
- Temp := Curr^.NextPage;
- Curr^.NextPage := Temp^.NextPage;
- Dispose(Temp);
- Writeln('Удаление страницы успешно!');
- end
- else
- begin
- Writeln('Термин не найден на данной странице!');
- end;
- end;
- end;
- end;
- procedure AddSubterm(NewTerm: PTerm);forward;
- procedure EditSubterm(NewTerm: PTerm);
- var
- SubtermValue: String;
- NowSubterm: PTerm;
- Choice:Integer;
- begin
- if NewTerm^.Subterm = nil then
- begin
- Writeln('У данного термина еще нет подтерминов!');
- Exit;
- end
- else
- begin
- Writeln('Введите поддтермин');
- Readln(SubtermValue);
- if HasSubtermListThisSubterm(NewTerm, SubtermValue) then
- begin
- if (NewTerm^.Subterm^.TermValue = SubtermValue) then
- begin
- NowSubterm := NewTerm^.Subterm;
- end
- else
- begin
- NowSubterm := NewTerm^.Subterm;
- while (NowSubterm^.NextTerm <> nil) and (NowSubterm^.NextTerm^.TermValue <> SubtermValue) do
- NowSubterm := NowSubterm^.NextTerm;
- NowSubterm := NowSubterm^.NextTerm;
- end;
- repeat
- Writeln('--------------------------------------------------------');
- Writeln('РЕДАКТОР ПОДТЕРМИНА ' + SubtermValue);
- OutputEditTermMenu;
- Choice := InputChoice(1,6);
- case Choice of
- 1: AddSubterm(NowSubterm);
- 2: EditSubterm(NowSubterm);
- 3: DeleteSubterm(NowSubterm);
- 4: AddPage(NowSubterm);
- 5: DeletePage(NowSubterm);
- 6:
- end;
- until Choice = 6;
- end
- else
- Writeln('Подтермин не найден!');
- end;
- end;
- procedure AddSubterm(NewTerm: PTerm);
- var
- Curr, NewSubterm: PTerm;
- NewSubtermValue: String;
- Choice:Integer;
- begin
- Writeln('Введите подтермин: ');
- Readln(NewSubtermValue);
- if HasSubtermListThisSubterm(NewTerm, NewSubtermValue) then
- Writeln('Такой подтермин уже существует')
- else
- begin
- NewSubterm := CreateNewTerm(NewSubtermValue);
- repeat
- Writeln('--------------------------------------------------------');
- Writeln('РЕДАКТОР ПОДТЕРМИНА ' + NewSubtermValue);
- OutputEditTermMenu;
- Choice := InputChoice(1,6);
- case Choice of
- 1: AddSubterm(NewSubterm);
- 2: EditSubterm(NewSubterm);
- 3: DeleteSubterm(NewSubterm);
- 4: AddPage(NewSubterm);
- 5: DeletePage(NewSubterm);
- 6:
- end;
- until Choice = 6;
- Curr := NewTerm^.Subterm;
- if Curr <> nil then
- begin
- while Curr^.NextTerm <> nil do
- Curr := Curr^.NextTerm;
- Curr^.NextTerm := NewSubterm;
- end
- else
- NewTerm^.Subterm := NewSubterm;
- Writeln('Подтермин добавлен успешно!');
- end;
- end;
- procedure InsertElementInAlphabet(var Header: PHeader; Term: PTerm);
- var
- Curr, Temp, NewTerm: PTerm;
- begin
- New(NewTerm);
- NewTerm^.TermValue := Term^.TermValue;
- NewTerm^.Subterm := Term^.Subterm;
- NewTerm^.Pages := Term^.Pages;
- NewTerm^.NextTerm := nil;
- if Header^.FirstTerm = nil then
- begin
- Header^.FirstTerm := NewTerm;
- end
- else
- begin
- if (NewTerm^.TermValue <= Header^.FirstTerm^.TermValue) then
- begin
- New(Temp);
- Temp^.NextTerm := Header^.FirstTerm;
- Header^.FirstTerm := Temp;
- Temp^.TermValue := NewTerm^.TermValue;
- Temp^.Subterm := NewTerm^.Subterm;
- Temp^.Pages := NewTerm^.Pages;
- end
- else
- begin
- Curr := Header^.FirstTerm;
- while (Curr^.NextTerm <> nil) and (Curr^.NextTerm^.TermValue <= NewTerm^.TermValue) do
- Curr := Curr^.NextTerm;
- New(Temp);
- Temp^.NextTerm := Curr^.NextTerm;
- Curr^.NextTerm := Temp;
- Temp^.TermValue := NewTerm^.TermValue;
- Temp^.Subterm := NewTerm^.Subterm;
- Temp^.Pages := NewTerm^.Pages;
- end;
- end;
- end;
- function InitializeList(): PHeader;
- var
- Header: PHeader;
- begin
- New(Header);
- Header^.FirstTerm := nil;
- InitializeList := Header;
- end;
- function TurnArrayToAlphabetSortedList(HashTable: THashTable): PHeader;
- Var
- I: Integer;
- Curr: PTerm;
- SortedListHeader: PHeader;
- Begin
- SortedListHeader := InitializeList();
- for I := Low(HashTable) to High(HashTable) do
- if HashTable[I]^.FirstTerm <> nil then
- begin
- Curr := HashTable[I]^.FirstTerm;
- while Curr^.NextTerm <> nil do
- begin
- InsertElementInAlphabet(SortedListHeader, Curr);
- Curr := Curr^.NextTerm;
- end;
- if Curr <> nil then
- InsertElementInAlphabet(SortedListHeader, Curr);
- end;
- TurnArrayToAlphabetSortedList := SortedListHeader;
- End;
- procedure OutputSubterm(Subterm: PTerm; Padding: String);
- var
- Page: PPages;
- begin
- if Subterm = nil then
- Exit
- else
- begin
- Write(Padding + Subterm^.TermValue + '| ');
- Page := Subterm^.Pages;
- while Page <> nil do
- begin
- Write(Page^.PageValue, ' ');
- Page := Page^.NextPage;
- end;
- Writeln;
- OutputSubterm(Subterm^.Subterm, Padding + ' ');
- end;
- end;
- procedure OutputList(Header: PHeader);
- var
- Term, Subterm: PTerm;
- Page: PPages;
- begin
- if Header^.FirstTerm = nil then
- Writeln('Предметный указатель не заполнен!')
- else
- begin
- Writeln('ПРЕДМЕТНЫЙ УКАЗАТЕЛЬ');
- Term := Header^.FirstTerm;
- repeat
- Writeln('----------------------------');
- Write(Term^.TermValue + '| ');
- Page := Term^.Pages;
- while Page <> nil do
- begin
- Write(Page^.PageValue, ' ');
- Page := Page^.NextPage;
- end;
- if (Term^.Subterm <> nil) then
- begin
- Writeln;
- Subterm := Term^.Subterm;
- repeat
- OutputSubterm(Subterm, ' ');
- Subterm := Subterm^.NextTerm;
- until Subterm = nil;
- end
- else
- Writeln;
- Writeln('----------------------------');
- Term := Term^.NextTerm;
- until Term = nil;
- end;
- end;
- procedure DisposeList (var Header: PHeader);
- var
- Curr, Temp: PTerm;
- begin
- Curr := Header^.FirstTerm;
- while Curr <> nil do
- begin
- Temp := Curr;
- Curr := Curr^.NextTerm;
- Dispose(Temp);
- end;
- Dispose(Header);
- end;
- procedure OutputSubjectIndexInAlphabet(HashTable: THashTable);
- var
- AlphabetListHeader: PHeader;
- begin
- AlphabetListHeader := TurnArrayToAlphabetSortedList(HashTable);
- OutputList(AlphabetListHeader);
- DisposeList(AlphabetListHeader);
- end;
- procedure InsertElementInPage(var Header: PHeader; Term: PTerm);
- var
- Curr, Temp, NewTerm: PTerm;
- TermPage, CurrPage: PPages;
- begin
- New(NewTerm);
- NewTerm^.TermValue := Term^.TermValue;
- NewTerm^.Subterm := Term^.Subterm;
- NewTerm^.Pages := Term^.Pages;
- NewTerm^.NextTerm := nil;
- if Header^.FirstTerm = nil then
- begin
- Header^.FirstTerm := NewTerm;
- end
- else
- begin
- if (NewTerm^.Pages^.PageValue <= Header^.FirstTerm^.Pages^.PageValue) then
- begin
- if (NewTerm^.Pages^.PageValue = Header^.FirstTerm^.Pages^.PageValue) then
- begin
- CurrPage := Header^.FirstTerm^.Pages;
- TermPage := NewTerm^.Pages;
- while (CurrPage <> nil) and (TermPage <> nil) and (TermPage^.PageValue = CurrPage^.PageValue) do
- begin
- CurrPage := CurrPage^.NextPage;
- TermPage := TermPage^.NextPage;
- end;
- if ((TermPage = nil) and (CurrPage <> nil)) or ((CurrPage <> nil) and (TermPage^.PageValue < CurrPage^.PageValue)) then
- begin
- New(Temp);
- Temp^.NextTerm := Header^.FirstTerm;
- Header^.FirstTerm := Temp;
- Temp^.TermValue := NewTerm^.TermValue;
- Temp^.Subterm := NewTerm^.Subterm;
- Temp^.Pages := NewTerm^.Pages;
- end
- else
- begin
- New(Temp);
- Temp^.NextTerm := Header^.FirstTerm^.NextTerm;
- Header^.FirstTerm^.NextTerm := Temp;
- Temp^.TermValue := NewTerm^.TermValue;
- Temp^.Subterm := NewTerm^.Subterm;
- Temp^.Pages := NewTerm^.Pages;
- end;
- end
- else
- begin
- New(Temp);
- Temp^.NextTerm := Header^.FirstTerm;
- Header^.FirstTerm := Temp;
- Temp^.TermValue := NewTerm^.TermValue;
- Temp^.Subterm := NewTerm^.Subterm;
- Temp^.Pages := NewTerm^.Pages;
- end;
- end
- else
- begin
- Curr := Header^.FirstTerm;
- while (Curr^.NextTerm <> nil) and (Curr^.NextTerm^.Pages^.PageValue < NewTerm^.Pages^.PageValue) do
- Curr := Curr^.NextTerm;
- if (Curr^.NextTerm <> nil) and (Curr^.NextTerm^.Pages^.PageValue = NewTerm^.Pages^.PageValue) then
- begin
- CurrPage := Curr^.NextTerm^.Pages;
- TermPage := NewTerm^.Pages;
- while (CurrPage <> nil) and (TermPage <> nil) and (CurrPage^.PageValue = TermPage^.PageValue) do
- begin
- CurrPage := CurrPage^.NextPage;
- TermPage := TermPage^.NextPage;
- end;
- if ((TermPage = nil) and (CurrPage <> nil)) or ((CurrPage <> nil) and (TermPage^.PageValue < CurrPage^.PageValue)) then
- begin
- New(Temp);
- Temp^.NextTerm := Curr^.NextTerm;
- Curr^.NextTerm := Temp;
- Temp^.TermValue := NewTerm^.TermValue;
- Temp^.Subterm := NewTerm^.Subterm;
- Temp^.Pages := NewTerm^.Pages;
- end
- else
- begin
- Curr := Curr^.NextTerm;
- New(Temp);
- Temp^.NextTerm := Curr^.NextTerm;
- Curr^.NextTerm := Temp;
- Temp^.TermValue := NewTerm^.TermValue;
- Temp^.Subterm := NewTerm^.Subterm;
- Temp^.Pages := NewTerm^.Pages;
- end;
- end
- else
- begin
- New(Temp);
- Temp^.NextTerm := Curr^.NextTerm;
- Curr^.NextTerm := Temp;
- Temp^.TermValue := NewTerm^.TermValue;
- Temp^.Subterm := NewTerm^.Subterm;
- Temp^.Pages := NewTerm^.Pages;
- end;
- end;
- end;
- end;
- function TurnArrayToPageSortedList(HashTable: THashTable): PHeader;
- Var
- I: Integer;
- Curr: PTerm;
- SortedListHeader: PHeader;
- Begin
- SortedListHeader := InitializeList();
- for I := Low(HashTable) to High(HashTable) do
- if HashTable[I]^.FirstTerm <> nil then
- begin
- Curr := HashTable[I]^.FirstTerm;
- repeat
- InsertElementInPage(SortedListHeader, Curr);
- Curr := Curr^.NextTerm;
- until Curr = nil;
- end;
- TurnArrayToPageSortedList := SortedListHeader;
- End;
- procedure OutputSubjectIndexInPage(HashTable: THashTable);
- var
- PageListHeader: PHeader;
- begin
- PageListHeader := TurnArrayToPageSortedList(HashTable);
- OutputList(PageListHeader);
- DisposeList(PageListHeader);
- end;
- procedure EditTerm(HashTable: THashTable);
- var
- TermValue: String;
- NowTerm: PTerm;
- Choice:Integer;
- Header: PHeader;
- begin
- Writeln('Введите термин');
- Readln(TermValue);
- if HasThisTerm(HashTable, TermValue) then
- begin
- Header := HashTable[GetHashValue(TermValue)];
- if (Header^.FirstTerm^.TermValue = TermValue) then
- begin
- NowTerm := Header^.FirstTerm;
- end
- else
- begin
- NowTerm := Header^.FirstTerm;
- while (NowTerm^.NextTerm <> nil) and (NowTerm^.NextTerm^.TermValue <> TermValue) do
- NowTerm := NowTerm^.NextTerm;
- NowTerm := NowTerm^.NextTerm;
- end;
- repeat
- Writeln('--------------------------------------------------------');
- Writeln('РЕДАКТОР ТЕРМИНА ' + TermValue);
- OutputEditTermMenu;
- Choice := InputChoice(1,6);
- case Choice of
- 1: AddSubterm(NowTerm);
- 2: EditSubterm(NowTerm);
- 3: DeleteSubterm(NowTerm);
- 4: AddPage(NowTerm);
- 5: DeletePage(NowTerm);
- 6:
- end;
- until Choice = 6;
- end
- else
- Writeln('Термин не найден!');
- end;
- procedure DeleteTerm(HashTable: THashTable);
- var
- Curr, Temp: PTerm;
- DelTermValue: String;
- Header: PHeader;
- begin
- Writeln('Введите термин: ');
- Readln(DelTermValue);
- if HasThisTerm(HashTable, DelTermValue) then
- begin
- Header := HashTable[GetHashValue(DelTermValue)];
- Curr := Header^.FirstTerm;
- if Curr^.TermValue = DelTermValue then
- begin
- Temp := Curr;
- Header^.FirstTerm := Curr^.NextTerm;
- Dispose(Temp);
- end
- else
- begin
- Temp := Curr^.NextTerm;
- while Temp^.TermValue <> DelTermValue do
- begin
- Curr := Temp;
- Temp := Temp^.NextTerm;
- end;
- Curr^.NextTerm := Temp^.NextTerm;
- Dispose(Temp);
- end;
- Writeln('Термин удален успешно!')
- end
- else
- Writeln('Термин не найден!');
- end;
- procedure OutputAllSubterms(Term: PTerm);
- var
- Subterm: PTerm;
- begin
- if (Term^.Subterm <> nil) then
- begin
- Subterm := Term^.Subterm;
- repeat
- OutputSubterm(Subterm, ' ');
- Subterm := Subterm^.NextTerm;
- until Subterm = nil;
- end
- else
- Writeln;
- end;
- procedure SearhSubtermByTerm(HashTable: THashTable; TermValue: String);
- var
- Hash: Integer;
- Curr: PTerm;
- begin
- Hash := GetHashValue(TermValue);
- if not HasThisTerm(HashTable, TermValue) then
- Writeln('Не найден такой термин!')
- else
- begin
- Curr := HashTable[Hash]^.FirstTerm;
- while (Curr <> nil) and (Curr^.TermValue <> TermValue) do
- Curr := Curr^.NextTerm;
- Writeln('Подтермины ', TermValue,':');
- OutputAllSubterms(Curr);
- end;
- end;
- procedure OutputTerm(Term: PTerm);
- var
- Page: PPages;
- Subterm: PTerm;
- begin
- Writeln('----------------------------');
- Write(Term^.TermValue + '| ');
- Page := Term^.Pages;
- while Page <> nil do
- begin
- Write(Page^.PageValue, ' ');
- Page := Page^.NextPage;
- end;
- if (Term^.Subterm <> nil) then
- begin
- Writeln;
- Subterm := Term^.Subterm;
- repeat
- OutputSubterm(Subterm, ' ');
- Subterm := Subterm^.NextTerm;
- until Subterm = nil;
- end
- else
- Writeln;
- Writeln('----------------------------');
- end;
- function CheckSubtermList(Subterm: PTerm; SubtermValue: String): Boolean;
- var
- HasSubterm: Boolean;
- Curr: PTerm;
- begin
- Curr := Subterm;
- if Curr^.Subterm <> nil then
- begin
- HasSubterm := CheckSubtermList(Curr^.Subterm, SubtermValue);
- if HasSubterm then
- begin
- CheckSubtermList := True;
- Exit;
- end;
- CheckSubtermList := SubtermValue = Curr^.TermValue;
- end
- else
- begin
- if Curr^.NextTerm <> nil then
- begin
- HasSubterm := CheckSubtermList(Curr^.NextTerm, SubtermValue);
- if HasSubterm then
- begin
- CheckSubtermList := True;
- Exit;
- end;
- CheckSubtermList := SubtermValue = Curr^.TermValue;
- end
- else
- CheckSubtermList := SubtermValue = Curr^.TermValue;
- end
- end;
- procedure CheckTermBySubterm(Term: PTerm; SubtermValue: String);
- begin
- while Term <> nil do
- begin
- if Term^.Subterm <> nil then
- begin
- if CheckSubtermList(Term^.Subterm, SubtermValue)then
- OutputTerm(Term);
- end;
- Term := Term^.NextTerm;
- end;
- end;
- procedure SearchTermBySubterm(HashTable: THashTable; SubtermValue: String);
- var
- I: Integer;
- begin
- for I := Low(HashTable) to High(HashTable) do
- begin
- if HashTable[I]^.FirstTerm <> nil then
- begin
- CheckTermBySubterm(HashTable[I]^.FirstTerm, SubtermValue);
- end;
- end;
- end;
- begin
- Writeln('Данная программа - предметный указатель');
- CreateHashTable(HashTable);
- repeat
- OutputMainMenu;
- Choice := InputChoice(1, 8);
- case Choice of
- 1: OutputSubjectIndexInAlphabet(HashTable);
- 2: OutputSubjectIndexInPage(HashTable);
- 3: begin
- Writeln('Введите термин: ');
- Readln(TermValue);
- if not HasThisTerm(HashTable, TermValue) then
- begin
- NewTerm := CreateNewTerm(TermValue);
- repeat
- Writeln('--------------------------------------------------------');
- Writeln('РЕДАКТОР ТЕРМИНА ' + TermValue);
- OutputEditTermMenu;
- Choice := InputChoice(1,6);
- case Choice of
- 1: AddSubterm(NewTerm);
- 2: EditSubterm(NewTerm);
- 3: DeleteSubterm(NewTerm);
- 4: AddPage(NewTerm);
- 5: DeletePage(NewTerm);
- 6: AddTerm(NewTerm);
- end;
- until Choice = 6;
- end;
- end;
- 4: EditTerm(HashTable);
- 5: DeleteTerm(HashTable);
- 6: begin
- Writeln('Введите подтермин:');
- Readln(TermValue);
- SearchTermBySubterm(HashTable, TermValue)
- end;
- 7: begin
- Writeln('Введите термин:');
- Readln(TermValue);
- SearhSubtermByTerm(HashTable, TermValue)
- end;
- end;
- until Choice = 8;
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement