view release on metacpan or  search on metacpan

scripts/colsummary  view on Meta::CPAN

#!/usr/bin/perl

#  colsummary : TSVまたはCSVファイルの各列の値の様子を表示する。とても便利。
#   2015/05/11 - 2016/07/05 , 2018-03-28 . Shimono Toshiyuki 
#   2019/10/24 さらに大幅に書き替え

use 5.014 ; use warnings ; # also confirmed on 5.011 5.014 5.018  
use strict ; 
use Time::HiRes qw [ gettimeofday tv_interval ] ; my ${ dt_start } = [ gettimeofday ] ; 
my $time0 = time ; 
use autodie qw [ open ] ; 
use Getopt::Std ; getopts 'g:i:jl:m:suwz=!@:#:0:2:' => \my %o ;
use List::Util qw/max min maxstr minstr/ ; 
use POSIX qw/strtod/;
use Scalar::Util qw/looks_like_number/;
use Term::ANSIColor qw/:constants color/ ; $Term::ANSIColor::AUTORESET = 1 ; 
use Encode qw[ decode_utf8 encode_utf8 ] ; 
use FindBin qw [ $Script ] ; 
my $sdt = sprintf '%04d-%02d-%02d %02d:%02d:%02d', do{my @t= @{[localtime]}[5,4,3,2,1,0]; $t[0]+=1900; $t[1]++; @t } ; 
eval "use PerlIO::gzip;1" or die "PerlIO::gzip cannot be loaded, so -z does not work. ($Script, $sdt)\n" if $o{z} ; 

sub AlignOut ( @ ) ; # 出力 ; eachFileでもColstatでも使う。
sub ColStat ( $$ ) ; # $colvals->[列番] と 列名を 渡す。そして、その中身が表示される。; eachFileでもColstatでも使う。
sub d3 ($) { $_[0] =~ s/(?<=\d)(?=(\d\d\d)+($|\D))/,/gr } ; # 数を3桁区切りに変換する。
#sub hhmmss () { sprintf '%02d:%02d:%02d' , @{[localtime]}[2,1,0] } ; # 現在時刻を hh:mm:ss の形式で取り出す。

$/ = "\r\n" if $o{w} ; # -r指定で 改行文字をWindows形式に変更。
my $L = ',' ; # 出力によく現れる区切り文字列
my $isep = $o{i} // "\t" ;  # 入力の区切り文字 $o{','} = do { $o{','} //= "\t" ; eval qq[qq[$o{','}]] } ;
my $nc = 0 ; # 計数対象としなかったセルの数をカウント。
my $sec = $o{'@'} // 15 ; # 何秒ごとにレポートを表示させるか
my $rl ; # 各ファイルの読んだ行数を格納。

$SIG{ ALRM } = sub { say STDERR GREEN + (d3 $rl) . " lines read. " , scalar localtime ; alarm $sec } ; 

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

$o{g} = 6 if ( ! defined $o{g} ) ; # 取り出す数
$| = 1 if $o{'!'} ;
* decode = $o{u} ? * decode_utf8 : sub ($){ $_[0] } ; #* encode = $o{u} ? * encode_utf8 : sub ($){ $_[0] } ; 
$o{'#'} = decode ( $o{'#'} ) if defined $o{'#'} ; 

my %fOut = (
j =>  [ map {UNDERLINE decode($_)} qw[列番号 値の異なり 数値化平均 列名 値の範囲 最頻値 最頻値の度数 ..テールの度数(重なり) 桁数範囲 ] ] ,
e =>  [ map {UNDERLINE $_ } qw[ cpos diff ave. name range frequent frequency ..lower(x_mul) digits] ] ) ; 

binmode *STDOUT , ':utf8' if $o{u} ;
alarm $sec ; 
push @ARGV , '-' unless @ARGV ; # 標準入力の追加
& eachFile ( $_ ) for @ARGV ;
exit 0 ;

sub eachFile ( $ ) {
  sub colnames( $ ) ; # -=の時に先頭行の情報を取り出す
  sub filePinfo ; # ファイル毎の2次情報(一行サマリ)
  sub ColFreq ( $$ ) ; # 第１変数はファイルハンドル 第２変数は参照 ;  各列の値の分布を取り出す
  my $FH = do { my $t = *STDIN if $_[0] eq '-' ; open $t, '<', $_[0] if!$t ; binmode $t , ':gzip(gzip)' if $o{z} ; $t } ; # ファイルハンドルの取得
  $rl = 0 ;
  my @colnames =  colnames $FH  if $o{'='} ; 
  my $maxCols = ColFreq $FH, my $colvals ; #my $colvals ; 各列の各データ値の度数を集計;$colvals->[列番-1]{データ値}=度数 
  close $FH  ;

  AlignOut @{ $fOut{$o{j}?'j':'e'} } if 0 ne ($o{0}//'') ; 
  defined $colvals->[$_] and ColStat $colvals->[ $_ ] , $colnames[$_] for 0 .. $maxCols - 1  ; # オプション -0 により全ての値が除外されることは起こりうる。 
  filePinfo ;
}

# ヘッダから列名を取得する。 -= が指定された場合のみ
sub colnames ( $ ) { my @F =  split /$isep/, do { my $FH = $_[0] ; my $t = <$FH> ; $rl++ if defined $t ; $t //= '' ; chomp $t ; decode ($t) } , -1 } 

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'} をやめた
  for ( my $FH = $_[0] ; <$FH> ; $rl ++ ) { 
    #$rl ++ ;
    chomp ; 
    my @F = map { decode ( $_ ) } split /$isep/ , $_ , -1 ; 
    & lenlim ( @F ) ; # 各セルの長さ制限
    & tailspacetrim ( @F ) ;
    $col = 0 ;
    EACH_CELL : 
    while ( defined ($_ = shift @F) ) { 
      #do { $zstr { $F[$_] } ++ ; next } if exists $o{'0'} && $F[$_] =~ m/$o{'0'}/ ; 
      & negcell ; #next if exists $o{'0'} && $F[$_] =~ m/$o{'0'}/ ; 
      ++ $_[1] -> [ $col ] { $_ } ; # 各列の各データ値の度数を集計
      $col ++ ;
    }
    $maxCols = $col if $maxCols < $col ; 
  }
  # 除去された値の頻度一覧。
  #if ( $o{'0'} ) { 
  #  print ON_WHITE BLACK "\t Suppressed cell value : " if keys %zstr; 
  #  print ON_WHITE BLACK "\t $zstr{$_} : $_ " for keys %zstr 
  #} ; 
  return $maxCols ;
}

# $colvals->[列番] と 列名を 渡す。そして、その中身が表示される。
sub ColStat ( $$ ) { 
  sub aveft ( $$ ) ; # 各列の平均値を計算する処理をする。
  sub MultSpec ( $$ ) ; # 度数(頻出上位の個数及びテールの様子) について表示文字列を準備する(..の前後で2回呼び出される)
  sub minmaxstr ( $ ) ; # 配列参照から、最小値最大値を取り出す