IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Как отсортировать?, двусторонний динамич. список
pukelis
сообщение 3.05.2005 12:17
Сообщение #1


Гость






По возрастанию ли - убыванию - нет разницы. smile.gif Надо всего лишь создать некую процедуру, что для таких АСОВ как Вы - не составит труда.. ^_^ Жду с нетерпением Вашей помощи! ;)

Код
program rabota;
type spis = ^el;
     el  = record
        next:spis;
        data : integer;
        back : spis;
     end;
             
procedure sozdat_spisok ( var nach, konc : spis );
  var g : spis;
      x : integer;
begin  { sozdat_spisok }
nach  := nil;    
konc := nil;
writeln('Sozdaem spisok, vvedite celye 4isla.');
writeln('Hotite zakon4it - voodite 0.');
readln ( x );
while x <> 0 do
   begin
     if nach = nil
     then
       begin
         new( g );
         g^.data  := x;
         g^.next := nil;
         g^.back := nil;
         nach       := g;
         konc      := g;
         readln( x );
       end
     else  
       begin
         new( g );
         g^.data    := x;
         g^.next   := nil;
         g^.back := konc;
         konc^.pnext:=g;
         konc        := g;
         readln( x );
       end
   end;
writeln('Spisok uspe6no sozdan');
end; { Sozdat spisok }

procedure pe4atat( nach : spis );
var p : spis;
begin  { pe4atat }
  writeln('pe4ataem spisok:' );
  p := nach;
  while p <> nil do
    begin
      write( p^.data, ' ');
      p := p^.next;
    end;
  writeln;
end; { pe4atat }

procedure uni4tozhit( var nach, konc : spis );
var s : spis;
begin  { uni4tozhit }
  writeln('uni4tozhaem spisok s konca.');
  while pr <> nil do
  begin

     s := nach;
     if konc <> nach
     then
       begin
         while (s^.next <> konc) and (nach<>konc) do
               s := s^.next;
         writeln('  uni4tozhaem ', s^.next^.data);
         konc := s;
         dispose( s^.next );
       end
     else
       begin
         writeln('  Ui4tozhaem 1-j: ', s^.data);
         dispose( s );
         nach  := nil;
         konc := nil;
       end;
  end;
end; { uni4tozhit }

var na4alo, konec : spis;
begin
  sozdat_spisok ( na4alo, konec );
  pe4atat ( na4alo );
 uni4tozhit(na4alo,konec);

end.
 К началу страницы 
+ Ответить 
2 страниц V  1 2 >  
 Ответить  Открыть новую тему 
Ответов(1 - 19)
volvo
сообщение 3.05.2005 12:51
Сообщение #2


Гость






Ну, во-первых, сразу возникает вопрос - можно или нельзя пользоваться дополнительным списком. И если можно, то всю вышеприведенную программу придется переделать, т.к. для нормальной работы со списками необходимы процедуры вставки и удаления элементов, а не "Создать список" и "Уничтожить список" :yes:

Если же дополнительным списком пользоваться нельзя, то придется имитировать либо очередь (Queue), либо обычный массив (Array), что непременно скажется на быстродействии программы. А вообще-то, чтобы не возникало вот таких проблем, списки с самого начала рекомендуется поддерживать в отсортированном состоянии, что гораздо проще, чем сортировать их потом...
 К началу страницы 
+ Ответить 
Guest
сообщение 3.05.2005 13:00
Сообщение #3


Гость






Все переделывать как-то неохота, тк на етой проге основана прога побольше ;) А там уж очень много чего исправлять надо ((( Давай лучше пойдем по пути имитации очереди или обычного массива ;) На быстродействие пофих, в аудитории сервер Ксеон 3 Ггц )))

Цитата
списки с самого начала рекомендуется поддерживать в отсортированном состоянии, что гораздо проще, чем сортировать их потом...


фишка в том, что в моей большой проге параметр сортировки списка появляется уже после создания списка (там высчитывается стоимость из цены) Для етой маленькой-то конечно все равно ))))
 К началу страницы 
+ Ответить 
volvo
сообщение 3.05.2005 13:34
Сообщение #4


Гость






