Xpoint
   [напомнить пароль]

Сортировка по нескольким полям в обрятном порядке

Метки: [без меток]
2009-07-08 16:25:16 [обр] Agar -Agar(3/68)[досье]

никогда раньше сам не занимался написанием сортировки, все время прикручивал специально препроцессор. Но уж мольно массивно. Хочу попробовать "вручную".

Итак, условно говоря есть массив, для удобства взял года:

my @list = ("0:0:9:1:<br>", "0:0:9:2:<br>", "0:0:9:3:<br>", "1:8:9:1:<br>", "1:8:9:2:<br>", "1:8:9:3:<br>", "1:9:9:1:<br>", "1:9:9:2:<br>", "1:9:9:3:<br>");

Нужно отсортировать по убыванию.
Пытаюсь так:

@list = sort ({$b <=> $a} @list);

print "@list";

Правильно выводит сотрировку только по первому числу. Как такое сделать правильно, или же решение столь громоздкое, что лучше продолжать использовать препроцессор?

спустя 8 минут [обр] Роман Чемисов(56/327)[досье]
Agar -Agar[досье]
my @sorted = sort { $a->[1] cmp $b->[1] ||
                    $a->[2] <=> $b->[2] ||
                    $a->[3] <=> $b->[3] }
             ;
спустя 1 минуту [обр] Agar -Agar(3/68)[досье]

Пока писал, Роман вставил сообщение. Спасибо!

Чтобы не пропадать написанному, привожу текст.

Да, сам препроцессор, который всегда использовал до этого:

#----- ПРЕПРОЦЕССОР ДЛЯ СОРТИРОВКИ---------

sub fieldsort {
my ($sep, $cols);
if (ref $_[0]) {
$sep = '\\s+'
} else {
$sep = shift;
}
unless (ref($cols = shift) eq 'ARRAY') {
die "fieldsort columns must be in anon array";
}
my (@sortcode, @col);
my $col = 1;
for (@$cols) {
my ($a, $b) = /^-/ ? qw(b a) : qw(a b);
my $op = /n$/ ? '<=>' : 'cmp';
push @col, (/(\d+)/)[0] - 1;
push @sortcode, "\$${a}->[$col] $op \$${b}->[$col]";
$col++;
}
my $sortfunc = eval "sub { " . join (" or ", @sortcode) . " } ";
my $splitfunc = eval 'sub { (split /$sep/o, $_)[@col] } ';
return
map $_->[0],
sort { $sortfunc->() }
map [$_, $splitfunc->($_)],
@_;
}

#----- КОНЕЦ ПРЕПРОЦЕССОРА ДЛЯ СОРТИРОВКИ---------

Используется так:

   @sorted = fieldsort ':::::', [3, '2n', 4, '-5', '1n'], @list;

Разделитель :::::
цифра-какое поле
n — числовое значение
- в обратном порядке

Подозреваю, еще и ресурсы жрет неслабо, а мне нужна скорость.

спустя 37 минут [обр] Agar -Agar(3/68)[досье]

Что-то у меня вообще не работает.

Пытаюсь для нашего примера сделать так:

