view release on metacpan or  search on metacpan

gapstat  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 '@:=G:L:R:u:' , \my %o  ; 
use Term::ANSIColor qw[ color :constants ] ; $Term::ANSIColor::AUTORESET = 1 ;
use FindBin qw[ $Script ] ; 
use List::Util qw[ min max uniq ] ; 
use Scalar::Util qw [ dualvar ]  ;  # dualvar は num, string の順である。
use utf8 ; 

* d3 = exists $o{','} && $o{','} eq 0 ? sub{$_[0]} : sub { $_[0] =~ s/(?<=\d)(?=(\d\d\d)+($|\D))/,/gr } ;
$/ = $o{R} ? "\r\n" : "\n" ;  # 入力の改行文字に関して。Windows形式なら -R 1 が指定されることになる。
* decode = ($o{u}//'') ne 0 ? * decode_utf8 : sub ( $ ) { $_[0] } ; 
binmode STDOUT , "utf8" unless ($o{u}//'') eq 0 ;
$o{'@'} //= 15 ; # 何秒おきにアラームを発生させるか
my $help = 0  ; # オンラインヘルプの文面の表示をしたか否か。
my $readLines  ; # 読み取った行数

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

my %gd ; # Gap Distribution 間隙の広さについての分布。 $gd{ gap } で 間の広さが gap であるものの、頻度を格納。
my %gw1 ; # w = Where ; それが発生した場所の最初
my %gw2 ; # w = Where ; それが最後に発生した場所(行番号)。$gw2{gap} は gapの大きさの間隙が最後に生じた両端の場所と値を示す。
my %g22 ; # $g2w{gap}により、大きさgapの間隙が生じた最後の場所の(始まりでなく)終わりについて、[w,v] で示す。


# 以下の lc は、 longest chain . 
our %lc ; #  @{ $lc{Gap} } により、dualvar n,"w:s"。何個(n)続いた、何行目(w)の文字列(s)。各Gapでnは出来るだけ大きく(長く)する。
our %lc0 ; # @lc を算出するための、一時的な格納場所
my $head = <> if $o{'='} ; 
my $v1 ; # 1行目の値を格納する。
my $prev ; # 直前の行について [ $. , $str ] を格納。 (ただし、[ , ] は dualvar である。
while( <> ) { 
  my $neof = 1 ; # 毎行読み取り終わった場合の、最後の処理が終わったら 1 になる。
  $_ = decode ($_) ;
  s/\s//g ; # chomp もしなくて良くなっている。
  y/０-９/0-9/ unless ($o{u}//'') eq 0 ;  
  my $gap = undef ; # 直前の行の内容数値との差分を格納する。
  $v1 //= $_ ; # 1行目の値を格納する。
  if ( defined $prev ) { 
    $gap = $_ - ($prev.'') ;
    $gd { $gap } ++ ; 
    $gw1 { $gap } //= dualvar $prev , sprintf "%s ~ %s:%s" , $prev . '' , $. , $_ ; # <-- 数段階トリッキー。
    $gw2 { $gap } =   dualvar $prev , sprintf "%s ~ %s:%s" , $prev . '' , $. , $_ ;
    # next if ($o{L}//'') eq 0 ;
    #$g22 { $gap } =   dualvar $. , $_  ;  # この変数は、2番目の出力表のための計算に使う。
  }
  next if ($o{L}//'') eq 0 ;
  my $str = $_ ; 

  sub d2 ($) { 
    my $m = min grep { $_ > $_[0] } keys %g22 ;  
    defined $m ? dualvar $.-$g22{$m} , sprintf "%g:%s",$g22{$m},$g22{$m} : dualvar -1+$., "1:$v1" ;
  } 

  #if ( ! defined $gap ) { $lc0 {Inf} = dualvar 1 , "$.:$str" ; $gd {Inf} = 0 ; next }  # $. の部分は 1 でも良いかも。 <-- - 
  next if ! defined $gap ; 
  if ( $gd { $gap } == 1 ) { # もしも、そのギャップの値での記録が 1 個つまり初めてだった時
    #my $max = max grep { abs $gap >= $_ } map { abs $_ } keys %gd ; # max 関数の対象が空であれば、返り値は undef となる。
    #$lc0 { abs $gap } = defined $max ? $lc0 { $max } : $lc0{Inf} ; # if defined $max ; 
    $lc0 { abs $gap } //= & d2 ( abs $gap ) ; 
    #print RED $gap ;
  }

  ULOOP : 
  for ( uniq map { abs $_ } keys %gd ) {
    if ( $_ < abs $gap && defined $lc0 { $_ } || $neof == 0 && defined $lc0 { $_ } )  {
      sub se($$){ dualvar $_[0] , sprintf "%s ~ %s:%s" , $_[0].'', $_[1]+0, $_[1].'' } # 関数 start end のつもり。次でしか使わないので、ここに書いた。