Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом
Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »

Вопрос # 2 085

Раздел: Pascal » Программирование на Pascal
/ вопрос открыт /

Здравствуйте, уважаемые эксперты!Необхдимо написать 3 процедуры по линейным спискам:
1) удаление всех элементов с информационным полем, равным данному числу;
2) удаление всех элементов, стоящих перед элементом с информационным полем, равным даному числу; (например, дан список:
2 3 4 8 3 1 11 3 4, и число k=3
на выходе должно получиться: 3 4 3 1 3 4)
3) удаление всех кроме одного элементов с одинаковыми информационными полями, стоящих друг за другом;
(например, входной список: 2 4 4 4 4 6 7 8 8 1 4 4 8 8 8 12
на выходе получим: 2 4 6 7 8 1 4 8 12)

Прикрепляю то, что пока что получилось у меня.
Заранее спасибо!!!

К вопросу прикреплён файл. Загрузить » (срок хранения: 60 дней с момента отправки вопроса)

s_ksuha Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задала: s_ksuha (статус: Посетитель)
Вопрос отправлен: 13 ноября 2008, 20:47
Состояние вопроса: открыт, ответов: 1.

Ответ #1. Отвечает эксперт: min@y™

В качестве утренней зарядки для мозгов попробовал реализовать всё это.
Писал, правда, на Delphi как консольное приложение, но переделать исходник под паскаль, думаю, труда не составит.
Все три функции удаления, соответствующие пунктам задания, возвращают количество удалённых элементов.
Изначально списки инициализируются случайными числами.
Вот результат работы программы, скопированный из консоли:



// Удаление элементов, у которых поле = 0

------ Test of function DeleteEqual(): -------

 List: 2 9 0 9 4 1 5 3 9 0

  DeleteEqual(0) = 2

 List: 2 9 9 4 1 5 3 9



// Удаление элементов, стоящих перед элементами, у которых поле = 0

------ Test of function DeleteBackwards(): -------

 List: 0 7 7 3 0 4 4 7 7 0

  DeleteBackwards(0) = 2

 List: 0 7 7 0 4 4 7 0



// Удаление всех, кроме одного, повторяющихся элементов

------ Test of function DeleteRepeated(): -------

 List: 1 1 2 3 3 0 5 4 3 0

  DeleteRepeated() = 2

 List: 1 2 3 0 5 4 3 0


Исходник - в приложении к ответу. Гонял под рандомайзом раз 10, вроде работает. Проверяй.

