#!/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} //= '' ; # æ–‡å—を切り分ã‘るパターン。æ£è¦è¡¨ç¾ binmode STDOUT, 'utf8' unless $binFlag ; sub main () ; * main = $o{L} ? * bylen : $o{S} ? * blanks : * normal ; # <-- mainã®å®šç¾©ã¯ã“ã“ã§ã‚る。 & main ; exit 0 ; # ã©ã‚“ãªç¨®é¡žã®ç©ºç™½ã‹ã‚’æ•°ãˆã‚‹ãƒ¢ãƒ¼ãƒ‰: sub blanks ( ) { my $header = <> if $o{'='} ; my %seen ; # åŒã˜è¡ŒãŒæ¥ãŸã‹ã©ã†ã‹ã®åˆ¤å®šã«ä½¿ã†ã€‚æ•°ãŒé›†è¨ˆã•ã‚Œã‚‹ã€‚ my %counts ; while ( <> ) { next if $o{1} && $seen{$_} ++ ; chomp ; $_ = decode_utf8 $_ unless $binFlag ; my @blanks = m/[[:blank:]]/g ; # <-- - perldoc perlrecharclass perlunicode ã‚’å‚ç…§ã™ã‚‹ã®ãŒè‰¯ã„ã‹ã‚‚ Unicodeæ–‡å—プãƒãƒ‘ティ #print "XX" if @blanks ; $counts { $_ } ++ for @blanks ; } for ( sort keys %counts ) { print sprintf "U+%X %s:\t%d\n", ord ($_) , $_ , $counts { $_ } ; } } # é•·ã•æ¯Žã«æ•°ãˆã‚‹ãƒ¢ãƒ¼ãƒ‰: sub bylen ( ) { my $header = <> if $o{'='} ; my %seen ; # åŒã˜è¡ŒãŒæ¥ãŸã‹ã©ã†ã‹ã®åˆ¤å®šã«ä½¿ã†ã€‚æ•°ãŒé›†è¨ˆã•ã‚Œã‚‹ã€‚ my %M ; # æ–‡å—列長ã•ã”ã¨ã®æ–‡å—列最å°å€¤ã¨æ–‡å—åˆ—æœ€å¤§å€¤ã‚’æ ¼ç´ã™ã‚‹ã€‚ my %frq ; # æ–‡å—列長ã”ã¨ã®é »åº¦ while ( <> ) { next if $o{1} && $seen{$_} ++ ; chomp ; $_ = decode_utf8 $_ unless $binFlag ; my $len = length $_ ; $frq{$len} ++ ; $M{$len}[0] = $_ if ! defined $M{$len}[0] || $M{$len}[0] gt $_ ; $M{$len}[1] = $_ if ! defined $M{$len}[1] || $M{$len}[1] lt $_ ; $M{$len}[2] = $_ if ! $o{2} && ! defined $M{$len}[2] ; $M{$len}[3] = $_ if ! $o{2} ; } print join ( "\t", map {UNDERLINE $_} qw[length freq min_str max_str] , ! $o{2} ? qw[first_str last_str ]:() ) , "\n" ; for ( sort { $a <=> $b } keys %M ) { # 数値 (æ–‡å—列ã®é•·ã•ã‚’表ã™)ã§ã‚½ãƒ¼ãƒˆ my @t = @{ $M{$_} } ; grep { defined $_ and $_ = qq['$_'] } @t unless defined $o{q} && $o{q} eq '0' ; $t[1] = '' if $t[1] eq $t[0] ; $t[2] = '' if defined $t[2] and $t[2] eq $t[0] || $t[2] eq $t[1]; $t[3] = '' if defined $t[3] and $t[3] eq $t[0] || $t[3] eq $t[1]; print join ( "\t" , $_ , $frq{$_}, @t ) , "\n" ; } } # 普通ã®ãƒ¢ãƒ¼ãƒ‰: sub normal ( ) { my %S ; # $S{$char}[$pos] ã®ã‚ˆã†ã«ä½¿ã†ã€‚ 出ç¾å›žæ•°ã®é›†è¨ˆè¡¨ my $maxlen = 0 ; # æ–‡å—列ã®æœ€å¤§é•· my $header = <> if $o{'='} ; my %seen ; # åŒã˜è¡ŒãŒæ¥ãŸã‹ã©ã†ã‹ã®åˆ¤å®šã«ä½¿ã†ã€‚æ•°ãŒé›†è¨ˆã•ã‚Œã‚‹ã€‚ while ( <> ) { next if $o{1} && $seen{$_} ++ ; chomp ; $_ = decode_utf8 $_ unless $binFlag ; my @c = split /$o{p}/, $_ , 0 ; # <-- - 区切る $S{ qq['$c[$_]'] }[ $_ ] ++ for 0 .. $#c ; # <-- ã‚¯ã‚©ãƒ¼ãƒ†ãƒ¼ã‚·ãƒ§ãƒ³ã‚’ä»˜åŠ ã™ã‚‹ã‚ˆã†ã«ã—ãŸã€‚ $S{ $o{'$'} } [ @c ] ++ ; # æ–‡å—列終端記å·ã®è¶³ã—åˆã‚ã› $maxlen = @c if $maxlen < @c ; # 最大長ã®ä¿ç®¡ } # 出力 print join ("\t" , map {UNDERLINE GREEN $_} '' , 1 .. $maxlen + 1 ) , "\n" ; for ( sort {$a eq $o{'$'} ? 1 : ( length ($a) <=> length($b) || $a cmp $b ) } keys %S ){ # <-- ã‚½ãƒ¼ãƒˆé †ã«ã¯æ³¨æ„ã—ãŸã„ my @tmp = map { $_ // 0 } @{ $S{$_} } [ 0 .. $maxlen ] ; s/(^\')|(\'$)//g if defined $o{q} && $o{q} eq '0' ; print join ( "\t" , YELLOW ($_) , @tmp ) , "\n" ; } } =x ## ヘルプã¨ãƒãƒ¼ã‚¸ãƒ§ãƒ³æƒ…å ± BEGIN { our $VERSION = 0.02 ; $Getopt::Std::STANDARD_HELP_VERSION = 1 ; grep { m/--help/} @ARGV and *VERSION_MESSAGE = sub {} ; # 目安: # 0.21 : 人ã«ãªã‚“ã¨ã‹æä¾›ã§ãる段階㧠0.21 を目安ã¨ã™ã‚‹ã€‚ # 1.00 以上 : 英語版ã®ãƒ˜ãƒ«ãƒ—ã‚’ãã¡ã‚“ã¨å‡ºã™ã“ã¨ãŒå¿…è¦æ¡ä»¶ã€‚ # 2.00 以上 : テストコードãŒå«ã‚€ã“ã¨ãŒå¿…è¦æ¡ä»¶ã€‚ # 0.01 : 2018-06-28 2個ã®å¤§ããªæ©Ÿèƒ½ã‚’最åˆã«ä½œã£ãŸã€‚ # 0.02 : 2018-06-29 空白文å—を分類ã—ã¦é›†è¨ˆã™ã‚‹æ©Ÿèƒ½ã‚’実装ã—ãŸã€‚ } sub HELP_MESSAGE { use FindBin qw[ $Script $Bin ] ; sub EnvJ ( ) { $ENV{LANG} =~ m/^ja_JP/ ? 1 : 0 } ; # # ja_JP.UTF-8 sub en( ) { grep ( /^en(g(i(sh?)?)?)?/i , @ARGV ) ? 1 : 0 } # English ã¨ã„ã†æ–‡å—列を先é ã‹ã‚‰2æ–‡å—以上をå«ã‚€ã‹ sub ja( ) { grep ( /^jp$|^ja(p(a(n?)?)?)?/i , @ARGV ) ? 1 : 0 } # jp ã¾ãŸã¯ japan ã¨ã„ã†æ–‡å—列を先é ã‹ã‚‰2æ–‡å—以上をå«ã‚€ã‹ sub opt( ) { grep (/^opt(i(o(ns?)?)?)?$/i, @ARGV ) ? 1 : 0 } # options ã¨ã„ã†æ–‡å—列を先é ã‹ã‚‰3æ–‡å—以上å«ã‚€ã‹ã‚‰ sub noPOD ( ) { grep (/^no-?pod\b/i, @ARGV) ? 1 : 0 } # POD を使ã‚ãªã„ã¨è¨€ã†æŒ‡å®šãŒã•ã‚Œã¦ã„ã‚‹ã‹ã©ã†ã‹ my $jd = "JapaneseManual" ; my $flagE = ! ja && ( en || ! EnvJ ) ; # 英語ã«ã™ã‚‹ã‹ã©ã†ã‹ã®ãƒ•ãƒ©ã‚° exec "perldoc $0" if $flagE && ! opt && ! noPOD ; $ARGV[1] //= '' ; open my $FH , '<' , $0 ; while(<$FH>){ s/\Qboxmuller\E/$Script/gi ; s/\$Bin/$Bin/gi ; if ( s/^=head1\b\s*// .. s/^=cut\b\s*// ) { if ( s/^=begin\s+$jd\b\s*// .. s/^=end\s+$jd\b\s*// xor $flagE ) { print $_ if ! opt || m/^\s+\-/ ; } } } close $FH ; exit 0 ; } =cut ## ヘルプã®æ‰±ã„ sub VERSION_MESSAGE {} sub HELP_MESSAGE { use FindBin qw[ $Script ] ; $ARGV[1] //= '' ; open my $FH , '<' , $0 ; while(<$FH>){ s/\$0/$Script/g ; print $_ if s/^=head1// .. s/^=cut// and $ARGV[1] =~ /^o(p(t(i(o(ns?)?)?)?)?)?$/i ? m/^\s+\-/ : 1; } close $FH ; $o{v} = 0 ; exit 0 ; } =encoding utf8 =begin JapaneseManual =head1 digitdist 改行区切りã®å€¤ã«å¯¾ã—ã¦ï¼Œå…ˆé ã‹ã‚‰$n$æ¡ç›®ã«ã©ã‚“ãªæ–‡å—ãŒç¾ã‚ŒãŸã‹ã‚’集計ã™ã‚‹ã€‚ (出力表ã¯ç¸¦ã¯å‡ºç¾ã—ãŸæ–‡å—ã§ã€$n$ãŒå¢—ãˆã‚‹ã¨å³æ–¹å‘ã®ã€ã‚¯ãƒã‚¹é›†è¨ˆè¡¨ãŒå‡ºåŠ›ã•ã‚Œã‚‹ã€‚) -L ãŒæŒ‡å®šã•ã‚Œã‚‹ã¨ã€æ–‡å—列長ã”ã¨ã®ã€æ–‡å—列ã®æœ€å°å€¤ã¨æœ€å¤§å€¤ãŒå‡ºåŠ›ã•ã‚Œã‚‹ã€‚ オプション: -= : å…ˆé 行をèªã¿é£›ã°ã™ -1 : データã§å…¨ãåŒã˜è¡ŒãŒ2回以上æ¥ãŸã‚‰ã€èªã¿é£›ã°ã™ã€‚ -u 0 : ãƒã‚¤ãƒŠãƒªã§å‡¦ç†ã™ã‚‹(通常㯠UTF-8ã§å‡¦ç†ã‚’ã™ã‚‹) -p str : æ£è¦è¡¨ç¾ã«ã‚ˆã‚‹ãƒ‘ターンã®æŒ‡å®šã€‚ '^(....)(...)(.)$' ç‰ã‚’指定ã™ã‚‹ã€‚ -q 0 : 出力ã§æ–‡å—をシングルクォーテーションã§å›²ã¾ãªã„。 -$ str : æ–‡å—列ã®çµ‚端を表ã™å‡ºåŠ›ç”¨ã®è¨˜å·ã‚’ENDã‹ã‚‰å¤‰æ›´ã™ã‚‹ã€‚ -L ; æ–‡å—列長毎ã«ã€æ–‡å—列ã®æœ€å°å€¤ã¨æœ€å¤§å€¤ã‚’å–り出ã™ã€‚ -2 ; -L ã®æŒ‡å®šãŒã‚ã‚‹å ´åˆã«ã€æœ€åˆã«å‡ºç¾ã—ãŸæ–‡å—列ã¨ã€æœ€å¾Œã«å‡ºç¾ã—ãŸæ–‡å—列をå–り出ã—ã¦ã„ã‚‹ãŒã€ãれをæ¢ã‚る。 -S ; 空白文å—を分類ã—ã¦æ•°ãˆã‚‹ã€‚(長音文å—も対応ã—ãŸã„。少画数ã®æ–‡å—も集計ã—ãŸã„。) --help : ã“ã®ã‚ªãƒ³ãƒ©ã‚¤ãƒ³ãƒ˜ãƒ«ãƒ—を表示ã™ã‚‹ã€‚ --version : ãƒãƒ¼ã‚¸ãƒ§ãƒ³æƒ…å ±ã‚’è¡¨ç¤ºã™ã‚‹ã€‚ 使ã„æ–¹ã®ä¾‹ : 1. 何も分ã‹ã‚‰ãªã„æ–‡å—列集åˆã«ã¤ã„ã¦ã€å…·ä½“çš„ãªå€¤ã®æ§˜åを確ã‹ã‚る最åˆã®1æ©ã§ã‚る。 2. ルールを発見ã™ã‚‹ã€‚極ã‚ã¦å°‘æ•°ã®ä¾‹ã‹ã‚‰ã€ãƒ‡ãƒ¼ã‚¿ã®å€¤ã®ç ´æやテスト値を見ã¤ã‘る。 3. 特異ãªå€¤ã«ã¤ã„ã¦ã€æ›´ã«æ·±ã調ã¹ã‚‹å¯¾è±¡ã¨ã™ã‚‹ã€‚ 開発上ã®ãƒ¡ãƒ¢ : * 出力ã™ã‚‹å„è¡Œã®ã‚½ãƒ¼ãƒˆé †ã¯æŒ‡å®šã§ãるよã†ã«ã—ãŸæ–¹ãŒä¾¿åˆ©ãã†ã€‚ * -Lã®å ´åˆã«ã€-g N ã®æŒ‡å®šã«ã‚ˆã‚Šã€æœ€å°å€¤N個ã€æœ€å¤§å€¤N個をå–り出ã›ã‚‹ã‚ˆã†ã«ã—ã¦ã‚‚良ã„ã‹ã‚‚。 * -Lã®å ´åˆã«å‡ºåŠ›ã™ã‚‹å‡ºç¾æ–‡å—列ã«ã¤ã„ã¦ã€å‡ºç¾é »åº¦ã‚‚出力出æ¥ã‚‹æ§˜ã«ã—ãŸã„。 =end JapaneseManual =cut