Списки. Поправить процедуру

@asd231 · Регистрация: 23.12.2016

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

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
Type
  rec=record
   FIO:string[30];
   Vozr:integer;
   adress:string[30];
  end;
Type
  position = ^celltype;                          {указатель на тип элемента}
  celltype = record                              {тип элемента списка}
  element: rec;                                  {поле данных элемента}
  next: position;                                {поле указателя на следующий элемент}
  end;
  LIST = ^celltype;
var
  L: LIST;                                       {указатель на первый элемент списка}
  p: position;                                   {указатель на текущий элемент}
  ylica:string;
  sred_vozr:real;
  name:string;
procedure Ins_SingleList(x: rec; var L: LIST; var p: position);
var  q: position;
begin
 New(q);   q^.element := x;
  if L = nil then begin
    q^.next := nil;
    L := q;
  end else begin  
    q^.next := p^.next;
    p^.next := q;
  end;
  p := q;
end;        
 
procedure input(var l:list);
var f:text;
    el:rec;
begin
Assign(f,'file.txt');
Reset(f);
  while not eof(f) do
    begin
      readln(f, el.FIO);
      readln(f, el.Vozr);
      readln(f, el.adress);
      Ins_SingleList(el, l, p);      
    end;
Close(f);
end;
 
procedure output(l:list);
var q:position;
begin
  q:=l;
  writeln('                Ф.И.О             Возраст          Адрес');
  writeln;
  while q <> nil do
  begin
    with q^.element do 
    Writeln(FIO:30,Vozr:9,adress:25);
    q :=q^.next;
  end;
end;
 
 
procedure scaningPRYAKOL(l:list; ylica:string; var sred_vozr:real);
var
  q: position; {вспомогательный указатель}   
  a:integer;
begin
  q:=L;
  a:=0;
  while q <> nil do begin  {пока не конец списка}
  if q^.element.adress = ylica then begin
  sred_vozr:= sred_vozr+q^.element.Vozr;
  a:=a+1;
  end;
    q := q^.next;
  end;
  if a<>0 then
  sred_vozr:=sred_vozr/a;
end;
 
procedure scan2(var l:list; name:string);
var
  q: position; {вспомогательный указатель}   
begin
  q:=L;
  while q <> nil do begin  {пока не конец списка}
  if q^.element.fio = name then begin
  while q^.next<>nil do begin
  dispose(q^.next)
  end;
  end;
  q := q^.next;
end;
end;
 
 
procedure vyvod(sred_vozr:real);
begin
if sred_vozr>0 then
begin
writeln;
writeln('Средний возраст по улице - ', sred_vozr);
end
else
writeln('Введена несуществующая улица');
end;    
begin
writeln('Исходная таблица');
input(l);
output(l);
readln(ylica);
scaningPRYAKOL(l,ylica,sred_vozr);
vyvod(sred_vozr);
readln(name);
scan2(l,name);
output(l);
end.

Здравствуйте, ув.форумчане, перейду сразу к делу.
Суть программы:
1) Определить средний возраст работников, проживающих по указанной улице (С этим проблем нету)
2) Удалить часть списка после элемента, содержащего информацию об указанном работнике. т.е указываем Фамилию Имя Отчество, всё что находится после указанного - удаляется. (Вот тут проблема)
Как выше написано, проблема с удалением части списка после указанного элемента, у меня это содержится в процедуре Scan2
В чем же проблема? Проблема в том, что мне сказали что мне нужно освободить память, но вот процедуру написал настолько криво, что без понятия, как правильно это сделать, толи создать дополнительный указатель..без понятия, или же найдется вариант более лучшей процедуры?
Буду благодарен за помощь.
Файл прикрепил: file.txt

@JuriiMW · 24.05.2018, 08:07

В PABC.NET не нужно освобождать память.
Достаточно просто потерять ссылку на динамический элемент и он считается освобождённым:

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
const
  fName = 'filetxt';
 
type
  rec = record
    FIO    : string[30]; 
    Vozr   : integer;
    adress : string[30];
  end;
 