Ну, тогда вспомни как выглядит пузырьковая сортировка:
Type
arrType = Array[1 .. n] Of Integer;

Procedure Bubble(Var ar: arrType; n: integer);
Var i, j, T: Integer;
Begin
For i := 1 To n Do
For j := n DownTo i+1 Do
If ar[Pred(j)] > ar[j] Then { < }
Begin
T := ar[Pred(j)]; ar[Pred(j)] := ar[j]; ar[j] := T
End
End;

и сделай ее имитацию на списке:
{ указатель на n -ый элемент списка }
function find_n(list: spis; n: integer): link;
begin
while (list <> nil) and (n >= 0) do begin
list := list^.next; dec(n);
end;
find_n := list
end;

Procedure BubbleList(Var list: spis);
Var n, i, j, T: Integer;
Begin
n := { здесь - длина списка }
For i := 1 To n Do
For j := n DownTo i+1 Do
{ > или < в зависимости от направления }
If find_n(list, pred(j))^.data > find_n(list, j)^.data Then
Begin
{ можно, конечно и запомнить адреса j и j - 1 элементов,
чтобы не вычислять повторно }
T := find_n(list, pred(j))^.data;
find_n(list, pred(j))^.data := find_n(list, j)^.data;
find_n(list, j)^.data := T;
End
End;

вот так это выглядит в случае "пузырька". Подставь сюда любой другой метод сортировки, он также будет работать...
 К началу страницы 
+ Ответить 
Pukelis
сообщение 3.05.2005 13:45
Сообщение #5


Гость






TX!! вот именно имитация пузырька мне и была нужна!! smile.gif Ща буду химичить, надеюсь все получицца ;)
 К началу страницы 
+ Ответить 
Guest
сообщение 3.05.2005 14:08
Сообщение #6


Гость






у меня что-то компилятор ругается на function
find_n(list: spis; n: integer): link;
говорит dentifier not found "link"

И еще - я так понял ета процедура меняет местами тока данные, но не елементы списка? А мне надо, чтоб местами менялись сами елементы (ето нужно, т.к. с каждым числом связана фамилия человека)
 К началу страницы 
+ Ответить 
volvo
сообщение 3.05.2005 14:14
Сообщение #7


Гость






Ну да, конечно. Я в одном месте поменял, в другом - нет... У меня - то это называлось "link", а у тебя - "spis"... Поменяй на "spis" :D

А насчет поменять местами сами элементы списка... blink.gif При таком определении это не играет роли. Если у тебя определение более сложное - то приведи его, я не телепат. Но скорее всего тебе все же придется все переписывать.

Не забудь, что в каждом элементе списка есть 2 указателя, и их ни в коем случае нельзя менять местами. Иначе представь, что ты меняешь первый и последний элемент... Так после обмена у тебя останется только первый - его next будет = nil...
 К началу страницы 
+ Ответить 
Pukelis
сообщение 3.05.2005 14:26
Сообщение #8


Гость






