VPF::Ошибка в сортировке линейного списка

Loginanton

Дата 31.12.2008, 13:44 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 114
Регистрация: 8.11.2007

Репутация: нет
Всего: нет

Вот код моей программы:

Код


program test;
type
    aaa = ^bbb;
    bbb = record
        st : string;
        next : aaa;
        prev : aaa;
        sort : aaa;
        end; { end of record }
var
    a , root , head , tmp : aaa;
    f : text;
    n , i , j : byte;
procedure p1;
begin
          assign(f, 'F1.txt');
          reset(f);
    new(a);
    root := a;
    a^.prev := nil;
    n := 0;
    while not eof(f) do begin
        readln(f, a^.st);
        n := n + 1;
        new(a^.next);
                    a^.sort := a^.next;
        a^.next^.prev := a;
        a := a^.next;
        end;
    head := a^.prev;
    a := nil;
    a := root;
          close(f);
    writeln('Количество строк в файле: ', n);

          for i := (n - 1) downto 1 do begin
           for j := 1 to i do begin
                     if length(a^.st) > length(a^.sort^.st) then begin
                               a^.sort^.sort^.prev := a;
                                        tmp := a^.sort^.sort; { ! }
                                        a^.sort^.sort := a;
                                        a^.sort^.prev := a^.prev;
                                        a^.prev^.sort := a^.sort;
                                        a^.prev := a^.sort;
                                        a^.sort := tmp;
                               end; { end if }
                              a := a^.sort;
                              end; { end for }
                    a := root;
                    end; { end for }
          while a^.sort <> nil do begin
           writeln(a^.st);
                    a := a^.sort;
                    end; { end while }
end; { end of p1 }
begin
p1;
readln;
end. { end of program }

Ошибка точно в месте где два элемента списка меняются местами, просто менять местами значения a^.st нельзя - задание не позволяет smile

Помогите найти ошибку пожалуйста, заранее благодарен.

Ofer

Дата 3.1.2009, 00:34 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 293
Регистрация: 15.10.2006
Где: КривбаСС

Репутация: нет
Всего: 5

Задание в студию!

pil69

Дата 3.1.2009, 03:23 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 16
Регистрация: 13.12.2007

Репутация: нет
Всего: нет

Цитата(Ofer @ 3.1.2009, 00:34)

Задание в студию!

Где-то на другом форуме Loginanton публикОвал условие задачи. А суть ее - отсортировать список. У меня решение получилось таким

Код


program test;
type
    aaa = ^bbb;
    bbb = record
        st : string;
        next : aaa;
        prev : aaa;
        sort : aaa;
        end; { end of record }
var
    a , root , root1 , head , tmp , tmp1 , tmp2 : aaa;
    f : text;
    n , i , j : byte;
procedure p1;
begin
          assign(f, 'F1.txt');
          reset(f);
    new(a);
    root := a;
    a^.prev := nil;
    a^.sort := nil;  {111}
    n := 0;
    while not eof(f) do begin
        readln(f, a^.st);
        n := n + 1;
        new(a^.next);
        a^.sort := a^.next;
        a^.next^.prev := a;
        a := a^.next;
        end;
    head := a^.prev;
    head^.sort := nil;  {111}
    head^.next := nil;  {111}
    dispose(a);       {111}
    root1 := root;
          close(f);
    a := root1;
 writeln('The initial list:');
    while a <> nil do begin   {111}
           writeln(a^.st);
           a := a^.sort;
            end; { end while }
    readln;
    writeln('In total in the list: ', n);
          for i := 1 to n do begin
           if root1^.st > root1^.sort^.st then begin              {111}
                                        tmp := root1^.sort^.sort;      {111}
                                        root1^.sort^.sort := root1;  {111}
                                        tmp1 := root1^.sort;      {111}
                                        root1^.sort := tmp;
                                        root1 := tmp1
                               end; { end if }
           a := root1;
           for j := 1 to n - 2 do begin
                     if a^.sort^.st > a^.sort^.sort^.st then begin
                                        tmp := a^.sort;
                                        tmp1 := a^.sort^.sort ;   {111}
                                        tmp2 := a^.sort^.sort^.sort ;   {111}
                                        tmp^.sort :=tmp1^.sort;   {111}
                                        tmp1^.sort :=tmp;   {111}
                                        a^.sort := tmp1
                               end ; { end if }
                      a := a^.sort;
                              end; { end for }
                    end; { end for }
 writeln('The sorted list:');
          a := root1;
          while a <> nil do begin
           writeln(a^.st);
           a := a^.sort;
            end; { end while }
 readln;
 writeln('The initial list:');
     a := root;
    while a <> nil do begin   {111}
           writeln(a^.st);
           a := a^.next;
            end; { end while }
 readln;
end; { end of p1 }
begin
p1;
readln;
end. { end of program }

root1 "смотрит" на начало отсортированного списка

volvo877

Дата 3.1.2009, 14:20 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 2
Всего: 116

Цитата(pil69 @ 3.1.2009, 02:23

)

Где-то на другом форуме Loginanton публикОвал условие задачи.

Вот пускай где-то на другом форуме (на котором он опубликовал условие) и ищет ответы... Здесь не обязаны прослеживать ВСЕ его вопросы на ВСЕХ форумах.

Dobermann

Дата 3.1.2009, 15:19 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 992
Регистрация: 7.1.2008

Репутация: нет
Всего: 0

Цитата(volvo877 @ 3.1.2009, 14:20

)

Вот пускай где-то на другом форуме (на котором он опубликовал условие) и ищет ответы... Здесь не обязаны прослеживать ВСЕ его вопросы на ВСЕХ форумах.

volvo

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Object Pascal: кроссплатформенные технологии \| Следующая тема »