#!/usr/bin/perl 
use 5.014 ; use warnings ; 
use Time::HiRes qw [ gettimeofday tv_interval ] ;
my ${ dt_start } = [ gettimeofday ] ; 
use Encode qw[ decode_utf8 encode_utf8 ] ; 
use Getopt::Std ; getopts '=@:0:2:q:v:y:rL' , \my %o  ; 
use Term::ANSIColor qw[ color :constants ] ; $Term::ANSIColor::AUTORESET = 1 ;
use FindBin qw[ $Script ] ; 
use autodie qw [ open ] ;
use List::Util qw[ max ] ; 
use Scalar::Util qw [ dualvar ]  ; 

* d3 = exists $o{','} && $o{','} eq 0 ? sub{$_[0]} : sub { $_[0] =~ s/(?<=\d)(?=(\d\d\d)+($|\D))/,/gr } ;
my $time0 = time ; 
my $help = 0  ; # オンラインヘルプの文面の表示をしたか否か。
my $readLines = 0 ; # иЄ­гЃїеЏ–гЃЈгЃџиЎЊж•°
my $diffChars = 0 ; # е‡єеЉ›гЃ®иЎЊж•°
my $sec = $o{'@'} // 15 ; # дЅ•з§’гЃЉгЃЌгЃ«г‚ўгѓ©гѓјгѓ г‚’з™єз”џгЃ•гЃ›г‚‹гЃ‹

