Сортировка каталога в perl с учетом чисел - PullRequest
Новая
       49

Сортировка каталога в perl с учетом чисел

1 голос
/ 02 июня 2010

Я думаю, мне нужно какое-то преобразование Шварца , чтобы это сработало, но мне сложно разобраться, так как Perl не мой самый сильный язык.

У меня есть каталог с таким содержимым: 

album1.htm
album2.htm
album3.htm
....
album99.htm
album100.htm

Я пытаюсь получить альбом с наибольшим номером из этого каталога (в данном случае, album100.htm). Обратите внимание, что временные метки на файлах не являются надежным средством определения вещей, так как люди добавляют старые «отсутствующие» альбомы после факта.

Предыдущий разработчик просто использовал приведенный ниже фрагмент кода, но он явно ломается, если в каталоге более 9 альбомов. 

opendir(DIR, PATH) || print $!;
@files = readdir(DIR);
foreach $file ( sort(@files) ) {
    if ( $file =~ /album/ ) {
        $last_file = $file;
    }
}

Ответы [ 6 ]

7 голосов
/ 02 июня 2010

Если вам просто нужно найти альбом с наибольшим номером, вам не нужно сортировать список, просто просматривайте его и отслеживайте максимальное количество. 

#!/usr/bin/perl 

use strict;
use warnings;

my $max = 0;

while ( <DATA> ) {
    my ($album) = $_ =~ m/album(\d+)/;
    $max = $album if $album > $max;
}

print "album$max.htm";

__DATA__
album1.htm
album100.htm
album2.htm
album3.htm
album99.htm
3 голосов
/ 02 июня 2010

Чтобы найти наибольшее число, попробуйте пользовательскую сортировку ... 

sub sort_files {
    (my $num_a = $a) =~ s/^album(\d+)\.htm$/$1/;
    (my $num_b = $b) =~ s/^album(\d+)\.htm$/$1/;
    return $num_a <=> $num_b;
}

my @sorted = sort \&sort_files @files;
my $last = pop @sorted;

Кроме того, взгляните на модуль File :: Next . Это позволит вам выбрать только те файлы, которые начинаются со слова «альбом». Я нахожу это немного легче, чем readdir .

2 голосов
/ 02 июня 2010

Причиной возникновения трудностей является оператор, <=> - это числовое сравнение, cmp - это по умолчанию , и это сравнение строк. 

$ perl -E'say for sort qw/01 1 02 200/';
01
02
1
200

С небольшой модификацией мы получаем нечто гораздо ближе к правильному: 

$ perl -E'say for sort { $a <=> $b } qw/01 1 02 200/';
01
1
02
200

Однако в вашем случае вам необходимо удалить не цифры. 

$ perl -E'say for sort { my $s1 = $a =~ m/(\d+)/; my $s2 = $b =~ /(\d+)/; $s1 <=> $s2  } qw/01 1 02 200/';
01
1
02
200

Вот оно красивее: 

sort {
  my $s1 = $a =~ m/(\d+)/;
  my $s2 = $b =~ /(\d+)/;
  $s1 <=> $s2
}

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

Да, и как следствие, Shcwartzian Transform решает другую проблему: он останавливает вас от необходимости запускать сложную задачу (в отличие от той, которая вам нужна - регулярное выражение) несколько раз в алгоритме поиска. Это требует затрат памяти для кеширования результатов (что не является неожиданным). По сути, вы выполняете сопоставление входных данных проблемы с выходными данными (обычно в массиве) [$input, $output], а затем сортируете по выходным данным $a->[1] <=> $b->[1]. Теперь, когда ваш материал отсортирован, вы возвращаетесь обратно, чтобы получить исходные данные $_->[0]. 

map $_->[0],
sort { $a->[1] <=> $b->[1] }
map [ $_, fn($_) ]
, qw/input list here/
;

Это круто, потому что он такой компактный и в то же время очень эффективный.

1 голос
/ 03 июня 2010

Вот общее решение: 

my @sorted_list
    = map  { $_->[0] } # we stored it at the head of the list, so we can pull it out
      sort {
          # first test a normalized version
          my $v = $a->[1] cmp $b->[1];
          return $v if $v;

          my $lim = @$a > @$b ? @$a : @$b;

          # we alternate between ascii sections and numeric
          for ( my $i = 2; $i < $lim; $i++ ) {
              $v  =  ( $a->[$i] || '' ) cmp ( $b->[$i] || '' );
              return $v if $v;

              $i++;
              $v = ( $a->[$i] || 0 ) <=> ( $b->[$i] || 0 );
              return $v if $v;
          }
          return 0;

      }
      map {
          # split on digits and retain captures in place.
          my @parts = split /(\d+)/;
          my $nstr  = join( '', map { m/\D/ ? $_ : '0' x length() } @parts );
          [ $_, $nstr, @parts ];
      } @directory_names
      ;
1 голос
/ 02 июня 2010

Вот альтернативное решение, использующее уменьшение : 

use strict;
use warnings;
use List::Util 'reduce';

my $max = reduce {
    my ($aval, $bval) = ($a =~ m/album(\d+)/, $b =~ m/album(\d+)/);
    $aval > $bval ? $a : $b
} <DATA>;
print "max album is $max\n";

__DATA__
album1.htm
album100.htm
album2.htm
album3.htm
album99.htm
1 голос
/ 02 июня 2010

Вот, пожалуйста, используя преобразование Шварца: 

my @files = <DATA>;

print join '',
    map  { $_->[1] }
    sort { $a->[0] <=> $b->[0] }
    map  { [ m/album(\d+)/, $_ ] }
    @files;


 __DATA__
album12.htm
album1.htm
album2.htm
album10.htm
...