App-Bin4TSV

 view release on metacpan or  search on metacpan

scripts/backcolor  view on Meta::CPAN

#!/usr/bin/perl
use 5.014 ; use strict ; use warnings ; 
use Getopt::Std ; getopts 'd:s' ,\my%o ; 
use FindBin qw [ $Script ] ; 
use Term::ANSIColor qw[ :constants color ] ; $Term::ANSIColor::AUTORESET = 1 ; 
use Scalar::Util qw[ looks_like_number ] ; 
use List::Util qw[ min max ] ; 

$o{d} //= 1 ; # 色を1段階上げるのに、数値がいくつ高い必要があるか。


while ( <> ) { 
	my @F = do { chomp ; split /\t/o, $_ , -1 } ; 
	for ( @F ) { 
		if ( looks_like_number ( $_ ) ) { 
			my $n = $o{s} ? sqrt ( $_ ) : $_ ;
			my $d = max 0, min 5, int $n / $o{d} ; 
			my $c = "on_rgb00$d" ;
			$_ = color ($c) . $_ . color ('reset') ; 
		}
	}
	say join "\t", @F ; 
}

scripts/boxmuller  view on Meta::CPAN

#!/usr/bin/perl
use 5.014 ; use strict ; use warnings ;  # the functions requires 5.10 for "state", 5.14 for srand. 
use Getopt::Std ; getopts ':.:@:1d:g:Lm:s:v:', \my%o ;  
use Math::Trig qw/pi/ ; # 5.4から
use Scalar::Util qw/looks_like_number/ ; # 5.7.3から
use Term::ANSIColor qw/:constants color/ ;  $Term::ANSIColor::AUTORESET = 1 ;
use Time::HiRes qw/sleep usleep gettimeofday tv_interval/ ; # 5.7.3から

$SIG{INT} = sub { & SecondInfo ; exit 130 } ;

my $time0 = [ gettimeofday ] ;
my ( $mu , $sd ) ;  #mu : 平均 , sd : 標準偏差
my ( $s1 , $s2 )  = (0,0) ; # 1乗和 と 2乗和
my $count = 0 ; # 出力した個数
my $upto = $o{g} // 6 ;  # 出力要素数
& init ; 
& main ; 
& SecondInfo ; 
exit 0 ;

sub init ( ) {   #オプションを使った設定
   $o{s} = defined $o{s} ? srand $o{s} : srand ; # 乱数シードの保管/設定

   sub LLN ( $ ) ; * LLN = * looks_like_number ; # 関数名が長すぎるので、短くした。
   sub printErr( $ ){ print STDERR BRIGHT_RED "Option -$_[0] should have a numeric specification.\n" ; exit 1 }
   $mu = $o{m} ? LLN $o{m} ? $o{m} : printErr "m" : 0 ;  #m : 平均
   $sd = $o{d} ? LLN $o{d} ? $o{d} : printErr "d" : $o{v} ? LLN $o{v} ? sqrt  $o{v} : printErr "v" : 1 ;  #sd：標準偏差 
}

sub main ( ) {  #  乱数の出力
   sub getrand  ;
   sub boxmuller ( $$ ) ;  #ボックスミュラー法によるガウス乱数の作成
   * getrand = * boxmuller ; 
   * getrand = * lognormal if $o{L} ;  # 対数正規分布の指定があった場合。

scripts/colsummary  view on Meta::CPAN

#   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 の形式で取り出す。

scripts/colsummary  view on Meta::CPAN

    push @ostr , $t.'(x'.$p_ccount->{$t} .')' if ( $p_ccount->{$t} >= 2 ) ; 
    last if ( $c >= $o{g} ) ;
  } 
  return @ostr ;
} ;

# 配列参照から、最小値最大値を取り出す 
sub minmaxstr ( $ ) {
  sub part ( &@ ) ; 
  sub RangeStr ( $$ ) ;
  my @gps = part {$_ eq '' ? 0 : looks_like_number $_ ? 1 : 2}  @{ $_[0] } ; 
  my @ostr ; 
  push @ostr, '' if $gps[0] ;  # 空文字列があるときの処理  
  push @ostr, RangeStr( min(@{$gps[1]}), max(@{$gps[1]}) ) if $gps[1] ;  # 数に見える値があるときの処理 
  push @ostr, RangeStr( minstr(@{$gps[2]}), maxstr(@{$gps[2]}) ) if $gps[2] ; # 数に見えない値があるときの処理 
  return @ostr; 
} ; 
sub part ( &@ ) { my ($cd, @l) = @_ ; my @p ; push @{ $p[ $cd->($_) ] } , $_ for @l ; @p } ;  # この関数は List::MoreUtils 
sub RangeStr ( $$ ) { $_[0] eq $_[1] ? "$_[0]" : "$_[0]..$_[1]" } # 2個の数or文字列から 1..2のような文字列を生成

