#!/usr/bin/perl

# このプログラムの作成者 : 下野寿之 bin4tsv@gmail.com

use 5.030 ; 
use warnings ; 
use Getopt::Std ;
use Getopt::Long qw [ GetOptions ] ; # GetOptionsFromArray ] ;
Getopt::Long::Configure qw [ bundling ] ; #  1文字のオプションに対して有効。ずらずらつなげられる。
Getopt::Long::Configure qw [ no_ignore_case ] ; # 大文字と小文字を区別する。
Getopt::Long::Configure qw [ pass_through ] ; # 拾わなかった @ARGV の引数を残してくれるっぽい。posix_defaultの後で書くこと(!)。
use Scalar::Util qw/looks_like_number/ ; # 5.7.3から
use Term::ANSIColor qw/:constants color/ ;  $Term::ANSIColor::AUTORESET = 1 ;
use Time::HiRes qw/sleep usleep gettimeofday tv_interval/ ; # 5.7.3から
use List::Util qw[ max first sum0 uniq ] ; 
use Encode qw [ decode_utf8 ] ;

GetOptions 'e=s' => \my@e ; # -e で指定されたパターンを何個でも拾う。
getopts '.1$:=g:q:u:w:L:R:S', \my%o ;  
my @e2 = map { qr/$_/x }  @e ;  # あらかじめ正規表現として先にコンパイルすることで高速化。

