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

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

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

2 страниц V  1 2 >  
 Ответить  Открыть новую тему 
> Как отсортировать?, двусторонний динамич. список
сообщение
Сообщение #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


Гость






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

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


Гость






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

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


фишка в том, что в моей большой проге параметр сортировки списка появляется уже после создания списка (там высчитывается стоимость из цены) Для етой маленькой-то конечно все равно ))))
 К началу страницы 
+ Ответить 
сообщение
Сообщение #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;

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


Гость






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


Гость






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

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


Гость






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

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

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


Гость






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

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


Гость






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

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

Конкретный вопрос: что содержит список? Какие данные из перечисленных?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #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;
 К началу страницы 
+ Ответить 
сообщение
Сообщение #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. Но я бы все-таки внес все данные о клиенте в отдельную запись...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Гость






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

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


Прикрепленные файлы
Прикрепленный файл  source.pas ( 14.24 килобайт ) Кол-во скачиваний: 218
 К началу страницы 
+ Ответить 
сообщение
Сообщение #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 килобайт ) Кол-во скачиваний: 231
 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Гость






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

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


Прикрепленные файлы
Прикрепленный файл  source.pas ( 15.31 килобайт ) Кол-во скачиваний: 228
 К началу страницы 
+ Ответить 
сообщение
Сообщение #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 килобайт ) Кол-во скачиваний: 235
 К началу страницы 
+ Ответить 
сообщение
Сообщение #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 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #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;
 К началу страницы 
+ Ответить 
сообщение
Сообщение #18


Новичок
*

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

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


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


Прикрепленные файлы
Прикрепленный файл  proga6.pas ( 15.33 килобайт ) Кол-во скачиваний: 260
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #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);
...

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


Новичок
*

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

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


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


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

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

 





- Текстовая версия 9.12.2021 14:31
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name