задача такая: используя инфу из 2-х разных файлов - создать список, состоящий из имени, фамилии и времени проживания, потом в зависимости от типа снимаемого помещения высчитать стоимость проживания и по этой стоимости отсортировать список. Вывести на экран пару таблиц.. Все уже написал, кроме самой сортировки. (((

Могу в принципе и саму прогу выложить, но она на другом языке ;-) Запарюсь переменные переводить..
 К началу страницы 
+ Ответить 
volvo
сообщение 3.05.2005 14:55
Сообщение #9


Гость






Цитата(Pukelis @ 3.05.05 14:26)
создать список, состоящий из имени, фамилии и времени проживания, потом в зависимости от типа снимаемого помещения высчитать стоимость проживания и по этой стоимости отсортировать список.

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

Конкретный вопрос: что содержит список? Какие данные из перечисленных?
 К началу страницы 
+ Ответить 
Guest
сообщение 3.05.2005 15:03
Сообщение #10


Гость






program Noname1;
uses crt;
type klient=^kli;
kli=record
familija:packed array [1..10] of char;
imia: packed array [1..10] of char;
data: packed array [1..10] of char;
next:klientas;
back:klientas;
sutok:integer;
tip_komnaty:(k1,k2,k3,k4);
stoimost:longint;
zena:integer;
end;
 К началу страницы 
+ Ответить 
volvo
сообщение 3.05.2005 15:24
Сообщение #11


Гость






Ну так тогда в чем дело? Просто объедини все поля кроме указателей next и back в отдельную запись, и меняй всю запись. Но если ты СОВСЕМ не хочешь ничего менять в программу, то вот такой изврат тебе поможет:

1. Поменяй местами поля в своей записи и опиши 2 дополнительных записи:
kli=record
familija:packed array [1..10] of char;
imia: packed array [1..10] of char;
data: packed array [1..10] of char;
sutok:integer;
tip_komnaty:(k1,k2,k3,k4);
stoimost:longint;
zena:integer;

{ вот это должно быть в конце !!! }
next:klientas;
back:klientas;
end;
myRec = record
familija, imia, data: packed array [1..10] of char;
sutok:integer;
tip_komnaty:(k1,k2,k3,k4);
stoimost:longint;
zena:integer;
end;
MySpisok = record
rec: myRec;
next:klientas;
back:klientas;
end;

2. А теперь вместо
Var T: integer;
...
T := find_n(list, pred(j))^.data;
find_n(list, pred(j))^.data := find_n(list, j)^.data;
find_n(list, j)^.data := T;

делай так:
Var T: myRec;
...
T := MySpisok(find_n(list, pred(j))^).rec;
MySpisok(find_n(list, pred(j))^).rec := MySpisok(find_n(list, j)^).rec;
MySpisok(find_n(list, j)^).rec := T;

wacko.gif

P.S. Но я бы все-таки внес все данные о клиенте в отдельную запись...
 К началу страницы 
+ Ответить 
Pukelis
сообщение 3.05.2005 16:41
Сообщение #12


Гость






Вот, перевел прогу ))) Посмотри, куда что вставить надо ;) А то я что-то не очень въехал ((((((( зарание СПАСИБО!!

Сообщение отредактировано: volvo - 3.05.2005 19:21


Прикрепленные файлы
Прикрепленный файл  source.pas ( 14.24 килобайт ) Кол-во скачиваний: 227
 К началу страницы 
+ Ответить 
volvo
сообщение 3.05.2005 16:57
Сообщение #13


Гость






Вот так (см. аттач)...
А теперь можешь спокойно сортировать с использованием:
Procedure BubbleList(Var list: spis);
Var n, i, j, T: Integer;
Begin
n := { здесь - длина списка }
For i := 1 To n Do
For j := n DownTo i+1 Do
{ > или < в зависимости от направления }
If find_n(list, pred(j))^.data.{по какому полю} > find_n(list, j)^.data.{по какому полю} Then
Begin
{ можно, конечно и запомнить адреса j и j - 1 элементов,
чтобы не вычислять повторно }
T := find_n(list, pred(j))^.data;
find_n(list, pred(j))^.data := find_n(list, j)^.data;
find_n(list, j)^.data := T;
End
End;

Теперь будут переноситься ВСЕ данные (для этого и введена структура)...


Прикрепленные файлы
Прикрепленный файл  __PROG.PAS ( 14.71 килобайт ) Кол-во скачиваний: 244
 К началу страницы 
+ Ответить 
Pukelis
сообщение 3.05.2005 18:42
Сообщение #14


Гость






попробовал я сделать как ты говорил.. не пашет нифига (( Процедура в строчках 35 и 264.
(надеюсь я еще не очень достал) ;)

Сообщение отредактировано: volvo - 3.05.2005 19:20


Прикрепленные файлы
Прикрепленный файл  source.pas ( 15.31 килобайт ) Кол-во скачиваний: 233
 К началу страницы 
+ Ответить 
volvo
сообщение 3.05.2005 19:17
Сообщение #15


Гость






Только одна просьба - такие большие исходники присоединяй файлом, иначе подсветка долго работает...
И потом - читай ответы внимательнее: я же написал: { по какому полю } !!! Что же поле не заполнено?
Procedure BubbleList(Var list: klientas; var nn:integer);
Var
i, j: Integer;
T: recType;
Begin
For i := 1 To nn Do
For j := nn DownTo i+1 Do

If find_n(list, pred(j))^.data.stoimost > find_n(list, j)^.data.stoimost Then
Begin
T := find_n(list, pred(j))^.data;
find_n(list, pred(j))^.data := find_n(list, j)^.data;
find_n(list, j)^.data := T;
End
End;

и про тип переменной T я тоже упоминал. Будь внимательнее... Вот программа, она прекрасно компилируется, только проверь как она работает. Хотя сбоев быть не должно...


Прикрепленные файлы
Прикрепленный файл  __PROG.PAS ( 15.34 килобайт ) Кол-во скачиваний: 254
 К началу страницы 
+ Ответить 
Pukelis
сообщение 3.05.2005 19:54
Сообщение #16


Новичок
*

Группа: Пользователи
Сообщений: 18
Пол: Мужской

Репутация: -  0  +


smile.gif Пасииб, да, компилируется превосходно, но при работе выдает

Runtime error 216 at $00401169
$00401169 BUBBLELIST, line 51 of G:/proga/proga6.pas
$00402232 main, line 266 of G:/proga/proga6.pas

А так же signal SIGSEGV sigmentation fault несколько раз подряд на той же строчке 51 и вылетает, если выполнять пошагово (((
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 3.05.2005 20:16
Сообщение #17


Гость






Цитата(Pukelis @ 3.05.05 19:54)
Runtime error 216 at $00401169

blink.gif Sorry... My fault

Ошибка закралась вот в эту функцию:
function find_n(list: spis; n: integer): spis;

Тут просто были попытки выхода за пределы списка... Вот так функция работает корректно:
{ указатель на n -ый элемент списка }
function find_n(list: spis; n: integer): link;
begin
while (list <> nil) and (n > 1) do begin { вместо >= 0 !!! }
list := list^.next; dec(n);
end;
find_n := list
end;
 К началу страницы 
+ Ответить 
Pukelis
сообщение 3.05.2005 20:35
Сообщение #18


Новичок
*

Группа: Пользователи
Сообщений: 18
Пол: Мужской

Репутация: -  0  +


та же фигня (( Вот как прога выглядит сейчас (см. аттач)


Прикрепленные файлы
Прикрепленный файл  proga6.pas ( 15.33 килобайт ) Кол-во скачиваний: 247
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 3.05.2005 21:02
Сообщение #19


Гость






Pukelis, а ты уверен, что N содержит правильное значение (то есть, правильную длину списка)? Я бы еще раз прошелся по списку перед самым вызовом процедуры сортировки и посчитал длину списка... А еще лучше сделать это прямо в BubbleList:
Procedure BubbleList(Var list: klientas);
Var i, j, nn: Integer;
T: recType;
p: klientas;
Begin
p := list; nn := 0;
while p <> nil do begin
p := p^.next; inc(nn);
end;

For i := 1 To nn Do
For j := nn DownTo i+1 Do

If find_n(list, pred(j))^.data.stoimost > find_n(list, j)^.data.stoimost Then
Begin
T := find_n(list, pred(j))^.data;
find_n(list, pred(j))^.data := find_n(list, j)^.data;
find_n(list, j)^.data := T;
End
End;
...
BubbleList(kl);
...

 К началу страницы 
+ Ответить 
Pukelis
сообщение 3.05.2005 22:07
Сообщение #20


Новичок
*

Группа: Пользователи
Сообщений: 18
Пол: Мужской

Репутация: -  0  +


ошибка пропала, но сортировка не происходит ((
Компилирую FPC, TP, GPC (юзаю литовскую прогу, где сразу все ети компиляторы встроены и дизайн под борланд си++ билдер - могу поделиться smile.gif ) - все одно и то же..
Если хочешь - глянь сам как все пашет, тексты с данными - прикрепил.


Прикрепленные файлы
Прикрепленный файл  1.txt ( 576 байт ) Кол-во скачиваний: 295
Прикрепленный файл  2.txt ( 93 байт ) Кол-во скачиваний: 241
Прикрепленный файл  proga6.pas ( 15.53 килобайт ) Кол-во скачиваний: 252
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

2 страниц V  1 2 >
 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 21.07.2025 9:27
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"