Работа со списками

@buba3230 · Регистрация: 05.03.2009

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

в общем задача состоит в том чтоб поменять 1й и последний елемент списка...
вот мой код что я уже осили )))

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
program spisok;
uses crt;
type tNext=^list_element;
list_element=record
    value:string[9];
    next:tNext;
end;
 
procedure newList(var h,t: tNext);
begin
   new(h);
   h^.next:=nil;
   t:=h;
end;
 
procedure Addelement(var h,t: tNext;val: string);
var  temp:tNext;
begin
   t^.value:=val;
   new(temp);
   t^.next:=temp;
   t:=temp;
   t^.next:=h;
end;
 
procedure printValues(h:tNext);
var  t:tNext;
begin
   writeln('Spisok :');
   t:=h;
   if t^.next=nil then
   exit;
   while t^.next <> h do
   begin
     write(t^.value, '    ');
     t:=t^.next;
   end;
end;
 
procedure change(h:tNext);
var t:tnext;
begin
 
end;
 
procedure mainmenu;
begin
  clrscr;
  writeln('1 ==> Dobavit element v spisok (konec spiska)');
  writeln('2 ==> Vivesti elementi spiska');
  writeln('3 ==> pomenyat mestami 1y i posledniy element spiska');
  writeln('4 ==> Exit');
end;
 
var
  head,temp,list:tNext;
  n:integer;
  s:string[3];
  c:char;
begin
clrscr;
writeln('nazmite');
writeln(' - lubuyu klavichu chobi sozdat spisok i nachat programu');
writeln(' - ESC chtobi viyti');
c:=readkey;
newList(head,temp);
if c=#27 then
EXIT;
 
repeat
mainMenu;
c:=readkey;
clrscr;
case c of
'1':begin
    writeln('Vvedite znachenie');
    readln(s);
    addelement(head,temp,s);
    clrscr;
    writeln('Element',s,' dobavlen');
    writeln('nazmite lubuyu klavichu dlya prodolzeniya');
    readkey;
    clrscr;
    end;
'2':begin
    printValues(head);
    writeln;
    writeln('nazmite lubuyu klavichu dlya prodolzeniya');
    readkey;
    clrscr;
    end;
'3':begin
    writeln('tut ewe ne rabotaet');
    readkey;
    clrscr;
    end;
end;
until c='4';
end.

данную задачу нада реализовать в процедуре CHANGE ... пожалуйста подскажите как поменять 1й и последний елемент списка .

@lexus_ilia · 21.01.2010, 01:41

