App-Bin4TSV-6

 view release on metacpan or  search on metacpan

colsummary  view on Meta::CPAN

my ${ INT1 } = sub {
  &{ $SIG{ALRM} } ;
  print STDERR BRIGHT_RED 
   'Do you want to get the halfway result? Then type Ctrl + C again within 2 seconds. '. "\n" .
   'Really want to Quit? Then press Ctrl + "\" or Ctrl + Yen-Mark. (Ctrl+Z may be what you want.) ' . RESET "\n" ;
  $SIG{INT} = sub { select *STDERR ; & ColStat ; select *STDOUT ; return } ; 
  sleep 2 ; 
  return ;
} ;
$SIG{ INT } = ${ INT1 } ;
$SIG{ ALRM } = sub { say STDERR GREEN + (d3 $rl) . " lines read. " , scalar localtime ; alarm $sec } ; 
alarm $sec ; 

eachFile $_ for @ARGV ;
exit 0 ;

## 1個ずつファイルを読み取る。
sub eachFile ( $ ) {
  my $FH = do { my $t = *STDIN if $_[0] eq '-' ; open $t, '<', $_[0] if!$t ; binmode $t , ':gzip(gzip)' if $o{z} ; $t } ; # ファイルハンドルの取得
  $rl = 0 ; # 各ファイルの読み取った行数
  # 1. 最初の列名の並びを読み取り: 

colsummary  view on Meta::CPAN

} 

