Удалить из списка элементы с фамилиями, длина которых больше «r» символов

@Vladimir_Prime · Регистрация: 24.12.2019

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

Помогите написать процедуру которая будет удалять из списка элементы с фамилиями, длина которых больше «r» символов.

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
Program spisok;
type 
  PElement = ^TypeElement;
  TypeElement = record
    n : integer;
    f : string;
    Next : PElement;
  end; 
var 
  pHead, pCur, pNew, pPred : PElement;
  a, kom : integer;
  fam: string;
  
  
//Новый элемент
procedure newe(a : integer; fa : string; var NewE : PElement); 
BEGIN 
  New(NewE);
  NewE^.n := a;
  NewE^.f :=fa;
END;
 
 
//Вставка
procedure paste(fa : string);
BEGIN
  a := a + 1;
  NewE(a, fa, pNew);
  if pHead = nil then 
  begin
    pNew^.Next := nil;
    pHead := pNew;
  end
  else 
  begin
    pCur := pHead;
    if pCur^.f > pNew^.f then
    begin
      pNew^.Next := pHead;
      pHead := pNew;
      exit;
    end;
    repeat
      if pCur^.f > pNew^.f then
      begin
        pNew^.Next := pCur;
        pPred^.Next :=pNew;
        exit
      end
    else
    begin
      pPred := pCur;
      pCur := pCur^.Next;
    end;
    until pCur = nil;
    pCur := pPred;
    pNew^.Next := nil;
    pCur^.Next := pNew;
  end;
END;
 
 
//Вывод списка
procedure printl;
BEGIN 
  if pHead = nil then 
  begin
    writeln('Список пуст');
    exit;
  end;
  pCur := pHead;
  while pCur <> nil do
  begin
    writeln(pCur^.n, ' ', pCur^.f);
    pCur := pCur^.Next;
  end;
END;
 
 
//Удаление
procedure delete (fa : string); 
BEGIN 
  if pHead = nil then
  begin
    writeln('Список пуст');
    exit;
  end;
  pCur := pHead;
  while (pCur^.Next <> nil) and (fa <> pCur^.f) do
  begin
    pPred := pCur;
    pCur := pCur^.Next;
  end;
  if fa <> pCur^.f then writeln('Элемент не найден')
  else
  begin
    writeln('Элемент: "', pCur^.n, ' ', pCur^.f, ' ', '" был удалён');
    if (pCur <> pHead) then 
      pPred^.Next := pCur^.Next
    else
      pHead := pCur^.Next;
    dispose(pCur);
  end;
END;
 
 
//Поиск
procedure find (fa : string);
BEGIN
  if pHead = nil then
  begin
    writeln('Список пуст');
    exit;
  end;
  pCur := pHead;
  while pCur <> nil do
  begin
    if fa = pCur^.f then
    begin
      writeln('Элемент найден: ');
      writeln(pCur^.n, ' ', pCur^.f);
      exit;
    end
    else 
      pCur := pCur^.Next;
  end;
  if pCur = nil then
    writeln('Элемент не найден');
END;
 
BEGIN
  a := 5000;
  paste('Волк');
  paste('Морозов');
  paste('Егоров');
  paste('Павлов');
  paste('Соловьев');
  while true do
  begin
    writeln('_____________________________________________');
    writeln('1 - Вывод списка на экран');
    writeln('2 - Добавить элемент в список');
    writeln('3 - Поиск элемента по фамилии');
    writeln('4 - Удаление элемента');
    Writeln('5 - Выход');
    writeln('_____________________________________________');
    writeln('Команда: ');
    readln(kom);
    writeln;
    case kom of
      1: printl;
      2:
      begin
        writeln('Введите фамилию ');
        readln(fam);
        paste(fam);
        writeln('Фамилия добавлена');
      end;
      3:
      begin
        writeln('Введите фамилию для поиска: ');
        readln(fam);
        find(fam);
      end;
      4:
      begin
        writeln('Введите фамилию для удаления ');
        readln(fam);
        delete(fam)
      end;
      5: Exit
      else
        writeln('Элемент не найден');
    end;
    writeln(' ');
  end;
END.

@mr-Crocodile · 19.05.2022, 15:11

Сообщение от Vladimir_Prime

Помогите написать процедуру которая будет удалять из списка элементы с фамилиями, длина которых больше «r» символов.

щас напишу...

Добавлено через 1 час 3 минуты

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
218
219
220
221
222
223
Program spisok;
type 
  PElement = ^TypeElement;
  TypeElement = record
    n : integer;
    f : string;
    Next : PElement;
  end; 
var 
  pHead : PElement;
  a : integer;
 
  
//Новый элемент
procedure newe(a : integer; fa : string; var NewE : PElement); 
BEGIN 
  New(NewE);
  NewE^.n := a;
  NewE^.f :=fa;
