1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
| program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils, Windows;
type
{Тип основных данных.}
TData = Integer;
{Тип указателя на элемент списка.}
TPElem = ^TElem;
{Тип элемента списка.}
TElem = record
Data : TData; {Основные данные.}
PNext : TPElem; {Указатель на следующий элемент списка.}
end;
{Тип, описывающий однонаправленный список.}
TDList = record
PFirst, PLast : TPElem; {Указатели на первый и на последний элементы списка.}
end;
{Начальная инициализация списка. Внимание! Эту процедуру можно выполнять
только в отношении пустого списка! Иначе, будут утечки памяти.}
procedure Init(var aList : TDList);
begin
aList.PFirst := nil;
aList.PLast := nil;
end;
{Добавление элемента в конец однонаправленного списка.}
procedure Add(var aList : TDList; const aData : TData);
var
PElem : TPElem;
begin
New(PElem);
PElem^.Data := aData;
PElem^.PNext := nil;
if aList.PFirst = nil then
aList.PFirst := PElem
else
aList.PLast^.PNext := PElem;
aList.PLast := PElem;
end;
{Особождение памяти, занятой под список.}
procedure Free(var aList : TDList);
var
PNext, PDel : TPElem;
begin
PNext := aList.PFirst;
while PNext <> nil do begin
PDel := PNext;
PNext := PNext^.PNext;
Dispose(PDel);
end;
Init(aList);
end;
{Распечатка однонаправленного списка.}
procedure LWriteln(const aList : TDList);
var
PElem : TPElem;
begin
if aList.PFirst = nil then begin
Writeln('Список пуст.');
Exit;
end;
PElem := aList.PFirst;
while PElem <> nil do begin
if PElem <> aList.PFirst then Write(', ');
Write(PElem^.Data);
PElem := PElem^.PNext;
end;
Writeln;
end;
const
M = 7;
var
L1, L2 : TDList;
PElem1, PNext1, PElem2, PPrev2 : TPElem;
i : Integer;
S : String;
begin
{Переключение окна консоли на кодовую страницу CP1251 (Win-1251).
Если после переключения русские буквы показываются неверно,
следует открыть системное меню консольного окна - щелчком мыши в левом
верхнем углу окна консоли и выбрать:
Свойства - закладка "Шрифт" - выбрать шрифт: "Lucida Console".}
SetConsoleCP(1251);
SetConsoleOutputCP(1251);
{Начальная инициализация списков.}
Init(L1);
Init(L2);
repeat
{Создание списка. Если понадобится сделать ручной ввод элементов, следует использовать этот код.
Предварительно в VAR надо будет добавить переменные: Data : TData; Code : Integer;}
{
Writeln('Создание списка.');
Writeln('Прекратить ввод - пустая строка + Enter.');
i := 0;
repeat
Write('Элемент ', i + 1, ': ');
Readln(S);
if S <> '' then begin
Val(S, Data, Code);
if Code = 0 then begin
Inc(i);
Add(L1, Data);
end else
Writeln('Неверный ввод. Повторите.');
end;
until S = '';
Writeln('Составлен список:');
LWriteln(L1);
}
{Создание неупорядоченного списка.}
for i := 1 to M do Add(L1, Random(M + 5));
Writeln('Составлен неупорядоченный список:');
LWriteln(L1);
{Создание списка, упорядоченного по неубыванию.}
for i := 1 to M do Add(L2, i);
Writeln('Составлен упорядоченный по неубыванию список:');
LWriteln(L2);
{Решение задачи.
Последовательно берём элементы из неупорядоченного списка (L1), ищем место
вставки в упорядоченном списке и выполняем вставку.}
PElem1 := L1.PFirst;
while PElem1 <> nil do begin
PNext1 := PElem1^.PNext;
{Ищем в упорядоченном списке указатель на элемент PPrev2, после которого
следует вставить очередной элемент из неупорядоченного списка.}
PPrev2 := nil;
PElem2 := L2.PFirst;
while (PElem2 <> nil) and (PElem2^.Data < PElem1^.Data) do begin
PPrev2 := PElem2;
PElem2 := PElem2^.PNext;
end;
{Вставляем элемент в упорядоченный список.}
PElem1^.PNext := PElem2;
if PPrev2 = nil then
L2.PFirst := PElem1
else
PPrev2^.PNext := PElem1;
if PPrev2 = L2.PLast then
L2.PLast := PElem1;
{Переходим к следующему элементу в неупорядоченном списке.}
PElem1 := PNext1;
end;
Init(L1);
{Ответ.}
Writeln('Упорядоченный список после слияния:');
LWriteln(L2);
{Освобождение памяти, занятую под списки.}
Free(L1);
Free(L2);
Writeln('Память, занятая под списки, освобождена.');
Writeln('Повторить - Enter. Выход - любой символ + Enter.');
Readln(S);
until S <> '';
end. |
(
Сообщение было отмечено RainbowUnicorn как решение
