logo标签列表

我该如何在Perl中从一系列单词的首字母生成一组范围？

perlalgorithmrange
4

我不确定如何准确地解释这个问题，因此我将从一个例子开始。

给定以下数据：

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中的字母开头。
我已经开始构建这个算法，但它变得非常混乱，我只能重新开始。我不知道如何在Google上搜索这个 - 我不确定这个方法叫什么名字。
以下是我开始使用的内容：
#!/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。

提前感谢！

my %index_frequency 会更好。这样你就不必写 if($index_frequency.... 了。 - Brad Gilbert
请再看一下我的解决方案，因为我添加了另一种方法，我认为更适合您的需求。 - JSBձոգչ
5个回答
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 ) {

如果您需要的话，请。
不错 - 我提到过，无论是 A..Z 还是 keys %frequencies 都可以。我运行了这个程序，它似乎正好符合我的需求 - 代码也很干净。看起来很棒！非常感谢！ - BrianH
是的 - 这很棒，而且非常简单 - 非常感谢！我的下一步将是自动计算$PAGE_SIZE。我考虑从文件中取出总数再除以26，但这可能会非常不平衡。我还在考虑对频率值进行平均处理。我会试试看。再次感谢你 - 这真的很棒！ - BrianH
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";
所以这个的输出是：1：E K M N S2：A B G R3：C4：P我认为这是一个不错的开始，但我仍然需要找到一种将它们组合在一起（按字母顺序）的方法。需要再考虑一下 - 谢谢！ - BrianH
更新了我的解决方案，因为我意识到我误解了要求。 - JSBձոգչ
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
我有类似的东西，是的。但我的代码开始变得混乱了，因为一个范围可能只包含一个字母。我将尝试以你的代码为基础，看看我能做出什么。谢谢！ - BrianH
对于我的示例数据，A 应该单独在一个范围内。使用您的代码，需要另一个变量来知道前一个字母。因此，A（2）不大于阈值。但是 A（2）+ B（2）大于阈值，所以我希望 A 单独在其范围内，然后继续下一个。我又回到了一堆混乱的代码... - BrianH
你说得对，这个输出结果与样例不符。但是为什么A应该单独成一段呢？我认为每个范围至少应该包含3个元素吧？你是想说“每个范围至少应该包含3个元素，但如果将它们与下一个元素组合超过阈值，则允许单个元素范围”吗？ - redtuna
当我们谈论像2和3这样的小数字时，那很好。但是如果阈值为300，A有299，B有600，我不想将A和B合并... - BrianH
好的。添加每个范围的最大条目数（threshold_high）应该允许漂亮的范围。新规则是：如果计数<threshold_min，则进行分组，除非这样做会使您超过threshold_max。 - redtuna
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.
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";
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接