#$SIG{INT} = sub { & info ; exit 130 } ;
$o{g} //= 1 ;
my $strime0 = [ gettimeofday ] ;
my $optu0 = ($o{u}//'') eq 0 ; 
my $optq0 = ($o{q}//'') eq 0 ;
my $optw0 = ($o{w}//'') eq 0 ; 
my $oL2 = ($o{L}//'') eq 2 ; # $optL2 は長すぎるので、ちょっと特例的に短くしてみた
my $oL4 = ($o{L}//'') eq 4 ; 
@e = map { decode_utf8 $_ } @e unless $optu0 ; 

$o{'$'} //= '$' ;  # 文字の終端を表す記号
#$o{p} //= '' ;  # 文字を切り分けるパターン。正規表現
binmode STDOUT, 'utf8' unless $optu0 ;

sub main () ; 
* main = $oL2 || $oL4 ? * bylen : * normal ; # <-- mainの定義はここである。
& main ; 
exit 0 ;

##
## 長さ毎に数えるモード :  (入力の具体的な値を見るため)
## 

sub bylen ( ) { 
  my $header = <> if $o{'='} ; 
  my %freq ; # 同じ行が来たかどうかの判定に使う。数が集計される。
  my %M ; # 文字列長さごとの文字列最小値と文字列最大値を格納する。
  my %Lfrq ; # 文字列長ごとの頻度
  while ( <> ) {
    chomp ;
    s/\r$// unless $optw0 ;    
    $_ = decode_utf8 $_ unless $optu0 ;
    next if $freq{$_} ++ && $o{1} ; # && の前後の順序に注意
    my $len = length $_ ; 
    $Lfrq{$len} ++ ;
    $M{$len}[0] = $_ if ! defined $M{$len}[0] || $M{$len}[0] gt $_ ; 
    $M{$len}[1] = $_ if ! defined $M{$len}[1] || $M{$len}[1] lt $_ ;     
    next unless $oL4 ; 
    $M{$len}[2] = $_ if ! defined $M{$len}[2] ; 
    $M{$len}[3] = $_ ;

  }
  #for(keys %freq){ say "$_, $freq{$_}"} ; exit 0 ;
  print join ( "\t", map {UNDERLINE $_} qw[length freq minstr maxstr] , $oL4 ? qw[first_str last_str ]:() ) , "\n" ;
  for ( sort { $a <=> $b } keys %M ) {  # 数値 (文字列の長さを表す)でソート 
    my @str = @{ $M{$_} } ;
    my @prt = $optq0 ? @str : map { defined $_ ? qq['$_'] : undef } @str ;
    $prt[1] = DARK '<-- same' if $str[1] eq $str[0] ; 
    #$str[2] = '' ; #if defined $str[2] and $str[2] eq $str[0] || $str[2] eq $str[1]; 
    $prt[3] = DARK '<-- same' if $oL4 and defined $str[3] and $str[3] eq $str[2] ; #|| $str[3] eq $str[1]; 

    for my $p ($oL4? 0..3 : 0..1 )  { 
      $prt[$p] = $prt[$p] . DARK "(" . $freq{ $str[$p] } . ")" if $freq{ $str[$p] } != $Lfrq{$_} ;
    }
    print join ( "\t" , $_ , $Lfrq{$_}, @prt ) , "\n" ;
  }
}

##
## 普通のモードと(-.の場合に)さらにに詳しく分析する機能
##

#sub uniq (@) {my %h;map { $h{$_}++ == 0 ? $_ : () } @_ } # List::MoreUtils から
sub majority2 ( @ ) { # いろんな値がやってくる。最も頻繁な頻度を持つ値の中から、(ランダムに) 1個返す。
  my %h ; # ヒストグラム
  for ( @_ ) { 
    $h { $_ } += 1 ;  # <<-- --
  }
  my $m = max values %h ; 
  $m ++ if $m == 1;  # <-- - 必要なのか、そうで無いのか、よく分からない。
  return first { $h {$_} == $m } keys %h
} # リストから最も成分の多いものをさらにひとつだけ選ぶ.

sub normal ( ) { 

  my %freq ; # 同じ行が来たかどうかの判定に使う。数が集計される。
  my %S1 ; # $S1{$cp}{$pos} のように使う。 出現回数の集計表
  my %S2 ; # $S2{ "$cp-$pos" } = "行番号+行番号+...行番号+" 
  my %S3 ; # @ { $S3{ FREQ } } によって、頻度FREQ回現れるような あらゆる $cp のそれぞれについて、どの行番号集合 だったかを 、貯める。
  my %P2 ; # $P2{$c-$p}が真ならピリオドを付ける
  my %G1  ; # @{ $G { $cp } { $pos } } で 行の具体例を格納。 
  my %G2  ; # @{ $G { $cp } { $pos } } で 行の具体例を格納。 最後の行の方の例を示す。
  my $maxlen = 0 ; # 文字列の最大長
  my $header = <> if $o{'='} ; 
  #my $patSplit = @e ? '(' . (join '|' , @e, '.') . ')' :  '' ; # split で割るためのパターンの設定。
  my $patSplit = @e ? do{ '(' . (join '|' , @e2, '.') . ')' } :  qr//o ; # split で割るためのパターンの設定。

  while ( <> ) { 
    #chomp ; # \n にマッチさせる可能性があるため。しかし、^ にマッチさせて集計したいときどうしたら良いだろうか?
    next if $freq{$_} ++ && $o{1} ; # && の前後の順序に注意
    s/\r$// unless $optw0 ;    
    $_ = decode_utf8 $_ unless $optu0 ;
    #my @chars = grep { $_ ne '' } split /$patSplit/ox , $_ , -1 ; # <-- - 区切る
    my @chars = grep { $_ ne '' } split qr/$patSplit/o , $_ , -1 ; # <-- - 区切る
    for my $pos ( 0 .. $#chars ) {
      my $char = $chars [ $pos ] ; # 実際の文字(列)。  (パターンにはまだ分類していない。)
      my $cp  ; # どのパターンまたは文字として認識するか。(分類されたパターンなのである。)
      #$char =~ /$_/ and $cp = $_ and last for @e ; # ++位置重要。 <-- - 時間が掛かるかも。
      $char =~ $e2[$_] and $cp = $e[$_] and last for 0..$#e ; # ++位置重要。 <-- - 時間が掛かるかも。
      $cp //= "'$chars[$pos]'" ; # 前行の処理で当てはまらない場合。クォーテーションを付加するようにした。    # chars を縮めてcp
      $S1 { $cp } { $pos } ++ ; 
      $S2 { "$cp-$pos" } .= "$.+" if $o{'.'} ; # <-- $S2{..}で、その「文字」がその桁で現れた、「行番号集合」L が結果的に生成される。
      do { my $t = \$G1{$cp}{$pos} ; push @{$$t},$_ ; pop   @{$$t} if @{$$t} > $o{g} }  if $o{g}  ; # 改行文字はここでは除去せず
      do { my $t = \$G2{$cp}{$pos} ; push @{$$t},$_ ; shift @{$$t} if @{$$t} > $o{g} }  if $o{g}  ; # 改行文字はここでは除去せず
    }
    $S1{ $o{'$'} } { scalar @chars } ++ ; # 文字列終端記号の足し合わせ
    $maxlen = @chars if $maxlen < @chars ; # 最大長の保管
    $S2{ $o{'$'} . '-' . scalar @chars } .= "$.+" if $o{'.'} ; # 文字列終端記号の足し合わせ
    do { my $t = \$G1{$o{'$'}}{@chars} ; push @{$$t},$_ ; pop   @{$$t} if @{$$t} > $o{g} }  if $o{g}  ; # 改行文字はここでは除去せず
    do { my $t = \$G2{$o{'$'}}{@chars} ; push @{$$t},$_ ; shift @{$$t} if @{$$t} > $o{g} }  if $o{g}  ; # 改行文字はここでは除去せず
  } # ← 入力読み取り処理の終わり
  if ( $o{'.'} ) {  ## 複雑な処理である↓ # $S1{ .. }　で その「文字」が「各桁」で、何回 (b回) 現れたのか。... # この  ; 「b回」現れた L を S3に保管。
    for my $cp ( keys %S1 ){ # ここの $cp は 文字と言うよりパターンを示す。'a'とか [1-3]とか。ここでは「文字」と呼ぶ。
      push @{  $S3 { $S1{$cp}{$_} }  }, $S2{"$cp-$_"} for keys %{ $S1{$cp} } ; 
    } 
    for( keys %S3 ){ # 各「文字」が各桁で何回現れたか(頻度) の 数 それぞれに対して
      my $mostFreq = majority2 @{ $S3{$_} }  ; # 行番号集合L を考えて、そういうLで最も頻度の高いものを取り出す。
      $P2{ $mostFreq } = 1 if defined $mostFreq ;
    }  
  }
  # 出力
  say join "\t" , map { UNDERLINE YELLOW $_ } 0 .. $maxlen , 'char' , 'code' , 'freq' , $o{g} ? 'example' :() ; # 行頭の出力
  my %om ; $om{$o{'$'}}=1 ; $om{$_}=2 for @e ; # omit する
  my @cps ; 
  push @cps , @e ; 
  push @cps , sort {length $a <=> length $b or $a cmp $b } grep { ! $om { $_ } } keys %S1 ; 
  push @cps , $o{'$'} ; 
  my $take = sub ($$) { return splice @{$_[1]} , 0, $_[0] } ; 
  for my $cp ( @cps ){ # <-- ソート順には注意したい
    my @out = map { $S1{$cp}{$_} // 0 } 0 .. $maxlen ; 
    #my $fst = first { $out[$_] } $o{g}=~/\.$/o ? reverse 0..$#out : 0..$#out ; 
    my @pex = grep { $out[$_] } $o{g}=~/\.$/o ? reverse 0..$#out : 0..$#out ; 
    my @example = map{s/\n$//r } uniq $take->($o{g},[uniq map{@{$G1{$cp}{$_}}}@pex]),$take->($o{g},[uniq map{@{$G2{$cp}{$_}}}@pex])  ;
    my $subtotal = sum0 @out ;  # その文字の出現回数
    do { @out = map{ $P2{$S2{"$cp-$_"}//''} && $out[$_] ? "$out[$_]." : $out[$_] } 0 .. $#out  } ; # 数字の後ろにピリオド付加
    do { my $c = substr $cp,1,1 ; push @out, $cp eq $o{'$'} ? 'end' : $om{$cp} ? '---' : sprintf 'U+%02X', ord $c } ; # コード
    #my @example = map { $_ =~ s/\n$//r } uniq @{$G1{$cp}{$fst}} , @{$G2{$cp}{$fst}}  ; 
    $cp = '"\n"' if $cp eq "'\n'" ;  # 改行記号
    $cp = '"\r"' if $cp eq "'\r'" ;  # 改行記号    
    $cp =~ s/(^\')|(\'$)//g if $optq0 ; # シングルクォーテーションによる囲みを外す
    splice @out , @out -1, 0, YELLOW BOLD $cp ; # 最後から2番目に挿入。
    push @out , YELLOW $subtotal ; 
    #push @out , do{ my $t = \$G{$cp}{$fst} ;($$t->[0]//'1' )=~ s/\n//r }//'' ;
    #push @out , eval{ my $t = \$G{$cp}{$fst} ; my @ary = @{$$t} ; $ary[@ary -1] =~ s/\n//r }  ;
    #push @out , eval{ my $t = \$G{$cp}{$fst} ; join "|" , map { $_ =~ s/\n$//r } @{$$t} }  ;
    push @out, join '|', @example ;
    say join "\t" , @out ;
  }
}

## ヘルプの扱い
sub VERSION_MESSAGE { } # --version でこの関数が使われる。
sub HELP_MESSAGE {
    use FindBin qw[ $Script ] ; 
    $ARGV[1] //= '' ;
    open my $FH , '<' , $0 ;
    while(<$FH>){
        s/\$0/$Script/g ;
        print $_ if s/^=head1// .. s/^=cut// and $ARGV[1] =~ /^o(p(t(i(o(ns?)?)?)?)?)?$/i ? m/^\s+\-/ : 1;
    }
    close $FH ;
    $o{v} = 0 ;
    exit 0 ;
}
=encoding utf8 

=begin JapaneseManual 

=head1

digitdist 

    入力の各行に対して，先頭から(0始まり) n 桁目にどんな文字が現れたかをクロス集計する。
    -L が指定されると、文字列長ごとの、文字列の最小値と最大値が出力される。

 想定されている使い方 : 
    1. 何も分からない文字列集合について、具体的な値の様子を確かめる最初の1歩である。
    2. ルールを発見する。極めて少数の例から、データの値の破損やテスト値を見つける。
    3. 特異な値について、更に深く調べる対象とする。

オプション : 
   --help  : このオンラインヘルプを表示する。

  入力の扱い方 : 
   -=     : 先頭行(1行目)を読み飛ばす
   -1     : データで全く同じ行が2回以上来たら、読み飛ばす。(-L2と-L4と-.の指定時は適用されない。)
   -u 0   : バイナリで処理する(通常は UTF-8で処理をする)
   -w 0   ; 通常は、Windows形式の改行文字が来たらUNIX形式の改行文字に変換しているが、その動作を解除する。

  動作モードの変更 : 
   -L2    ; 文字列長毎に、文字列の最小値と最大値を取り出す。両者が一致する場合は、後者を空文字列にする。
   -L4    ; 文字列長毎に、文字列の最小値と最大値の他に、最初に現れたもの、最後に現れたものも表示する。

  実質的な処理に与えるオプション : 
   -.     : 出力表の値で "同じ数." と表示された値は、同じ入力の(改行文字で区切られた)文字列に由来することを表す。
   -e STR : このオプションは何回も指定できる。STRは正規表現であり、最初のパターンにマッチするものを計数対象にする。

  出力へ影響するオプション : 
   -g N   : (実験的) N個のそれぞれ最初と最後の出現例を出す(重複は省かれる)。未指定だとN=1。各文字の最も左での出現での例(行全体)を出す。
   -g N.  : 数値にピリオドをつけると、該当する文字の、最も右での出現の例で示す。
   -g 0   : 例を表示しない。計算が軽くなることが期待できる。
   -q 0   : 出力で文字をシングルクォーテーションで囲まない。# 廃止 --> (-L2と-L4指定時に適用。)   
   -$ str : 文字列の終端をドルマーク($)として示すが、それを str に変更する。

開発上のメモ : 
    * 出力する各行のソート順は指定できるようにした方が便利そう。
    * -Lの場合に、-g N の指定により、最小値N個、最大値N個を取り出せるようにしても良いかも。
    * -Lの場合に出力する出現文字列について、出現頻度も出力出来る様にしたい。
    * メモリを無駄に消費してないか、考えたい。%S1とか%S2とか%S3とか%Gとか。
    * 行の終端記号が、二重に被るリスクあり。
    * -e で指定したパターンに該当する文字列についても、そのうち代表例(最初の出現の1文字目など)に対して、文字コードを出力するようにしたい。

=end JapaneseManual

=cut