END;
 
 
//Вставка
procedure paste(fa : string);
var pNew, pCur, pPred : PElement;
BEGIN
  a := a + 1;
  NewE(a, fa, pNew);
  if pHead = nil then 
  begin
    pNew^.Next := nil;
    pHead := pNew;
  end
  else 
  begin
    pCur := pHead;
    if pCur^.f > pNew^.f then
    begin
      pNew^.Next := pHead;
      pHead := pNew;
      exit;
    end;
    repeat
      if pCur^.f > pNew^.f then
      begin
        pNew^.Next := pCur;
        pPred^.Next :=pNew;
        exit
      end
    else
    begin
      pPred := pCur;
      pCur := pCur^.Next;
    end;
    until pCur = nil;
    pCur := pPred;
    pNew^.Next := nil;
    pCur^.Next := pNew;
  end;
END;
 
 
//Вывод списка
procedure printl;
var pCur : PElement;
BEGIN
  if pHead = nil then 
  begin
    writeln('Список пуст');
    exit;
  end;
  pCur := pHead;
  while pCur <> nil do
  begin
    writeln(pCur^.n, ' ', pCur^.f);
    pCur := pCur^.Next;
  end;
END;
 
 
//Удаление
procedure delete (fa : string); 
var pCur, pPred : PElement;
BEGIN
  if pHead = nil then
  begin
    writeln('Список пуст');
    exit;
  end;
  pCur := pHead;
  while (pCur^.Next <> nil) and (fa <> pCur^.f) do
  begin
    pPred := pCur;
    pCur := pCur^.Next;
  end;
  if fa <> pCur^.f then writeln('Элемент не найден')
  else
  begin
    writeln('Элемент: "', pCur^.n, ' ', pCur^.f, ' ', '" был удалён');
    if (pCur <> pHead) then 
      pPred^.Next := pCur^.Next
    else
      pHead := pCur^.Next;
    dispose(pCur);
  end;
END;
 
//Удаление из списка элементы с фамилиями, длина которых больше «r» символов
procedure deleteLongerThan (r : integer);
var pCur, pTemp, pPred : PElement;
BEGIN
  if pHead = nil then
  begin
    writeln('Список пуст');
    exit;
  end;
 
  PCur := pHead;
  while (pCur <> nil) do
  begin
    {WriteLn('обрабатываем ',pCur^.n, ' ', pCur^.f);}
    if Length(pCur^.f)>r then begin {удаление текущего элемента}
      pTemp := pCur^.Next;
      writeln('Элемент: "', pCur^.n, ' ', pCur^.f, ' ', '" был удалён');
      if (pCur <> pHead) then
           pPred^.Next := pTemp
      else
           pHead := pTemp;
      dispose(pCur);
      pCur := pTemp
    end
    else begin
      pPred := pCur;
      pCur := pCur^.Next;
    end;
  end;
END;
 
 
 
//Поиск
procedure find (fa : string);
var pCur : PElement;
BEGIN
  if pHead = nil then
  begin
    writeln('Список пуст');
    exit;
  end;
  pCur := pHead;
  while pCur <> nil do
  begin
    if fa = pCur^.f then
    begin
      writeln('Элемент найден: ');
      writeln(pCur^.n, ' ', pCur^.f);
      exit;
    end
    else 
      pCur := pCur^.Next;
  end;
  if pCur = nil then
    writeln('Элемент не найден');
END;
 
var
  kom, r : integer;
  fam: string;
BEGIN
  a := 5000;
  paste('Волк');
  paste('Морозов');
  paste('Егоров');
  paste('Павлов');
  paste('Соловьев');
  paste('Антей');
  while true do
  begin
    writeln('_____________________________________________');
    writeln('1 - Вывод списка на экран');
    writeln('2 - Добавить элемент в список');
    writeln('3 - Поиск элемента по фамилии');
    writeln('4 - Удаление элемента gj фамилии');
    writeln('5 - Удаление элемента с длиной более заданной:');
    Writeln('6 - Выход');
    writeln('_____________________________________________');
    writeln('Команда: ');
    readln(kom);
    writeln;
    case kom of
      1: printl;
      2:
      begin
        writeln('Введите фамилию ');
        readln(fam);
        paste(fam);
        writeln('Фамилия добавлена');
      end;
      3:
      begin
        writeln('Введите фамилию для поиска: ');
        readln(fam);
        find(fam);
      end;
      4:
      begin
        writeln('Введите фамилию для удаления ');
        readln(fam);
        delete(fam)
      end;
      5:
      begin
        writeln('Введите длину фамилии r, элементы с фамилиями больше которой удалять (0 - отказ от удаления): ');
        readln(r);
        if r>0 then deleteLongerThan(r)
      end;
      6: Exit
      else
        writeln('Элемент не найден');
    end;
    writeln(' ');
  end;
END.

@bormant · 20.05.2022, 06:47

Хозяйке на заметку:
Если положительная ветка условного оператора завершпется Exit, то отрицательную ветку можно писать без else на том же уровне кода.

Pascal
1
2
3
4
if условие then begin
   ... Exit;
