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

单击“DG”链接将显示：

Elderberry
Grapefruit
Grapes

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

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

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

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

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

我已经开始为此构建算法，但它变得如此混乱，我重新开始。我不知道如何在 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。

提前致谢！

4

5 回答 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 ) {

如果你需要。

于 2009-09-02T16:00:01.390 回答
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";
于 2009-09-02T15:53:35.303 回答
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
于 2009-09-02T15:33:01.320 回答
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.
于 2009-09-02T20:02:52.803 回答
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";
于 2009-09-02T16:48:56.237 回答