dune
FZH01****@nifty*****
2005年 5月 8日 (日) 02:52:34 JST
極悪です。
mgsm.pl で複数のファイルをマージできるようにしました。
perl mgsm.pl 文献１ 文献２ 文献３ ... というふうに morogram の出力ファ
イル名を与えると、
「頻度の合計，文字列，文字数，<各文献での出現頻度>, 出現頻度の分散」の
順に出力します。utf8 入出力専用です。
D:$ perl mgsm.pl mg_manyo.txt mg_kokin.txt mg_genji.txt mg_sarasina.txt
4 あきかぜのふきにしに 10 <2 2 0 0> 1.000
2 あさつゆにぬれてのの 10 <1 1 0 0> 0.250
5 あしひきのやまたちば 10 <4 1 0 0> 2.688
3 あしひきのやまべにい 10 <2 1 0 0> 0.688
5 あたらしきねんのはじ 10 <4 1 0 0> 2.688
2 あなかまにんにきかす 10 <0 0 1 1> 0.250
3 あはれにかなしきこと 10 <0 0 1 2> 0.688
2 あはれにくちおしくお 10 <0 0 1 1> 0.250
4 あはれにこころぼそく 10 <0 0 3 1> 1.500
2 あまのあさなゆうなに 10 <1 1 0 0> 0.250
3 あれやくんがきまさぬ 10 <2 1 0 0> 0.688
2 いくみずのおとにはた 10 <1 1 0 0> 0.250
2 いさむらいところにも 10 <0 0 1 1> 0.250
2 いせのあまのあさなゆ 10 <1 1 0 0> 0.250
2 いでばじんちりぬべみ 10 <1 1 0 0> 0.250
2 いのまつてきはなのし 10 <1 1 0 0> 0.250
2 いまはなににつけてか 10 <0 0 1 1> 0.250
2 いみじきことにおもい 10 <0 0 1 1> 0.250
2 いみじくおぼしたちて 10 <0 0 1 1> 0.250
2 うがつじゅうさんにち 10 <1 0 0 1> 0.250
2 うきよのなかをおもひ 10 <0 1 1 0> 0.250
3 うけたまはらまほしき 10 <0 0 2 1> 0.688
2 うさればころもてさむ 10 <1 1 0 0> 0.250
10 うたつぶどのしょうに 10 <0 0 9 1> 14.250
2 うみにつりするあまの 10 <1 1 0 0> 0.250
2 うめのはなおりてかざ 10 <1 1 0 0> 0.250
3 うめのはなそれともみ 10 <2 1 0 0> 0.688
2 うもあるかなとこころ 10 <0 0 1 1> 0.250
2 うらなみたたぬにちは 10 <1 1 0 0> 0.250
2 おきつしらなみたつた 10 <1 1 0 0> 0.250
2 おぐらのやまになくし 10 <1 1 0 0> 0.250
2 おしきものにぞありけ 10 <0 1 1 0> 0.250
2 おそろしとおもへるけ 10 <0 0 1 1> 0.250
3 おなじこころなるにん 10 <0 0 2 1> 0.688
2 おびにせるほそやかわ 10 <1 1 0 0> 0.250
2 おぼつかなくのみおぼ 10 <0 0 1 1> 0.250
2 おもはぬにんをおもふ 10 <0 1 1 0> 0.250
4 おもふさまにかしづき 10 <0 0 3 1> 1.500
2 おもふよりほかのこと 10 <0 0 1 1> 0.250
2 おもへばあしひきのや 10 <1 1 0 0> 0.250
〜以下省略〜
--^mgsm.pl ここから
#!/usr/local/bin/perl
use strict;
#use Encode qw(from_to);
#use Time::HiRes qw/time/;
#my $time = time;
#END{ printf STDERR "time-cost: %.1lf s\n",time - $time }
sub new{
my $self = {};
$self->{file} = shift or return undef;
open($self->{fh},$self->{file}) or return undef;
bless $self;
$self->next();
return $self;
}
sub next{
my $self = shift or die qq/internal error/;
my $fh = $self->{fh} or return $self;
local $_ = <$fh>;
if(m/^(\d+)\t(.+)\t(\d+)\n/){
$self->{freq} = $1;
$self->{str} = $2;
$self->{gram} = $3;
}else{
$self->{freq} = 0;
$self->{str} = "";
$self->{gram} = 0;
close $self->{fh};
$self->{fh} = undef;
}
return $self;
}
my @file = @ARGV;
if(@file < 2){
die qq/usage: $0 file1 file2 [..fileN]\n/;
}
my @ngram = ();
foreach my $file (@file){
my $ngram = new($file) or die qq/$file:$!\n/;
push(@ngram,$ngram);
}
my($ngram1, ＠ ngram2) = @ngram;
while(@ngram2){
my $freq = $ngram1->{freq};
my $str = $ngram1->{str};
my $gram = $ngram1->{gram};
foreach my $ngram (@ngram2){
my $g = $ngram->{gram};
my $s = $ngram->{str};
my $f = $ngram->{freq};
if(0 < ($gram == $g ? $str cmp $s : $g <=> $gram)){
$freq = $f;
$str = $s;
$gram = $g;
}
}
my @freq = ();
my $total = 0;
foreach my $ngram (@ngram){
if($ngram->{str} eq $str){
push(@freq,$ngram->{freq});
$total += $ngram->{freq};
$ngram->next();
}else{
push(@freq,0);
}
}
if($total == $freq){
($ngram1, ＠ ngram2) = grep($_->{fh}, ＠ ngram);
@ngram2 ? next : last;
}
my $var = 0;
foreach my $freq (@freq){
$var += $freq * $freq;
}
$var = ($var - $total * $total / @freq) / @freq;
# from_to($str,"utf8" => "sjis");
printf "%d\t%s\t%d\t<%s>\t%.3lf\n",
$total,$str,$gram,join(" ", ＠ freq),$var;
}
__END__
--$ ここまで
--
極悪, mailto:FZH01****@nifty*****