end;
{ сюда управление попадёт только если условие не было истинным }

Добавлено через 5 минут
Хозяйке на заметку:
Если использовать pCur: ^pElement, то не будет необходимости в проверках pCur<>pHead.

@mr-Crocodile · 20.05.2022, 09:05

Сообщение от bormant

Если использовать pCur: ^pElement, то не будет необходимости в проверках pCur<>pHead.

Что то я не понял. Как это поможет?
PCur - это уже ссылочный тип. Если использовать ссылку на ссылку, то что это даст? Как это поможет понять, какой элемент удаляется - первый или в середине/конце списка?

ps. и что, для разыменования нужно будет писать pCur^^.f ?

@bormant · 20.05.2022, 12:55

Сообщение от mr-Crocodile

Как это поможет понять, какой элемент удаляется - первый или в середине/конце списка?

Полностью избавит от необходимости это понимать

В остальном -- вы на правильном пути:
https://www.cyberforum.ru/post16201727.html

@mr-Crocodile · 20.05.2022, 13:13

bormant, понял. хитро.

Добавлено через 6 минут
по рецепту bormant:

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
//Удаление из списка элементы с фамилиями, длина которых больше «r» символов
procedure deleteLongerThan (r : integer);
var pCur: ^PElement;
  pTemp : PElement;
begin
  pCur:=@pHead;
  while pCur^<>nil do  
    if Length(pCur^^.f)>r then begin
      writeln('Элемент: "', pCur^^.n, ' ', pCur^^.f, ' ', '" был удалён');
      pTemp:=pCur^; pCur^:=pCur^^.next; Dispose(pTemp);
    end 
   else pCur:=@pCur^^.next;
end;

@bormant · 20.05.2022, 16:56

mr-Crocodile,
и еще замечание:
обычно в Паскале оператор with do -- это оператор времени исполнения, а не просто действующая во время компиляции декларация для добавления области видимости. Поэтому в примере по ссылке with p^^ do использовано совсем не просто так, это обычно позволяет избежать лишних накладных расходов на двойную косвенную адресацию (указатель по указателю):

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
//Удаление из списка элементы с фамилиями, длина которых больше «r» символов
procedure deleteLongerThan(r: Integer);
var
  pCur: ^PElement;
  pTemp: PElement;
begin
  pCur:=@pHead;
  while pCur^<>nil do with pCur^^ do
    if Length(f)>r then begin
      WriteLn('Элемент: "',n,' ',f,' ','" был удалён');
      pTemp:=pCur^; pCur^:=next; Dispose(pTemp);
    end else pCur:=@next;
end;

@mr-Crocodile · 20.05.2022, 18:11

bormant, я в курсе. но спасибо за уточнение.

Новые блоги и статьи Все статьи Все блоги /
Восстановить юзерскрипты Greasemonkey из бэкапа браузера damix 15.01.2026 Если восстановить из бэкапа профиль Firefox после переустановки винды, то список юзерскриптов в Greasemonkey будет пустым. Но восстановить их можно так. Для этого понадобится консольная утилита. . .	Изучаю kubernetes lagorue 13.01.2026 А пригодятся-ли мне знания kubernetes в России?	Сукцессия микоризы: основная теория в виде двух уравнений. anaschu 11.01.2026 https:/ / rutube. ru/ video/ 7a537f578d808e67a3c6fd818a44a5c4/	WordPad для Windows 11 Jel 10.01.2026 WordPad для Windows 11 — это приложение, которое восстанавливает классический текстовый редактор WordPad в операционной системе Windows 11. После того как Microsoft исключила WordPad из. . .
Classic Notepad for Windows 11 Jel 10.01.2026 Old Classic Notepad for Windows 11 Приложение для Windows 11, позволяющее пользователям вернуть классическую версию текстового редактора «Блокнот» из Windows 10. Программа предоставляет более. . .	Почему дизайн решает? Neotwalker 09.01.2026 В современном мире, где конкуренция за внимание потребителя достигла пика, дизайн становится мощным инструментом для успеха бренда. Это не просто красивый внешний вид продукта или сайта — это. . .	Модель микоризы: классовый агентный подход 3 anaschu 06.01.2026 aa0a7f55b50dd51c5ec569d2d10c54f6/ O1rJuneU_ls https:/ / vkvideo. ru/ video-115721503_456239114	Owen Logic: О недопустимости использования связки «аналоговый ПИД» + RegKZR ФедосеевПавел 06.01.2026 Owen Logic: О недопустимости использования связки «аналоговый ПИД» + RegKZR ВВЕДЕНИЕ Введу сокращения: аналоговый ПИД — ПИД регулятор с управляющим выходом в виде числа в диапазоне от 0% до. . .

@mr-Crocodile 3053 / 1672 / 657 Регистрация: 19.03.2019 Сообщений: 5,381
	20.05.2022, 18:11
	bormant, я в курсе. но спасибо за уточнение. 0

Удалить из списка элементы с фамилиями, длина которых больше «r» символов

Решение