Двусвязный список с простым интерфейсом.

@mark1ra · Регистрация: 19.10.2011

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

ЗАДАЧА:
Нужен двусвязный список с простым интерфейсом для пользователя, и сто бы в него входило:
1. Полное удаление списка,
2. Удаление выбранного элемента (создать через процедуру),
3. Добавление элемента в список,
4. Вывод списка на экран,
5. Выход.

Программа работает, но некорректно. Никак не могу найти ошибки. :/

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
Program Nr4_10;
uses crt;
type
  Tinf=integer;
  List=^TList;
  TList=record
    data:TInf;
    next,prev:List;
  end;
/// - - - - - - - - - - - - Udolenie vybranogo elementa - - - - - - - - - - - - - - - - -
Procedure DelElemPos(var Head:List; pos:integer);
var
  i:integer;
  tmp,tmpi:List;
  begin
    if (pos>=1) and (Head<>nil) then
      begin
        i:=1;
        tmp:=Head;
        while (tmp<>nil) and (i<>pos) do
          begin
            tmp:=tmp^.next;
            inc(i);
          end;
        if tmp<>nil then
          begin
            if tmp=Head then
              begin
                Head:=tmp^.next;
                Dispose(tmp);
                tmp:=nil;
              end
                else
                  begin
                    tmpi:=Head;
                    while tmpi^.next<>tmp do
                    tmpi:=tmpi^.next;
                    tmpi^.next:=tmp^.next;
                    Dispose(tmp);
                    tmp:=nil;
                  end;
            Writeln('Element uspeshno udalen.');
      end
        else
          Writeln('Elementa s nomerom ' ,pos, ' nesushcestvuet.');
          Readln;
            end
              else
                begin
                  Writeln('Elementa s nomerom ' ,pos, ' nesushcestvuet.');
                end;
  end;
/// - - - - - - - - - - - - - - Glavnaja programa - - - - - - - - - - - - - - - - - - - -
var
  Head,Last,Current,tmp:List;
  i,num,pos,number:integer; //number - chisla dlia interfejsa
  value:Tinf;
  begin
     Writeln('Chto budem delac? =)');
     Writeln('1 - Polnoe udalenie spiska.');
     Writeln('2 - Udalenie vybranogo elementa.');
     Writeln('3 - Dobavic element v spisok.');
     Writeln('4 - Napechatac spisok.');
     Writeln('5 - Konec programy.');
     Readln(number);
       while number<>5 do
         begin
// - - - - - - - - Polnoe udolenie spiska - - - - - -
           if number=1 then
             begin
               while head<>nil do
                 begin
                   tmp:=head;
                   head:=head^.next;
                   Dispose(tmp);
                   tmp:=nil;
                 end;
            end;
// - - - - - - - - Udalenie vybranogo elemnta - - - - - -
          if number=2 then
            begin
              Writeln('Vvedite nomer elementa dlia udalenija: ');
              Readln(pos);
              DelElemPos(Head,pos);
            end;
// - - - - - - - - Dobavic element v spisok - - - - - -
          if number=3 then
               begin
               Writeln('Vvedite lement:');
               Readln(value);
               GetMem(tmp,sizeof(TList));
               tmp^.next:=Head;
               tmp^.data:=value;
               Head:=tmp;
             end;
// - - - - - - - - Napechatac spisok - - - - - -
          if number=4 then
            begin
              Writeln('Poluchenij spisak: ');
              While Head<>nil do
                begin
                  Write(Head^.Data, ' ');
                  Head:=Head^.Next;
                end;
              Readln;
            end;
          clrscr;
          Writeln('Chto budem delac =)?');
          Writeln('1 - Polnoe udolenie spiska.');
          Writeln('2 - Udalenie vybranogo elementa.');
          Writeln('3 - Dobavic element v spisok.');
          Writeln('4 - Napechatac spisok.');
          Writeln('5 - Konec programy.');
          readln(number);
       end;
  end.

@volvo · 01.12.2011, 00:19

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

Программа работает, но некорректно. Никак не могу найти ошибки. :/

1) ты не используешь двунаправленность списка, используется только поле next, хотя есть еще и prev
2) после того, как вывел на экран список - Head уже = nil, то есть, все введенные до этого значения потеряны. Надо использовать временную переменную, а Head оставлять без изменения.
3) при создании элемента списка опять же, не заполняется поле prev.
4) зачем тебе все эти If-ы и дублирование меню? Есть же не только цикл While, но и Repeat/Until, который тут подходит как нельзя лучше.

В общем, попробуй вот это:

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
Program Nr4_10;
uses crt;
type
   Tinf = integer;
   List = ^TList;
   TList =
   record
      data : TInf;
      next, prev : List;
  end;
 
// - - - - - - - - - - - - Udolenie vybranogo elementa - - - - - - - - - - - - - - - - -
procedure DelElemPos(var Head, Tail : List;
                     pos : integer);
var
   tmp, q : List;
   i : integer;
