Нуждаюсь в написании программы. Линейные списки - Delphi - Ответ 4701600
10.06.2013, 22:17. Показов 1347. Ответов 1
Сообщение было отмечено как решение
Решение

Сообщение от Kertas
Запись содержит фамилию ученика и 2 оценки. Удалить из списка всех учеников с неудовлетворительными оценками.
Delphi | 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
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
| program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils, Windows;
const
M = 2;
type
{Массив с оценками.}
TArrEst = array[1..M] of Integer;
{Тип основных данных списка.}
TData = record
Fio : String; {ФИО ученика.}
ArrEst : TArrEst; {Массив с оценками}
end;
{Тип указателя на элемент списка.}
TPElem = ^TElem;
{Тип элемента списка.}
TElem = record
Data : TData; {Основные данные элемента.}
PNext : TPElem; {Указатель на следующий элемент списка.}
end;
{Тип, описывающий однонаправленный список.}
TDList = record
Cnt : Integer; {Количество элементов в списке.}
PFirst, PLast : TPElem; {Указатели на первый и последний элементы списка.}
end;
{Инициализация списка. Внимание! Эту процедуру можно выполнять только
в отношении пустого списка. Иначе - будут утечки памяти.}
procedure Init(var aList : TDList);
begin
aList.Cnt := 0;
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;
Inc(aList.Cnt);
end;
{Освобождение памяти, занятой под список и инициализация списка.}
procedure LFree(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;
i : Integer;
begin
if aList.PFirst = nil then begin
Writeln('Список пуст.');
Exit;
end;
PElem := aList.PFirst;
while PElem <> nil do begin
{ФИО ученика.}
Write(PElem^.Data.Fio, '. Оценки: ');
{Оценки ученика.}
for i := 1 to High(PElem^.Data.ArrEst) do
Write(PElem^.Data.ArrEst[i], ' ');
Writeln;
{Получаем указатель на следующий элемент списка.}
PElem := PElem^.PNext;
end;
end;
{Удаление из списка тех записей, которые содержат оценки меньше заданной.
Функция возвращает количество удалённых записей.}
function Del(var aList : TDList; const aEst : Integer) : Integer;
var
PElem, PPrev, PDel : TPElem;
i : Integer;
MustDel : Boolean;
begin
Result := 0;
PPrev := nil; {Указатель на предыдущий элемент.}
PElem := aList.PFirst; {Указатель на текущий элемент.}
while PElem <> nil do begin
{Проверяем, есть ли хотябы одна оценка меньше заданной.}
MustDel := False;
for i := 1 to High(PElem^.Data.ArrEst) do
if PElem^.Data.ArrEst[i] < aEst then begin
MustDel := True;
Break;
end;
{Если была обнаружена оценка меньше заданной, то выполняем удаление элемента.}
if MustDel then begin
PDel := PElem; {Указатель на удаляемый элемент.}
PElem := PElem^.PNext; {Указатель на следующий элемент списка.}
{Если удаляемый элемент является первым элементом в списке.}
if PDel = aList.PFirst then
aList.PFirst := PElem
{Если удаляемый элемент не является первым элементом в списке.}
else
PPrev^.PNext := PElem;
{Если удаляемый элемент является последним элементом в списке.}
if PDel = aList.PLast then
aList.PLast := PPrev;
{Освобождаем память, выделенную для элемента.}
Dispose(PDel);
Dec(aList.Cnt); {Количество элементов в списке теперь стало на 1 меньше.}
Inc(Result); {Количество удалённых элементов стало на 1 больше.}
end else begin
{Переходим к следующему элементу.}
PPrev := PElem;
PElem := PElem^.PNext;
end;
end;
end;
var
L : TDList;
Data : TData;
i, Code : Integer;
S : String;
begin
{Переключение окна консоли на кодовую страницу CP1251 (Win-1251).
Если после переключения русские буквы показываются неверно,
следует открыть системное меню консольного окна - щелчком мыши в левом
верхнем углу окна консоли и выбрать:
Свойства - закладка "Шрифт" - выбрать шрифт: "Lucida Console".}
SetConsoleCP(1251);
SetConsoleOutputCP(1251);
{Начальная инициализация списка.}
Init(L);
repeat
{Добавление элементов в список.}
Writeln('Добавление элементов в список.');
Writeln('Прекратить ввод - оставить в поле ФИО пустую строку и нажать Enter.');
repeat
Writeln('Элемент ', L.Cnt + 1, '.');
Write('ФИО: ');
Readln(S);
if S <> '' then begin
Data.Fio := S;
for i := 1 to High(Data.ArrEst) do
repeat
Write('Оценка ', i, ': ');
Readln(S);
Val(S, Data.ArrEst[i], Code);
if Code > 0 then
Writeln('Неверный ввод. Повторите.');
until Code = 0;
Add(L, Data);
end;
until S = '';
Writeln('Составлен список:');
LWriteln(L);
{Удаляем из списка элементы, которые содержат хотябы одну
неудовлетворительную оценку.}
i := Del(L, 3);
{Ответ.}
Writeln('Удалено элементов: ', i);
Writeln('Список после обработки:');
LWriteln(L);
{Освобождение памяти, занятой под список.}
LFree(L);
Writeln('Память, выделенная для списка, освобождена.');
Writeln('Повторить - Enter, выход - любой символ + Enter.');
Readln(S);
until S <> '';
end. |
|

Сообщение от Kertas
Сформировать односвязный список из 7 записей, вывести список, удалить записи, удовлетворяющие некоторому условию, добавить новую запись в конец списка и вновь вывести список на экран.
Выделенное красным в коде не реализовано. Чтобы добавить реализацию этого условия, достаточно после кода удаления записей добавить код добавления элементов в список:
Delphi | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
| {Добавление элементов в список.}
Writeln('Добавление элементов в список.');
Writeln('Прекратить ввод - оставить в поле ФИО пустую строку и нажать Enter.');
repeat
Writeln('Элемент ', L.Cnt + 1, '.');
Write('ФИО: ');
Readln(S);
if S <> '' then begin
Data.Fio := S;
for i := 1 to High(Data.ArrEst) do
repeat
Write('Оценка ', i, ': ');
Readln(S);
Val(S, Data.ArrEst[i], Code);
if Code > 0 then
Writeln('Неверный ввод. Повторите.');
until Code = 0;
Add(L, Data);
end;
until S = '';
Writeln('Составлен список:');
LWriteln(L); |
|
Добавлено через 2 секунды

Сообщение от Kertas
Запись содержит фамилию ученика и 2 оценки. Удалить из списка всех учеников с неудовлетворительными оценками.
Delphi | 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
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
| program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils, Windows;
const
M = 2;
type
{Массив с оценками.}
TArrEst = array[1..M] of Integer;
{Тип основных данных списка.}
TData = record
Fio : String; {ФИО ученика.}
ArrEst : TArrEst; {Массив с оценками}
end;
{Тип указателя на элемент списка.}
TPElem = ^TElem;
{Тип элемента списка.}
TElem = record
Data : TData; {Основные данные элемента.}
PNext : TPElem; {Указатель на следующий элемент списка.}
end;
{Тип, описывающий однонаправленный список.}
TDList = record
Cnt : Integer; {Количество элементов в списке.}
PFirst, PLast : TPElem; {Указатели на первый и последний элементы списка.}
end;
{Инициализация списка. Внимание! Эту процедуру можно выполнять только
в отношении пустого списка. Иначе - будут утечки памяти.}
procedure Init(var aList : TDList);
begin
aList.Cnt := 0;
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;
Inc(aList.Cnt);
end;
{Освобождение памяти, занятой под список и инициализация списка.}
procedure LFree(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;
i : Integer;
begin
if aList.PFirst = nil then begin
Writeln('Список пуст.');
Exit;
end;
PElem := aList.PFirst;
while PElem <> nil do begin
{ФИО ученика.}
Write(PElem^.Data.Fio, '. Оценки: ');
{Оценки ученика.}
for i := 1 to High(PElem^.Data.ArrEst) do
Write(PElem^.Data.ArrEst[i], ' ');
Writeln;
{Получаем указатель на следующий элемент списка.}
PElem := PElem^.PNext;
end;
end;
{Удаление из списка тех записей, которые содержат оценки меньше заданной.
Функция возвращает количество удалённых записей.}
function Del(var aList : TDList; const aEst : Integer) : Integer;
var
PElem, PPrev, PDel : TPElem;
i : Integer;
MustDel : Boolean;
begin
Result := 0;
PPrev := nil; {Указатель на предыдущий элемент.}
PElem := aList.PFirst; {Указатель на текущий элемент.}
while PElem <> nil do begin
{Проверяем, есть ли хотябы одна оценка меньше заданной.}
MustDel := False;
for i := 1 to High(PElem^.Data.ArrEst) do
if PElem^.Data.ArrEst[i] < aEst then begin
MustDel := True;
Break;
end;
{Если была обнаружена оценка меньше заданной, то выполняем удаление элемента.}
if MustDel then begin
PDel := PElem; {Указатель на удаляемый элемент.}
PElem := PElem^.PNext; {Указатель на следующий элемент списка.}
{Если удаляемый элемент является первым элементом в списке.}
if PDel = aList.PFirst then
aList.PFirst := PElem
{Если удаляемый элемент не является первым элементом в списке.}
else
PPrev^.PNext := PElem;
{Если удаляемый элемент является последним элементом в списке.}
if PDel = aList.PLast then
aList.PLast := PPrev;
{Освобождаем память, выделенную для элемента.}
Dispose(PDel);
Dec(aList.Cnt); {Количество элементов в списке теперь стало на 1 меньше.}
Inc(Result); {Количество удалённых элементов стало на 1 больше.}
end else begin
{Переходим к следующему элементу.}
PPrev := PElem;
PElem := PElem^.PNext;
end;
end;
end;
var
L : TDList;
Data : TData;
i, Code : Integer;
S : String;
begin
{Переключение окна консоли на кодовую страницу CP1251 (Win-1251).
Если после переключения русские буквы показываются неверно,
следует открыть системное меню консольного окна - щелчком мыши в левом
верхнем углу окна консоли и выбрать:
Свойства - закладка "Шрифт" - выбрать шрифт: "Lucida Console".}
SetConsoleCP(1251);
SetConsoleOutputCP(1251);
{Начальная инициализация списка.}
Init(L);
repeat
{Добавление элементов в список.}
Writeln('Добавление элементов в список.');
Writeln('Прекратить ввод - оставить в поле ФИО пустую строку и нажать Enter.');
repeat
Writeln('Элемент ', L.Cnt + 1, '.');
Write('ФИО: ');
Readln(S);
if S <> '' then begin
Data.Fio := S;
for i := 1 to High(Data.ArrEst) do
repeat
Write('Оценка ', i, ': ');
Readln(S);
Val(S, Data.ArrEst[i], Code);
if Code > 0 then
Writeln('Неверный ввод. Повторите.');
until Code = 0;
Add(L, Data);
end;
until S = '';
Writeln('Составлен список:');
LWriteln(L);
{Удаляем из списка элементы, которые содержат хотябы одну
неудовлетворительную оценку.}
i := Del(L, 3);
{Ответ.}
Writeln('Удалено элементов: ', i);
Writeln('Список после обработки:');
LWriteln(L);
{Освобождение памяти, занятой под список.}
LFree(L);
Writeln('Память, выделенная для списка, освобождена.');
Writeln('Повторить - Enter, выход - любой символ + Enter.');
Readln(S);
until S <> '';
end. |
|

Сообщение от Kertas
Сформировать односвязный список из 7 записей, вывести список, удалить записи, удовлетворяющие некоторому условию, добавить новую запись в конец списка и вновь вывести список на экран.
Выделенное красным в коде не реализовано. Чтобы добавить реализацию этого условия, достаточно после кода удаления записей добавить код добавления элементов в список:
Delphi | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
| {Добавление элементов в список.}
Writeln('Добавление элементов в список.');
Writeln('Прекратить ввод - оставить в поле ФИО пустую строку и нажать Enter.');
repeat
Writeln('Элемент ', L.Cnt + 1, '.');
Write('ФИО: ');
Readln(S);
if S <> '' then begin
Data.Fio := S;
for i := 1 to High(Data.ArrEst) do
repeat
Write('Оценка ', i, ': ');
Readln(S);
Val(S, Data.ArrEst[i], Code);
if Code > 0 then
Writeln('Неверный ввод. Повторите.');
until Code = 0;
Add(L, Data);
end;
until S = '';
Writeln('Составлен список:');
LWriteln(L); |
|
Вернуться к обсуждению: Нуждаюсь в написании программы. Линейные списки Delphi
0
|