Приложение:
  1. program p2085;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. type
  6. PItem = ^TItem;
  7. TItem = record
  8.  
  9.  
  10.  
  11. end;
  12.  
  13. procedure CreateList(const Count: Integer; var BeginItem: PItem);
  14. var
  15. Index: Integer;
  16. Item, ForwardLink: PItem;
  17. begin
  18. New(Item);
  19. Item^.BackwardLink:= nil;
  20. BeginItem:= Item;
  21. Index:= 0;
  22.  
  23. while Index < Count - 1 do
  24. begin
  25.  
  26.  
  27.  
  28.  
  29.  
  30. Inc(Index);
  31. end;
  32. end;
  33.  
  34. procedure FreeList(const BeginItem: PItem);
  35. var
  36. Item, ForwardLink: PItem;
  37. begin
  38. Item:= BeginItem;
  39. while Item <> nil do
  40. begin
  41. ForwardLink:= Item^.ForwardLink;
  42. Dispose(Item);
  43. Item:= ForwardLink;
  44. end;
  45. end;
  46.  
  47. procedure ListOut(const BeginItem: PItem);
  48. var
  49. Item: PItem;
  50. begin
  51. Write(' List:');
  52.  
  53. Item:= BeginItem;
  54. while Item <> nil do
  55. begin
  56. Write(' ', Item^.Value);
  57. Item:= Item^.ForwardLink;
  58. end;
  59.  
  60. WriteLn;
  61. end;
  62.  
  63.  
  64. procedure DeleteFromList(var Item: PItem);
  65. var
  66.  
  67. begin
  68. if Item = nil
  69. then Exit;
  70.  
  71.  
  72. if Item^.ForwardLink <> nil
  73. then Item^.ForwardLink^.BackwardLink:= Item^.BackwardLink;
  74. if Item^.BackwardLink <> nil
  75. then Item^.BackwardLink^.ForwardLink:= Item^.ForwardLink;
  76.  
  77.  
  78.  
  79.  
  80. end;
  81.  
  82.  
  83. function DeleteEqual(var BeginItem: PItem; const Value: Integer): Integer;
  84. var
  85. Item: PItem;
  86. Deleted: Integer;
  87. begin
  88. Deleted:= 0;
  89. Item:= BeginItem;
  90.  
  91. while Item <> nil do
  92. if Item^.Value = Value
  93. then begin
  94.  
  95. if Item = BeginItem
  96. then BeginItem:= Item.ForwardLink;
  97.  
  98. DeleteFromList(Item);
  99. Inc(Deleted);
  100. end
  101. else Item:= Item^.ForwardLink;
  102.  
  103. DeleteEqual:= Deleted;
  104. end;
  105.  
  106. function DeleteBackwards(var BeginItem: PItem; const Value: Integer): Integer;
  107. var
  108. Item, BackwardLink: PItem;
  109. Deleted: Integer;
  110. begin
  111. Deleted:= 0;
  112.  
  113.  
  114. while Item <> nil do
  115. begin
  116. if Item^.Value = Value
  117. then begin
  118. BackwardLink:= Item^.BackwardLink;
  119.  
  120.  
  121. if BackwardLink = BeginItem
  122. then BeginItem:= Item;
  123.  
  124. DeleteFromList(BackwardLink);
  125. Inc(Deleted);
  126. end;
  127.  
  128. if Item <> nil
  129. then Item:= Item^.ForwardLink;
  130. end;
  131.  
  132. DeleteBackwards:= Deleted;
  133. end;
  134.  
  135. function DeleteRepeated(var BeginItem: PItem): Integer;
  136. var
  137. Item, BackwardLink: PItem;
  138. Deleted: Integer;
  139. begin
  140. Deleted:= 0;
  141.  
  142.  
  143. while Item <> nil do
  144. begin
  145.  
  146. while Item^.BackwardLink^.Value = Item^.Value do
  147. begin
  148. DeleteFromList(Item);
  149. Inc(Deleted);
  150. end;
  151.  
  152. if Item <> nil
  153. then Item:= Item^.ForwardLink;
  154. end;
  155.  
  156. DeleteRepeated:= Deleted;
  157. end;
  158.  
  159. var
  160. BeginItem: PItem;
  161.  
  162. const
  163.  
  164.  
  165. begin
  166. Randomize();
  167.  
  168.  
  169. WriteLn(#13#10'------ Test of function DeleteEqual(): -------');
  170. CreateList(10, BeginItem);
  171. ListOut(BeginItem);
  172. WriteLn(' DeleteEqual(', Value, ') = ', DeleteEqual(BeginItem, Value));
  173. ListOut(BeginItem);
  174. FreeList(BeginItem);
  175.  
  176.  
  177.  
  178. WriteLn(#13#10'------ Test of function DeleteBackwards(): -------');
  179. CreateList(10, BeginItem);
  180. ListOut(BeginItem);
  181. WriteLn(' DeleteBackwards(', Value, ') = ', DeleteBackwards(BeginItem, Value));
  182. ListOut(BeginItem);
  183. FreeList(BeginItem);
  184.  
  185.  
  186.  
  187. WriteLn(#13#10'------ Test of function DeleteRepeated(): -------');
  188. CreateList(10, BeginItem);
  189. ListOut(BeginItem);
  190. WriteLn(' DeleteRepeated() = ', DeleteRepeated(BeginItem));
  191. ListOut(BeginItem);
  192. FreeList(BeginItem);
  193.  
  194. Write(#13#10' Press "Enter" for exit...');
  195. ReadLn;
  196. end.


Ответ отправил: min@y™ (статус: Доктор наук)
Время отправки: 14 ноября 2008, 10:31


Мини-форум вопроса

Мини-форум пуст.

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
Версия движка: 2.6+ (26.01.2011)
© 2005-2025
Текущее время: 22 февраля 2025, 11:56
Выполнено за 0.02 сек.