view release on metacpan or  search on metacpan

chartimes  view on Meta::CPAN

#!/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:R' , \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 ;

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

# 集計
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{''} ; 
    #for ( keys %t )
  }
  $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 の文字列の方の比較になっている    
  }
}

& output () ;
exit ; 

# 出力

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)' ;