###
sub filePinfo {
  exit if ($o{2}//'') eq 0 ;
  $rl = d3 ($rl // 0) ; # read lines
  my $procsec = tv_interval ${ dt_start } ;
  my $out = "$rl line(s) read; "; 
  $out .= "$nc cells are not counted; " if $nc ;
  $out .= sprintf '%0.6f seconds (colsummary)', $procsec ; # たまにマイクロ秒単位の$procsecが15桁くらいで表示されるのでsprintf。
  say STDERR BOLD DARK ITALIC CYAN $out ;
}

### 各列の値の分布を取り出す
sub ColFreq ( $$ ) { # 第１変数はファイルハンドル 第２変数は参照
  #my %zstr ; # 除外された文字列の出現頻度。(点検用でもある。)     #my $intflg ; #$SIG{INT} = sub { $intflg = 1 } ; 
  my $maxCols = 0 ;
  my $col = undef ; # 0オリジンのカラム番号
  * lenlim = defined $o{l} ? sub { grep { $_ = substr $_, 0, $o{l} } @_ } : sub {} ; # -l で長さ制限
  * tailspacetrim = defined $o{s} ? sub { grep { s/\s+$// } @_ } : sub {} ; 
  * negcell = defined $o{'#'} ? sub { if (m/$o{'#'}/ ) { $col ++ ; $nc ++ ; goto EACH_CELL } }  : sub {} ; # o{'0'} をやめた

colsummary  view on Meta::CPAN

  my @p = @_ ; 
  my @P ; 
  push @P , $p[0] ;  ## (1) 列番号の表示1から
  push @P , GREEN BOLD $p[1] ; ## (2) 何通りの値が出現したかを表示 
  push @P , BRIGHT_BLUE $p[2] if ($o{m}//'') ne 0 ; ## (3) 平均値の表示 (加算と減算の関係を把握する目的があるので、値が無いところは0と見なす)
  push @P , BRIGHT_YELLOW $p[3] ;## (4) 列の名前(列名)を表示
  push @P , BRIGHT_WHITE $p[4] ; ## (5) 値の最大と最小を取り出す。
  push @P , $p[5] ;## (6)  具体的な値の表示 (出現度数の多い順に $o{g} 個 ) 
  push @P , BRIGHT_GREEN $p[6] . GREEN $p[7] ;## ## (7) 最頻度数の分布## (7) 中点(なかてん)の処理 (7) テール度数の分布
  push @P , BRIGHT_BLUE $p[8] ;  ## (8) 値の文字列長の範囲の表示
  say join "\t" , @P ;
}

# 平均値を計算する処理をする。
sub aveft ( $$ ) {
  my ($rHash,$rKeys) = @_ ;
  my ($tval, $freq, $asum, $afreq ) ; 
  for( @{$rKeys} ) { 
    ( my $num = $_ ) =~ s/(\d),/$1/g ; #s/,//g ; # 3桁区切りに現れる区切りコンマを消去する
    $tval = POSIX::strtod ( $num ) ; 
    $freq = $rHash->{ $_ }  ; 

freq  view on Meta::CPAN

my @givenL ;   
my %gl ; # 個数を数える対象を指定されて場合は、それを読み取る。(Given List)

my ($hTake, $tGet) = $o{x} =~ m/\d+/g if defined $o{x} ; # -xのオプションから数値を最大2個取り出す
$tGet //= 12 ; ## 画面を溢れないように制限した

my $sec = $o{'@'} // 15 ; # 何秒おきにアラームを発生させるか

$SIG{ALRM} = sub { 
  my $n = $.  =~ s/(?<=\d)(?=(\d\d\d)+($|\D))/,/gr ; # 3桁ごとに区切る。
  say STDERR GREEN "$n lines read ($Script). " , scalar localtime ; 
  alarm $sec 
} ; 
sub IntFirst {
  &{ $SIG{ALRM} } ;
  print STDERR BRIGHT_RED 
   'Do you want to get the halfway result? Then type Ctrl + \ again within 2 seconds. '. "\n" .
   'Really want to Quit? Then press Ctrl + "\" or Ctrl + Yen-Mark after 2 seconds later. ' . RESET "\n" ;
  local $SIG{QUIT} = sub { select *STDERR ; & output ; select *STDOUT } ;
  sleep 2 ; # eval { local $SIG{ALRM} = sub { alarm $sec ; die } ; alarm 2 ; 1 while 1  } ; 
  #$SIG{INT} = 'IntFirst' ;

freq  view on Meta::CPAN

  # 書き出し
  #my $header ; 
  my @cNames ;  # 最初の行に出力するリスト
  push @cNames , "Lin#Range"  if $o{':'} ; 
  push @cNames , "CumRat"  if $o{a} && $o{'%'} ;
  push @cNames , "AccSum"  if $o{a} ;
  push @cNames , "Ratio"  if $o{'%'} ; 
  push @cNames , "Freq*" unless $o{1} ;
  push @cNames , $first // "LinStr" ; # unless defined $first ; 
  push @cNames , "RIGHT_FIELDS.." if defined $hTake ;
  say UNDERLINE join $o , @cNames if ($o{0}//'') ne '0' ; 

  * lineRange = sub { $strfst{$_} //= 0 ; $strlst{$_} //= 0 ; "$strfst{$_}-$strlst{$_}:" } ; 
  * accOutput = sub { $cumsum += $strcnt { $_ } ; $o{'%'} ? $cumsum . sprintf( "\t%5.2f%%", 100.0 * $cumsum / $totalSum) : $cumsum } ;

  for ( @K ) { 

    sub tailx {
      my @keys = sorting ( $cntX1X2 { $_ } ) ; 
      @keys = splice @keys , 0, $tGet if defined $tGet ;
      my $out = '' ; 
      #say STDERR "@keys" ; # = sort { $cntX1X2{$_}{$a} <=> $cntX1X2{$_}{$b} } @keys 
      @keys = sort { $cntX1X2{$_}{$b} <=> $cntX1X2{$_}{$a} } @keys ;
      for my $k ( @keys ) { $out .= "\t[$k]x$cntX1X2{$_}{$k}" } ; 
      return $out ; 
    }

    $strcnt{ $_ } //=  0 ;
    next unless y_filter ( $strcnt{$_} ) ; 
    print & lineRange, "\t" if exists $o{':'} ; # -: オプションにより、どの行番号で現れたのかを出力。
    print & accOutput, "\t" if exists $o{a} ; # -s オプションにより、累和を表示。 
    printf "%5.2f%%$o", 100.0 * $strcnt{$_} / $totalSum if $o{'%'} ;  

venn  view on Meta::CPAN

      if ( eof ) { $N++ ; my $dummy = <> if $o{'='} && ! eof() ; last } ; 
  }
  while ( <> ) { 
      chomp ; 
      $fqE[$N]{$_} ++ if exists $fqA{$_} ;
      #$fqA{$_} ++ ;
      if ( eof ) { $N++ ; my $dummy = <> if $o{'='} && ! eof() } ; 
  }

  # Printing
  say join "\t", "*", (map {"file$_"} 1 .. $N) ; # , $optv0 ? () :  ('strmin','strmax') ; 
  #my @out ; 
  #push @out , scalar keys %fqA ; 
  say join "\t" , 'freq' , map { sum0 values %{$fqE[$_]} }  0 .. $N-1 ;
  say join "\t" , 'card' , map { scalar keys %{$fqE[$_]} }  0 .. $N-1 ;
  #for my $B ( sort { $a <=> $b } keys %BfqA ) { 
  #    my @out = map { $_ // 0 } map { $BfqE { $B } [$_] } 0 .. $N -1   ;
  #    push @out , $BfqA1{$B} , $BfqA2{$B}  if ! $optv0 ;
  #say join "\t" , $BfqA{$B} , @out ; #, 
  #}
}

## それぞれのファイルを全部読む
sub read_all 
{
  my $dummy = <> if $o{'='} ;
  while ( <> ) { 
      chomp ; 
      s/\r$// unless $optR0 ;

venn  view on Meta::CPAN

    my @which = grep { exists $fqE[$_]{$word} } 0 .. $N-1 ; # その文字列をどのファイルが持つか
    my $B = sum0 map { 1 << $_ } @which ; # ビットパターン ## <-- - 良い演算子は無いだろうか?? 
    $BfqA { $B } ++ ; # 異なる個数を数える
    $BfqE { $B } [ $_ ] += $fqE [ $_ ] { $word } for @which ; # 1行前と異なり、のべ数を計数。
    next if $optv0 ;
    $BfqA1{$B} //= $word ; $BfqA1{$B} = $word if $BfqA1{$B} gt $word ; # 文字列最小値の格納
    $BfqA2{$B} //= $word ; $BfqA2{$B} = $word if $BfqA2{$B} lt $word ; # 文字列最大値の格納
  }

  # Printing
  say join "\t", "cardi.", (map {"file$_"} 1 .. $N) , $optv0 ? () :  ('strmin','strmax') ; 
  my @B = keys %BfqA ; 
  @B = sort { $BfqA1{$a} cmp $BfqA1{$b} } @B unless $optv0 ;
  for my $B ( @B ) { 
    my @out = map { $_ // 0 } map { $BfqE { $B } [$_] } 0 .. $N -1   ;
    do { $_ = "$o{q}$_$o{q}" for $BfqA1{$B} , $BfqA2{$B} } unless $optv0 || $optq0 ; # 値があれば囲む
    $BfqA2{$B} = '' if $BfqA1{$B} eq $BfqA2{$B} ; # 値一定なら空文字列変換(除去はしない。TSVは列数一定とすべし)
    push @out , ($BfqA1{$B} , $BfqA2{$B}) if ! $optv0 ;
    say join "\t" , qq[$BfqA{$B}.] , @out ; # 最初の列はピリオドを付加する(数であること保ちつつ他と視認識別容易に) 
  }
}

sub secondary_info 
{ 
  my $procsec = tv_interval ${ dt_start } ; #time - $time0 ; # このプログラムの処理にかかった秒数。比較する2個の時刻は秒単位なので、±1秒未満の誤差は発生する。
  * d3 = sub { $_[0] =~ s/(?<=\d)(?=(\d\d\d)+($|\D))/,/gr } ;
  print STDERR BOLD ITALIC DARK CYAN & d3 ( $. ) . " lines processed in total. $N files. " ; 
  print STDERR BOLD ITALIC DARK CYAN "($Script ; " . $procsec . " sec.)\n" ;
}