паскаль динамич. списки...помогите кто чем может)

[Никита35]

Программа сортирует двусвязный список по неубыванию...
Для этого я сначала нахожу максимальный элемент,затем ставлю его на первое место,затем нахожу максимальный элемент среди остальных элементов и ставлю его перед предыдущим максимальным элементом...и так до тех пор, пока не отсортируется список...
ПРИМЕР:
исходный список: 1 5 4 6 8
1 проход:8 1 5 4 6
2 проход:6 8 1 5 4
3 проход:5 6 8 1 4
4 проход:4 5 6 8 1
5 проход:1 4 5 6 8

мои наработки:
program L02;
uses crt;

type
PList = ^TList;
TList = record
a: integer;
pred,next : PList;
end;
var head,max: PList;
{Процедура создания списка}
procedure MakeList(Var head:PList);
var
p,q : PList;
n,i : integer;
begin
writeln('Введите количество элементов*');
readln(n);
randomize;
{Формирование списка*}
new(head); {Сторож - головной элемент}
head^.next:=nil;
head^.pred:=nil;
p:=head;
for I:=1 to n do
begin
new(q);
q^.a:=random(10)-4;
q^.pred:=p;
q^.next:=nil;
p^.next:=q;
p:=q;
end;
end;

{Процедура выводит список на экран}
procedure PrintList (var head : PList);
var p:PList;
begin
{Вывод списка на экран}
p:=head^.next;
while p<>nil do
begin
write(p^.a:6);
p:=p^.next;
end;
writeln;
end;

{Процедура сортировки списка*}
procedure Sort(var head:PList);
var p,q,h,max:PList;
begin {Нахождение максимального элемента*}
p:=head^.next;
max:=head;
while p<>nil do
begin
while p<>nil do
begin
if p^.a > max^.a then
begin
max:=p;
p:=p^.next;
end
else
p:=p^.next;
end;
{Переброс ссылок}
max^.pred^.next:=max^.next;
max^.next^.pred:=max^.pred;

max^.next:=head^.next;
max^.pred:=head;

head^.next^.pred:=max;
head^.next:=max;

p:=max^.next;
end;
end;

{Начало программы}
begin
clrscr;
MakeList(head);
writeln('Исходный список');
PrintList(head);
Sort(head);
writeln;
writeln('Отсортированный список');
PrintList(head);
readln;
end.

максимальный элемент находится корректно,а дальше идёт какое-то зацикливание...исправьте, пожалуйста код,если сможете...

[Stilet]

Ты о сортировке пузырьком слышал что-нибудь?
Тут на форуме уже обсуждалась такая сортировка, советую проштудировать поиском.

[Никита35]