$o{0} //= '-' ; # иЎЊе€—зЉ¶гЃ®е‡єеЉ›гЃ§ еЂ¤гЃЊ 0 гЃ®е ґеђ€гЃ«е‡єеЉ›гЃ™г‚‹ж–‡е­—
$o{q} //= "'" ; # ж–‡е­—г‚’е›Іг‚Ђж–‡е­—
$o{y} //= 1   ; # гЃ“гЃ®ж•°г‚€г‚Ље°‘гЃЄгЃ„й »еє¦гЃ—гЃ‹гЃ©гЃ®иЎЊгЃ§г‚‚е‡єеЉ›гЃ—гЃЄгЃ‹гЃЈгЃџе ґеђ€гЃЇгЂЃе‡єеЉ›гЃ—гЃЄгЃ„гЂ‚
my $optV0 = ($o{v}//'') eq '0' ? 1 : 0 ;

$SIG{INT} = sub { exit } ;
$SIG{ALRM} = sub { 
  my $n = $.  =~ s/(?<=\d)(?=(\d\d\d)+($|\D))/,/gr ; # 3桁ごとに区切る。
  say STDERR GREEN "$n lines read ($Script). " , scalar localtime ; 
  alarm $sec 
} ; 
alarm $sec ;

if ( $o{L} ) { 
  my %frq ; # $frq{$c}[$.] で頻度を集計 
  while ( <> ) { 
    $readLines ++ ;
    chomp ; 
    $frq{$_}[$.] ++ for split // , decode_utf8 $_  , 0  ;
  }  
  my @chars = sort keys %frq ; 
  binmode STDOUT, ":utf8" ;
  say join "\t", map { $_= '\t' if $_ eq "\t" ; "$o{q}$_$o{q}"} @chars ; 
  for my $l ( 1 .. $.  ) { say join "\t" , ( map { $frq{$_}[$l] // $o{0} } @chars ) , ":$l" } ; 
  say join "\t", map { $_= '\t' if $_ eq "\t" ; "$o{q}$_$o{q}"} @chars ; 
  exit ; 
}

binmode STDOUT, ":utf8" ;
my %f2 ; # $f2{ $char } [ $times ] гЃЇгЂЃеђ„ж–‡е­— charг‚’дёЃеє¦timesеЂ‹жЊЃгЃ¤ж–‡е­—гЃЊгЂЃдЅ•иЎЊгЃ«е‡єзЏѕгЃ—гЃџгЃ‹г‚’ж јзґЌгЂ‚
my %fs ; # $f2{$c}[$t] の 数$t で現れた値を記録。
my %fm1 ; # $fm1{$c} で $c の出現の最大値を記録。dualvar である。すなわち、その時の最大値の時の、行文字列も格納。
my %fm2 ; # %fm1 とよく似ているが、最後の例を取り出す。 dualvar であることは同じ。
my ( %fm1c , %fm2c ) ; # гЃќгЃ®еЇѕеїњгЃ™г‚‹ж–‡е­—е€—гЃ®е‡єзЏѕе›ћж•°г‚’ж јзґЌгЃ™г‚‹гЂ‚
my $head = <> if $o{'='} ;
chomp $head if defined $head ;
$SIG{INT} = sub { & output ; exit } ;
& totalling () ; 
& output () ;
exit ; 

# 集計
sub totalling () { 
  while ( <> ) {
    $readLines ++ ;
    chomp ; 
    $_ = decode_utf8 $_ ;
    my @F = split // , $_ , 0 ; # 文字単位でばらばらにする。0 でなくて-1にすると、配列の最後が空文字列になる。
    #say join "+" , @F ; 
    my %f1 ; #  $f1{ $char } гЃ§гЃќгЃ®иЎЊгЃ«гЃќгЃ®ж–‡е­—гЃЊдЅ•е›ће‡єзЏѕгЃ—гЃџгЃ‹г‚’ж јзґЌгЂ‚
    if ( ! $o{r} ) { $f1 { $_ } ++ for @F } # 単純に集計
    else { 
      my %t ; # $t{$c}гЃЇ $cгЃЊйЂЈз¶љгЃ§жњЂй•·дЅ•ж–‡е­—з¶љгЃ„гЃџгЃ‹г‚’ж јзґЌгЃ™г‚‹г‚€гЃ†гЃ«гЃ™г‚‹гЂ‚
      my $z = '' ; # 直前の文字
      my $d = 1 ; # й•·гЃ•
      push @F , '' ; # и»ЅгЃ„гѓ€гѓЄгѓѓг‚Ї
      for ( @F ) { 
        if ( $_ eq $z ) {
          $d ++ ; #print $d ; 
        } else 
        {
          $t {$z} = $d ; #print $d if $d > 1 ; 
          $d = 1 ; # гѓЄг‚»гѓѓгѓ€
          $f1 { $z } = $t{ $z } if ( $f1 { $z } // 0 ) < $t { $z } ;
        }
        $z = $_ ;
      }
      delete $f1{''} ; 
    }
    $f2 { $_ } [ $f1{$_} ] ++ for keys %f1 ;
    $fs { $_ } = 1 for values %f1 ; 

    for my $c ( keys %f1 ) { 
      do{ $fm1c{$c} = 0 ; $fm1{$c} = dualvar $f1{$c},$_ } if ($fm1{$c}//0) <  $f1 { $c } ; 
      $fm1c { $c } ++ if $_ eq $fm1{$c} ; # dualvar гЃ®ж–‡е­—е€—гЃ®ж–№гЃ®жЇ”ијѓгЃ«гЃЄгЃЈгЃ¦гЃ„г‚‹
      do{ $fm2c{$c} = 0 if defined $fm2{$c} && $fm2{$c} ne $_ ; $fm2{$c} = dualvar $f1{$c},$_ } if ($fm2{$c}//0) <= $f1 { $c } && $fm1{$c} ne $_ ;
      $fm2c { $c } ++ if defined $fm2{$c} && $_ eq $fm2{$c} ; # dualvar гЃ®ж–‡е­—е€—гЃ®ж–№гЃ®жЇ”ијѓгЃ«гЃЄгЃЈгЃ¦гЃ„г‚‹    
    }
  }
}

# е‡єеЉ›
sub output () { 
  #say STDERR $o{y} ; exit ;
  my @fsE = sort { $a <=> $b } keys %fs ; # E は Entire の頭文字のつもり。数値の集合となる。
  my @chars = grep { scalar @{$f2{$_}} > $o{y} } sort keys %f2 ; 
  $diffChars = @chars  ; 
  say UNDERLINE join "\t" , 'char', @fsE , $optV0 ? () : 'examples' . FAINT '(count)' ; 
  for my $c ( @chars ) { 
    print "$o{q}$c$o{q}\t" ; 
    my @out ; 
    push @out , map { $f2{$c}[$_] || $o{0} } @fsE ;
    my $fm1c = "$o{q}$fm1{$c}$o{q}" . FAINT "($fm1c{$c})" if defined $fm1{$c} ; # 
    my $fm2c = "$o{q}$fm2{$c}$o{q}" . FAINT "(>= $fm2c{$c})" if defined $fm2{$c} ; # 直前の行とよく似ている。保守時にトラブりがち。
    #push @out , map {"$o{q}$_$o{q}"} grep { defined $_ } $fm1{$c}, $fm2{$c} unless $optV0 ; 
    push @out , grep { defined $_ } $fm1c, $fm2c unless $optV0 ; 
    do { splice @out , -1 , 1 ; push @out , FAINT "--"} if $out[-1] eq $out[-2] && @fsE +2 == @out; # 同じなら除去。  # トリッキー
    say join "\t" , @out ; 
  }
}

END {
  exit if $help ;
  my $procsec = sprintf "%.5f", tv_interval ${ dt_start } ; #time - $time0 ; # このプログラムの処理にかかった秒数。比較する2個の時刻は秒単位なので、±1秒未満の誤差は発生する。
  $readLines //= $. ; # Ctrl+Cの連打で必要となる処理。
  return if ($o{2}//'') eq 0 ; 
  my $linenumeral = $readLines > 1 ? 'lines' : 'line' ; 
  print STDERR BOLD FAINT ITALIC & d3 ( $readLines ) . " $linenumeral read" ; 
  print STDERR BOLD FAINT ITALIC $o{'='} ? " after $o{q}$head$o{q}. " : ". " ; 
  my $charnumeral = $diffChars > 1 ? 'characters' : 'character' ; 
  print STDERR BOLD FAINT ITALIC & d3 ( $diffChars ) . " different $charnumeral in input are shown. " ; 
  my $s = tv_interval $dt_start , [ gettimeofday ] ; 
  say STDERR BOLD FAINT ITALIC " -- $Script ; " . $procsec . " sec. in process" ;
}

## ヘルプの扱い
sub VERSION_MESSAGE {}
sub HELP_MESSAGE {
  use FindBin qw[ $Script ] ; 
  $help = 1 ;
  $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 ;
  exit 0 ;
}

=encoding utf8

=head1

г‚ігѓћгѓігѓ‰

  $0 inputfile 
  $0 < inuptfile 
  cat inputfile | $0 

 еђ„ж–‡е­—yгЃЊдёЃеє¦xеЂ‹жЊЃгЃ¤ж–‡е­—гЃЊгЂЃдЅ•еЂ‹гЃ®иЎЊгЃ«е‡єзЏѕгЃ—гЃџгЃ‹г‚’иЎЊе€—зЉ¶гЃ«иЎЁз¤єгЃ™г‚‹г‚ігѓћгѓігѓ‰гЃ§гЃ‚г‚‹гЂ‚

 下記の用途に使える。他にも幅広い用途に使えるであろう。
  - 小数点が2回出現したとか、括弧の対応がついていない可能性が検出容易。
  - 特別値や特殊文字も見つけやすくなる。

г‚Єгѓ—г‚·гѓ§гѓігЃ«й–ўгЃ—гЃ¦: 

  -0 STR : 頻度が0であることをSTRで表示。未指定なら"-" となる。-0 0 のような使い方が想定される。
  -2 0 : 入力行数や処理時間などの2次情報を、標準エラー出力に出力しない。
  -q STR : 出現した各文字を、STR で囲って表示する。未指定ならシングルクォーテーション(')。'1'のようになる。
  -r   : з•°гЃЄг‚‹еђ„ж–‡е­—гЃЊгЂЃгЃќг‚ЊгЃћг‚ЊгЃ®иЎЊгЃ§гЂЃжњЂй•·гЃ§дЅ•ж–‡е­—йЂЈз¶љгЃ—гЃџгЃ‹г‚’гЂЃж•°гЃ€г‚‹г‚€гЃ†гЃ«гЃ™г‚‹гЂ‚(experimental)
  -v 0 : 具体例の抑制。(出力される具体例は、その文字を最も多く持つ入力行で、最初のものと、それとは異なる最後のものである。)
  -y N : 横軸の値が N 以上の場合の、文字のみ出力する。(experimental)

  -L    : еђ„иЎЊгЃ«гЃ©г‚“гЃЄж–‡е­—гЃЊе‡єзЏѕгЃ—гЃџгЃ‹г‚’гЂЃиЎЁгЃ«гЃѕгЃЁг‚Ѓг‚‹гЂ‚-LгЃЄгЃ—гЃ®е ґеђ€гЃ«жЇ”гЃ№гЃ¦гЂЃзё¦жЁЄгЃЊеЏЌи»ўгЃ—гЃ¦гЃ„г‚‹гЃ“гЃЁгЃ«жіЁж„ЏгЂ‚ seq 12 | $0 -L

  -@ N  : N秒おきに、入力の読み取り状況を標準エラー出力に出力する。
  --help : このオンラインヘルプの文面を表示する。

гЃќгЃ®д»–: 
  * 具体例の表示の説明は、もう少し正確で的確で簡潔な説明が必要。(内部のプログラムを見る必要あり。)
  * -: によって、具体例のところに行番号が付加されるようにしたい。 123:"someline" のように。
  * е‡єеЉ›гЃ®иЎЁз¤єй †еєЏгЃ«гЃ¤гЃ„гЃ¦гЂЃtimes (й »еє¦; жЁЄи»ёгЃ®ж•°) гЃЊе¤љгЃ„й †гЃ«иЎЁз¤єгЃ™г‚‹г‚Єгѓ—г‚·гѓ§гѓігЃЊж¬ІгЃ—гЃ„гЂ‚
  * д»–гЃ®иЎЁз¤єй †еєЏгЃ®г‚Єгѓ—г‚·гѓ§гѓіг‚‚иЂѓгЃ€гЃџгЃ„гЂ‚еђ„ж–‡е­—гЃ®е‡єзЏѕй »еє¦й †гЃЄгЃ©гЂ‚-~гЃ§йЂ†и»ўгЃ•гЃ›г‚‹гЃЄгЃ©гЂ‚
  * 具体例において、その文字列が何回出現したかを暗い文字で括弧内で表示させたい。
  * 文字コードも出したいが、他のコマンドで今は代替できるので、もしかしたら後で実装する。
  * 1文字単位にばらばにして処理するので、このコマンドは動作が少し遅く感じられるかも。

=cut