Помощь - Поиск - Пользователи - Календарь
Полная версия: Как отсортировать?
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
pukelis
По возрастанию ли - убыванию - нет разницы. 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.
volvo
Ну, во-первых, сразу возникает вопрос - можно или нельзя пользоваться дополнительным списком. И если можно, то всю вышеприведенную программу придется переделать, т.к. для нормальной работы со списками необходимы процедуры вставки и удаления элементов, а не "Создать список" и "Уничтожить список" :yes:

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

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


фишка в том, что в моей большой проге параметр сортировки списка появляется уже после создания списка (там высчитывается стоимость из цены) Для етой маленькой-то конечно все равно ))))
volvo
Ну, тогда вспомни как выглядит пузырьковая сортировка:
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
TX!! вот именно имитация пузырька мне и была нужна!! smile.gif Ща буду химичить, надеюсь все получицца ;)
Guest
у меня что-то компилятор ругается на function
find_n(list: spis; n: integer): link;
говорит dentifier not found "link"

И еще - я так понял ета процедура меняет местами тока данные, но не елементы списка? А мне надо, чтоб местами менялись сами елементы (ето нужно, т.к. с каждым числом связана фамилия человека)
volvo
Ну да, конечно. Я в одном месте поменял, в другом - нет... У меня - то это называлось "link", а у тебя - "spis"... Поменяй на "spis" :D

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

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

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

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

