Advertisement
THOMAS_SHELBY_18

aisd2

Mar 27th, 2024
15
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 28.98 KB | None | 0 0
  1. program AISD_LAB2;
  2.  
  3. uses
  4. System.SysUtils;
  5.  
  6. const
  7. SegmentCount = 10;
  8.  
  9. type
  10. PPages = ^PagesListElem;
  11. PagesListElem = record
  12. PageValue: Word;
  13. NextPage: PPages;
  14. end;
  15.  
  16. PTerm = ^TermListElem;
  17. TermListElem = record
  18. TermValue: String;
  19. Subterm: PTerm;
  20. Pages: PPages;
  21. NextTerm: PTerm;
  22. end;
  23.  
  24. PHeader = ^PSegmentListHeader;
  25. PSegmentListHeader = record
  26. FirstTerm: PTerm;
  27. end;
  28.  
  29. THashTable = array [0..SegmentCount-1] of PHeader;
  30.  
  31. var
  32. Choice: Integer;
  33. NewTerm: PTerm;
  34. TermValue: String;
  35. HashTable: THashTable;
  36.  
  37. procedure OutputMainMenu;
  38. begin
  39. Writeln('--------------------------------------------------------');
  40. Writeln('1. Просмотреть предметный указатель по алфавиту');
  41. Writeln('2. Просмотреть предметный указатель по номерам страниц');
  42. Writeln('3. Добавить термин');
  43. Writeln('4. Редактировать термин');
  44. Writeln('5. Удалить термин');
  45. Writeln('6. Поиск терминов по подтермину');
  46. Writeln('7. Поиск подтермина по термину');
  47. Writeln('8. Выход');
  48. Writeln('--------------------------------------------------------');
  49. Writeln('Выберите желаемое действие:');
  50. end;
  51.  
  52. procedure OutputEditTermMenu;
  53. begin
  54. Writeln('--------------------------------------------------------');
  55. Writeln('1. Добавить подтермин');
  56. Writeln('2. Редактировать подтермин');
  57. Writeln('3. Удалить подтермин');
  58. Writeln('4. Добавить номер страницы');
  59. Writeln('5. Удалить номер страницы');
  60. Writeln('6. Завершить');
  61. Writeln('--------------------------------------------------------');
  62. Writeln('Выберите желаемое действие:');
  63. end;
  64.  
  65. function InputChoice(Min, Max: Integer): Integer;
  66. var
  67. Num: Integer;
  68. IsCorrect: Boolean;
  69. begin
  70. repeat
  71. IsCorrect := True;
  72. try
  73. Readln(Num);
  74. except
  75. Writeln('Некорректный ввод! Попробуйте еще:');
  76. IsCorrect := False;
  77. end;
  78. if IsCorrect and ((Num < Min) or (Num > Max)) then
  79. begin
  80. Writeln('Некорректный ввод! Попробуйте еще:');
  81. IsCorrect := False;
  82. end;
  83. until IsCorrect;
  84. InputChoice := Num;
  85. end;
  86.  
  87. procedure CreateHashTable(var HashTable: THashTable);
  88. var
  89. I: Integer;
  90. begin
  91. for I := Low(HashTable) to High(HashTable) do
  92. begin
  93. New(HashTable[I]);
  94. HashTable[I]^.FirstTerm := nil;
  95. end;
  96. end;
  97.  
  98. function HasTermListThisTerm (Header: PHeader; NewTermValue: String): Boolean;
  99. var
  100. HasThisTerm: Boolean;
  101. Head: PTerm;
  102. begin
  103. HasThisTerm := False;
  104. if Header^.FirstTerm <> nil then
  105. begin
  106. Head := Header^.FirstTerm;
  107. repeat
  108. if Head^.TermValue = NewTermValue then
  109. begin
  110. HasThisTerm := True;
  111. Break;
  112. end;
  113. Head := Head^.NextTerm;
  114. until Head = nil;
  115.  
  116. if HasThisTerm then
  117. Writeln('Такой термин найден!');
  118. end;
  119.  
  120. HasTermListThisTerm := HasThisTerm;
  121. end;
  122.  
  123. function GetHashValue(NewTermValue: String): Integer;
  124. var
  125. I, Temp: Integer;
  126. begin
  127. Temp := 0;
  128. for I := Low(NewTermValue) to High(NewTermValue) do
  129. begin
  130. Temp := Temp + Ord(NewTermValue[I]);
  131. end;
  132. GetHashValue := Temp mod SegmentCount;
  133. end;
  134.  
  135. function HasThisTerm(HashTable: THashTable; NewTermValue: String): Boolean;
  136. begin
  137. HasThisTerm := HasTermListThisTerm (HashTable[GetHashValue(NewTermValue)], NewTermValue);
  138. end;
  139.  
  140. function CreateNewTerm(Value: String): PTerm;
  141. var
  142. NewTerm: PTerm;
  143. begin
  144. New(NewTerm);
  145. NewTerm^.TermValue := Value;
  146. NewTerm^.Subterm := nil;
  147. NewTerm^.Pages := nil;
  148. NewTerm^.NextTerm := nil;
  149.  
  150. CreateNewTerm := NewTerm;
  151. end;
  152.  
  153. procedure AddTermToHashTable(Header: PHeader; Term: PTerm);
  154. var
  155. Head: PTerm;
  156. begin
  157. if Header^.FirstTerm <> nil then
  158. begin
  159. Head := Header^.FirstTerm;
  160. while Head^.NextTerm <> nil do
  161. Head := Head^.NextTerm;
  162. Head^.NextTerm := Term;
  163. end
  164. else
  165. Header^.FirstTerm := Term;
  166. end;
  167.  
  168. procedure AddTerm(NewTerm: PTerm);
  169. begin
  170. AddTermToHashTable(HashTable[GetHashValue(NewTerm^.TermValue)], NewTerm);
  171. Writeln('Термин добавлен успешно!');
  172. end;
  173.  
  174. function CreateSubterm(Value: String): PTerm;
  175. var
  176. NewSubterm: PTerm;
  177. begin
  178. New(NewSubterm);
  179. NewSubterm^.TermValue := Value;
  180. NewSubterm^.Subterm := nil;
  181. NewSubterm^.Pages := nil;
  182. NewSubterm^.NextTerm := nil;
  183.  
  184. CreateSubterm := NewSubterm;
  185. end;
  186.  
  187. function HasSubtermListThisSubterm(Term: PTerm; NewSubtermValue: String): Boolean;
  188. var
  189. Curr: PTerm;
  190. HasThisSubterm: Boolean;
  191. begin
  192. HasThisSubterm := False;
  193. Curr := Term^.Subterm;
  194. if Curr <> nil then
  195. begin
  196. repeat
  197. if Curr^.TermValue = NewSubtermValue then
  198. begin
  199. HasThisSubterm := True;
  200. Break;
  201. end;
  202. Curr := Curr^.NextTerm;
  203. until Curr = nil;
  204. end;
  205.  
  206. HasSubtermListThisSubterm := HasThisSubterm;
  207. end;
  208.  
  209. procedure DeleteSubterm(NewTerm: PTerm);
  210. var
  211. Curr, Temp: PTerm;
  212. DelSubtermValue: String;
  213. begin
  214. Writeln('Введите подтермин: ');
  215. Readln(DelSubtermValue);
  216. if HasSubtermListThisSubterm(NewTerm, DelSubtermValue) then
  217. begin
  218. Curr := NewTerm^.Subterm;
  219. if Curr^.TermValue = DelSubtermValue then
  220. begin
  221. Temp := Curr;
  222. NewTerm^.Subterm := Curr^.NextTerm;
  223. Dispose(Temp);
  224. end
  225. else
  226. begin
  227. Temp := Curr^.NextTerm;
  228. while Temp^.TermValue <> DelSubtermValue do
  229. begin
  230. Curr := Temp;
  231. Temp := Temp^.NextTerm;
  232. end;
  233.  
  234. Curr^.NextTerm := Temp^.NextTerm;
  235. Dispose(Temp);
  236. end;
  237. Writeln('Подтермин удален успешно!')
  238. end
  239. else
  240. Writeln('Подтермин не найден!');
  241. end;
  242.  
  243. function CreatePage(PageValue: Word): PPages;
  244. var
  245. Page: PPages;
  246. begin
  247. New(Page);
  248. Page^.PageValue := PageValue;
  249. Page^.NextPage := nil;
  250.  
  251. CreatePage := Page;
  252. end;
  253.  
  254. procedure AddPage(NewTerm: PTerm);
  255. var
  256. Page: Word;
  257. Curr, Temp: PPages;
  258. begin
  259. Writeln('Введите страницу с термином:');
  260. Page := InputChoice(0, 65000);
  261.  
  262. if NewTerm^.Pages = nil then
  263. begin
  264. NewTerm^.Pages := CreatePage(Page);
  265. Writeln('Страница добавлена успешно!');
  266. end
  267. else
  268. begin
  269. Curr := NewTerm^.Pages;
  270. if Page <= Curr^.PageValue then
  271. begin
  272. if Curr^.PageValue = Page then
  273. begin
  274. Writeln('Такая страница уже указана!');
  275. Exit;
  276. end
  277. else
  278. begin
  279. Temp := CreatePage(Page);
  280. Temp^.NextPage := Curr;
  281. NewTerm^.Pages := Temp;
  282. end;
  283. end
  284. else
  285. begin
  286. while (Curr^.NextPage <> nil) and (Curr^.NextPage^.PageValue <= Page) do
  287. begin
  288. if Curr^.NextPage^.PageValue = Page then
  289. begin
  290. Writeln('Такая страница уже указана!');
  291. Exit;
  292. end;
  293. Curr := Curr^.NextPage;
  294. end;
  295.  
  296. if Curr^.NextPage = nil then
  297. Curr^.NextPage := CreatePage(Page)
  298. else
  299. begin
  300. Temp := CreatePage(Page);
  301. Temp^.NextPage := Curr^.NextPage;
  302. Curr^.NextPage := Temp;
  303. end;
  304. end;
  305. Writeln('Страница добавлена успешно!');
  306. end;
  307. end;
  308.  
  309. procedure DeletePage(NewTerm: PTerm);
  310. var
  311. Page: Word;
  312. Curr, Temp: PPages;
  313. begin
  314. Writeln('Введите страницу с термином:');
  315. Page := InputChoice(0, 65000);
  316.  
  317. if NewTerm^.Pages = nil then
  318. begin
  319. Writeln('Термин не указан ни на одной из страниц!');
  320. Exit;
  321. end
  322. else
  323. begin
  324. Curr := NewTerm^.Pages;
  325. if Curr^.PageValue = Page then
  326. begin
  327. NewTerm^.Pages := Curr^.NextPage;
  328. Dispose(Curr);
  329. Writeln('Удаление страницы успешно!');
  330. end
  331. else
  332. begin
  333. while (Curr^.NextPage <> nil) and (Curr^.NextPage^.PageValue <> Page) do
  334. Curr := Curr^.NextPage;
  335.  
  336. if (Curr^.NextPage <> nil) and (Curr^.NextPage^.PageValue = Page) then
  337. begin
  338. Temp := Curr^.NextPage;
  339. Curr^.NextPage := Temp^.NextPage;
  340. Dispose(Temp);
  341. Writeln('Удаление страницы успешно!');
  342. end
  343. else
  344. begin
  345. Writeln('Термин не найден на данной странице!');
  346. end;
  347. end;
  348. end;
  349. end;
  350.  
  351. procedure AddSubterm(NewTerm: PTerm);forward;
  352.  
  353. procedure EditSubterm(NewTerm: PTerm);
  354. var
  355. SubtermValue: String;
  356. NowSubterm: PTerm;
  357. Choice:Integer;
  358. begin
  359. if NewTerm^.Subterm = nil then
  360. begin
  361. Writeln('У данного термина еще нет подтерминов!');
  362. Exit;
  363. end
  364. else
  365. begin
  366. Writeln('Введите поддтермин');
  367. Readln(SubtermValue);
  368. if HasSubtermListThisSubterm(NewTerm, SubtermValue) then
  369. begin
  370. if (NewTerm^.Subterm^.TermValue = SubtermValue) then
  371. begin
  372. NowSubterm := NewTerm^.Subterm;
  373. end
  374. else
  375. begin
  376. NowSubterm := NewTerm^.Subterm;
  377. while (NowSubterm^.NextTerm <> nil) and (NowSubterm^.NextTerm^.TermValue <> SubtermValue) do
  378. NowSubterm := NowSubterm^.NextTerm;
  379.  
  380. NowSubterm := NowSubterm^.NextTerm;
  381. end;
  382.  
  383. repeat
  384. Writeln('--------------------------------------------------------');
  385. Writeln('РЕДАКТОР ПОДТЕРМИНА ' + SubtermValue);
  386. OutputEditTermMenu;
  387. Choice := InputChoice(1,6);
  388. case Choice of
  389. 1: AddSubterm(NowSubterm);
  390. 2: EditSubterm(NowSubterm);
  391. 3: DeleteSubterm(NowSubterm);
  392. 4: AddPage(NowSubterm);
  393. 5: DeletePage(NowSubterm);
  394. 6:
  395. end;
  396. until Choice = 6;
  397. end
  398. else
  399. Writeln('Подтермин не найден!');
  400. end;
  401. end;
  402.  
  403. procedure AddSubterm(NewTerm: PTerm);
  404. var
  405. Curr, NewSubterm: PTerm;
  406. NewSubtermValue: String;
  407. Choice:Integer;
  408. begin
  409. Writeln('Введите подтермин: ');
  410. Readln(NewSubtermValue);
  411. if HasSubtermListThisSubterm(NewTerm, NewSubtermValue) then
  412. Writeln('Такой подтермин уже существует')
  413. else
  414. begin
  415. NewSubterm := CreateNewTerm(NewSubtermValue);
  416. repeat
  417. Writeln('--------------------------------------------------------');
  418. Writeln('РЕДАКТОР ПОДТЕРМИНА ' + NewSubtermValue);
  419. OutputEditTermMenu;
  420. Choice := InputChoice(1,6);
  421. case Choice of
  422. 1: AddSubterm(NewSubterm);
  423. 2: EditSubterm(NewSubterm);
  424. 3: DeleteSubterm(NewSubterm);
  425. 4: AddPage(NewSubterm);
  426. 5: DeletePage(NewSubterm);
  427. 6:
  428. end;
  429. until Choice = 6;
  430.  
  431. Curr := NewTerm^.Subterm;
  432. if Curr <> nil then
  433. begin
  434. while Curr^.NextTerm <> nil do
  435. Curr := Curr^.NextTerm;
  436. Curr^.NextTerm := NewSubterm;
  437. end
  438. else
  439. NewTerm^.Subterm := NewSubterm;
  440.  
  441. Writeln('Подтермин добавлен успешно!');
  442. end;
  443. end;
  444.  
  445. procedure InsertElementInAlphabet(var Header: PHeader; Term: PTerm);
  446. var
  447. Curr, Temp, NewTerm: PTerm;
  448. begin
  449. New(NewTerm);
  450. NewTerm^.TermValue := Term^.TermValue;
  451. NewTerm^.Subterm := Term^.Subterm;
  452. NewTerm^.Pages := Term^.Pages;
  453. NewTerm^.NextTerm := nil;
  454.  
  455. if Header^.FirstTerm = nil then
  456. begin
  457. Header^.FirstTerm := NewTerm;
  458. end
  459. else
  460. begin
  461. if (NewTerm^.TermValue <= Header^.FirstTerm^.TermValue) then
  462. begin
  463. New(Temp);
  464. Temp^.NextTerm := Header^.FirstTerm;
  465. Header^.FirstTerm := Temp;
  466. Temp^.TermValue := NewTerm^.TermValue;
  467. Temp^.Subterm := NewTerm^.Subterm;
  468. Temp^.Pages := NewTerm^.Pages;
  469. end
  470. else
  471. begin
  472. Curr := Header^.FirstTerm;
  473. while (Curr^.NextTerm <> nil) and (Curr^.NextTerm^.TermValue <= NewTerm^.TermValue) do
  474. Curr := Curr^.NextTerm;
  475.  
  476. New(Temp);
  477. Temp^.NextTerm := Curr^.NextTerm;
  478. Curr^.NextTerm := Temp;
  479. Temp^.TermValue := NewTerm^.TermValue;
  480. Temp^.Subterm := NewTerm^.Subterm;
  481. Temp^.Pages := NewTerm^.Pages;
  482. end;
  483. end;
  484. end;
  485.  
  486. function InitializeList(): PHeader;
  487. var
  488. Header: PHeader;
  489. begin
  490. New(Header);
  491. Header^.FirstTerm := nil;
  492. InitializeList := Header;
  493. end;
  494.  
  495. function TurnArrayToAlphabetSortedList(HashTable: THashTable): PHeader;
  496. Var
  497. I: Integer;
  498. Curr: PTerm;
  499. SortedListHeader: PHeader;
  500. Begin
  501. SortedListHeader := InitializeList();
  502. for I := Low(HashTable) to High(HashTable) do
  503. if HashTable[I]^.FirstTerm <> nil then
  504. begin
  505. Curr := HashTable[I]^.FirstTerm;
  506. while Curr^.NextTerm <> nil do
  507. begin
  508. InsertElementInAlphabet(SortedListHeader, Curr);
  509. Curr := Curr^.NextTerm;
  510. end;
  511. if Curr <> nil then
  512. InsertElementInAlphabet(SortedListHeader, Curr);
  513. end;
  514. TurnArrayToAlphabetSortedList := SortedListHeader;
  515. End;
  516.  
  517. procedure OutputSubterm(Subterm: PTerm; Padding: String);
  518. var
  519. Page: PPages;
  520. begin
  521. if Subterm = nil then
  522. Exit
  523. else
  524. begin
  525. Write(Padding + Subterm^.TermValue + '| ');
  526. Page := Subterm^.Pages;
  527. while Page <> nil do
  528. begin
  529. Write(Page^.PageValue, ' ');
  530. Page := Page^.NextPage;
  531. end;
  532. Writeln;
  533. OutputSubterm(Subterm^.Subterm, Padding + ' ');
  534. end;
  535. end;
  536.  
  537. procedure OutputList(Header: PHeader);
  538. var
  539. Term, Subterm: PTerm;
  540. Page: PPages;
  541. begin
  542. if Header^.FirstTerm = nil then
  543. Writeln('Предметный указатель не заполнен!')
  544. else
  545. begin
  546. Writeln('ПРЕДМЕТНЫЙ УКАЗАТЕЛЬ');
  547. Term := Header^.FirstTerm;
  548. repeat
  549. Writeln('----------------------------');
  550. Write(Term^.TermValue + '| ');
  551. Page := Term^.Pages;
  552. while Page <> nil do
  553. begin
  554. Write(Page^.PageValue, ' ');
  555. Page := Page^.NextPage;
  556. end;
  557. if (Term^.Subterm <> nil) then
  558. begin
  559. Writeln;
  560. Subterm := Term^.Subterm;
  561. repeat
  562. OutputSubterm(Subterm, ' ');
  563. Subterm := Subterm^.NextTerm;
  564. until Subterm = nil;
  565. end
  566. else
  567. Writeln;
  568. Writeln('----------------------------');
  569. Term := Term^.NextTerm;
  570. until Term = nil;
  571. end;
  572. end;
  573.  
  574. procedure DisposeList (var Header: PHeader);
  575. var
  576. Curr, Temp: PTerm;
  577. begin
  578. Curr := Header^.FirstTerm;
  579. while Curr <> nil do
  580. begin
  581. Temp := Curr;
  582. Curr := Curr^.NextTerm;
  583. Dispose(Temp);
  584. end;
  585. Dispose(Header);
  586. end;
  587.  
  588. procedure OutputSubjectIndexInAlphabet(HashTable: THashTable);
  589. var
  590. AlphabetListHeader: PHeader;
  591. begin
  592. AlphabetListHeader := TurnArrayToAlphabetSortedList(HashTable);
  593. OutputList(AlphabetListHeader);
  594. DisposeList(AlphabetListHeader);
  595. end;
  596.  
  597. procedure InsertElementInPage(var Header: PHeader; Term: PTerm);
  598. var
  599. Curr, Temp, NewTerm: PTerm;
  600. TermPage, CurrPage: PPages;
  601. begin
  602. New(NewTerm);
  603. NewTerm^.TermValue := Term^.TermValue;
  604. NewTerm^.Subterm := Term^.Subterm;
  605. NewTerm^.Pages := Term^.Pages;
  606. NewTerm^.NextTerm := nil;
  607.  
  608. if Header^.FirstTerm = nil then
  609. begin
  610. Header^.FirstTerm := NewTerm;
  611. end
  612. else
  613. begin
  614. if (NewTerm^.Pages^.PageValue <= Header^.FirstTerm^.Pages^.PageValue) then
  615. begin
  616. if (NewTerm^.Pages^.PageValue = Header^.FirstTerm^.Pages^.PageValue) then
  617. begin
  618. CurrPage := Header^.FirstTerm^.Pages;
  619. TermPage := NewTerm^.Pages;
  620.  
  621. while (CurrPage <> nil) and (TermPage <> nil) and (TermPage^.PageValue = CurrPage^.PageValue) do
  622. begin
  623. CurrPage := CurrPage^.NextPage;
  624. TermPage := TermPage^.NextPage;
  625. end;
  626.  
  627. if ((TermPage = nil) and (CurrPage <> nil)) or ((CurrPage <> nil) and (TermPage^.PageValue < CurrPage^.PageValue)) then
  628. begin
  629. New(Temp);
  630. Temp^.NextTerm := Header^.FirstTerm;
  631. Header^.FirstTerm := Temp;
  632. Temp^.TermValue := NewTerm^.TermValue;
  633. Temp^.Subterm := NewTerm^.Subterm;
  634. Temp^.Pages := NewTerm^.Pages;
  635. end
  636. else
  637. begin
  638. New(Temp);
  639. Temp^.NextTerm := Header^.FirstTerm^.NextTerm;
  640. Header^.FirstTerm^.NextTerm := Temp;
  641. Temp^.TermValue := NewTerm^.TermValue;
  642. Temp^.Subterm := NewTerm^.Subterm;
  643. Temp^.Pages := NewTerm^.Pages;
  644. end;
  645. end
  646. else
  647. begin
  648. New(Temp);
  649. Temp^.NextTerm := Header^.FirstTerm;
  650. Header^.FirstTerm := Temp;
  651. Temp^.TermValue := NewTerm^.TermValue;
  652. Temp^.Subterm := NewTerm^.Subterm;
  653. Temp^.Pages := NewTerm^.Pages;
  654. end;
  655. end
  656. else
  657. begin
  658. Curr := Header^.FirstTerm;
  659. while (Curr^.NextTerm <> nil) and (Curr^.NextTerm^.Pages^.PageValue < NewTerm^.Pages^.PageValue) do
  660. Curr := Curr^.NextTerm;
  661.  
  662. if (Curr^.NextTerm <> nil) and (Curr^.NextTerm^.Pages^.PageValue = NewTerm^.Pages^.PageValue) then
  663. begin
  664. CurrPage := Curr^.NextTerm^.Pages;
  665. TermPage := NewTerm^.Pages;
  666.  
  667. while (CurrPage <> nil) and (TermPage <> nil) and (CurrPage^.PageValue = TermPage^.PageValue) do
  668. begin
  669. CurrPage := CurrPage^.NextPage;
  670. TermPage := TermPage^.NextPage;
  671. end;
  672.  
  673. if ((TermPage = nil) and (CurrPage <> nil)) or ((CurrPage <> nil) and (TermPage^.PageValue < CurrPage^.PageValue)) then
  674. begin
  675. New(Temp);
  676. Temp^.NextTerm := Curr^.NextTerm;
  677. Curr^.NextTerm := Temp;
  678. Temp^.TermValue := NewTerm^.TermValue;
  679. Temp^.Subterm := NewTerm^.Subterm;
  680. Temp^.Pages := NewTerm^.Pages;
  681. end
  682. else
  683. begin
  684. Curr := Curr^.NextTerm;
  685.  
  686. New(Temp);
  687. Temp^.NextTerm := Curr^.NextTerm;
  688. Curr^.NextTerm := Temp;
  689. Temp^.TermValue := NewTerm^.TermValue;
  690. Temp^.Subterm := NewTerm^.Subterm;
  691. Temp^.Pages := NewTerm^.Pages;
  692. end;
  693. end
  694. else
  695. begin
  696. New(Temp);
  697. Temp^.NextTerm := Curr^.NextTerm;
  698. Curr^.NextTerm := Temp;
  699. Temp^.TermValue := NewTerm^.TermValue;
  700. Temp^.Subterm := NewTerm^.Subterm;
  701. Temp^.Pages := NewTerm^.Pages;
  702. end;
  703. end;
  704. end;
  705. end;
  706.  
  707. function TurnArrayToPageSortedList(HashTable: THashTable): PHeader;
  708. Var
  709. I: Integer;
  710. Curr: PTerm;
  711. SortedListHeader: PHeader;
  712. Begin
  713. SortedListHeader := InitializeList();
  714. for I := Low(HashTable) to High(HashTable) do
  715. if HashTable[I]^.FirstTerm <> nil then
  716. begin
  717. Curr := HashTable[I]^.FirstTerm;
  718. repeat
  719. InsertElementInPage(SortedListHeader, Curr);
  720. Curr := Curr^.NextTerm;
  721. until Curr = nil;
  722. end;
  723. TurnArrayToPageSortedList := SortedListHeader;
  724. End;
  725.  
  726. procedure OutputSubjectIndexInPage(HashTable: THashTable);
  727. var
  728. PageListHeader: PHeader;
  729. begin
  730. PageListHeader := TurnArrayToPageSortedList(HashTable);
  731. OutputList(PageListHeader);
  732. DisposeList(PageListHeader);
  733. end;
  734.  
  735. procedure EditTerm(HashTable: THashTable);
  736. var
  737. TermValue: String;
  738. NowTerm: PTerm;
  739. Choice:Integer;
  740. Header: PHeader;
  741. begin
  742. Writeln('Введите термин');
  743. Readln(TermValue);
  744. if HasThisTerm(HashTable, TermValue) then
  745. begin
  746. Header := HashTable[GetHashValue(TermValue)];
  747. if (Header^.FirstTerm^.TermValue = TermValue) then
  748. begin
  749. NowTerm := Header^.FirstTerm;
  750. end
  751. else
  752. begin
  753. NowTerm := Header^.FirstTerm;
  754. while (NowTerm^.NextTerm <> nil) and (NowTerm^.NextTerm^.TermValue <> TermValue) do
  755. NowTerm := NowTerm^.NextTerm;
  756.  
  757. NowTerm := NowTerm^.NextTerm;
  758. end;
  759.  
  760. repeat
  761. Writeln('--------------------------------------------------------');
  762. Writeln('РЕДАКТОР ТЕРМИНА ' + TermValue);
  763. OutputEditTermMenu;
  764. Choice := InputChoice(1,6);
  765. case Choice of
  766. 1: AddSubterm(NowTerm);
  767. 2: EditSubterm(NowTerm);
  768. 3: DeleteSubterm(NowTerm);
  769. 4: AddPage(NowTerm);
  770. 5: DeletePage(NowTerm);
  771. 6:
  772. end;
  773. until Choice = 6;
  774. end
  775. else
  776. Writeln('Термин не найден!');
  777. end;
  778.  
  779. procedure DeleteTerm(HashTable: THashTable);
  780. var
  781. Curr, Temp: PTerm;
  782. DelTermValue: String;
  783. Header: PHeader;
  784. begin
  785. Writeln('Введите термин: ');
  786. Readln(DelTermValue);
  787. if HasThisTerm(HashTable, DelTermValue) then
  788. begin
  789. Header := HashTable[GetHashValue(DelTermValue)];
  790. Curr := Header^.FirstTerm;
  791. if Curr^.TermValue = DelTermValue then
  792. begin
  793. Temp := Curr;
  794. Header^.FirstTerm := Curr^.NextTerm;
  795. Dispose(Temp);
  796. end
  797. else
  798. begin
  799. Temp := Curr^.NextTerm;
  800. while Temp^.TermValue <> DelTermValue do
  801. begin
  802. Curr := Temp;
  803. Temp := Temp^.NextTerm;
  804. end;
  805.  
  806. Curr^.NextTerm := Temp^.NextTerm;
  807. Dispose(Temp);
  808. end;
  809. Writeln('Термин удален успешно!')
  810. end
  811. else
  812. Writeln('Термин не найден!');
  813. end;
  814.  
  815. procedure OutputAllSubterms(Term: PTerm);
  816. var
  817. Subterm: PTerm;
  818. begin
  819. if (Term^.Subterm <> nil) then
  820. begin
  821. Subterm := Term^.Subterm;
  822. repeat
  823. OutputSubterm(Subterm, ' ');
  824. Subterm := Subterm^.NextTerm;
  825. until Subterm = nil;
  826. end
  827. else
  828. Writeln;
  829. end;
  830.  
  831. procedure SearhSubtermByTerm(HashTable: THashTable; TermValue: String);
  832. var
  833. Hash: Integer;
  834. Curr: PTerm;
  835. begin
  836. Hash := GetHashValue(TermValue);
  837. if not HasThisTerm(HashTable, TermValue) then
  838. Writeln('Не найден такой термин!')
  839. else
  840. begin
  841. Curr := HashTable[Hash]^.FirstTerm;
  842. while (Curr <> nil) and (Curr^.TermValue <> TermValue) do
  843. Curr := Curr^.NextTerm;
  844.  
  845. Writeln('Подтермины ', TermValue,':');
  846. OutputAllSubterms(Curr);
  847. end;
  848. end;
  849.  
  850. procedure OutputTerm(Term: PTerm);
  851. var
  852. Page: PPages;
  853. Subterm: PTerm;
  854. begin
  855. Writeln('----------------------------');
  856. Write(Term^.TermValue + '| ');
  857. Page := Term^.Pages;
  858. while Page <> nil do
  859. begin
  860. Write(Page^.PageValue, ' ');
  861. Page := Page^.NextPage;
  862. end;
  863. if (Term^.Subterm <> nil) then
  864. begin
  865. Writeln;
  866. Subterm := Term^.Subterm;
  867. repeat
  868. OutputSubterm(Subterm, ' ');
  869. Subterm := Subterm^.NextTerm;
  870. until Subterm = nil;
  871. end
  872. else
  873. Writeln;
  874. Writeln('----------------------------');
  875. end;
  876.  
  877. function CheckSubtermList(Subterm: PTerm; SubtermValue: String): Boolean;
  878. var
  879. HasSubterm: Boolean;
  880. Curr: PTerm;
  881. begin
  882. Curr := Subterm;
  883. if Curr^.Subterm <> nil then
  884. begin
  885. HasSubterm := CheckSubtermList(Curr^.Subterm, SubtermValue);
  886. if HasSubterm then
  887. begin
  888. CheckSubtermList := True;
  889. Exit;
  890. end;
  891. CheckSubtermList := SubtermValue = Curr^.TermValue;
  892. end
  893. else
  894. begin
  895. if Curr^.NextTerm <> nil then
  896. begin
  897. HasSubterm := CheckSubtermList(Curr^.NextTerm, SubtermValue);
  898. if HasSubterm then
  899. begin
  900. CheckSubtermList := True;
  901. Exit;
  902. end;
  903. CheckSubtermList := SubtermValue = Curr^.TermValue;
  904. end
  905. else
  906. CheckSubtermList := SubtermValue = Curr^.TermValue;
  907. end
  908. end;
  909.  
  910. procedure CheckTermBySubterm(Term: PTerm; SubtermValue: String);
  911. begin
  912. while Term <> nil do
  913. begin
  914. if Term^.Subterm <> nil then
  915. begin
  916. if CheckSubtermList(Term^.Subterm, SubtermValue)then
  917. OutputTerm(Term);
  918. end;
  919. Term := Term^.NextTerm;
  920. end;
  921. end;
  922.  
  923. procedure SearchTermBySubterm(HashTable: THashTable; SubtermValue: String);
  924. var
  925. I: Integer;
  926. begin
  927. for I := Low(HashTable) to High(HashTable) do
  928. begin
  929. if HashTable[I]^.FirstTerm <> nil then
  930. begin
  931. CheckTermBySubterm(HashTable[I]^.FirstTerm, SubtermValue);
  932. end;
  933. end;
  934. end;
  935.  
  936. begin
  937. Writeln('Данная программа - предметный указатель');
  938. CreateHashTable(HashTable);
  939. repeat
  940. OutputMainMenu;
  941. Choice := InputChoice(1, 8);
  942. case Choice of
  943. 1: OutputSubjectIndexInAlphabet(HashTable);
  944. 2: OutputSubjectIndexInPage(HashTable);
  945. 3: begin
  946. Writeln('Введите термин: ');
  947. Readln(TermValue);
  948. if not HasThisTerm(HashTable, TermValue) then
  949. begin
  950. NewTerm := CreateNewTerm(TermValue);
  951. repeat
  952. Writeln('--------------------------------------------------------');
  953. Writeln('РЕДАКТОР ТЕРМИНА ' + TermValue);
  954. OutputEditTermMenu;
  955. Choice := InputChoice(1,6);
  956. case Choice of
  957. 1: AddSubterm(NewTerm);
  958. 2: EditSubterm(NewTerm);
  959. 3: DeleteSubterm(NewTerm);
  960. 4: AddPage(NewTerm);
  961. 5: DeletePage(NewTerm);
  962. 6: AddTerm(NewTerm);
  963. end;
  964. until Choice = 6;
  965. end;
  966. end;
  967. 4: EditTerm(HashTable);
  968. 5: DeleteTerm(HashTable);
  969. 6: begin
  970. Writeln('Введите подтермин:');
  971. Readln(TermValue);
  972. SearchTermBySubterm(HashTable, TermValue)
  973. end;
  974. 7: begin
  975. Writeln('Введите термин:');
  976. Readln(TermValue);
  977. SearhSubtermByTerm(HashTable, TermValue)
  978. end;
  979. end;
  980. until Choice = 8;
  981. end.
  982.  
  983.  
  984.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement