我不确定如何解释这一点，所以我将从一个例子开始。
鉴于以下数据：
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。
提前致谢！
答案 0 :(得分：6)
基本方法：
#!/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 ) {
如果你需要。
答案 1 :(得分：2)
这是我的建议：
# get the number of instances of each letter
my %count = ();
while (<FILE>)
{
$count{ uc( substr( $_, 0, 1 ) ) }++;
}
# transform the list of counts into a map of count => letters
my %freq = ();
while (my ($letter, $count) = each %count)
{
push @{ $freq{ $count } }, $letter;
}
# now print out the list of letters for each count (or do other appropriate
# output)
foreach (sort keys %freq)
{
my @sorted_letters = sort @{ $freq{$_} };
print "$_: @sorted_letters\n";
}
更新：我认为我误解了您的要求。以下代码块更像您想要的内容。
my %count = ();
while (<FILE>)
{
$count{ uc( substr( $_, 0, 1 ) ) }++;
}
# get the maximum frequency
my $max_freq = (sort values %count)[-1];
my $curr_set_count = 0;
my @curr_set = ();
foreach ('A' .. 'Z') {
push @curr_set, $_;
$curr_set_count += $count{$_};
if ($curr_set_count >= $max_freq) {
# print out the range of the current set, then clear the set
if (@curr_set > 1)
print "$curr_set[0] - $curr_set[-1]\n";
else
print "$_\n";
@curr_set = ();
$curr_set_count = 0;
}
}
# print any trailing letters from the end of the alphabet
if (@curr_set > 1)
print "$curr_set[0] - $curr_set[-1]\n";
else
print "$_\n";
答案 2 :(得分：1)
尝试类似的方法，其中frequency是您在上一步计算的频率数组，threshold_low是范围内的最小条目数，threshold_high是最大值。数。这应该会产生和谐的结果。
count=0
threshold_low=3
threshold_high=6
inrange=false
frequency['Z'+1]=threshold_high+1
for letter in range('A' to 'Z'):
count += frequency[letter];
if (count>=threshold_low or count+frequency[letter+1]>threshold_high):
if (inrange): print rangeStart+'-'
print letter+' '
inrange=false
count=0
else:
if (not inrange) rangeStart=letter
inrange=true
答案 3 :(得分：1)
use strict;
use warnings;
use List::Util qw(sum);
my @letters = ('A' .. 'Z');
my @raw_data = qw(
Apple Apricot Blackberry Blueberry Cherry Crabapple Cranberry
Elderberry Grapefruit Grapes Kiwi Mulberry Nectarine
Pawpaw Peach Pear Plum Raspberry Rhubarb Strawberry
);
# Store the data by starting letter.
my %data;
push @{$data{ substr $_, 0, 1 }}, $_ for @raw_data;
# Set max page size dynamically, based on the average
# letter-group size (in this case, a multiple of it).
my $MAX_SIZE = sum(map { scalar @$_ } values %data) / keys %data;
$MAX_SIZE = int(1.5 * $MAX_SIZE + .5);
# Organize the data into pages. Each page is an array reference,
# with the first element being the letter range.
my @pages = (['']);
for my $letter (@letters){
my @d = exists $data{$letter} ? @{$data{$letter}} : ();
if (@{$pages[-1]} - 1 < $MAX_SIZE or @d == 0){
push @{$pages[-1]}, @d;
$pages[-1][0] .= $letter;
}
else {
push @pages, [ $letter, @d ];
}
}
$_->[0] =~ s/^(.).*(.)$/$1-$2/ for @pages; # Convert letters to range.
答案 4 :(得分：0)
这是我如何编写这个程序的一个例子。
#! /opt/perl/bin/perl
use strict;
use warnings;
my %frequency;
{
use autodie;
open my $data_file, '<', 'datafile';
while( my $line = <$data_file> ){
my $first_letter = uc( substr( $line, 0, 1 ) );
$frequency{$first_letter} ++
}
# $data_file is automatically closed here
}
#use Util::Any qw'sum';
use List::Util qw'sum';
# This is just an example of how to calculate a threshold
my $mean = sum( values %frequency ) / scalar values %frequency;
my $threshold = $mean * 2;
my @index;
my @group;
for my $letter ( sort keys %frequency ){
my $frequency = $frequency{$letter};
if( $frequency >= $threshold ){
if( @group ){
if( @group == 1 ){
push @index, @group;
}else{
# push @index, [@group]; # copy @group
push @index, "$group[0]-$group[-1]";
}
@group = ();
}
push @index, $letter;
}elsif( sum( @frequency{@group,$letter} ) >= $threshold ){
if( @group == 1 ){
push @index, @group;
}else{
#push @index, [@group];
push @index, "$group[0]-$group[-1]"
}
@group = ($letter);
}else{
push @group, $letter;
}
}
#push @index, [@group] if @group;
push @index, "$group[0]-$group[-1]" if @group;
print join( ', ', @index ), "\n";