scripts/crosstable  view on Meta::CPAN

#!/Users/toshiyuki-shimono/.plenv/versions/5.32.1/bin/perl5.32.1
use 5.014 ; use strict ; use warnings ; 
use Scalar::Util qw/looks_like_number/; # 5.7 ~
use Getopt::Std; getopts '::^:~=+:,:@:0:1:d:i:qvm:' , \my %o ;
use Term::ANSIColor qw/:constants color/; $Term::ANSIColor::AUTORESET = 1 ;# v5.6 ~ 
#use utf8 ; 
my $isep = $o{i} // "\t" ; # 入力の区切り文字
my $oemp = $o{'0'} // 0 ; # 出力のセルが未定義値の場合に代わりに出力する文字列
my $sec = $o{'@'} // 10 ; # 何秒ごとに処理状態を出力するか。
my $addC ; # ある列を加算する場合の列の指定
my $t00 ;  # 表の左上隅に載せる文字列
my %ax2 ; # キーは横軸の項目名となる。
my %C ; # セルの値 

scripts/crosstable  view on Meta::CPAN

		showMat( \%Ce , "empties" ) ; # 空文字列がいくつ出現したか
	}

	$SIG{INT} = $IntFirst

	# my %Cv ; for my$i(@a1){for my$j(@a2){$Cv{$i}{$j}=($Cc{$i}{$j}//0)-($Ce{$i}{$j}//0)}}
}


sub StrNumSort ( @ ) {
	+( sort { $a cmp $b } grep { ! looks_like_number ($_) } @_ ) ,
	 ( sort { $a <=> $b } grep {   looks_like_number ($_) } @_ ) ;
}

