#!/usr/bin/perl use 5.014 ; use strict ; use warnings ; use POSIX qw [ floor ceil ] ; use FindBin qw [ $Script $Bin ] ; use Getopt::Std ; getopts '=@:LIbhi:lp:q:stw02:3' , \my %o ; use List::Util qw[ sum sum0 ] ; use Term::ANSIColor qw [ color :constants ] ; $Term::ANSIColor::AUTORESET = 1 ; use Time::HiRes qw[ alarm tv_interval gettimeofday ] ; use Scalar::Util qw[ dualvar ] ; sub proc_read ( ) ; # èªå–りã®å‡¦ç† sub proc_out ( ) ; # 出力ã®å‡¦ç† sub Info2ndry ( ) ; # 2æ¬¡æƒ…å ±ã®å‡ºåŠ› sub high_val ( $ ) ; # 0ã‹ã‚‰$Qã¾ã§ã®ä½•番目を表示ã—ãŸã„ã‹ã‚’引数ã¨ã—ã¦å—ã‘å–りã€ç·šå½¢è£œé–“ã—ãŸå€¤ã‚’è¿”ã™ã€‚ sub low_val ( $ ) ; # 0ã‹ã‚‰$Qã¾ã§ã®ä½•番目を表示ã—ãŸã„ã‹ã‚’引数ã¨ã—ã¦å—ã‘å–りã€ç·šå½¢è£œé–“ã—ãŸå€¤ã‚’è¿”ã™ã€‚ sub near_val ( $ ) ; # 0ã‹ã‚‰$Qã¾ã§ã®ä½•番目を表示ã—ãŸã„ã‹ã‚’引数ã¨ã—ã¦å—ã‘å–りã€ç·šå½¢è£œé–“ã—ãŸå€¤ã‚’è¿”ã™ã€‚ sub intp_val ( $ ) ; # 0ã‹ã‚‰$Qã¾ã§ã®ä½•番目を表示ã—ãŸã„ã‹ã‚’引数ã¨ã—ã¦å—ã‘å–りã€ç·šå½¢è£œé–“ã—ãŸå€¤ã‚’è¿”ã™ã€‚ sub midreport ( ) ; my $time0 = [gettimeofday] ; my $header = <> if $o{'='} ; my $Q = int ( $o{q} // 4 ) ; # 分ä½ç‚¹ã‚’求ã‚ã‚‹ã®ã«ã€ä½•分割をã™ã‚‹ã‹ã€‚ã“ã®ãƒ—ãƒã‚°ãƒ©ãƒ ã®ä½œæˆè€…ã¯å€‹äººçš„ã«å…åˆ†ä½æ•°ãŒå¥½ãã§ã‚る。 my @xco = defined $o{p} ? eval $o{p} : 0 .. $Q ; # ã©ã®åˆ†ä½ç‚¹ã‚’出力ã™ã‚‹ã‹ã€‚ my $sep = $o{i} // "\t" ; my $LL = -1 ; # èªã¿å–ã£ãŸè¡Œæ•° マイナス 1 ; 分ä½ç‚¹ã‚’算出ã™ã‚‹ãŸã‚ã«ã€1 を減ã˜ã‚‹ãƒˆãƒªãƒƒã‚¯ã‚’使ã£ã¦ã„る。 my @V = () ; # ãƒ¬ã‚³ãƒ¼ãƒ‰ã®æ•°å€¤ã‚’æ ¼ç´ã™ã‚‹ã€‚ my %VV = () ; # 複数列(2列目以é™ã®å€¤ã§å±¤åˆ¥ã™ã‚‹ã‚ªãƒ–シヨン) ã®æ™‚ã«ã€@V ã‚’æ ¼ç´ã™ã‚‹ã‚ˆã†ãªæ™‚ã«ç”¨ã„る。 proc_read ; proc_out ; Info2ndry if not 0 eq ($o{2}//1) ; exit 0 ; # 以下ã¯é–¢æ•° sub proc_read ( ) { $SIG{ALRM} = sub { & midreport ; alarm $o{'@'}//2 } ; alarm $o{'@'}//2 ; my $layer ; # 層別ã®å±¤ã®å€¤ã€‚ãŸã ã— -2ãŒæŒ‡å®šã•れãªã„å ´åˆã¯ 空文å—列を使ã†ã“ã¨ã«ãªã‚‹ã€‚ * layer = ! $o{3} ? $o{L} ? sub { ( $_ , $layer ) = split /$sep/ , $_ , 2 } : sub { $layer = '' } : $o{L} ? sub { my @F = split /$sep/, $_, 3 ; $_ = dualvar $F[0],$F[1] ; $layer = $F[2] } : sub { my @F = split /$sep/, $_, 2 ; $_ = dualvar $F[0],$F[1] ; $layer = '' } ; while ( <> ) { chomp ; & layer ; push @{ $VV{ $layer } } , $_ ; $LL ++ ; } alarm 0 ; do { * STDOUT = * STDERR ; HELP_MESSAGE () ; exit } if $. == 0 ; # èªå–りãŒ0行ãªã‚‰ã°ã€ãƒ˜ãƒ«ãƒ—を出ã™ã€‚ } sub proc_out ( ) { say UNDERLINE join "\t" , @xco , 'num' , $o{L} ? 'Layer' : '' ; # 出力表ã®è¡¨é do { @V = @{ $VV{$_} } ; LayerOut ( $_ ) } for sort keys %VV ; # 出力表ã®ä¸èº« # <-- - ソートã®ä»•æ–¹ã«æ•°å€¤ã‚½ãƒ¼ãƒˆã®ã‚ªãƒ—ã‚·ãƒ§ãƒ³ãŒæ¬²ã—ã„。 } sub LayerOut ( $ ) { # 出力å„行ã«ã¤ã„ã¦ã®å‡¦ç† : our $layer = $_[0] ; our $Vd = $#V ; # divisionã®æ•° @V = $o{s} ? sort @V : sort { $a <=> $b } @V ; sub LineOut ( &$ ) { # 出力1行ã®å‡¦ç†å†…容 say join "\t", map ( $_[0]->($_) + 0, @xco ) , ($Vd+1) . $_[1] , $layer if!$o{s} ; say join "\t", map ( $_[0]->($_) .'', @xco ) , ($Vd+1) . $_[1] , $layer if $o{s} ; # dualvar 対ç–ã§å†—é•·ã«ãªã£ã¦ã—ã¾ã£ãŸã€‚ } # 分ä½ç‚¹ã®è¨ˆç®—法 (概念的ã«è€ƒãˆã‚‰ã‚Œã‚‹ä½Žã„æ–¹ã®å€¤ã€é«˜ã„æ–¹ã®å€¤ã€ç·šåž‹è£œé–“ã€å˜ç´”ã«è¿‘ã„値) sub low_val ( $ ) { $V[ floor $_[0] * $Vd / $Q ] } ; sub high_val ( $ ) { $V[ ceil $_[0] * $Vd / $Q ] } ; sub near_val ( $ ) { $V[ floor $_[0] * $Vd / $Q + 0.5 ] } ; # å››æ¨äº”入法ã¨ãªã‚‹. sub intp_val ( $ ) { my $x=$_[0]*$Vd/$Q ; my $x1=floor $x ; my $x2=ceil $x ; my $f1=$x-$x1 ; $V[$x1]*(1-$f1)+$V[$x2]*$f1 } LineOut ( \& high_val , '+' ) if $o{h} ; # 上å´ã®å€¤ LineOut ( \& near_val , '' ) if!$o{0} ; # 通常ã®ä¸é–“ã®å€¤ ( -0ãŒæŒ‡å®šã•れãŸã‚‰ã€é€šå¸¸ã®å€¤ã¯å‡ºåŠ›ã—ãªã„。) LineOut ( \& intp_val , 'i' ) if $o{I} ; # 線型補間値ã§å‡ºåŠ› LineOut ( \& low_val , '-' ) if $o{l} ; # 下å´ã®å€¤ say BOLD join "\t" , & SelfWeight() , $layer if $o{w} || $o{3} ; sub SelfWeight () { #my $total = sum0 @V ; my $total = sum0 map { $_ . '' } @V ; # dualvarã®å ´åˆã€æ–‡å—列ã¨ã—ã¦æ ¼ç´ã•ã‚ŒãŸæ–¹(é‡ã¿)ã ã‘ãŒè¶³ã•れる my @ths = map { $total * $_ / $Q } @xco ; # 閾値 my ( $t, $t_ ) = ( 0 , 0 ) ; # 途ä¸ã®åˆè¨ˆ my @ret ; # çµæžœã®æ ¼ç´ç”¨ my $i = 0 ; # 引数 do { push @ret , $V[0] ; $i++ } if $ths[0] == 0 ; #<-- 0ã®ä»£ã‚りã«V[0]を代入。ã“ã“ã ã‘特別ã§ã€ä¾¿å®œä¸Šã®ã‚‚ã®ã€‚よããªã„。 LOOP : for ( @V ) { $t_ = $t ; $t += $_ . '' ; # dualvarã®å ´åˆã€æ–‡å—åˆ—ã®æ–¹ãŒé‡ã¿ã§ã‚ã£ãŸã€‚ while ( $t_ < $ths[$i] && $ths[$i] <= $t ) { push @ret , $_ + 0 ; # dualvarã®å ´åˆã€æ•°ã®æ–¹(ã™ã§ã«ã‚½ãƒ¼ãƒˆæ¸ˆã¿ã•れる方)を採用 last LOOP if ++ $i > $#ths ; } } push @ret , $total ; return @ret ; } } sub midreport ( ) { #return if eof ; # <-- ãŸã コメントアウトã—ãŸã‚‰ã€æ„図通り動作ã™ã‚‹ã‚ˆã†ã«ãªã£ãŸã€‚ã“れã§è‰¯ã‹ã£ãŸã®ã‹? use FindBin '$Script' ; $| = 1 ; my $lines = $. ; $lines =~ s/(?<=\d)(?=(\d\d\d)+($|\D))/,/g ; # 3æ¡æ¯Žã«ã‚³ãƒ³ãƒžã§åŒºåˆ‡ã‚‹ $lines .= $lines eq "1" ? ' line' : ' lines' ; my @out ; my @t2 = gettimeofday ; my @dt = (localtime $t2[0])[5,4,3,2,1,0] ; push @out, "[$Script ", (sprintf "%02d-%02d-%02d %02d:%02d:%02d.%06d", $dt[0]+1900,$dt[1]+1,@dt[2..5],$t2[1]) , "]" ; # <-- æ¨™æº–å‡ºåŠ›ã«æ›¸è¾¼ã¿ push @out, " $lines read" ; print STDERR GREEN @out , "\n" ; } sub Info2ndry ( ) { $LL ++ ; $LL =~ s/(?<=\d)(?=(\d\d\d)+($|\D))/,/g ; # 3æ¡æ¯Žã«ã‚³ãƒ³ãƒžã§åŒºåˆ‡ã‚‹ my $out = '' ; $out = CYAN "[$Script] read lines : " ; $out .= BRIGHT_CYAN $LL ; $out .= CYAN " (" . tv_interval ($time0) . " sec.) " ; $out .= BRIGHT_CYAN $Q . CYAN " divisions." ; say STDERR $out ; } =encoding utf8 =head1 $0 -/ 分ä½åˆ†å‰²æ•° 分ä½ç‚¹ã‚’求ã‚る。通常ã®(ç·šå½¢)補間値ã®ã¿ãªã‚‰ãšã€ä¸Šå´ã®å€¤ã¨ä¸‹å´ã®å€¤ã‚‚出力ã™ã‚‹ã€‚ 2æ¬¡æƒ…å ±ã¨ã—ã¦ä½•個ã®å€¤ã‚’入力ã‹ã‚‰èªã¿å–ã£ãŸã‹ã‚‚ã€æ¨™æº–エラー出力ã«å‡ºåŠ›ã€‚ オプション : -= : 最åˆã®è¡Œã‚’èªã¿é£›ã°ã™ã€‚ -q N : 分ä½åˆ†å‰²ã®æ•°Nを指定ã™ã‚‹ã€‚ -p 1..5ãªã© : 何番目ã®åˆ†ä½ç‚¹ã‚’出力ã™ã‚‹ã‹ã‚’指定ã™ã‚‹ã€‚å°æ•°ã‚‚指定å¯èƒ½ã€‚, ã‚„ .. ãŒä½¿ãˆã‚‹ã€‚ -h : 分ä½ç‚¹ã®è¨ˆç®—ã«ãŠã„ã¦ã€è€ƒãˆã‚‰ã‚Œã‚‹å¤§ãã„値ã«ã¤ã„ã¦ã‚‚ã€å‡ºåŠ›ã™ã‚‹ã€‚ -I : 分ä½ç‚¹ã‚’観測値ã«å˜åœ¨ã™ã‚‹å€¤ã§ã¯ãªãã¦ã€ç·šå½¢è£œé–“ã—ãŸå€¤ã‚’用ã„る。 -l : 分ä½ç‚¹ã®è¨ˆç®—ã«ãŠã„ã¦ã€è€ƒãˆã‚‰ã‚Œã‚‹å°ã•ã„値ã«ã¤ã„ã¦ã‚‚ã€å‡ºåŠ›ã™ã‚‹ã€‚ -0 : 通常ã®ã‚ˆã使ã‚れる分ä½ç‚¹ã®å€¤ã‚’出ã•ãªã„。(-h, -l, -i ã‚’ä½¿ã†æ™‚ã«ä¾¿åˆ©ã€‚) -s : 入力を数値ã¨ã—ã¦ã§ã¯ãªãã€æ–‡å—列ã¨ã—ã¦å‡¦ç†ã™ã‚‹ã€‚日時を扱ã†å ´åˆãªã©ã«ä½¿ã†ã€‚ -L ; 層別ã«åˆ†ä½ç‚¹ã‚’出力ã™ã‚‹ã€‚1列目を値ã¨è¦‹ãªã—ã€ã‚¿ãƒ–区切り2列目以é™ã‚’層ã®ãƒ©ãƒ™ãƒ«ã¨è¦‹ãªã™ã€‚ -w ; 分ä½å€¤ã‚’算出ã™ã‚‹éš›ã«ã€å„値を平ç‰ã«æ‰±ã†ã®ã§ã¯ãªãã¦ã€ãã®å€¤è‡ªä¿¡ã§é‡ã¿ã‚’付ã‘る。(æ£ã®å€¤ã‚’仮定ã™ã‚‹ã€‚) -3 : -w ã§æ•°å€¤ãŒ2列ã¨ã™ã‚‹ã€‚å·¦å´ãŒæ˜‡é †ã‚½ãƒ¼ãƒˆã•れるãŒã€é‡ã¿ã¯è‡ªå·±é‡ã¿ã§ã¯ãªãã¦ã€å³å´ã®å€¤ã¨ãªã‚‹ã€‚ -i str ; 入力ã®åŒºåˆ‡ã‚Šæ–‡å—ã‚’strã¨ã™ã‚‹ã€‚ -@ N : 一定秒数ã”ã¨ã«ã€æ¨™æº–エラー出力ã«ãƒ¬ãƒãƒ¼ãƒˆã‚’出ã™ã€‚未指定ãªã‚‰ã€10秒。 -2 0 : 2æ¬¡æƒ…å ±ã‚’å‡ºåŠ›ã—ãªã„。 --help : ヘルプを出力。(ã“ã®è¡¨ç¤ºã‚’出力ã™ã‚‹ã€‚) --help opt : $0 ã®å¼•æ•°ã®å†…ã®ã‚ªãƒ•ションスイッãƒ( - ã§å§‹ã¾ã‚‹å¼•æ•°)ã«ã¤ã„ã¦ã®è§£èª¬ã‚’表示。 --version : ãƒãƒ¼ã‚¸ãƒ§ãƒ³æƒ…å ±ã®è¡¨ç¤º 開発メモ : * 出力ã™ã‚‹æ•°ã®æ¡æ•°ã®æŒ‡å®šãŒå¿…è¦ãã†ã€‚sprintf , printf を使ã‚ãªã„よã†ã«ã—ãŸã„。 * 出力出æ¥ã‚‹æ•°ã«ã¤ã„ã¦ã€ printf書å¼ã‚’指定ã§ãるよã†ã«ã—ãŸã„。 * -@ ã«ã‚ˆã‚‹ä¸€å®šæ•°è¡Œæ¯Žã®ãƒ¬ãƒãƒ¼ãƒˆã§ã¯ç„¡ãã¦ã€ALRMを使ã£ã¦ä¸€å®šæ™‚é–“ãŠã(10ç§’ã”ã¨)ã®ãƒ¬ãƒãƒ¼ãƒˆã¨ã—ãŸã„。 * 数値ã§ã‚ã‚‹ã‹ã©ã†ã‹ã®åˆ¤å®šã‚’入れãŸã„。 * ä¿å®ˆã®ãŸã‚ã«ã€é–¢æ•°å†…ã®é–¢æ•°ã‚’活用ã—よã†ã‹ã€‚ * -w ã®å ´åˆã«ã€ -h, -I, -l も考慮ã—ãŸã„。今ã¯å˜ç´”ãªã‚‚ã®ã®ã¿ã§ã‚る。 ** -w ç„¡ã—ã® -3 ã®æŒ™å‹•ã®è¨è¨ˆãŒä¸è‡ªç„¶ãªã®ã§ã€å†æ¤œè¨Ž # <--- -- "-w" ã¯è‡ªå·±é‡ã¿ä»˜ã‘ , -3 ã¯ã€é‡ã¿ä»˜ã‘自体を表ã—ã¦ã„ã‚‹ =cut ## ヘルプã¨ãƒãƒ¼ã‚¸ãƒ§ãƒ³æƒ…å ± BEGIN { $Getopt::Std::STANDARD_HELP_VERSION = 1 ; grep { m/--help/} @ARGV and *VERSION_MESSAGE = sub {} ; 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 ; }