Сортировка списка

Здравствуйте! Не работает сортировка списка ни одним способом. Пробовал и вставками и пузырьком. Когда делаю вставками, вылезает exitcode 216 при начале обмена. В общем вот код:

type  el=^opisanie;
      opisanie= record
        model: string[20];
        ves: integer;
        tip_corp: string[20];
        diag_d: string[10];
        dif: string[10];
        f_mem: string[5];
        cam: string[10];
        ovpam: integer;
        next,prev: el;
end;
var
    SE: opisanie;
    s: file of opisanie;
    n,x,r,i: integer;
    kolsymb: integer;
    search1, search2: string[15];
    h,p,p1,first: el;
    tmp: string;
 
procedure sort2;    {собственно 1 вариант}
   var i,j: integer;
   begin
      for i:=1 to (n-1) do
      begin
         p:=h;
         for j:=1 to (n-1) do
         begin
            p1:=p^.next;
            if p^.model > p1^.model then
            begin
               tmp:=p^.model;
               p^.model:=p1^.model;
               p1^.model:=tmp;
            end;
         p:=p1;
         end;
      end;
      p:=h;
      for i:=1 to n do
      begin
         writeln(p^.model);
         p:=p^.next;
      end;
    end;
 
function sortvib (var first: el):el;   {2 вариант}
   var l,p:el;
       tmp: string;
   begin
      l:=first;
      while l^.next <> nil do
      begin
         p:=l^.next;
         while p<>nil do
         begin
            if l^.model>p^.model then
            begin
               tmp:=l^.model;
               l^.model:=p^.model;
               p^.model:=tmp;
            end;
         p:=p^.next;
         end;
      l:=l^.next;
      end;
   end;
 
procedure sortvs (var first: el);     {3 вариант}
   var  i,j: el;
        t: string;
   begin
      i:= first;
      while i<>nil do
      begin
         t:=i^.model;
         j:=i^.prev;
         while (j<>nil) and (t<j^.model) do
         begin
            j^.next^.model:=j^.model;
            j:=j^.prev;
         end;
         if j=nil then
         first^.model:=t
         else j^.next^.model:=t;
         i:=i^.next;
      end;
   end;
 
procedure sort1 (first: el);     {4 вариант}
var sn,nd: el;
    tmp: string;
    begin
       getmem(sn, sizeof(opisanie));
       nd:=first;
       while nd<nil do {>}
       begin
          sn:=nd^.next;
          while sn<>nil do
          begin
             if sn^.model < nd^.model then
                begin
                   tmp:=sn^.model;
                   sn^.model:=nd^.model;
                   nd^.model:=tmp;
                end;
             sn:=sn^.next;
          end;
          nd:=nd^.next;
          end;
       end;
 
 begin
     sortvs (first); {последним этот пробовал}
 end;

Уже больше двух недель вожусь с этим. Надо уже курсач защищать, а у меня эта сортировка неработает.
PS. Поиском прользовался, подобное находил, от туда кстати тоже есть способ. Просьба ответить как можно быстрее.. Прикреплённый файлSony2.rar (1,57 Кбайт, скачиваний: 272)

Добавлено 06.06.12, 16:28
Забыл совсем пользуюсь FreePascal.

Собственно, сразу же следует вопрос: а где хоть как-то инициализируется First? Он же у тебя неинициализирован, как ты хочешь, чтоб список сортировался? Списка-то фактически и нет...

Сообщение отредактировано: volvo877 - 06.06.12, 17:37

В том-то и дело, что я незнаю как его сортировать. Процедуру sort1 я взял в одной работе, там работает. Хотя переписал все учитывая, не помогло.

Еще раз: ЧТО сортировать? Чтоб что-то сортировать, надо сначала это что-то СОЗДАТЬ. Где создается список по-твоему?

вот здесь:

if n=1 then
     begin
     clrscr;
     new (p);
        writeln ('Введите описание телефона');
        writeln;
        writeln ('модель: ');
        readln (p^.model);
        for i:=1 to length(SE.model) do
        SE.model[i]:=upcase(SE.model[i]);
        writeln ('вес: ');
        readln (p^.ves);
        writeln ('тип корпуса: ');
        readln (p^.tip_corp);
        writeln ('диагональ дисплея: ');
        readln (p^.dif);
        writeln ('разрешение: ');
        readln (p^.diag_d);
        writeln ('встроенная память: ');
        readln (p^.ovpam);
        writeln ('поддержка флеш-карт: ');
        readln (p^.f_mem);
        writeln ('камера: ');
        readln (p^.cam);
        p^.next:=nil;
        assign (s, 'D:\fp\test.txt');
        reset (s);
        seek (s, filesize (s));
        write (s, p^);
        close (s);
        writeln ('Данные записаны.');
        readln;
      end;