type
  myList = class
    element: rec;
    next: myList;
    
    constructor (x : rec);
    begin
      element := x; next := nil;
    end;
  end;
 
procedure Ins_SingleList(x: rec; var First, Last : myList);
begin
  if First = nil then
    begin
      First := New myList(x);
      Last := First;
    end
  else
    begin
      Last.next := New myList(x);
      Last := Last.next;
    end;
end;
 
function input : myList;
begin
  Result := nil;
  var Last : myList;
  var f : Text;
  Reset(f, fName);
  while not eof(f) do
    begin
      var el : rec;
      readln(f, el.FIO);
      readln(f, el.Vozr);
      readln(f, el.adress);
      Ins_SingleList(el, Result, Last);
    end;
  Close(f);
end;
 
procedure output(L : myList);
begin
  writeln('                Ф.И.О             Возраст          Адрес');
  WriteLn('-'*70);
  while L <> nil do
    begin
      WriteLnFormat('{0,-30} | {1,9} | {2}', L.element.FIO, L.element.Vozr, L.element.adress);
      L := L.next;
    end;
  WriteLn('-'*70);
end;
 
procedure MiddleAge(L : myList);
begin
  var Street := ReadLnString('Название улицы:');
  var Age := New List<integer>;
  while L <> nil do
    begin
      if L.element.adress = Street then
        Age.Add(L.element.Vozr);
      L := L.next;
    end;
  if Age.count = 0 then
    WriteLn($'Введена несуществующая улица "{Street}"')
  else
    WriteLn($'Средний возраст по улице составляет {Age.toArray.Average}');
end;
 
function Truncate(var L : myList) : Boolean;
begin
  var FIO := ReadLnString('ФИО работника, после которого усечь список:');
  var Cur := L;
  Result := True;
  while Cur <> nil do
    begin
      if Cur.element.FIO = FIO then
        begin
          Cur.next := nil;
          WriteLn('Список усечён');
          Exit;
        end;
      Cur := Cur.next;
    end;
  WriteLn($'Такого работника "{FIO}" не найдено');
  Result := False;
end;
 
begin
  var L := input;
  writeln('Исходная таблица'); output(L);
  MiddleAge(L);
  if Truncate(L) then
    begin
      WriteLn('Новая таблица'); output(L);
    end;
end.

Добавлено через 5 минут
P.S. Вот ссылка на первоисточник Связные списки - новый стиль

@asd231 · 30.05.2018, 19:53 **[ТС]**

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
Type
  rec=record
   FIO:string[30];
   Vozr:integer;
   adress:string[30];
  end;
Type
  position = ^celltype;                       
  celltype = record                              
  element: rec;                              
  next: position;                         
  end;
  LIST = ^celltype;
var
  L: LIST;                                       
  p: position;                              
  ylica:string;
  sred_vozr:real;
  name:string;
procedure Ins_SingleList(x: rec; var L: LIST; var p: position);
var  q: position;
begin
 New(q);   q^.element := x;
  if L = nil then begin
    q^.next := nil;
    L := q;
  end else begin  
    q^.next := p^.next;
    p^.next := q;
  end;
  p := q;
end;
 
//ЭТА ПРОЦЕДУРА УДАЛЕНИЯ ПРАВИЛЬНАЯ
procedure Del_SingleList(var L: LIST; var p: position);
var q:position;
begin
  if p <> nil then begin 
    if p = L then begin   
      L := L^.next;
      dispose(p);
      p := L;
    end else begin
        q := L;
        while q^.next <> p do
          q := q^.next;
      q^.next := p^.next;
        dispose(p);
        p := q;
    end;
  end;
end;    
 
procedure input(var l:list);
var f:text;
    el:rec;
begin
Assign(f,'file.txt');
Reset(f);
  while not eof(f) do
    begin
      readln(f, el.FIO);
      readln(f, el.Vozr);
      readln(f, el.adress);
      Ins_SingleList(el, l, p);      
    end;