begin
   if (pos >= 1) and (Head <> nil) then
   begin
 
      tmp := Head; i := 1;
      while (tmp <> nil) and (i < pos) do
      begin
         tmp := tmp^.next;
         inc(i);
      end;
 
      if (i = pos) and (tmp <> nil) then
      begin
         q := tmp^.prev;
         if q <> nil then q^.next := tmp^.next
         else head := tmp^.next;
 
         q := tmp^.next;
         if q <> nil then q^.prev := tmp^.prev
         else tail := tmp^.prev;
 
         dispose(tmp);
         tmp := nil;
         writeln('Элемент успешно удален');
      end
      else writeln('Список содержит меньше элементов, чем ', pos)
 
   end
   else writeln('Неправильный номер ИЛИ пустой список');
end;
 
/// - - - - - - - - - - - - - - Glavnaja programa - - - - - - - - - - - - - - - - - - - -
var
   Head, Tail, tmp:List;
   pos,number:integer; //number - chisla dlia interfejsa
   value:Tinf;
begin
   Head := nil; Tail := nil;
   repeat
      clrscr;
      Writeln('Chto budem delac? =)');
      Writeln('1 - Polnoe udalenie spiska.');
      Writeln('2 - Udalenie vybranogo elementa.');
      Writeln('3 - Dobavic element v spisok.');
      Writeln('4 - Napechatac spisok.');
      Writeln('5 - Konec programy.');
      Readln(number);
      case number of
         // - - - - - - - - Polnoe udolenie spiska - - - - - -
         1 :
         begin
            while Head <> nil do
            begin
               tmp := Head;
               Head := Head^.next;
               Dispose(tmp);
               tmp := nil;
            end;
         end;
 
         // - - - - - - - - Udalenie vybranogo elemnta - - - - - -
         2 :
         begin
            Writeln('Vvedite nomer elementa dlia udalenija: ');
            Readln(pos);
            DelElemPos(Head, Tail, pos);
            readln;
         end;
 
         // - - - - - - - - Dobavic element v spisok - - - - - -
         3 :
         begin
            Writeln('Vvedite lement:');
            Readln(value);
            GetMem(tmp,sizeof(TList));
            tmp^.next := nil;
            tmp^.prev := Tail;
            tmp^.data := value;
 
            if Head = nil then Head := tmp
            else Tail^.next := tmp;
 
            Tail := tmp;
         end;
 
         // - - - - - - - - Napechatac spisok - - - - - -
         4 :
         begin
            Writeln('Poluchenij spisak: ');
            tmp := Head;
            while tmp <> nil do
            begin
               Write(tmp^.Data, ' ');
               tmp := tmp^.next;
            end;
            Readln;
         end;
      end;
   until number = 5;
end.

@mark1ra · 01.12.2011, 12:35 **[ТС]**

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

4) зачем тебе все эти If-ы и дублирование меню? Есть же не только цикл While, но и Repeat/Until, который тут подходит как нельзя лучше.

Да мне это не к чему, просто преподавателю не нравится процедура exit. Ну да, с Whilom и If-om я сглупил.
СПАСИБО ОГРОМНОЕ ЗА ПОМОЩЬ!

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Desktop (MinGW): Создаём пустое окно с нуля для 2D-графики на SDL3, Си и C++ 8Observer8 10.03.2026 Содержание блога Финальные проекты на Си и на C++: hello-sdl3-c. zip hello-sdl3-cpp. zip Результат:	Установка CMake и MinGW 13.1 для сборки С и C++ приложений из консоли и из Qt Creator в EXE 8Observer8 10.03.2026 Содержание блога MinGW - это коллекция инструментов для сборки приложений в EXE. CMake - это система сборки приложений. Здесь описаны базовые шаги для старта программирования с помощью CMake и. . .	Как дизайн сайта влияет на конверсию: 7 решений, которые реально повышают заявки Neotwalker 08.03.2026 Многие до сих пор воспринимают дизайн сайта как “красивую оболочку”. На практике всё иначе: дизайн напрямую влияет на то, оставит человек заявку или уйдёт через несколько секунд. Даже если у вас. . .	Модульная разработка через nuget packages DevAlt 07.03.2026 Сложившийся в . Net-среде способ разработки чаще всего предполагает монорепозиторий в котором находятся все исходники. При создании нового решения, мы просто добавляем нужные проекты и имеем. . .
Модульный подход на примере F# DevAlt 06.03.2026 В блоге дяди Боба наткнулся на такое определение: В этой книге («Подход, основанный на вариантах использования») Ивар утверждает, что архитектура программного обеспечения — это структуры,. . .	Управление камерой с помощью скрипта OrbitControls.js на Three.js: Вращение, зум и панорамирование 8Observer8 05.03.2026 Содержание блога Финальная демка в браузере работает на Desktop и мобильных браузерах. Итоговый код: orbit-controls-threejs-js. zip. Сканируйте QR-код на мобильном. Вращайте камеру одним пальцем,. . .	SDL3 для Web (WebAssembly): Синхронизация спрайтов SDL3 и тел Box2D 8Observer8 04.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-sync-physics-sprites-sdl3-c. zip На первой гифке отладочные линии отключены, а на второй включены:. . .	SDL3 для Web (WebAssembly): Идентификация объектов на Box2D v3 - использование userData и событий коллизий 8Observer8 02.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-collision-events-sdl3-c. zip Сканируйте QR-код на мобильном и вы увидите, что появится джойстик для управления главным героем. . . .