2

sortで使用できるPerl比較関数が必要です。

各キーは、区切り文字（ドット、コロン、スペース、スラッシュ）で区切られた任意の数のサブキーを持つテキスト文字列です。一部のサブキーは数値であり、数値で並べ替える必要があります。キーの形式とサブキーの数は異なります。したがって、比較では、一方のキーがもう一方のキーよりも長い場合を処理する必要があり、サブキーが1つのキーでは数値であるが、別のキーでは数値でない場合を処理する必要があります（この場合、テキストによる比較がそのサブキーに適しています）。

これは機能しますが、もっと良い解決策があるに違いありません。

use warnings;
use strict;
use Scalar::Util qw[looks_like_number];

sub hier_cmp {

    my $aa = $a;
    my $bb = $b;

    # convert all delims (. : / space) to the same delim

    $aa =~ tr/.:\/ /::::/;
    $bb =~ tr/.:\/ /::::/;
    my @lista = split(":", $aa);
    my @listb = split(":", $bb);

    my $result;

    for my $ix (0 .. min($#lista, $#listb)) {
        if (exists($lista[$ix]) && exists($listb[$ix])) {
            if ( looks_like_number($lista[$ix]) && looks_like_number($listb[$ix])) {
                # compare numerically
                $result = ($lista[$ix] <=> $listb[$ix]);
            } else {
                # compare as strings
                $result = ($lista[$ix] cmp $listb[$ix]);
            }
            if ($result == 0) {
                next;
            }
            return $result;

        } elsif (exists($lista[$ix])) {
            return 1;
        } else {
            return -1;
        }
    }
}

私の目的では、読みやすさは速度よりも重要です。これは内部ツール専用であり、リストに数百を超える要素が含まれることはめったにありません。ただし、何かを学ぶ機会はあります。

ご覧のとおり、私はPerlウィザードではありません。私のコードの些細な改善でさえいただければ幸いです。

ありがとう！

4

2 に答える 2

2

それは自然なソートのように見えます。Sort::NaturallyやSort::Key::Naturalなど、すでにそれを行っている CPAN のモジュールがいくつかあります。

例えば：

use Sort::Key::Natural qw(natsort);
my @sorted = natsort @data;
于 2012-07-17T18:52:13.820 に答える
1

テスト用のデータを提供していただけると助かりますが、このコードはいくつかの基本的なテストに合格し、正しく表示されます。

List::MoreUtils関数pairwiseを使用してフィールド ペアの配列を作成することで、問題を単純化します。

次に、リストの 1 つが他のリストの前に終了し、最初にソートする必要がある場合は、1 つだけが定義されているかどうかを確認するだけです。それらが両方とも数値である場合、数値比較で比較する必要がある場合。または、単純にそれらを文字列として比較します。

ペアの配列の最後に到達すると、すべてが一致し、等しいことを示すためにゼロが返されます。

アップデート

への依存を削除するために、このコードを変更しましたList::MoreUtils::pairwise。

use strict;
use warnings;

use Scalar::Util 'looks_like_number';

sub hier_cmp {

  our ($a, $b);

  my @a = split m|[.: /]+|, $a;
  my @b = split m|[.: /]+|, $b;

  for my $i (0 .. $#a > $#b ? $#a : $#b) {
    my @ab = ( $a[$i], $b[$i] );
    if (grep defined, @ab < 2) {
      return defined $ab[0] ? 1 : -1;
    }
    else {
      my $numeric = grep(looks_like_number($_), @ab) == 2;
      my $result = $numeric ? $ab[0] <=> $ab[1] : $ab[0] cmp $ab[1];
      return $result if $result;
    }
  }

  return 0;
}
于 2012-07-17T19:16:01.103 に答える