«Человеческая» сортировка в perl

1

1

Доброго времени суток.

В современных файловых менеджерах ( nautilus, проводник ), числа сортируются в виде, удобном для человека, т.е.

Traffic on interface FC port 0/1
Traffic on interface FC port 0/2
Traffic on interface FC port 0/10

вместо машинной сортировки

Traffic on interface FC port 0/1
Traffic on interface FC port 0/10
Traffic on interface FC port 0/2

Как бы это реализовать на perl? Предполагаю, что через написание своей функции

sort { human_readable_sort($a) cmp human_readable_sort($b) } @list

Но вот алгоритм никак не соображу. Или есть готовые?

Ссылка

←	Python, chmod

gtk_main()

→

$v = right('0000000000' . $v, 10);

вот по такому значению сортировать надо. а после сортировки - приводить к (int)

bvn13 ★★★★★
(02.10.13 20:12:21 MSK)

Ссылка

Я реализовывал такую функцию сортировки. Попробую описать алгоритм:

Если дошли до конца одной из строк, то возвращаем результат сравнения двух текущих символов.
- Иначе, если текущие символы обеих строк являются цифрами
  - Преобразуем строки с текущей позиции в числа, смещая позиции в строках до первого не цифрового символа.
  - Если числа из обеих строк различаются, возвращаем результат их сравнения.
  - Если различаются первые цифры, только что обработаных чисел, то вернуть результат их сравнения.
- Если текущие символы равны, то перейти к следующим и идём на начало алгоритма.
- Иначе выйти, вернув результат сравнения чисел.

Пример на C (Perl практически не знаю, не могу перевести, но идея должна быть понятна):

static int
vercmp(const char s[], const char t[])
{
    while (*s != '\0' && *t != '\0') {
        if (isdigit(*s) && isdigit(*t)) {
            char *after_num;

            const int num_s = strtol(s, &after_num, 10);
            const char *const orig_s = s;
            s = after_num;

            const int num_t = strtol(t, &after_num, 10);
            const char *const orig_t = t;
            t = after_num;

            if (num_s != num_t) {
                return num_s - num_t;
            } else if (*orig_s != *orig_t) {
                return *orig_s - *orig_t;
            }
        } else if (*s == *t) {
            s++;
            t++;
        } else {
            break;
        }
    }

    return *s - *t;
}

xaizek ★★★★★
(02.10.13 21:13:37 MSK)

вместо машинной сортировки

Это не машинная сортировка. Это строковая. Тебе нужна числовая.

#!perl

use strict;
use warnings;

my @data = (
  q{Traffic on interface FC port 0/10},
  q{Traffic on interface FC port 0/1},
  q{Traffic on interface FC port 0/2},
  q{Traffic on interface FC port 1/10},
);

my @sorted = sort {
    my ($ia, $pa) = split /\//, $a, 2;
    my ($ib, $pb) = split /\//, $b, 2;
    $ia =~ s/\D//g;
    $ib =~ s/\D//g;
#    $ib <=> $ia || $pb <=> $pa;
    $ia <=> $ib || $pa <=> $pb;
} @data;

print "$_\n" for (@sorted);

Есть еще такой модуль: Sort::Naturally. Сравнение перформанса произведи сам :)

~~gh0stwizard~~ ★★★★★
(02.10.13 21:37:53 MSK)

Ссылка

sub human_readable_sort($) {
  @_[0] =~ /\s(\d+)\/(\d+)/;
  return sprintf ("%04d%04d", $1, $2);
}

~~redgremlin~~ ★★★★★
(02.10.13 21:38:04 MSK)

На вот еще в общем виде:


sub ncmp($$) {
    use Scalar::Util qw/looks_like_number/;

    my @a = split /(\d+)/, shift;
    my @b = split /(\d+)/, shift;

    for (my $i = 0; $i < (@a < @b ? @a : @b); $i++) {
        my ($a, $b, $r) = ($a[$i], $b[$i]);
        if (looks_like_number($a) and looks_like_number($b)) {
            $r = $a <=> $b;
        } else {
            $r = $a cmp $b;
        }
        return $r if $r;
    }
    return @a <=> @b;
}

my @arr = (
    "30 haha",
    "haha 1", "haha 10", "haha 2",
    "item 1", "item 10", "item 11",
    "item 2", "item 20", "item 3",
);

print(join("\n", sort { ncmp($a, $b) } @arr), "\n");

~~arturpub~~ ★★
(02.10.13 21:48:34 MSK)

Ссылка

Ответ на: комментарий от redgremlin 02.10.13 21:38:04 MSK

Спасибо, так в итоге и сделаю.

P.S. Пока ехал с работы, подумал что для общего случая проще всего рекурсию использовать. Но пожалуй это перебор

sub human_readable_sort($) {
    my $src_str = shift;

    if ( $src_str =~ m/^([^\d]*)(\d+)([^\d].*|)$/ ){
        return sprintf ("%s%010d%s", $1, $2, human_readable_sort($3));
    } else {
        return $src_str;
    }
}

