#!/usr/bin/perl
use 5.011 ; use strict ; use warnings ;
use List::Util qw[ max min ] ;
use Getopt::Std ; getopts "12g:qs=" , \my%o ;
use Term::ANSIColor qw[ :constants ] ; $Term::ANSIColor::AUTORESET = 1 ;
use FindBin qw [ $Script ] ;
my %str2cnt ; # 各文字列から出現回数を参照 ; その文字列が何回出現したか
my %cnt2strs ; # @{ $cnt2strs { N } } が出現回数Nの文字列のリスト(配列)
if ( $o{'='} ) {
my $header = <> ;
$. = 0 ;
}
$o{g} //= 3 ; # 詳細情報のexamplesに出力するデータの個数
sub main ( ) ;
sub readingAndCount ( ) ; # 各文字列ごとに出現回数をカウント
sub tableOutput ( ) ; # それ以外の場合の処理:詳細情報作成
main ;
exit -1 ;
sub main ( ) {
readingAndCount ;
tableOutput if ! $o{1} ;
exit simpleAllUniq ( ! grep { $_ != 1 } values %str2cnt ) ; # -1 が指定されたら簡単に結果を出力して終了。
}
sub readingAndCount ( ) {
while( <> ){
chomp ;
$str2cnt {$_} ++ ;
}
}
# 全てが異なる場合の処置
sub simpleAllUniq ( $ ) {
if ( $_[0] ) {
print 1 , "\n" if $o{1} ; # <-- alluniq と聞かれて、Yes だから、ブール値の1 を出力。
return 0 if $o{q} ;
print STDERR YELLOW "All ". (scalar keys %str2cnt ) . " counted lines are " , BRIGHT_RED "different" , YELLOW ". ($Script) \n" ;
return 0 ;
}
else {
print 0 , "\n" if $o{1} ; # <-- alluniq と聞かれて、No だから、ブール値の0 を出力。
return 1 if $o{q} ;
print STDERR # {$o{q} ? \* STDOUT : \*STDERR }
YELLOW "Some counted lines are " , BRIGHT_RED "same. " ,
YELLOW , "Different " , CYAN (scalar keys %str2cnt) , YELLOW " / All " , CYAN $. . "; " ,
YELLOW , "Maximum multiplication : " , CYAN max( values %str2cnt ) ,
" ($Script)\n" ;
return 1 ;
}
}
sub tableOutput( ) {
## 2. 度数nの異なる文字列が、具体的にどんな値であったか。
while ( my( $str, $cnt) = each %str2cnt ) {
push @{ $cnt2strs {$cnt} }, $str ;
}
my $msep = $o{2} ? "\n" : "\t" ;
print $o{2} ? "mult\tfreq\n" : "mult\tfreq\texamples\n" ;
for my $count ( sort { $a <=> $b } keys %cnt2strs ) {
print "$count\t", scalar @{ $cnt2strs {$count} }, $msep ;
next if $o{2} ; # -2 指定の場合は、該当文字列の例を出力しない。
my @L = @{ $cnt2strs { $count } } ;
@L = sort @L if $o{s} ;
my @L2 = splice @L, 0, $o{g} ;
my @L3 = splice @L, - min $o{g}, scalar @L if $o{s} ;
print @L3 ? join "\n\t\t" , @L2 , @L3 : join "\n\t\t" , @L2 ; # @L2, @L3 の間に ".."がこのコードにあったのを消去
print "\n" ;
}
}
## ヘルプの扱い
sub VERSION_MESSAGE {}
sub HELP_MESSAGE{
use FindBin qw [ $Script ] ;
$ARGV[1] //= '' ;
open my $FH , '<' , $0 ;
while(<$FH>){
s/\$0/$Script/g ;
print $_ if $ARGV[1] eq 'opt' ? m/^\ +\-/ : s/^=head1// .. s/^=cut// ;
}
close $FH ;
exit 0 ;
}
=encoding utf8
=head1
$0
入力の各行が全て異なるか、もしくは、どのような重なり方をするかの判定をする。
コマンド $0 の戻り値は、前者の場合0、後者の場合1となる。
重なり方の様子について、$0 は標準出力に出力をする。
オプション :
-1 ; 全ての対象行が異なるかどうかだけを 1 または 0 で出力。コマンドの返値 $? はそれぞれ0,1 。
-2 : 重複の様子を、度数とそのまた出現回数の2列で出力。( only 2 columns output )
-g num : 各 ”度数” ごとの文字列の例の最大個数を指定。未指定の場合は 3
-q : 標準エラー出力への二次情報の出力をしない。( quick の q )
-s : 各 ”度数” ごとの該当文字列リストをソートして、最初と最後の g 個を出力。
-= : 入力の最初の行を処理対象としない。
$0の動作テストの方法 :
seq 10 | $0 ;
( seq 5 ; seq 3 ; seq 2 ) | $0 ;
# ここから下は古いバージョンを説明している。現状を反映していない。
コマンド$0の動作モードとその出力 :
1. 入力の各行が全て異なる場合 ⇒ 戻り値は0。標準出力に1。標準エラー出力に「全て異なる」bと出力。
2. 入力の各行の文字列がどこかで同じものがある場合
2-1. -q が指定された場合 ⇒ 戻り値1。数個の要約値のみ出力。
2-2. -q を指定しない場合
2-2-1. -0 が指定された場合 ⇒ 戻り値1。標準出力は "度数" の分布。
2-2-2. -0 を指定しない場合
2-2-2-1. -s を指定しない場合 ⇒ 戻り値1。各度数の該当文字列を適当に抽出。
2-2-2-2. -s が指定された場合 ⇒ 戻り値1。各度数の具体的な値の範囲も分かる。
=cut