Работа со списком, его сортировка и выполнение некоторого алгоритма

@AtomicBear · Регистрация: 10.11.2015

Студворк — интернет-сервис помощи студентам

Задача: Описать структуру с именем Sportsmen (данные о спортсмене) с полями: фамилия, имя, год рождения, вид спорта, результат. Сформировать двусвязный список. Затем напечатать список в прямом и обратном направлениях. Затем напечатать список спортсменов, имеющих лучший результат (по одному для каждого вида спорта), учитываются только спортсмены младше указанного года.
Незавершенный код программы:

Кликните здесь для просмотра всего текста

Pascal
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
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
 {uses crt;}
 
const n = 10000;
var j:integer;
type
  TData = string;
  TPElem = ^TElem;
  TElem = record 
    Sname: TData;
    Name: TData;
    Year: TData;
    Sport: TData;
    Res: TData;
    PNext: TPElem;
  end;
  TList = record
    PFirst, PLast: TPElem; 
  end;
//-------------------------------------------  
procedure Init(var aList: TList);
begin
  aList.PFirst := nil;
  aList.PLast := nil;
end;
//-------------------------------------------
function SR(s: string): string;
var
  k, res: integer;
 
begin
  readln(s);
  repeat
    val(s, res, k);
    
    if (k > 0) or (res < 0)  then readln(s);
    
  until (k = 0);
  SR := s;
end;
//-------------------------------------------  
//---------------------------
procedure Print(const aList: TList);
var
  PElem: TPElem; 
begin
  if aList.PFirst = nil then begin
    Writeln('Список пуст.');
    Exit;
  end;
  j:=0;
  PElem := aList.PFirst;
  writeln ('Введенный список :');
  while PElem <> nil do
  begin
    inc(j);
    if PElem <> aList.PFirst then writeln();
    Write(j,'. ',PElem^.Sname, ' ', PElem^.Name, ' ', PElem^.Year, ' ', PElem^.Sport, ' ', PElem^.Res);
    PElem := PElem^.PNext;
  end;
 
end;
//------------------------------
//--------------------------------
procedure Add(var aList: TList; const aSname, aName, aYear, aSport, aRes: TData);
var
  PElem: TPElem;
begin
  New(PElem);
  PElem^.Sname := aSname;
  PElem^.Name := aName;
  PElem^.Year := aYear;
  PElem^.Sport := aSport;
  PElem^.Res := aRes;
  PElem^.PNext := nil;
  if aList.PFirst = nil then
    aList.PFirst := PElem
  else
    aList.PLast^.PNext := PElem;
  aList.PLast := PElem;
end;
//------------------------------
function YearSort (var year:integer;const aList:TList):TList;
var PElem: TPElem; bList:TList;
    s1,s2,s3,s4,s5:string;
begin
PElem := aList.PFirst;
Init(bList);
while PElem <> nil do begin
if strtoint(PElem^.Year) > year 
 then begin
  s1:=PElem^.Sname;
  s2:=PElem^.Name;
  s3:=PElem^.Year;
  s4:=PElem^.Sport;
  s5:=PElem^.Res;
 Add(bList,s1,s2,s3,s4,s5);
 end;
 PElem := PElem^.PNext;
 
end;
YearSort:= bList;
end;
//-------------------------------
procedure PrintR(const aList: TList);
var
  PElem: TPElem; k:integer;
  a: array [1..n] of string;
begin
  if aList.PFirst = nil then begin
    Writeln('Список пуст.');
    Exit;
  end;
  j:=0;
  PElem := aList.PFirst;
  writeln ('Введенный список в обратном направлени:');
  while PElem <> nil do
  begin
    inc(j);
   { if PElem <> aList.PFirst then };
    
    a[j]:= inttostr(j)+'. '+PElem^.Sname+ ' '+ PElem^.Name+ ' '+ PElem^.Year+ ' '+ PElem^.Sport+ ' '+ PElem^.Res;
    PElem := PElem^.PNext;
  end;
 k:=0;
 for k:= j downto 1 do 
  writeln (a[k]);
 {while k <> j do begin
  inc(k);
  writeln (a[k]);
 end;}
 
end;
//-----------------
procedure SortAlpSport(j: integer; const aList: TList);
var i: integer;
     PElem: TPElem; 
begin
for i:=1 to j do
begin
PElem:=aList.PFirst;
while PElem^.PNext<> nil do
begin
if CompareStr(PElem^.Sport,PElem^.PNext^.Sport)>0 then
Swap(PElem^.Sport,PElem^.PNext^.Sport);
PElem:=PElem^.PNext;
end;
end;
PElem:=aList.PFirst;
end;
//-----------------------
function BestOf (const aList:TList):TList;
var n1,PElem:TPElem;
    bList:TList;
begin
Init(bList);
PElem:=aList.PFirst;
while PElem^.PNext <> nil do begin 
 if PElem^.Sport = PElem^.PNext^.Sport then begin
  if PElem^.Res > PElem^.PNext^.Res then n1:=PElem
    else n1:=PElem^.PNext
     end
     else if PElem^.Res > PElem^.PNext^.Res then n1:=PElem
    else n1:=PElem^.PNext;
 Add(bList, n1^.Sname,n1^.Name,n1^.Year,n1^.Sport,n1^.Res);
 PElem:=PElem^.PNext;
 end;
 BestOf:= bList;
end;
//-----------------
var Sportsmen,SM2,SM3: TList; PElem, PPrev: TPElem;
    i, a, Data, Code,Year:integer; 
    s1,s2,s3,s4,s5:string;