Всё это понятно,если бы так было можно-я бы воспользовался пузырьком...Проблема в том,что сортировать нужно именно таким методом,как у меня в алгоритме...(

[alexBlack]

Здравствуйте, Никита. Уже пятая тема об одном и том-же. В этом Вашем варианте "наработок" уже есть хоть что-то.
Давайте как-то уже разбирайтесь с этим вопросом. Мы то напишем, но даст ли это Вам хоть что-то ?

Вот сортировка двухсвязного списка тем методом, который Вы предложили

procedure Sort(var head:PList);
var p,p1,mp:PList;
begin
   p1 := head^.next;
   head^.next := nil; // отрываем список
   while p1 <> nil do begin
      // Поиск максимального элемента
      p := p1; mp := p;
      while p <> nil do begin
         if p^.a > mp^.a then mp := p;
         p := p^.next;
      end;
      // mp - максимальный элемент
      // Удаляем его из списка
      // Ссылки назад не восстанавливаем, т.к. они не нужны для поиска
      if mp = p1
      then p1 := mp^.next
      else begin
         mp^.pred^.next := mp^.next;
         if mp^.next <> nil
         then mp^.next^.pred := mp^.pred
      end;

      // помещаем его в голову списка
      mp^.pred := head;
      mp^.next := head^.next;
      if head^.next <> nil then head^.next^.pred := mp;
      head^.next := mp;
   end;
end;

Вот сортировка односвязного списка:

procedure sortList(head:PList);
var p1, p2, pm, lpm, lp, p : PList;
begin
   p1 := head.next;
   p2 := head;
   while p1 <> nil do begin
      // Поиск минимального элемента
      pm := p1; lpm := nil; p := p1; lp := nil;
      while p <> nil do begin
         if p.a <= pm.a then begin
            pm := p;
            lpm := lp;  // Запоминаем предыдущий
         end;
         lp := p;
         p := p.next;
      end;
      // Минимальный элемент убираем из списка
      if lpm = nil
      then p1 := pm.next
      else lpm.next := pm.next;
      // и помещаем в новый список
      p2.next := pm;
      p2 := p2.next;
      p2.next := nil;
   end;
end;

// А вот две головы для двух списков (это уже для слияния)
var head1, head2:PList;
begin
   randomize;
   MakeList(head1);
   MakeList(head2);
   WriteList(head1);
   WriteList(head2);
   SortList(head1);
   SortList(head2);
   WriteList(head1);
   WriteList(head2);
   readln;

PS. - написано на Delphi. В Pascal проставьте где нужно символы ^.
Следующий свой вопрос о списках задавайте здесь. Не нужно плодить темы. Неплохо было-бы заключать код в тэги CODE.

[Никита35]

Спасибо за сортировку!!!
Но теперь проблема в том, что не смотря на то,какие значения вводишь в количество элементов обоих списков,они выводятся совершенно одинаковые...

[alexBlack]

randomize; нужно ставить не в MakeList, а один раз и до вызовов MakeList. Посмотрите в примере выше.

[Никита35]

все равно...(((может,мой код выслать?

[alexBlack]

Давайте, посмотрим

[Никита35]

program L02;
uses crt;

type
PList = ^TList;
TList = record
a: integer;
pred,next : PList;
end;
var head,head1,head2: PList;


procedure MakeList(Var head:PList);
var
p,q : PList;
n,i : integer;
begin
writeln('Введите количество элементов списка*:');
readln(n);

new(p);
head^.next:=nil;
head^.pred:=nil;
p:=head;
for I:=1 to n do
begin
new(q);
q^.a:=random(10)-4;
q^.pred:=p;
q^.next:=nil;
p^.next:=q;
p:=q;
end;
end;


procedure PrintList (var head: PList);
var p:PList;
begin
{‚лў®¤ бЇЁбЄ* ** нЄа**}
p:=head^.next;
while p<>nil do
begin
write(p^.a:6);
p:=p^.next;
end;
writeln;
end;


procedure Sort(var head:PList);
var p,p1,mp:PList;
begin
p1:=head^.next;
head^.next:=nil;
while p1<>nil do
begin
p:=p1;
mp:=p;
while p<>nil do
begin
if p^.a > mp^.a then
mp:=p;
p:=p^.next;
end;

if mp=p1 then
p1:=mp^.next
else
begin
mp^.pred^.next:=mp^.next;
if mp^.next<>nil then
mp^.next^.pred:=mp^.pred;
end;

mp^.pred:=head;
mp^.next:=head^.next;
if head^.next<>nil then
head^.next^.pred:=mp;
head^.next:=mp;
end;
end;


begin
clrscr;
randomize;
MakeList(head1);
MakeList(head2);
writeln('Данный список:');
PrintList(head1);
PrintList(head2);
writeln;
writeln('отсортированный список:');
Sort(head1);
Sort(head2);
PrintList(head1);
PrintList(head2);
readln;
end.

[alexBlack]

Издеваетесь ?
"они выводятся совершенно одинаковые" - они совершенно одинаково НЕ выводятся из того, что в makeList Вы не инициализировали head.
Исправляйте:

type
   PList = ^TList;
   TList = record
      a: integer;
      pred,next : PList;
   end;

var head1,head2: PList;

procedure MakeList(Var head:PList);
var p,q : PList;
    n,i : integer;
begin
  writeln('Введите количество элементов списка*:');
  readln(n);
  new(head);   { ВОТ ЗДЕСЬ БЫЛА ОШИБКА -------------------- } 
  head^.next:=nil;
  head^.pred:=nil;
  p:=head;
  for I:=1 to n do begin
     new(q);
     q^.a:=random(10)-4;
     q^.pred:=p;
     q^.next:=nil;
     p^.next:=q;
     p:=q;
  end;
end;


procedure PrintList (var head: PList);
var p:PList;
begin
   p:=head^.next;
   while p<>nil do begin
     write(p^.a:6);
     p:=p^.next;
   end;
   writeln;
end;


procedure Sort(var head:PList);
var p,p1,mp:PList;
begin
   p1:=head^.next;
   head^.next:=nil;
   while p1<>nil do begin
     p:=p1;
     mp:=p;
     while p<>nil do begin
        if p^.a > mp^.a then mp:=p;
        p:=p^.next;
     end;

     if mp=p1
     then p1:=mp^.next
     else begin
        mp^.pred^.next:=mp^.next;
        if mp^.next<>nil then
        mp^.next^.pred:=mp^.pred;
     end;
     mp^.pred:=head;
     mp^.next:=head^.next;
     if head^.next<>nil
     then head^.next^.pred:=mp;
     head^.next:=mp;
   end;
end;


begin
   randomize;
   MakeList(head1);
   MakeList(head2);
   writeln('Данный список:');
   PrintList(head1);
   PrintList(head2);
   writeln;
   writeln('отсортированный список:');
   Sort(head1);
   Sort(head2);
   PrintList(head1);
   PrintList(head2);
   readln;
end.