25_.pas 1.4 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182
  1. Uses CRT;
  2. type
  3. PList = ^TList;
  4. TList = record
  5. num : real;
  6. Next : PList;
  7. end;
  8. function p26(L:PList):boolean;
  9. var
  10. i,j,k : PList;
  11. begin
  12. p26:=False;
  13. i:=L;
  14. while i <> nil do
  15. begin
  16. j:=i^.next;
  17. while j <> nil do
  18. begin
  19. k:=j^.next;
  20. while k <> nil do
  21. begin
  22. if (i^.num = j^.num) and (k^.num = j^.num) then
  23. begin
  24. p26:=true;
  25. exit;
  26. end;
  27. k:=k^.next;
  28. end;
  29. j:=j^.next;
  30. end;
  31. i:=i^.next;
  32. end;
  33. end;{Задание}
  34. {---------------------------------}
  35. Function GetList:PList;
  36. var
  37. N,p : PList;
  38. cur : real;
  39. begin
  40. WriteLn('Вводите числа, заканичивая 0-м');
  41. read(cur);
  42. New(p);
  43. p^.num := cur;
  44. p^.Next := nil;
  45. while cur <> 0 do begin
  46. read(cur);
  47. New(N);
  48. N^.num := cur;
  49. N^.Next := p;
  50. p:=N;
  51. end;
  52. GetList := P;
  53. end;
  54. Procedure WriteList(var L : PList);
  55. var
  56. P : Plist;
  57. begin
  58. p:=L;
  59. while p<>nil do begin
  60. write(p^.num:0:2,' ');
  61. p:=p^.next;
  62. end;
  63. end;
  64. var
  65. List : PList;
  66. begin
  67. ClrScr;
  68. List := GetList;
  69. WriteLn('Список такой:');
  70. WriteList(List);
  71. WriteLn;
  72. If p26(List) then
  73. writeLn('Есть элементы, встечающиеся больше 2-х раз')
  74. else
  75. writeLn('Нет элементов, встечающиеся больше 2-х раз');
  76. end.