label m1;
begin 
//создание списка 
Init(Sportsmen);
Init(SM2);
Init(SM3);
Writeln('Создание списка.');
    Writeln('Прекратить ввод - пустая строка + Enter.');
    i := 0;
    j:=0;
    repeat
      Write('Элемент ', i + 1, ': ');
      Writeln('Фамилия - ');
      Readln(s1);
      if s1 = '' then goto m1;
      Writeln('Имя - ');
      Readln(s2);
      Writeln('Год Рождения - ');
      s3 := SR(s3); 
      Writeln('Вид Спорта - ');
      Readln(s4);
      Writeln ('Результат (в баллах) - ');
      s5:=SR(s5);
      if (s1 <> '')  then begin
        Val(s5, Data, Code);
        if Code = 0 then begin
          Inc(i);
          Add(Sportsmen, s1, s2, s3, s4, s5);
        end else
          Writeln('Неверный ввод. Повторите.');
      end;
      m1: 
    until (s1 = '');
    Print(Sportsmen);
    writeln;
    PrintR(Sportsmen);
    writeln ('Введите год');
    readln(a);
    SM2:=YearSort(a,Sportsmen);
    {Print(SM2);
    {SortAlpSport(j,Sportsmen);}
    SM3:=BestOf(SM2);
    Print (SM3);
    
    end.

Проблема с функцией BestOf - решение поставленной задачи
1. 1-ый вариант функции

Кликните здесь для просмотра всего текста

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
function BestOf (const aList:TList):TList;
var n1,PElem:TPElem;
    bList:TList;
begin
Init(bList);
PElem:=aList.PFirst;
while PElem^.PNext <> nil do begin 
 if PElem^.Sport = PElem^.PNext^.Sport then begin
  if PElem^.Res > PElem^.PNext^.Res then n1:=PElem
    else n1:=PElem^.PNext
     end
     else if PElem^.Res > PElem^.PNext^.Res then n1:=PElem
    else n1:=PElem^.PNext;
 Add(bList, n1^.Sname,n1^.Name,n1^.Year,n1^.Sport,n1^.Res);
 PElem:=PElem^.PNext;
 end;
 BestOf:= bList;
end;

Она работает только для 2-х элементов
2-ой вариант

Кликните здесь для просмотра всего текста

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
function BestOf (j:integer; const aList:TList):TList;
var n1,tmp,tmpJ:TPElem; i:integer;
    bList:TList;
begin
Init(bList);
tmpJ:=aList.PFirst;
tmp:=tmpJ^.PNext;
for i:= 1 to j-1 do begin 
while tmp <> nil do begin 
 if tmpJ^.Sport = tmp^.Sport then begin
  if tmpJ^.Res > tmp^.Res then n1:=tmpJ
    else n1:=tmp
     end
     else if tmpJ^.Res > tmp^.Res then n1:=tmpJ
    else n1:=tmp;
    tmp:=tmp^.PNext;
    end;
    tmpj:=tmpJ^.PNext;
    Add(bList, n1^.Sname,n1^.Name,n1^.Year,n1^.Sport,n1^.Res);
    end;
    BestOf:= bList;
end;

j - глобальная переменная, в ней находится кол-во эл-тов списка.
Но функция выводит единственное значение j раз.
Я только начал проходить работу с динамической памятью и любая помощь приветствуется.

Новые блоги и статьи Все статьи Все блоги /
Midnight Chicago Blues kumehtar 24.03.2026 Такой Midnight Chicago Blues, знаешь?. . Когда вечерние улицы становятся ночными, а ты не можешь уснуть. Ты идёшь в любимый старый бар, и бармен наливает тебе виски. Ты смотришь на пролетающие. . .	Контроль уникальности заводского номера - вариант №2 Maks 24.03.2026 В отличие от предыдущего варианта добавлено прерывание циклов, также добавлены новые переменные для сохранения контекста ошибки перед прерыванием цикла: Процедура ПередЗаписью(Отказ, РежимЗаписи,. . .	SDL3 для Desktop (MinGW): Вывод текста со шрифтом TTF с помощью библиотеки SDL3_ttf на Си и C++ 8Observer8 24.03.2026 Содержание блога Финальные проекты на Си и на C++: finish-text-sdl3-c. zip finish-text-sdl3-cpp. zip	Жизнь в неопределённости kumehtar 23.03.2026 Жизнь — это постоянное существование в неопределённости. Например, даже если у тебя есть список дел, невозможно дойти до точки, где всё окончательно завершено и больше ничего не осталось. В принципе,. . .
Модель здравоСохранения: работники работают быстрее после её введения. anaschu 23.03.2026 geJalZw1fLo Корпорация до введения программа здравоохранения имела много невыполненных работниками заданий, после введения программы количество заданий выросло. Но на выплатах по больничным это. . .	Контроль уникальности заводского номера - вариант №1 Maks 23.03.2026 Алгоритм контроля уникальности заводского (или серийного) номера на примере документа выдачи шин для спецтехники с табличной частью. Данные берутся из регистра сведений, по которому настроено. . .	Хочу заставить корпорации вкладываться в здоровье сотрудников: делаю мат модель здравосохранения anaschu 22.03.2026 e7EYtONaj8Y Z4Tv2zpXVVo https:/ / github. com/ shumilovas/ med2. git	Программный отбор элементов справочника по группе Maks 22.03.2026 Установка программного отбора элементов справочника "Номенклатура" из модуля формы документа. В качестве фильтра для отбора справочника служит группа номенклатуры. Отбор по наименованию группы. . .