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 には独自のリンクがあるだけです。データの 2 番目の文字で分割する必要はありません。 .

私のデータセットはあまり頻繁に変更されないので、静的な「範囲ごとの最大値」で問題ありませんが、それも動的に計算するとよいでしょう。また、データセットは数字で始まることはありません - AZ からの文字で始まることが保証されています。

このためのアルゴリズムの構築を開始しましたが、非常に面倒になり、最初からやり直しています。これをグーグルで検索する方法がわかりません-このメソッドが何と呼ばれているかわかりません。

これが私が始めたものです：

#!/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

Here's my suggestion:

# 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";
}

Update: I think that I misunderstood your requirements. The following code block does something more like what you want.

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 に答える