#!/usr/bin/perl
use 5.001 ; use strict ; use warnings ; 
use Getopt::Std ; getopts 'bhilqt=sx:/:02@:' , \my %o ; 
use POSIX qw [ floor ceil ] ; 
use Term::ANSIColor qw [ color :constants ] ; $Term::ANSIColor::AUTORESET = 1 ; 
use FindBin qw [ $Script $Bin ] ; 
sub proc_read ( ) ; # 読取りの処理 
sub proc_out ( ) ; # 出力の処理
sub Info2ndry ( ) ; # 2次情報の出力
sub high_val ( $ ) ; # 0から$Qまでの何番目を表示したいかを引数として受け取り、線形補間した値を返す。
sub down_val ( $ ) ; # 0から$Qまでの何番目を表示したいかを引数として受け取り、線形補間した値を返す。
sub near_val ( $ ) ; # 0から$Qまでの何番目を表示したいかを引数として受け取り、線形補間した値を返す。
sub intp_val ( $ ) ; # 0から$Qまでの何番目を表示したいかを引数として受け取り、線形補間した値を返す。
sub midreport ( ) ;
* near_val = * intp_val if $o{i} ; # -i は線型補間値であることの指定
my $Q = int ( $o{'/'} // 1 ) ; # 分位点を求めるのに、何分割をするか。このプログラムの作成者は個人的に六分位数が好きである。
my @xco = defined $o{x} ? eval $o{x} : 0 .. $Q ;  # どの分位点を出力するか。
my $header = <> if $o{'='} ; 
my $L ;
my $LL = -1 ; # 読み取った行数 マイナス 1 ; 分位点を算出するために、1 を減じるトリックを使っている。 
my @V = () ; # レコードの数値を格納する。
my %VV = () ; # 複数列(2列目以降の値で層別するオブシヨン) の時に、@V を格納するような時に用いる。
my $midcycle = $o{'@'} // 1e5 ; # 何行毎にレポートを発生させるか。
my $time0 = time ;

proc_read ; 
proc_out ; 
Info2ndry unless $o{q} ; 
exit 0 ;

# 以下は関数

sub proc_read ( ) {
	print STDERR RED "Waiting input from STDIN.. ($Script)  \n" if -t ;

	unless ( $o{2} ) 
	{ 
		while ( <> ) { 
			chomp ;
			push @{ $VV{ '' } } , $_ ; 
		    #push @V , $_ ; #+ 0 ; 
		    $LL ++ ; 
			midreport () ;
		}
	}
	else 
	{
		while ( <> ) { 
			chomp ; 
			my ( $value , $layer ) = split /\t/, $_ , 2 ; 
			push @{ $VV{ $layer } } , $value ; 
			$LL ++ ;
			midreport () ;		
		} 
	}


 	if ( $. == 0 ) { 
 		* STDOUT = * STDERR ;
	 	HELP_MESSAGE() ; # 読取りが発生師無かった場合は、ヘルプを出す。
	 	exit ; 
	}
}

sub midreport ( ) {
	if ( $. % $midcycle == 0 ) { 
	      use FindBin '$Script' ;
	      $| = 1 ; 
	      my $num = $. ; 
	      $num =~ s/(?<=\d)(?=(\d\d\d)+($|\D))/,/g ; # 3桁毎にコンマで区切る
	      #1 while $num =~ s/(.*\d)(\d\d\d)/$1,$2/ ; 
	      print STDERR GREEN $num , ":\t" , sprintf "%02d:%02d:%02d" , ( localtime )[2,1,0] ;  #  <-- 標準出力に書込み
	      print STDERR "\t" , GREEN  time - $time0 , " sec.\t($Script)" ; 
	      $time0 = time ;
	      print STDERR "\n" ;
    }
}

sub proc_out ( ) { 
	# 表頭
	if( 1 ) { 
		print $_ , "\t" for @xco ; 
		print '#' ; 
		print "\t" , 'Layers' if $o{2} ; 
		print "\n" ;
	} 

	for ( sort keys %VV ) 
	{
		@V = @{ $VV{$_} } ;
		line_out ( $_ ) ; 
	}

}

sub line_out ( $ ) { 
	@V = $o{s} ? sort @V : sort { $a <=> $b } @V ;
	$L = $#V ; 

	# 上側の値
	if ( $o{h} ) { 
	    print high_val $_ , "\t" for @xco ; 
		print $L+1 , "+\t" ; 
	    print "$_[0]\n" ;  
	}
    # 通常の中間の値
    if ( ! $o{0} ) { 
	    print near_val $_ , "\t" for @xco ;
		print $L+1 , "\t" ; 
	    print "$_[0]\n" ;  
	}
    #下側の値
    if ( $o{l} ) { 
	    print down_val $_ , "\t" for @xco ; 
		print $L+1 , "-\t" ; 
	    print "$_[0]\n" ;
	}
}

sub Info2ndry ( ) { 
    print STDERR CYAN ,"counted : ", BRIGHT_CYAN $LL+1, CYAN "  ($Script)\n"  ; 
} 

# 分位点の計算 (概念的に考えられる低い方の値、高い方の値、線型補間、単純に近い値)

sub down_val ( $ )  { $V[ floor $_[0] * $L / $Q ]  } ; 
sub high_val ( $ ) { $V[ ceil $_[0] * $L / $Q ] } ; 
sub near_val ( $ ) { $V[ floor $_[0] * $L / $Q + 0.5 ] } ; 

sub intp_val ( $ ) { 
    my $x = $_[0] * $L / $Q  ;
    my $x1 = floor $x ; 
    my $x2 = ceil  $x ; 
    my $f1 = $x - $x1 ; 
    return $V[ $x1 ] * ( 1 - $f1 )  + $V[ $x2 ] * $f1 ;
} 



=encoding utf8 

=head1

 $0 -/ 分位分割数 

  分位点を求める。通常の(線形)補間値のみならず、上側の値と下側の値も出力する。
  2次情報として何個の値を入力から読み取ったかも、標準エラー出力に出力。

 オプション : 

  -= : 最初の行を読み飛ばす。
  -/ num : num は分位分割数。 ( Cutting )
  -x 1..5など : 何番目の分位点を出力するかを指定する。小数も指定可能。, や .. が使える。

  -h : 分位点の計算において、考えられる大きい値についても、出力する。
  -i : 分位点を観測値に存在する値ではなくて、線形補間した値を用いる。
  -l : 分位点の計算において、考えられる小さい値についても、出力する。
  -0 : -h と -l で出力される値以外は出さない。
  -q : 2次情報を出力しない。
  -s : 入力を数値としてではなく、文字列として処理する。日時を扱う場合などに使う。

  -2 ; 層別に分位点を出力する。1列目を値と見なし、タブ区切り2列目以降を層のラベルと見なす。
  -@ num : 入力を読み取る際に、一定行数を読み取る毎に標準エラー出力にレポートを出す。未指定なら、10万行。

  --help : ヘルプを出力。(この表示を出力する。)
  --help opt : $0 の引数の内のオフションスイッチ( - で始まる引数)についての解説を表示。
  --version : バージョン情報の表示

 開発メモ : 
   * 出力する数の桁数の指定が必要そう。sprintf , printf を使わないようにしたい。
   * 出力出来る数について、 printf書式を指定できるようにしたい。
   * -@ による一定数行毎のレポートでは無くて、ALRMを使って一定時間おき(10秒ごと)のレポートとしたい。
   * 数値であるかどうかの判定を入れたい。
   * 保守のために、関数内の関数を活用しようか。
=cut 

## ヘルプとバージョン情報
BEGIN {
  $Getopt::Std::STANDARD_HELP_VERSION = 1 ; 
  our $VERSION = 0.11 ;
    # 最初は 0.21 を目安とする。
    # 1.00 以上とする必要条件は英語版のヘルプをきちんと出すこと。
    # 2.00 以上とする必要条件はテストコードが含むこと。
}  
sub HELP_MESSAGE{
    use FindBin qw[ $Script ] ; 
    $ARGV[1] //= '' ;
    open my $FH , '<' , $0 ;
    while(<$FH>){
        s/\$0/$Script/g ;
        print $_ if $ARGV[1] eq 'opt' ? m/^\ +\-/ : s/^=head1// .. s/^=cut// ;
    }
    close $FH ;
    exit 0 ;
}