Конкретный вопрос: что содержит список? Какие данные из перечисленных?
Guest
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
Ну так тогда в чем дело? Просто объедини все поля кроме указателей 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
Вот, перевел прогу ))) Посмотри, куда что вставить надо ;) А то я что-то не очень въехал ((((((( зарание СПАСИБО!!
volvo
Вот так (см. аттач)...
А теперь можешь спокойно сортировать с использованием:
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
попробовал я сделать как ты говорил.. не пашет нифига (( Процедура в строчках 35 и 264.
(надеюсь я еще не очень достал) ;)
volvo
Только одна просьба - такие большие исходники присоединяй файлом, иначе подсветка долго работает...
И потом - читай ответы внимательнее: я же написал: { по какому полю } !!! Что же поле не заполнено?
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 я тоже упоминал. Будь внимательнее... Вот программа, она прекрасно компилируется, только проверь как она работает. Хотя сбоев быть не должно...
Pukelis
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 и вылетает, если выполнять пошагово (((
volvo
Цитата(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
та же фигня (( Вот как прога выглядит сейчас (см. аттач)
volvo
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
ошибка пропала, но сортировка не происходит ((
Компилирую FPC, TP, GPC (юзаю литовскую прогу, где сразу все ети компиляторы встроены и дизайн под борланд си++ билдер - могу поделиться smile.gif ) - все одно и то же..
Если хочешь - глянь сам как все пашет, тексты с данными - прикрепил.
volvo
В-общем, с такими файлами данных ты замучаешься делать что-либо... Тем более, что используется array of char вместо string. Что я могу сказать? Вывод не отработан, очень трудно следить за результатами. Кстати, я добился того что она начала сортировать ( для этого достаточно передавать BubbleList(nachalo); ), но при пошаговом прогоне обратил внимание, что в первой же паре, которая меняется местами, есть отрицательное значение стоимости (= -17536). Глюк? Сначала отрабатывается алгоритм, а уже потом - сортировка... :yes:
Pukelis
Цитата
Вывод не отработан, очень трудно следить за результатами.

unsure.gif поетому я и не хотел ее сразу выкладывать ;) Она переделывалась из статической, где все было гладенько smile.gif

Цитата
Кстати, я добился того что она начала сортировать ( для этого достаточно передавать BubbleList(nachalo); ), но при пошаговом прогоне обратил внимание, что в первой же паре, которая меняется местами, есть отрицательное значение стоимости (= -17536). Глюк? Сначала отрабатывается алгоритм, а уже потом - сортировка...


BubbleList(nachalo); - ето куда? Алгоритм еще попробую причесать.. Иначе в пятницу звиздец настанет (( :o
volvo
Значится, так... smile.gif Вот что мне удалось сделать после длительного прыгания с бубном около монитора :D
Pukelis
Цитата(volvo @ 4.05.05 1:53)
Значится, так...  smile.gif Вот что мне удалось сделать после длительного прыгания с бубном около монитора  :D

smile.gif ПАСИБ!!! :molitva: Ты - просто супер!!! :yes:
Я еще ближе к вечеру несколько вопросов по етой проге задам, чтоб во все окончательно въехать, ок? ;)

Даж не знаю как благодарить.. :p2: Глянь вот на такую штуку, что ли.. ;) Мож не видел такую оболочку, авось для твоего сайта пригодится )))
http://aldona.mii.lt/pms/fps/en/gallery.html
http://ims.mii.lt/fps/download/0.8.5/en/

ps: и еще раз: СПА-СИ-БО!!!!!! rolleyes.gif
Pukelis
Ну а вот и вопросы, которые я собирался тебе задать:

Зачем каждый раз в цикле перед присваиванием arr[i] значения переменной ch присваивать ей пробел? И что конкретно делает предпоследняя строчка?

procedure get_array(var f: text; var arr: myArray;
const n: integer);
var
i: integer;
ch: char;
begin
for i := low(arr) to high(arr) do begin
arr[i] := #32;
read(f, ch);
arr[i] := ch;
end;
for i := succ(high(arr)) to n do read(f, ch)
end;


а вот ето нужно, чтоб потом нормально пользоваться методом пузырька, да?

type
clients = ^node;
node = record
data: recType;
next, back: clients;
end;

tlist = record
first, last: clients;
end;


вот ето еще немного неясно, особенно то, что в скобках:
r.tip_komnaty := komType(ord(ch) - ord('1'));
а так же ето:
chr(ord('1') + byte(tip_komnaty))

Еще непонятно, зачем кое-где ты прописывал типы:
byte(p^.data.tip_komnaty)
longint(p^.data.cena)

Вот пока что все вопросы smile.gif Ответь до 12 завтрашнего дня, ок? :P
volvo
Значит, по-порядку: smile.gif
Цитата(Pukelis @ 5.05.05 20:59)
Зачем каждый раз в цикле перед присваиванием arr[i] значения переменной ch присваивать ей пробел? И что конкретно делает предпоследняя строчка?

Пробел - это для гарантии того, что ни при каких условиях старое значение элемента массива не сохранится.

А предпоследняя строчка делает вот что: если в процедуру передана константа N, равная размеру массива arr, то ничего не происходит, т.е. сразу же после прочтения из файла всех элементов массива выполнение процедуры заканчивается.
А вот если мне нужно кроме строки прочесть еще и несколько символов, чтобы при следующем заходе опять спокойно считывать саму строку, то я передам в N не 10, а большее число, и процедура считает из файла дополнительно
N - high(arr) символов. Кстати, high(arr) это верхняя граница массива Arr, то есть 10 smile.gif Есть такая функция в Паскале.


Цитата(Pukelis @ 5.05.05 20:59)
а вот ето нужно, чтоб потом нормально пользоваться методом пузырька, да?
Именно. Чтобы проще было менять записи местами...

Цитата(Pukelis @ 5.05.05 20:59)
вот ето еще немного неясно, особенно то, что в скобках:
r.tip_komnaty := komType(ord(ch) - ord('1'));
а так же ето:
chr(ord('1') + byte(tip_komnaty))

У тебя читается символ от '1' до '4' как признак типа комнаты, правда? smile.gif
А сами k1, k2, k3, k4 в описании komType = (k1,k2,k3,k4); чему равны, ты знаешь? Для компилятора 0, 1, 2 и 3 соответственно. Вот и пользуемся этим.
Берем порядковый номер символа и вычитаем из него номер '1' - цы. Результат приводим к нужному типу, чтобы не было сообщений о несовместимости.
Вторая строка - то же самое, только обратный процесс...

Цитата(Pukelis @ 5.05.05 20:59)
Еще непонятно, зачем кое-где ты прописывал типы:
byte(p^.data.tip_komnaty)
longint(p^.data.cena)

Первый случай - чтобы избежать несовместимости... Если там не поставить byte(), то программа даже не скомпилируется. Но это не страшно, потому что проблема явная, и ты знаешь, что она есть. А значит - решишь.

Вот вторая строка - ГОРАЗДО опаснее. В Паскале есть очень нехорошая особенность - Тип результата приводится к самому емкому из типов операндов. Так вот если у тебя есть:
Var a, b: Word; c: LongInt;
{ и ты сделаешь так: }
begin
a := 300; b := 300;
c := a * b;
WriteLn( c );
end.

То ты вроде бы должен получить 90000, но ты их не получишь. Почему? Объясняю: сначала тип результата устанавливается в самый емкий из типов операндов (в этом случае - Word), потом производится умножение, результат "запихивается" в Word... Все что не поместилось - усекается. Что имеем после усечения - 24464. А потом этот результат запишется в LongInt ( переменную C ). Вот эту ошибку ОЧЕНЬ трудно найти, она никак компилятором не определяется sad.gif

Как ее избежать? Правильно:
Var a, b: Word; c: LongInt;
begin
a := 300; b := 300;
c := LongInt( a ) * b;
WriteLn( c );
end.

Теперь результат будет заноситься в LongInt, как более емкий, и усечения не произойдет...

smile.gif Что-то много получилось...
Pukelis
спасибо, ВСЕ понял! smile.gif Узнал много нового для себя! теперь бы ето хорошенько запомнить и сказать-по литовски завтра ))) Мож еще к завтру каких вопросов придумаю ^_^
sheka
я бы использовал не пузырьковую, а гибридную: тот же пузырек, но индексы чуть другие:
for i := 1 to n-1 do
for j := i+1 to n do
if a[ i ] < a[ j ] then
begin
//...
end;

вместо
for использовать while,
і : integer использовать pmin: spis
j : integer использовать pelse: spis

ГЫ: на даты не посмотрел smile.gif
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.