Добавлено 06.06.12, 18:06
сортировать надо по полю model, по алфавиту.

Добавлено 06.06.12, 18:09
разобрался, кажется... У меня нет добавления в список елементов. Я правильно понимаю?

Цитата MrSmmiT @ 06.06.12, 18:05

У меня нет добавления в список елементов. Я правильно понимаю?

Наконец то Да, ты правильно понимаешь.

можно сделать так?

procedure ad (var spis1: el; zhach1: string);
   var
      tmp: el;
      begin
         if spis1=nil then
         begin
            new(spis1);
            tmp:= spis1;
         end
         else
         begin
            tmp:= spis1;
            while tmp^.next <> nil do
            new(tmp^.next);
            tmp:=tmp^.next;
         end;
      tmp^.next:=nil;
      tmp^.model:=zhach1;
      end;

Только как сделать, чтобы добавлялись все поля (model, ves, tip_corp и т.д.)?

Добавлено 06.06.12, 18:45
в лекции у меня написано так:

procedure Create_New_Elem(var p: el);
   begin
      New (p);
      Writeln ('введите значение первого информационного поля: ');
      Readln ( p^.inf1 );
      Writeln ('введите значение второго информационного поля: ');
      Readln ( p^.inf2 );
      p^.next := nil; {все поля элемента должны быть инициализированы}
   end;

Добавлено 06.06.12, 18:49
Разьве оно не совпадает с моим

Цитата

begin
     clrscr;
     new (p);
        writeln ('Введите описание телефона');
        writeln;
        writeln ('модель: ');
        readln (p^.model);
        for i:=1 to length(SE.model) do
        SE.model[i]:=upcase(SE.model[i]);
        writeln ('вес: ');
        readln (p^.ves);
        writeln ('тип корпуса: ');
        readln (p^.tip_corp);
        writeln ('диагональ дисплея: ');
        readln (p^.dif);
        writeln ('разрешение: ');
        readln (p^.diag_d);
        writeln ('встроенная память: ');
        readln (p^.ovpam);
        writeln ('поддержка флеш-карт: ');
        readln (p^.f_mem);
        writeln ('камера: ');
        readln (p^.cam);
        p^.next:=nil;
        assign (s, 'D:\fp\test.txt');
        reset (s);
        seek (s, filesize (s));
        write (s, p^);
        close (s);
        writeln ('Данные записаны.');
        readln;

end;

Добавлено 06.06.12, 18:52
Хотя скорее всего так что-то не так. Потому что в другой работе елементы не создавались.

Вроде бы сделал запись елементов.

procedure ad (var first: el);
   var
      p: el;
      model, tip_corp, diag_d, dif, f_mem, cam: string[20];
      ves, ovpam: integer;
      begin
         if first=nil then
          writeln ('Введите описание телефона');
          writeln;
          writeln ('модель: ');
          readln (model);
          writeln ('вес: ');
          readln (ves);
          writeln ('тип корпуса: ');
          readln (tip_corp);
          writeln ('диагональ дисплея: ');
          readln (diag_d);
          writeln ('разрешение: ');
          readln (dif);
          writeln ('встроенная память: ');
          readln (ovpam);
          writeln ('поддержка флеш-карт: ');
          readln (f_mem);
          writeln ('камера: ');
          readln (cam);
         begin
            new(p);
            p^.next:=nil;
            p^.model:=model;
            p^.ves:=ves;
            p^.tip_corp:=tip_corp;
            p^.diag_d:=diag_d;
            p^.dif:=dif;
            p^.ovpam:=ovpam;
            p^.f_mem:=f_mem;
            p^.cam:=cam;
           { read(model);       \
            read(ves);           |
            read(tip_corp);      |
            read(diag_d);        |  непонимаю зачем это, оно вроде выше есть,но и без него работает (вроде)
            read(dif);           |
            read(ovpam);         |
            read(f_mem);         |
            read(cam);}         /
         end;
      writeln;
      end;

только теперь незнаю как записать елемент в файл.

Вроде бы сделал запись елементов.