@list = sort {

   (((split(/:/,$b))->[1] <=> ((split(/:/,$a))->[1])
   ||
   (((split(/:/,$b))->[2] <=> ((split(/:/,$a))->[2])
   ||
   (((split(/:/,$b))->[3] <=> ((split(/:/,$a))->[3])
   ||
   (((split(/:/,$b))->[4] <=> ((split(/:/,$a))->[4])
   
   }@list;

print "@list";
спустя 9 минут [обр] Agar -Agar(3/68)[досье]

Перестарался со скобками, правильнее так:

my @list = ("0:0:0:1:<br>", "0:0:0:2:<br>", "0:0:1:1:<br>", "0:0:1:2:<br>", "0:1:0:0:<br>", "0:1:1:0:<br>", "1:1:0:0:<br>", "1:2:0:0:<br>", "1:3:0:0:<br>");


@list = sort {

   (split(/:/,$b))->[1] <=> (split(/:/,$a))->[1]
   ||
   (split(/:/,$b))->[2] <=> (split(/:/,$a))->[2]
   ||
   (split(/:/,$b))->[3] <=> (split(/:/,$a))->[3]
   ||
   (split(/:/,$b))->[4] <=> (split(/:/,$a))->[4]
   
   }@list;

print "@list";

Но все равно не сортирует.

спустя 7 минут [обр] Agar -Agar(3/68)[досье]
Методом тыка подправил, заработало как надо:
@list = sort {

   (split(/:/,$b))[4] <=> (split(/:/,$a))[4]
||
   (split(/:/,$b))[3] <=> (split(/:/,$a))[3]
||
   (split(/:/,$b))[2] <=> (split(/:/,$a))[2]
||
   (split(/:/,$b))[1] <=> (split(/:/,$a))[1]
   
   }@list;

print "@list";
спустя 12 минут [обр] Alexander O(122/460)[досье]
Agar -Agar[досье]
а так пробовали?
@list = sort @list;
спустя 1 час 1 минуту [обр] Agar -Agar(3/68)[досье]
Так глючно(для человеческого восприятия сначала идет 1, потом 2, потом 10, а не 1-10-2), да и в обратном порядке надо.
спустя 40 минут [обр] Alexander O(122/460)[досье]

Agar -Agar[досье] в примере были только однозначные числа, а обратный порядок я проморгал.
Тогда вот что:

@list  = map  { $_->[0] }
         sort { $b->[1] cmp $a->[1] } 
         map  { [$_, join ':', map {sprintf '%03d', $_} split ':', $_ ]} 
         @list;

Эта идиома называется "Schwartzian transform". Работает следующим образом (читаем код снизу вверх):

  1. Преобразовываем наш список(@list) в список пар (анонимных массивов из двух элементов) У нас это [$_, join ...] Преобразовываем так, что первый элемент каждой пары — это неизменившийся элемент нашего списка, а второй элемент является пригодным для последующих сравнений изменением первого элемента. В нашем случае "1:10:2" превратилось в "001:010:002"
  1. Сортируем получившийся список сравнивая вторые элементы пар.
  1. Из сортированного списка пар вытаскиваем первые элементы.

Польза идиомы в том, что преобразование элемента списка в пригодный для сравнивания вид производится только 1 раз. Если же мы будем делать преобразования внутри процедуры сравнения — то таких преобразований придется делать гораздо больше. Для больших списков получается хорошая экономия времени. Сама процедура сравнения становится тривиальной. Идиома очень популярна и знать ее необходимо.

спустя 53 минуты [обр] Agar -Agar(3/68)[досье]
Я уже работаю с вариантом, к которому благодаря наводке Роман Чемисов[досье]пришел ранее. Но если Ваш вариант жрет меньше ресурсов, буду потом пытаться разобрать и его. Не совсем, правда, понятно, как такая сортировка будет вестись с продвинутым списком, где числа-идентификаторы уже не 3-х, а n-значные. Хотя можно задать по умолчанию 6-разрядные числа и не беспокоится, что такой уровень вложенности будет достигнут. Я делаю как раз скрипт-каталогизатор с навигацией на предыдущие уровни. Потом я не совсем понял, как может такая сортировка выглядеть, скажем, для 6 полей массива, когда "выравнивание" начинается с 6-го поля, а заканчивается 1-м. И не будет ли в данном случае перегружена память?
спустя 1 минуту [обр] Agar -Agar(3/68)[досье]
... благодаря наводке Романа Чемисова ...
спустя 8 дней [обр] Dennis F. Latypoff aka funky_dennis(24/78)[досье]
@list = sort
{
   (split(/:/,$b))[4] <=> (split(/:/,$a))[4] ||
   (split(/:/,$b))[3] <=> (split(/:/,$a))[3] ||
   (split(/:/,$b))[2] <=> (split(/:/,$a))[2] ||
   (split(/:/,$b))[1] <=> (split(/:/,$a))[1]
   
} @list;

print "@list";
В худшем случае, будет 4 вызова split() за итерацию, неужели в школах не учат антибыдлокодству?
спустя 43 секунды [обр] Dennis F. Latypoff aka funky_dennis(24/78)[досье]
Я извиняюсь, не 4, а 8
Powered by POEM™ Engine Copyright © 2002-2005