view release on metacpan or  search on metacpan

digitdemog  view on Meta::CPAN

sub main_normal ( ) { 

  my %freq ; # 同じ行が来たかどうかの判定に使う。数が集計される。
  my %S1 ; # $S1{$v}{$pos} のように使う。 出現回数の集計表 ; # ここの $v は 文字と言うよりパターンを示す。'a'とか [1-3]とか。ここでは「文字」と呼ぶ。
  my %S2 ; # $S2{$v}{$pos} = "行番号+行番号+...行番号+" (Lとする); $vが出現した桁$posに対応する行番号を蓄える。
  my %S3 ; # @ { $S3{ F } } によって、分割表で頻度 F 回現れた 行番号集合の値 L (%S2の持つ値)を参照できるようにする。
  my %mark ; # $mark{ L } がピリオドをピリオド付ける。 ( -. で使う。)
  my %Gs  ; # @{ $G { $v } { $pos } [ 0 or 1 ] } で 行の具体例を格納。 ( -g で使う。)
  my $maxlen = 0 ; # 文字列の最大長
  my $eol = "EOL" . int rand 8 ; # 各行の終わりを示す。## saikoro -g10,3 でいろいろ試した。

  @e = map { decode_utf8 $_ } @e unless $optu0  ;
  unshift @e , "$eol\$" ;  # 正規表現パターン群に $eol を 最初に 追加。 # 「行末」は頻度が多いので最初に持ってきた。
  #push @e , "$eol\$" ;  # 正規表現パターン群に $eol を 最後に 追加。# ここは、unshift でも push でも良い。
  my @eqr ; # 「e をqrされた 」により名付けた。
  my @exu ; # 「eにおいて、エスケープ(escape)してユニコード(unicode)で表した部分がある」により名付けた
  for ( 0 .. $#e ) { 
    my $eout = $e[$_] =~ s/#.*$//r ; # 正規表現で、コメント#の部分は除去する。
    my @F  = split /([[:^ascii:]])/o , $eout , 0 ; # パターンで切った最後は空文字列なら切り落とすための0
    grep { $_ =  (sprintf '\x{%02X}', ord $_ ) if m/[[:^ascii:]]/ } @F ;
    my $p = join '' , @F ;
    $eqr [ $_ ] = qr/$p/ ; # あらかじめ正規表現として先にコンパイルすることで高速化。
    push @exu , $p ;
  }

digitdemog  view on Meta::CPAN

  my $piecePattern = @e ? do{ my$t=join'|',@exu,'.','\n';qr/$t/o} : qr//o ; # @exuに1文字(.)と改行文字を追加した。

  $header = <> if $o{'='} ; 
  while ( <> ) { 
    chomp if 0 eq ($o{n}//'') ; #-n0 で改行文字を除去。
    next if $freq{$_} ++ && $o{1} ; # && の前後の順序に注意
    s/\r$// unless $optw0 ;    
    $_ = decode_utf8 $_ unless $optu0 ;
     # ▽ パターンに文字列を分解。
    my @vvec = m/$piecePattern/go ; 
    push @vvec , $eol ; # 各行をバラバラにした後に、$eolを最後に追加。
    splice @vvec , $width, if defined $width ; 
    $maxlen = @vvec if $maxlen < @vvec ; # 最大長の保管
    for my $pos ( 0 .. $#vvec ) {
      my $char = $vvec [ $pos ] ; # 実際の文字(列)。  (パターンにはまだ分類していない。)
      my $v  ; # どのパターンまたは文字として認識するか。(分類されたパターンなのである。)
       # ▽ どのパターンにマッチしたかを$vに格納する。次の2行のコードで。
      $char =~ $eqr[$_] and do { $v = $e[$_] ; last } for 0 .. $#e ; # 指定したパターンの数が多いと遅くなるであろう。頻度の高いパターンを先に置くと早くなる。
      $v //= "'$vvec[$pos]'" ; # 前行の処理で当てはまらない場合。クォーテーションを付加するようにした。
      $S1 { $v } { $pos } ++ ; 
      $S2 { $v } { $pos } .= "$.+" if $o{'.'} ; # <-- $S2{..}で、その「文字」がその桁で現れた、「行番号集合」L が結果的に生成される。

digitdemog  view on Meta::CPAN

  for my $v ( @vset ){ # <-- ソート順には注意したい
    my @out = map { $S1{$v}{$_} // 0 } 0 .. ( $maxlen - 1 ) ; 
    my @pvec = grep { $out[$_] } $o{g}=~/\.$/o ? reverse 0..$#out : 0..$#out ;  # 何桁目を見るか、そして、優先的にどこから見るか。
    my @pv = map { [ grep { $out[$_] } @{$_} ] } [0..$#out] , [reverse 0..$#out] ;  # 何桁目を見るか、そして、優先的にどこから見るか。
    my @example = $take2 -> ( $o{g} , map { my $way = $_ ; [ map{ @{$Gs{$v}{$_}[ $way ]} } @{$pv[$way]} ] } 0,1 ) if $o{g} ;
    @example = map{ backslash $_ , q['] } @example unless 0 eq ($o{b}//'') ; # -b0の指定が無ければ、改行などの文字をエスケープする。
    my $subtotal = sum0 @out ;  # その文字の出現回数 -- @out をさらに加工する前にここで取得。
    next until y_filter ( $subtotal )  ; 
    do { $out[$_] .= $mark{ $S2{$v}{$_} // '' } // '' if $out[$_] } for 0 .. $#out ; # 数字の後ろにピリオド付加
    @out = map { $_ eq 0 ? $o{0} : $_ } @out if defined $o{0} ;  # 頻度値がゼロの場合の置換
    my $code = do { my $c = substr $v,1,1 ; $v eq "$eol\$" ? 'end' : $vcate{$v} ? '---' : $ucd -> ($c) } ; # 文字コード取得。$vの加工前にここで処理。
    $v = $o{'$'} if $v eq "$eol\$" ; 
    $v = backslash $v , q["] ; 
    push @out , (YELLOW BOLD $v) , $code , (YELLOW $subtotal) ; 
    push @out, join $sep , @example ;
    say join "\t" , @out ;
  }
}

## ヘルプの扱い
sub VERSION_MESSAGE { } # --version でこの関数が使われる。
sub HELP_MESSAGE {