procedure ad (var first: el);
   var
      p: el;
      model, tip_corp, diag_d, dif, f_mem, cam: string[20];
      ves, ovpam: integer;
      begin
         if first=nil then
          writeln ('Введите описание телефона');
          writeln;
          writeln ('модель: ');
          readln (model);
          writeln ('вес: ');
          readln (ves);
          writeln ('тип корпуса: ');
          readln (tip_corp);
          writeln ('диагональ дисплея: ');
          readln (diag_d);
          writeln ('разрешение: ');
          readln (dif);
          writeln ('встроенная память: ');
          readln (ovpam);
          writeln ('поддержка флеш-карт: ');
          readln (f_mem);
          writeln ('камера: ');
          readln (cam);
         begin
            new(p);
            p^.next:=nil;
            p^.model:=model;
            p^.ves:=ves;
            p^.tip_corp:=tip_corp;
            p^.diag_d:=diag_d;
            p^.dif:=dif;
            p^.ovpam:=ovpam;
            p^.f_mem:=f_mem;
            p^.cam:=cam;
           { read(model);       \
            read(ves);           |
            read(tip_corp);      |
            read(diag_d);        |  непонимаю зачем это, оно вроде выше есть. если убрать скобки,
            read(dif);           |  то после записи всех ел-ов пустые строки  и если что-то ввести, то exicode 216.
            read(ovpam);         |
            read(f_mem);         |
            read(cam);}         /
         end;
      writeln;
      end;

только теперь незнаю как записать елемент в файл.
После процедуры пишу:

        assign (s, 'D:\fp\test.txt');
        reset (s);
        seek (s, filesize (s));
        write (s, p^);
        close (s);
        writeln ('Данные записаны.');
        readln;

но ругается на p^ в строке write (s, p^);

MrSmmiT, смотри:

type
   el=^titem;
   opisanie= record
      model: string[20];
      ves: integer;
      tip_corp: string[20];
      diag_d: string[10];
      dif: string[10];
      f_mem: string[5];
      cam: string[10];
      ovpam: integer;
   end;
   // тысячу раз говорил - повторяю еще раз: Мухи отдельно, котлеты - отдельно.
   // Какое отношение имеют поля prev/next к телефону? Никакого, это доп. информация.
   // Вот и храни эту доп. информацию там, где она нужна - это элемент списка!!!
   // На кой ее пихать в файл? Все равно там будет записан мусор, при следующем запуске
   // все адреса, которые были записаны раньше, поменяются, и твои prev/next будут
   // указывать "в космос".
   titem = record
      data : opisanie;
      next,prev: el;
   end;
 
 
// ...
 
procedure GetPhone(var Op : opisanie);
begin
   with Op do
   begin
      writeln ('Введите описание телефона');
      writeln;
      writeln ('модель: ');
      readln (model);
      writeln ('вес: ');
      readln (ves);
      writeln ('тип корпуса: ');
      readln (tip_corp);
      writeln ('диагональ дисплея: ');
      readln (diag_d);
      writeln ('разрешение: ');
      readln (dif);
      writeln ('встроенная память: ');
      readln (ovpam);
      writeln ('поддержка флеш-карт: ');
      readln (f_mem);
      writeln ('камера: ');
      readln (cam);
   end;
end;
 
// Добавляем данные очередного элемента к списку
procedure Add(var first, last : el; const Op : opisanie);
var p : el;
begin
   new(p);
   p^.data := Op;
   p^.next := nil;
   p^.prev := last;
 
   if first = nil then first := p
   else last^.next := p;
 
   last := p;
end;

Дальше исправляй самостоятельно. Чтобы обменять значения двух элементов списка местами, теперь достаточно обменять поля data, а у тебя в sortvs менялись только модели, всё остальное оставалось на местах, в итоге получался полный бред.

Спасибо! Заработало!
Только при сравнении элемнтов пишет:
Operator is not overloaded: "opisanie" < "opisanie".

procedure sortvs (var first: el);
   var  i,j: el;
        t: opisanie;
   begin
      i:= first;
      while i<>nil do
      begin
         t:=i^.data;
         j:=i^.prev;
         while (j<>nil) and (t<j^.data) do
         begin
            j^.next^.data:=j^.data;
            j:=j^.prev;
         end;
         if j=nil then
         first^.data:=t
         else j^.next^.data:=t;
         i:=i^.next;
      end;
   end;

Цитата MrSmmiT @ 07.06.12, 13:25

Только при сравнении элемнтов пишет:
Operator is not overloaded: "opisanie" < "opisanie".

Естественно. Ты не можешь сравнивать сразу всю запись с другой записью. Надо ж отсортировать по значению какого-то поля? Вот эти поля и сравнивай между собой.

Цитата volvo877 @ 07.06.12, 16:29

Вот эти поля и сравнивай между собой.

то есть?

Добавлено 07.06.12, 16:32
можно пример? если не сложно.

Ну, если тебе надо упорядочить список по названию модели - то так:

// ...
while (j<>nil) and (t.model<j^.data.model) do
// ...

