perl - 如何从 Perl 中的单词列表的首字母生成一组范围？

Question

我不确定如何解释这一点，所以我将从一个例子开始。

给定以下数据:

Apple
Apricot
Blackberry
Blueberry
Cherry
Crabapple
Cranberry
Elderberry
Grapefruit
Grapes
Kiwi
Mulberry
Nectarine
Pawpaw
Peach
Pear
Plum
Raspberry
Rhubarb
Strawberry

我想根据数据的首字母生成索引，但我希望将这些字母组合在一起。

这是上述数据集中第一个字母出现的频率:

   2 A
   2 B
   3 C
   1 E
   2 G
   1 K
   1 M
   1 N
   4 P
   2 R
   1 S

由于我的示例数据集很小，所以假设将字母组合在一起的最大数量是 3。使用上面的数据，这就是我的索引结果:

A B C D-G H-O P Q-Z

点击“D-G”链接会显示:

Elderberry
Grapefruit
Grapes

在我上面的范围列表中，我涵盖了完整的字母表——我想这不是完全必要的——我也可以接受这个输出:

A B C E-G K-N P R-S

显然我的数据集不是水果，我会有更多的数据(大约 1000-2000 项)，我的“每个范围的最大值”将超过 3。

我也不太担心不平衡的数据 - 所以如果我 40% 的数据以“S”开头，那么 S 将只有自己的链接 - 我不需要通过第二个字母来分解它在数据中。

由于我的数据集不会经常更改，所以我可以使用静态的“每个范围的最大值”，但也可以动态计算它会很好。此外，数据集不会以数字开头 - 它保证以 A-Z 中的字母开头。

我已经开始为此构建算法，但它变得越来越困惑，我需要重新开始。我不知道如何在谷歌上搜索这个 - 我不确定这个方法叫什么。

这是我的开头:

#!/usr/bin/perl

use strict;
use warnings;

my $index_frequency = { map { ( $_, 0 ) } ( 'A' .. 'Z' ) };
my $ranges = {};

open( $DATASET, '<', 'mydata' ) || die "Cannot open data file: $!\n";

while ( my $item = <$DATASET> ) {
    chomp($item);
    my $first_letter = uc( substr( $item, 0, 1 ) );
    $index_frequency->{$first_letter}++;
}

foreach my $letter ( sort keys %{$index_frequency} ) {
    if ( $index_frequency->{$letter} ) {

        # build $ranges here
    }
}

我的问题是我一直在使用一堆全局变量来跟踪计数和检查过的先前字母 - 我的代码很快就会变得非常困惑。

有人能帮我朝正确的方向迈出一步吗？我想这更像是一个算法问题，所以如果您没有办法在 Perl 中执行此操作，伪代码也可以，我想 - 我可以将其转换为 Perl。

提前致谢!

Answer 1

基本方法:

#!/usr/bin/perl -w
use strict;
use autodie;

my $PAGE_SIZE = 3;
my %frequencies;

open my $fh, '<', 'data';
while ( my $l = <$fh> ) {
    next unless $l =~ m{\A([a-z])}i;
    $frequencies{ uc $1 }++;
}
close $fh;

my $current_sum = 0;
my @letters     = ();
my @pages       = ();

for my $letter ( "A" .. "Z" ) {
    my $letter_weigth = ( $frequencies{ $letter } || 0 );

    if ( $letter_weigth + $current_sum > $PAGE_SIZE ) {
        if ( $current_sum ) {
            my $title = $letters[ 0 ];
            $title .= '-' . $letters[ -1 ] if 1 < scalar @letters;
            push @pages, $title;
        }
        $current_sum = $letter_weigth;
        @letters     = ( $letter );
        next;
    }
    push @letters, $letter;
    $current_sum += $letter_weigth;
}
if ( $current_sum ) {
    my $title = $letters[ 0 ];
    $title .= '-' . $letters[ -1 ] if 1 < scalar @letters;
    push @pages, $title;
}

print "Pages : " . join( " , ", @pages ) . "\n";

问题在于它输出(从您的数据):

Pages : A , B , C-D , E-J , K-O , P , Q-Z

但我认为这实际上是个好方法 :) 而且您始终可以将 for 循环更改为:

for my $letter ( sort keys %frequencies ) {

如果你需要的话。