buba3230, Возьмите за основу мой код(https://www.cyberforum.ru/pascal/thread77419.html), а то Ваш, как бы это помягче, не совсем корректен, и допишите Вашу процедуру вот так:

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
procedure change(var spis1:List);
var
  tmp,tmp1:List;
begin
  if (spis1=nil) or (spis1^.next=nil) then {если список пуст или <2 элементов в списке...}
    exit;    {то выходим}
  tmp:=spis1;
  while tmp^.next^.next<>nil do
    tmp:=tmp^.next; {ставим tmp на предпоследний элемент}
  if tmp=spis1 then {2 элемента в списке}
  begin
    tmp:=spis1^.next;
    spis1^.next:=nil;
    tmp^.next:=spis1;
    spis1:=tmp;
  end
  else
  begin
    tmp1:=tmp^.next;
    tmp1^.next:=spis1^.next;
    tmp^.next:=spis1;
    spis1^.next:=nil;
    spis1:=tmp1;
  end;
end;

Не компилировалось и не проверялось.

@buba3230 · 21.01.2010, 14:41 **[ТС]**

вот я сделал с помощью вашего кода... но на процедуре ЧЕНДЖ виснет прога ((( кто может сказать в чем ошибка ? список сформирован правильно, вывод тоже...

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
program spisok;
uses crt;
type tNext=^list_element;
list_element=record
    value:string[9];
    next:tNext;
        first:tNext;
        last:integer;
end;
 
procedure newList(var h,t: tNext);
begin
   new(h);
   h^.next:=nil;
   t:=h;
end;
 
procedure Addelement(var h,t: tNext;val: string);
var  temp:tNext;
begin
   t^.value:=val;
   new(temp);
   t^.next:=temp;
   t:=temp;
   t^.next:=h;
end;
 
procedure printValues(h:tNext);
var  t:tNext;
begin
   writeln('Spisok :');
   t:=h;
   if t^.next=nil then
   exit;
   while t^.next <> h do
   begin
     write(t^.value, '    ');
     t:=t^.next;
   end;
end;
 
procedure change(h:tNext);
var
  tmp,tmp1:tNext;
begin
  if (h=nil) or (h^.next=nil) then {если список пуст или <2 элементов в списке...}
    exit;    {то выходим}
  tmp:=h;
  while h^.next<>nil do
    tmp:=h^.next^.next; {ставим tmp на предпоследний элемент}
  if tmp=h then {2 элемента в списке}
  begin
    tmp:=h^.next;
    h^.next:=nil;
    tmp^.next:=h;
    h:=tmp;
  end
  else
  begin
    tmp1:=tmp^.next;
    tmp1^.next:=h^.next;
    tmp^.next:=h;
    h^.next:=nil;
    h:=tmp1;
  end;
end;
 
procedure mainmenu;
begin
  clrscr;
  writeln('1 ==> Dobavit element v spisok (konec spiska)');
  writeln('2 ==> Vivesti elementi spiska');
  writeln('3 ==> pomenyat mestami 1y i posledniy element spiska');
  writeln('4 ==> Exit');
end;
 
var
  head,temp,list:tNext;
  n:integer;
  s:string[3];
  c:char;
begin
clrscr;
writeln('nazmite');
writeln(' - lubuyu klavichu chobi sozdat spisok i nachat programu');
writeln(' - ESC chtobi viyti');
c:=readkey;
newList(head,temp);
if c=#27 then
EXIT;
 
repeat
mainMenu;
c:=readkey;
clrscr;
case c of
'1':begin
    writeln('Vvedite znachenie');
    readln(s);
    addelement(head,temp,s);
    clrscr;
    writeln('Element',s,' dobavlen');
    writeln('nazmite lubuyu klavichu dlya prodolzeniya');
    readkey;
    clrscr;
    end;
'2':begin
    printValues(head);
    writeln;
    writeln('nazmite lubuyu klavichu dlya prodolzeniya');
    readkey;
    clrscr;
    end;
'3':begin
        change(head);
{writeln('tut ewe ne rabotaet');}
    {readkey;}
    clrscr;
    end;
end;
until c='4';
end.

@lexus_ilia · 22.01.2010, 00:30

buba3230, а var не надо писать в процедуре, думаете я его там просто так написал, что за народ... Надо было просто скопировать мой код и поменять наименование переменных.

Pascal
1
procedure change(h:tNext);

Это Ваш вариант, а вот мой:

Pascal
1
procedure change(var spis1:List);

Новые блоги и статьи Все статьи Все блоги /
Уведомление о неверно выбранном значении справочника Maks 06.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "НарядПутевка", разработанного в конфигурации КА2. Задача: уведомлять пользователя, если в документе выбран неверный склад. . .	Установка Qt Creator для C и C++: ставим среду, CMake и MinGW без фреймворка Qt 8Observer8 05.04.2026 Среду разработки Qt Creator можно установить без фреймворка Qt. Есть отдельный репозиторий для этой среды: https:/ / github. com/ qt-creator/ qt-creator, где можно скачать установщик, на вкладке Releases:. . .	AkelPad-скрипты, структуры, и немного лирики.. testuser2 05.04.2026 Такая программа, как AkelPad существует уже давно, и также давно существуют скрипты под нее. Тем не менее, прога живет, периодически что-то не спеша дополняется, улучшается. Что меня в первую очередь. . .	Отображение реквизитов в документе по условию и контроль их заполнения Maks 04.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеСпецтехники", разработанного в конфигурации КА2. Данный документ берёт данные из другого нетипового документа. . .
Фото всей Земли с борта корабля Orion миссии Artemis II kumehtar 04.04.2026 Это первое подобное фото сделанное человеком за 50 лет. Снимок называют новым вариантом легендарной фотографии «The Blue Marble» 1972 года, сделанной с борта корабля «Аполлон-17». Новое фото. . .	Вывод диалогового окна перед закрытием, если документ не проведён Maks 04.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: реализовать программный контроль на предмет проведения документа. . .	Программный контроль заполнения реквизитов табличной части документа Maks 02.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: 1. Реализовать контроль заполнения реквизита. . .	wmic не является внутренней или внешней командой Maks 02.04.2026 Решение: DISM / Online / Add-Capability / CapabilityName:WMIC~~~~ Отсюда: https:/ / winitpro. ru/ index. php/ 2025/ 02/ 14/ komanda-wmic-ne-naydena/