, если надо по другому полю - сравнивай другое поле.

А как сделать, чтобы записанные ранее элементы брались из файла. Т.е. ввели элеменыты списка, они записались в файл, закрыли программу. Потом открыли и отсортировали то что записано в файле. Проще говоря, как взять элементы для списка из файла для сортировки.
Уже все кроме этого работает:

Program Sony;
Uses heaptrc, lineinfo, crt;
type  el=^titem;
      opisanie= record
        model: string[20];
        ves: integer;
        tip_corp: string[20];
        diag_d: string[10];
        dif: string[10];
        f_mem: string[5];
        cam: string[10];
        ovpam: integer;
      end;
      titem=record
        data: opisanie;
        next, prev: el;
      end;
var
    SE: opisanie;
    s: file of opisanie;
    n,x,r,i: integer;
    kolsymb: integer;
    search1, search2: string[15];
    p,p1,first,last: el;
 
procedure getphone (var SE: opisanie);
   var i: integer;
   begin
      with SE do
      begin
         writeln ('Введите описание телефона');
         writeln;
         writeln ('модель: ');
         readln (model);
         for i:=1 to length (SE.model) do
         SE.model[i]:=upcase(SE.model[i]);
         writeln ('вес: ');
         readln (ves);
         writeln ('тип корпуса: ');
         readln (tip_corp);
         writeln ('диагональ дисплея: ');
         readln (diag_d);
         writeln ('разрешение: ');
         readln (dif);
         writeln ('встроенная память: ');
         readln (ovpam);
         writeln ('поддержка флеш-карт: ');
         readln (f_mem);
         writeln ('камера: ');
         readln (cam);
      end;
   end;
 
 
procedure ad (var first, last: el; const SE: opisanie);
   var p: el;
   begin
      new(p);
      p^.data:=SE;
      p^.next:=nil;
      p^.prev:=last;
      if first=nil then
      first:=p
      else
      last^.next:=p;
      last:=p
   end;
 
procedure sortvs (var first: el);
   var  i,j: el;
        t: opisanie;
   begin
      i:= first;
      while i<>nil do
      begin
         t:=i^.data;
         j:=i^.prev;
         while (j<>nil) and (t.model<j^.data.model) do
         begin
            j^.next^.data:=j^.data;
            j:=j^.prev;
         end;
         if j=nil then
         first^.data:=t
         else j^.next^.data:=t;
         i:=i^.next;
      end;
   end;
 
procedure view (first: el);
   var nd: el;
       l: string;
   begin
      nd:=first;
      if nd=nil then
      writeln ('‘ЇЁб®Є Їгбв')
      else
      begin
         while nd<>nil do
         begin
            write(nd^.:15);
            nd:=nd^.next;
         end;
      end;
   end;
{procedure sort1 (first: el);
var sn,nd: el;
    tmp: string;
    begin
       getmem(sn, sizeof(opisanie));
       nd:=first;
       while nd<>nil do
       begin
          sn:=nd^.next;
          while sn<>nil do
          begin
             if sn^.data < nd^.data then
                begin
                   tmp:=sn^.data;
                   sn^.data:=nd^.data;
                   nd^.data:=tmp;
                end;
             sn:=sn^.next;
          end;
          nd:=nd^.next;
          end;
       end;}
 
  begin
        repeat
        clrscr;
          writeln ('            МЕНЮ');
          writeln;
          writeln ('1 - добавить информацию о телефоне');
          writeln ('2 - просмотр списка телефонов');
          writeln ('3 - поиск');
          writeln ('4 - сортировка по алфавиту');
          writeln ('5 - выход');
          readln (n);
 
if n=1 then
     begin
        getphone (SE);
        ad (first, last, SE);
        assign (s, 'D:\fp\test.txt');
        reset (s);
        seek (s, filesize (s));
        write (s, SE);
        close (s);
        writeln ('„ ­­лҐ б®еа ­Ґ­л ў д ©«');
        readln;
 
     end;
if n=2 then
     begin
        assign (s, 'D:\fp\test.txt');
        reset (s);
        writeln ('       модель   вес   тип корпуса    разрешение   диагональ   память  флеш-карта    камера ');
        while not eof (s) do
        with SE do
        begin
          read (s, SE);
          writeln (model:12,'', ves:7,'', tip_corp:11,'', dif:15,'', diag_d:11, ovpam:11,'', f_mem:10,'', cam:12);
        end;
        readln;
        close (s);
     end;