sub showMat ( $$ ) { 
	my ($C,$h11) = @_ ; # セル, 縦軸, 横軸, 出力表の左上の文字列
	my @a1 = StrNumSort ( keys %{$C} ) ; # 縦軸の各項目名
	my @a2 = StrNumSort ( keys %ax2 ) ; # 横軸の各項目名


    if ( defined $o{':'} ) { 
    	@a1 = () ; # リセット

scripts/digitdemog  view on Meta::CPAN

#!/usr/bin/perl
use 5.014 ; use strict ; use warnings ;  # the functions requires 5.10 for "state", 5.14 for srand. 
use Getopt::Std ; getopts '12$:=p:q:u:LS', \my%o ;  
use Math::Trig qw/pi/ ; # 5.4から
use Scalar::Util qw/looks_like_number/ ; # 5.7.3から
use Term::ANSIColor qw/:constants color/ ;  $Term::ANSIColor::AUTORESET = 1 ;
use Time::HiRes qw/sleep usleep gettimeofday tv_interval/ ; # 5.7.3から
use Encode ;

#$SIG{INT} = sub { & info ; exit 130 } ;
my $time0 = [ gettimeofday ] ;
my ${binFlag} = 1 if defined $o{u} && $o{u} eq '0' ;

$o{'$'} //= 'end' ;  # 文字の終端を表す記号
$o{p} //= '' ;  # 文字を切り分けるパターン。正規表現

scripts/joinn  view on Meta::CPAN

#!/usr/bin/perl -T 
use 5.001 ; use strict ; use warnings ; 
use Getopt::Std ; getopts '0:12:cf:nr_~/:' , \my%o ; 
use Scalar::Util qw/looks_like_number/ ;
use Term::ANSIColor qw/:constants/ ; $Term::ANSIColor::AUTORESET = 1 ; 

my $sep = $o{'/'} // "\t" ; # 入出力の区切り文字
my $empty = $o{0} // 'undef' ;   # 対応する値が無い場合の代替の値 
my $cutpos = $o{f} // 1 ;	 # 各行を左から何番目の列で切るか
my %val ; # $val{ キーの値 } [ ファイル番号 ] = バリューの値 
my $pole = 0 ; 
my $Flst = (defined $o{2} && $o{2} =~ m/\./ ) ; # 各ファイルで同じキーが出現した場合に最後のバリューを採用するかどうかのフラグ
my $Fcon = (defined $o{2} && $o{2} =~ m/:/ ) ; # 各ファイルで同じキーが出現した場合に最後のバリューを採用するかどうかのフラグ
my (@keg1,%keg1) ; # -1 が指定された場合、キーが最初に読まれた順に、出力の順序を一致させる、ために使う変数

scripts/joinn  view on Meta::CPAN

        elsif ($Fcon) { grep { if ( defined $_ ) { $_ .= ":$value" } else { $_ = $value } } $val{ $key } [ $pole ] }  
        else { $val{ $key } [ $pole ] //= $value } ; # キー(1列目)ごとに ファイル番号を表す $pole ごとに値(2列目)を格納。
    }
}

sub outputting { 
    my @keg = keys %val unless $o{1} ; 
    @keg = 
        $o{1} ? @keg1 : 
        $o{n} ? 
            (@{[sort {$a <=> $b} grep {   looks_like_number($_) } @keg ]} ,  
                sort {$a cmp $b} grep { ! looks_like_number($_) } @keg   ) : 
           sort @keg ;  
     
    @keg = reverse @keg if $o{r} ;

    *UNDERLINE = sub {@_} unless $o{'_'} ;
    for my $k ( @keg ) { 
        print scalar @{[grep {defined $_} @{$val{$k}} ]}, "\t" if $o{c} ;
        print UNDERLINE $k ;
        print join $sep , '' , map {  $val{$k}[$_] // $empty } 0 .. $pole -1 ; 
        print "\n" ; 

scripts/summing  view on Meta::CPAN

#!/usr/bin/perl
use 5.014 ; use strict; use warnings;
use Time::HiRes qw [ gettimeofday tv_interval ] ;
my ${ dt_start } = [ gettimeofday ] ; 
use Scalar::Util qw/looks_like_number/;
use Getopt::Std; getopts "=~1:c:f:ghqu", \my%o;
use Term::ANSIColor qw[ :constants ] ; 
use feature qw[ say ] ; 
sub readInput () ;  # 入力の読取り 
sub printOutput () ; # 出力の書き出し

eval { use bigint qw[ hex ]} if $o{h} ;

$| = 1 unless $o{u} ;
my $sum = 0 ; # 求めたい合計値

scripts/summing  view on Meta::CPAN

sub readInput () { 
  chomp ( $header = <> ) if $o{'='} ; # ヘッダ行
  $SIG{ INT } = $ { ctrl_c }  ;
  # 型グロブ/シンボルテーブルを使ってみた。
  #my $org ; # 入力の元の文字列
  * orgStore = defined $o{1} && $o{1} ? sub { @_ =  ($_) } : sub { @_ = () } ; 
  * colChoose = defined $fp ? sub { $_ = [ split ] -> [ $fp ] }  : sub {  } ; 
  * caseHex = defined $o{h} ? sub { $_ = hex $_ } : sub {} ; 
  * outOfCount = defined $o{c} && $o{c} == 0 ? sub {  } : sub { do { $nlln ++ ; goto LOOP } if ! & get_num } ; 
  * theSumming = $o{h} ? sub { $sum += $_ } : sub { $sum = "$sum" + "$_" } ;
  * get_num  = $o{g} ? sub {   m/[-\.\d]+/ ; $_ = $& ; looks_like_number $_  } : sub { looks_like_number $_ }  ;
  * progress = defined $o{1} && $o{1} eq '0' ? sub { () } :
      ! $o{'~'} ? sub{ s/(^|[^0123456789.eEfF+-])(\d+)/$1+$2/g ; "$sum"."\t<= $_" } : # eEfFなどとある部分はこれで良いのか?
      sub { s/(^|[^+-0123456789.eEfF+-])(\d+)/$1+$2/g ; "$_\t"."=> $sum" } ; 
  * doPrint = defined $o{1} && $o{1} eq '0' ? sub { } : sub { say join "\t" , @_ } ; 
      
  LOOP : while( <> ) {
    chomp ;
    & orgStore ;
    & colChoose ; 
    & caseHex ;

scripts/summing  view on Meta::CPAN

    exit 0 ;
}

=encoding utf8
=head1

    $0 

    入力の値を1行ずつに単純に足し合わせる。補助情報として、何行が数として扱われたか、平均値など出力する。
    10進数で加算を行う。
    数かどうかの判定は Scalar::Util の looks_like_number 関数を使っている。値は単純に足している。atof など使っていない。

 出力: 
   1. 合計値
   2. 合計に使われた数の個数
   3. 合計に使われなかった行の数
   4. 平均値
   5. 計算に使った秒数(小数点以下6桁)

 オプション: 
   -= : 最初の行をヘッダと見なし、それが何であったかを最後に出力する。