Close(f);
end;
 
procedure output(l:list);
var q:position;
begin
  q:=l;
  writeln('                Ф.И.О             Возраст          Адрес');
  writeln;
  while q <> nil do
  begin
    with q^.element do 
    Writeln(FIO:30,Vozr:9,adress:25);
    q :=q^.next;
  end;
end;
 
 procedure scaningPRYAKOL(l:list; ylica:string; var sred_vozr:real);
var
  q: position; {вспомогательный указатель}   
  a:integer;
begin
  q:=L;
  a:=0;
  while q <> nil do begin  {пока не конец списка}
  if q^.element.adress = ylica then begin
  sred_vozr:= sred_vozr+q^.element.Vozr;
  a:=a+1;
  end;
    q := q^.next;
  end;
  if a<>0 then
  sred_vozr:=sred_vozr/a;  
end; 
 
//ТУТ ПРОБЛЕМА
procedure Scan_SingleList(L: LIST; var p: position; name: string);
var
  q: position;  
begin
  q := L;
  while q <> nil do begin 
  if (q^.element.FIO = name) then begin
        writeln(q^.element.Vozr:19,q^.element.Vozr:9,q^.element.adress:11);  
        p:=q;
        Del_SingleList(l,p);
        end;
    q := q^.next;
  end;
  end;
 
procedure vyvod(sred_vozr:real);
begin
if sred_vozr>0 then
begin
writeln;
writeln('Средний возраст по улице - ', sred_vozr);
end
else
writeln('Введена несуществующая улица');
end;    
begin
writeln('Исходная таблица');
input(l);
writeln('Введите элемент, после которого всё будет удалено(Вводить Ф.И.О.): ');
output(l);
readln(ylica);
// scaningPRYAKOL(l,ylica,sred_vozr);
// vyvod(sred_vozr);
// readln(name);
//Del
 
Scan_SingleList(l,p,name);
output(l);
dispose(l);
end.

Дело такое, мне нужно удалить всё, после указанного элемента, т.е. я ввожу Фамилию Имя Отчество, после этого должно быть всё удалено, а то что вверху, вывестись на экран, процедура "Del_SingleList" - она выполняет правильно свою работу, а вот Scan_SingleList что-то пошло не по плану..
Выручайте)file.txt

Новые блоги и статьи Все статьи Все блоги /
Ритм жизни kumehtar 27.02.2026 Иногда приходится жить в ритме, где дел становится всё больше, а вовлечения в происходящее — всё меньше. Плотный график не даёт вниманию закрепиться ни на одном событии. Утро начинается с быстрых,. . .	SDL3 для Web (WebAssembly): Сборка библиотек SDL3 и Box2D из исходников с помощью CMake и Emscripten 8Observer8 27.02.2026 Недавно вышла версия SDL 3. 4. 2 библиотеки SDL3. На странице официальной релиза доступны исходники, готовые DLL (для x86, x64, arm64), а также библиотеки для разработки под Android, MinGW и Visual. . .	SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами 8Observer8 20.02.2026 Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .	Конвертировать закладки radiotray-ng в m3u-плейлист damix 19.02.2026 Это можно сделать скриптом для PowerShell. Использование . \СonvertRadiotrayToM3U. ps1 <path_to_bookmarks. json> Рядом с файлом bookmarks. json появится файл bookmarks. m3u с результатом. # Check if. . .
Семь CDC на одном интерфейсе: 5 U[S]ARTов, 1 CAN и 1 SSI Eddy_Em 18.02.2026 Постепенно допиливаю свою "многоинтерфейсную плату". Выглядит вот так: https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11617&stc=1&d=1771445347 Основана на STM32F303RBT6. На борту пять. . .	Камера Toupcam IUA500KMA Eddy_Em 12.02.2026 Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .	И ясному Солнцу zbw 12.02.2026 И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.	«Знание-Сила» zbw 12.02.2026 «Знание-Сила» «Время-Деньги» «Деньги -Пуля»