динамическая структура данных, Линейные списки Опции

[valeral]

Дано условие:
Описать процедуру, которая вставляет в непустой список L, элементы которого упорядочены по неубы-ванию, новый элемент E так, чтобы сохранилась упо-рядоченность.

не могу вьехать, что надо сделать. Подскажите пожалуйста

Сообщение отредактировано: valeral - 1.06.2006 17:17

[valeral]

Volvo примерно так это должно быть

Program Example;
Uses Crt;
Type
   PEl=^TEl;
   TEl=Record
          Inf:Integer;
          Next:PEl;
       end;
Var Spisok1,Spisok2:PEl;

Procedure CreateSpisok(var A:PEl);
Var B:PEl;
    I:Integer;
begin
    New(A);
    Readln(A^.Inf);
    B:=A;
    Readln(I);
    While not(I=0) do
    begin
         New(B^.Next);
         B:=B^.Next;
         B^.Inf:=I;
         Readln(I);
    end;
    B^.Next:=Nil
end;

Procedure DelSpisok(var A:PEl);
var B:PEl;
begin
     While not(A=nil) do
     Begin
          B:=A;
          A:=A^.Next;
          Dispose(B);
     end;
end;

Procedure PrintSpisok(A:PEl);
var B:PEl;
begin
     B:=A;
     while not(B=nil) do
     begin
          Write(B^.Inf:1,'  ');
          B:=B^.Next;
     end;
     Writeln
end;

Function MinEl(Ab:PEl):Integer;
var B:PEl;
    Min:Integer;
begin
     Min:=Ab^.Inf;
     B:=Ab^.Next;
     While not(B=nil) do
     begin
          If B^.Inf<Min then Min:=B^.Inf;
          B:=B^.Next;
     end;
     MinEl:=Min;
end;

Procedure SortSpisok(var A:PEl);
var B,C,D:PEl;
    I:Integer;
begin
     {Переносится первый элемент списка}
     I:=MinEl(A);
     If I=A^.Inf Then
     begin
          D:=A;
          A:=A^.Next;
     end
     else
     begin
          B:=A;
          While not(B^.Next^.Inf=I) do
                B:=B^.Next;
          D:=B^.Next;
          B^.Next:=D^.Next;
     end;
     {Переносятся все остальные элементы списка}
     C:=D;
     While not(A=nil) do
     begin
          I:=MinEl(A);
          if I=A^.Inf then
          begin
              C^.Next:=A;
              A:=A^.Next
          end
          else
          begin
              B:=A;
              While not(B^.Next^.Inf=I) do
                    B:=B^.Next;
              C^.Next:=B^.Next;
              B^.Next:=C^.Next^.Next;
          end;
          C:=C^.Next;
     end;
     C^.Next:=Nil;
     A:=D;
end;

Procedure AddSpisok(var A,D:PEl);
Var B,C:PEl;
Begin
     While not(D=nil) do
     begin
          C:=D;
          D:=D^.Next;
          If C^.Inf<A^.Inf then
          begin
               C^.Next:=A;
               A:=C;
          end
          else
          begin
               B:=A;
               While not(B^.Next^.Inf>C^.Inf) and not(B^.Next=Nil) do
                   B:=B^.Next;
               C^.Next:=B^.Next;
               B^.Next:=C;
          end;
     end;
end;

Begin
     ClrScr;
     Writeln('Введите первый список:');
     CreateSpisok(Spisok1);
     ClrScr;
     Writeln('Введите второй список:');
     CreateSpisok(Spisok2);
     ClrScr;
     Writeln('Первый список:');
     PrintSpisok(Spisok1);
     Writeln('Второй список:');
     PrintSpisok(Spisok2);
     Writeln;

     SortSpisok(Spisok1);
     Writeln('Остсортированный первый список:');
     PrintSpisok(Spisok1);
     AddSpisok(Spisok1,Spisok2);
     Writeln('Результат объединения списков:');
     PrintSpisok(Spisok1);
     DelSpisok(Spisok1);
     Readkey;
end.

[volvo]

примерно так это должно быть

Ты не хочешь понимать того, что тебе объясняют? КАК еще надо сказать, что приведенный тобой код НЕ ВЫПОЛНЯЕТ задачи, перед тобой поставленной??? Ты задание-то прочти!

Описать процедуру, которая вставляет в непустой список L, элементы которого упорядочены по неубыванию, новый элемент E так, чтобы сохранилась упорядоченность.

А твой код что делает? Слияние списков? Зачем? Второго списка по условию нет, да и в первый надо добавить всего один элемент, НО не пересортировывать его (это просто), а добавить так, чтобы сохранить упорядоченность!!!

Вот все, что от тебя требовалось:

Program Example;
Uses Crt;
Type
   PEl=^TEl;
   TEl=Record
          Inf:Integer;
          Next:PEl;
       end;
Var
  spisok: PEl;
  E: integer;

Procedure CreateSpisok(var A:PEl);
Var B:PEl;
    I:Integer;
begin
    New(A);
    Readln(A^.Inf);
    B:=A;
    Readln(I);
    While not(I=0) do
    begin
         New(B^.Next);
         B:=B^.Next;
         B^.Inf:=I;
         Readln(I);
    end;
    B^.Next:=Nil
end;

Procedure DelSpisok(var A:PEl);
var B:PEl;
begin
     While not(A=nil) do
     Begin
          B:=A;
          A:=A^.Next;
          Dispose(B);
     end;
end;

Procedure PrintSpisok(A:PEl);
var B:PEl;
begin
     B:=A;
     while not(B=nil) do
     begin
          Write(B^.Inf:1,'  ');
          B:=B^.Next;
     end;
     Writeln
end;

procedure InsertElement(var a: PEl; E: integer);
var
  p, T: PEl;
  before_first: boolean;
begin
  p := a;
  before_first := (p^.inf > E);
  while (p^.next <> nil) and (p^.next^.inf < E) do p := p^.next;

  new(T); T^.inf := E;
  if before_first then begin
    T^.next := a; a := T;
  end
  else begin
    t^.next := p^.next; p^.next := T;
  end;
end;

Begin
     ClrScr;
     Writeln('List:');
     spisok := nil;
     CreateSpisok(Spisok);

     PrintSpisok(spisok);
     write('E = '); readln(E);
     InsertElement(spisok, E);
     PrintSpisok(spisok);

     DelSpisok(spisok);
     Readkey;
end.

И, пожалуйста, в следующий раз читай задание внимательно... Правильно прочтя задание ты делаешь бОльшую часть работы...