if n=3 then
     begin
     clrscr;
        writeln ('Введите модель телефона');
        readln (search1);
        kolsymb:= length (search1);
        assign (s, 'D:\\fp\test.txt');
        reset (s);
        while not eof (s) do
           begin
           read (s, SE);
           search2:= copy(SE.model,1,kolsymb);
           if (upcase(search1)=upcase(search2)) then
              begin
                 writeln ('модель - ', SE.model);
                 writeln ('вес - ', SE.ves, '':1, 'гр.');
                 writeln ('тип корпуса  - ', SE.tip_corp);
                 writeln ('диагональ дисплея - ', SE.diag_d, '':1, 'inch');
                 writeln ('поддержка флеш-карт', SE.f_mem);
                 writeln ('камера  - ', SE.cam, '':1, 'Mpix');
                 writeln ('встроенная память - ', SE.ovpam, '':1, 'Mb')
              end;
           end;
        close (s);
        readln;
     end;
if n=4 then
     begin
        sortvs (first);
     end;
if n=5 then
     view (first);
until n>5;
end.

Добавлено 07.06.12, 19:17
volvo877Очень прошу поскорее ответить!

begin // основная программа
   first := nil; last := nil;
 
   // Тут можно добавить проверку существования файла, и загружать из него данные
   // только если файл существует, чтоб при первом вызове не было сбоя
   assign (s, 'D:\fp\test.txt'); // Этого достаточно, не надо делать Assign каждый раз, остальные Assign-ы можешь убрать
   reset (s);
   while not eof (s) do
   begin
      read (s, SE);
      ad (first, last, SE)
   end;
   close (s);
 
   repeat
      clrscr; // далее - по тексту

P.S. Почему ты делаешь просмотр списка телефонов из файла - непонятно. Печатай прямо список:

writeln ('       модель   вес   тип корпуса    разрешение   диагональ   память  флеш-карта    камера ');
p := first;
while p <> nil do
begin
   with p^.data do
      writeln (model:12,'', ves:7,'', tip_corp:11,'', dif:15,'', diag_d:11, ovpam:11,'', f_mem:10,'', cam:12);
   p := p^.next;
end;

не проще?

Проще, но это все приблуды преподавателя.
Сортировка видимо как-то не так работает.
Вот что было в файле до сортировки:

И вот что стало после:

Кажется понял почему так. Я открываю файл, беру оттуда записи, сортирую это все. И записывается оно туда же, не стирая того, что уже есть в файле. Если это так, то как это можно исправить?

Цитата MrSmmiT @ 09.06.12, 11:54

Я открываю файл, беру оттуда записи, сортирую это все. И записывается оно туда же, не стирая того, что уже есть в файле.

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

reset(s);
truncate(s);
// и только теперь записывать данные

, а практически - надо видеть код. Я его не вижу.

Процедура сортировки осталась та же,

begin
        first:=nil;
        last:=nil;
        repeat
        clrscr;
          writeln ('            МЕНЮ');
          readln (n);
         \\ и так далее до
if n=4 then
     begin
        assign (s, 'D:\fp\test.txt');
        reset (s);
        while not eof (s) do
        begin
           read (s, SE);
           sortvs (first);
           write (s, SE);
        end;
        close (s);
     end;

Добавлено 09.06.12, 12:17
Попробовал с

truncate(s);

получается тоже самое... все записи заменились одной. Видимо не в этом дело. Хотя новой строки не добавилось.
Вот на всякий случай еще процедура сортировки:

procedure sortvs (var first: el);
   var  i,j,k: el;
        t: opisanie;
   begin
      i:= first;
      while i<>nil do
      begin
         t:=i^.data;
         j:=i^.prev;
         while (j<>nil) and (t.model<j^.data.model) do
         begin
            j^.next^.data:=j^.data;
            j:=j^.prev;
         end;
         if j=nil then
         first^.data:=t
         else j^.next^.data:=t;
         i:=i^.next;
      end;
   end;

Добавлено 09.06.12, 12:40
еще заметил, что после добавления от 3 до н записей в файл. Сортировка работает не так: остается только первая запись, и она написана 2 раза.

Запись списка в файл:

     begin
        getphone (SE);
        ad (first, last, SE);
        assign (s, 'D:\fp\test.txt');
        reset (s);
        seek (s, filesize (s));
        getmem (p, sizeof(titem));
        write (s, p^.data);
        close (s);
        writeln ('Данные сохранены в файл');
        readln;

после этой "записи", при просмотре содержимого файла пишется не модель, вес и т.д., а чушь какая-то.
Помогите пожалуйста!

Цитата MrSmmiT @ 09.06.12, 15:35

после этой "записи", при просмотре содержимого файла пишется не модель, вес и т.д., а чушь какая-то.

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