router ★★★★★
(02.10.13 22:06:50 MSK) автор топика
Последнее исправление: router 02.10.13 22:12:20 MSK (всего исправлений: 1)

Ответ на: комментарий от xaizek 02.10.13 21:13:37 MSK

Для этого я слишком непрограммист :) Мне нужно было один раз написать скрипт для автоматического создания screen'ов в zabbix и забыть об этом

router ★★★★★
(02.10.13 22:10:14 MSK) автор топика

Ссылка

Всем спасибо за помощь

router ★★★★★
(02.10.13 22:10:35 MSK) автор топика

Ссылка

Это называет natural sort. Гугли, motherfucker!

Есть модуль на Перле. Есть функция в glibc

anonymous
(02.10.13 23:46:49 MSK)

Ссылка

Ответ на: комментарий от router 02.10.13 22:06:50 MSK

Больше не езди на работу.

anonymous
(02.10.13 23:48:01 MSK)

Ответ на: комментарий от xaizek 02.10.13 21:13:37 MSK

Аналог на перле :)

#!perl

use strict;
use warnings;

my @data = (
  q{Traffic on interface FC port 0/10},
  q{Traffic on interface FC port 0/1},
  q{Traffic on interface FC port 0/2},
  q{Traffic on interface FC port 2/1},
  q{Traffic on interface FC port 1/25},
  q{Traffic on interface FC port 1/13},
);

sub hr($$) {
    my ($s, $t) = @_;

    my $pos = 0;
    my $len1 = length $s;
    my $len2 = length $t;
    my ($sc, $st);

    while ($pos < $len1 && $pos < $len2) {
        $sc .= substr $s, $pos, 1;
        $st .= substr $t, $pos, 1;

        if ($sc =~ /\d/ && $st =~ /\d/) {
            pos ($s) = $pos;
            pos ($t) = $pos;
            my ($scnt, $tcnt) = (0, 0);

            $sc = $st = undef;

            for ($s, $t) {
                $scnt++, redo if ($s =~ /\G\d/gc);
                $tcnt++, redo if ($t =~ /\G\d/gc);
            }

            if ($tcnt) {
                $st .= substr $t, $pos, $tcnt;
            }

            if ($scnt) {
                $sc .= substr $s, $pos, $scnt;
            }

            unless (defined $sc and defined $st) {
                $pos++;
                next;
            }

            if ($sc == $st) {
                $pos++;
                next;
            } else {
                return $sc - $st;
#                return $st - $sc;
            }
        } elsif ($sc eq $st) {
            $pos++;
            next;
        } else {
            last;
        }
    }

    return $sc cmp $st;
#    return $st cmp $sc;
}

my @sorted = sort { &hr($a, $b) } @data;

print "$_\n" for (@sorted);

~~gh0stwizard~~ ★★★★★
(02.10.13 23:53:51 MSK)

Недавно сталкивался с подобной задачей. Надо было вывести уникальный список текстовых строк с включением цифр, натурально сортированный, модули с CPAN давали немного не то, что мне надо. На всякий случай, вдруг пригодится, вот такой uniq natsort получился:

sub unatsort (@) {
	my %seen = ();
	grep { not $seen{$_}++ }
	grep {s/(^|\D)0+(\d)/$1$2/g,1}
	sort grep {s/(\d+)/sprintf"%06.6d",$1/ge,1} @_
	}

Лепил из найденных в интернетах примеров, так что, возможно, можно и лучше сделать, но работает.

massimus ★★★
(03.10.13 00:13:22 MSK)

% lsort {00 01 02 0 1 2 3 4 5 6 7 8 9 10 11 12 19 20 21}
0 00 01 02 1 10 11 12 19 2 20 21 3 4 5 6 7 8 9

типа такой сортировки?

anonymous
(03.10.13 00:24:47 MSK)

Ссылка

Ответ на: комментарий от massimus 03.10.13 00:13:22 MSK

Уникальность это уникальность, сортировка это сортировка.

#!perl

use strict;
use warnings;

$, = "\n";

my @data = (
    "hello",
    "hello",
    "wowo"
);

my %hash = ();

print map { $hash{$_}++ ? () : $_ } @data;

~~gh0stwizard~~ ★★★★★
(03.10.13 00:37:58 MSK)

Ссылка

sort {($a =~ m|/(\d+)\z|)[0] <=> ($b=~ m|/(\d+)\z|)[0]} @list

добавь проверки и не используй cmp, если сравниваешь числа

chg ★★★★★
(03.10.13 00:49:26 MSK)

Ссылка

Ответ на: комментарий от gh0stwizard 02.10.13 23:53:51 MSK

Как-то он менее похож на мой код, чем я ожидал :-) Но всё равно спасибо, интересно было сравнить. Надо будет всё таки осилить Perl по нормальному, для общего развития, так сказать.

xaizek ★★★★★
(03.10.13 01:39:26 MSK)