view release on metacpan or  search on metacpan

bin/denomfind  view on Meta::CPAN

    $cmd = "$0 -y0,3,4,5 -g290,20 -I -% 2.0 50.7 13.5 21.6 6.8" when  '3'  ;
    # ↓ワクチン1回目の例. 整数の分子が見つかるものが複数ある分母を出力。配付資料に253と書かれているが、その数あたりを出力。
    #   四捨五入を2回行って、最下位を1桁ずつ縮めた場合も想定している。従って、誤差も表示すると、最大のずれは0.05%でなく0.055%。
    $cmd = "$0  -y1.. -g230,50 -D-3% -Q -52 -% 48.2 26.9 23.1 21.6 20.0 12.2 6.7 5.9 2.4" when  'v1'  ;
    # ↓ワクチン2回目の例. 整数の分子が見つからないものが3個以下の分母を出力。配付資料の250という数が正しそうであると分かる。
    $cmd = "$0 -y-3.. -g50 -D0 -Q -% 65.2 45.6 35.6 30.8 29.6 26.4 14.8 7.2 5.6 4.8 4.4" when  'v2'  ;
    # ↓ワクチン3回目の例. 整数の分子が見つかるものが複数ある分母を出力。配付資料に分母97とあるが96も3個混じったとも考えられる。
    $cmd = "$0 -y2.. -D0 -Q -% 81.4 63.3 54.6 51.0 46.9 45.9 28.6 17.3 13.3 11.3 10.3" when  'v3'  ;
    # ↓ バンダイのお年玉の2018年の調査で、小学生、中学生、男子、女子の場合
    $cmd = "$0 -y, -52 -g5 -D-3% -Q -% 39.9 30.4 29.5 18.0 17.2" when  'o1'  ;
    $cmd = "$0 -y, -52 -g5 -D-3% -Q -% 33.7 31.8 23.5 22.7 22.0" when  'o2'  ;
    $cmd = "$0 -y, -52 -g5 -D-3% -Q -% 37.5 36.2 27.3 18.8 18.5" when  'o3'  ;
    $cmd = "$0 -y, -52 -g5 -D-3% -Q -% 39.4 35.7 21.5 20.7 18.4" when  'o4'  ;
    ## ↓ https://www.nexer.co.jp を表示する者が運営するサイトのページから。 
    #  ↓ https://trend-research.jp/3038/ の「どのくらいの頻度で..?」
    $cmd = "$0 -% 0.7 1.8 5.5 7.7 18.4 12.9 21.3 8.5 23.2" when 'n1' ; 
    #  ↓ https://prtimes.jp/main/html/rd/p/000000231.000087626.html 月々いくらまでなら?
    $cmd = "$0 -D-2%,----------- -y-1.. -a0.07% -% 11.2 29.3 28.2 11.6 9.7 10.1" when 'n2' ; 
    $cmd = "$0 -g259,1 -a0.194% -D-3% -% 16.9 23.9 31.0 9.9 2.8 5.6" when 'n3' ; # -a で分子をなんとか探索している。
    # ここからは自分で用意したスライドに関して。
    $cmd = "$0 -y0.. -D5 -Q -g141,20 -% 2.0 13.5 21.6 6.8" when 's18' ;
    $cmd = "$0 -y-1.. -D5 -52 -g20 -% 2.0 50.7 13.5 21.6 6.8" when 's19' ;
    $cmd = "$0 -y-1.. -I  -g20 -% 2.0 50.7 13.5 21.6 6.8" when 's20' ; 
    $cmd = "$0 -D5 -I -Q -g150,-inf -% 2.0 13.5 21.6" when 's21' ; 
    $cmd = "$0 -y1.. -g75,20 -D0,----- -Q -% 81.4 63.3 54.6 51.0 46.9 45.9 28.6 17.3 13.3 11.3 10.3" when 's24' ;
    # 機能追加に合わせてテストパターン
    $cmd = "$0 -M0 -D9 33.3% 50.0% 57.1%" when 'D9' ; # -% 以外に%を直接数値に付けることを可能とした。%から&への誤字に注意。
    $cmd = "$0 -y, -L1 -% 3.2 59.0 17.5 20.3" when 'L1' ; # -L の実装の伴うテスト
  } for $o{T} ; 
  say STDERR BOLD ITALIC YELLOW " >> " , $cmd ; 
  system $cmd ; 
  exit ; # systemで exit するはずだが、違うコードを増やすことも考え、ここに exitと書いた。
}

### テスト以外はここから開始


$o{D} =~ s/,(.*)$// if exists $o{D};
my $Demp = $1 if defined $1 ; # // '-' ; 
$o{D} //= 0 unless grep { m/[DIQ]/ } keys %o ; 
$o{g} //= 12 ; # 取得する分母の個数の最大値 なお、コンマ区切りで、取得分母の開始値(最小値)も指定可能。
$o{a} =~ s/(^.*)%$/"$1"*"0.01"/e if exists $o{a} && $o{a} =~ /%$/ ;  # -a の指定が % で終わる場合の処理
$o{y} //= '1..' ; # 何か候補があれば表示とした。

do { pipe *STDIN , my $WH ; print {$WH} join "\n" , splice @ARGV , 0 } ;
my @nums = & readNums ;  # $q は、-y のオプションのパラメータでevalする際に、裏技的に使うことを意図している。
my $q = @nums ;

# ここは、同じ引数で同じ関数を2回(以上)呼び出すという意味で、不効率で冗長とも言える。後で整理。.. 
my @ddg = map { & decDig ($_ ) } @nums ; # 与えられた割合近似値が、それぞれ、小数点以下何桁であるか? dig digit 
my $ymx = max ( exists $o{y} ? & yparse ( $o{y} ) : $q ) ; # y max # 計算が冗長.. 何度も気になる。ƒexp
my $roa = abs 1/$o{a} if exists $o{a} ; # reciprocal $o{a}

my $count = 0 ; # 探索した分母の個数
my $denom = do { $o{g} =~ s/(.+),// && $1 } || 1 ; #　開始する分母の値  $o{g} を書き換える場合に注意。
& main () ; 
END{
  exit unless $count ; # 1個も分母を探索していないなら、すぐ終了。
  exit if 0 eq ($o{2}//'') ;
  my $sum = 0 ; $sum = "$sum" + "$_" for @nums ; 
  my $bf = color 'bold faint white' ;
  print STDERR $bf . scalar @nums . " ratios are given (sum=" . color('reset bold yellow').($sum) . $bf .")." if @nums > 1 ; 
  my $ud = [ 'down to','from','up to' ] -> [ ( $o{g} <=> 0 ) + 1 ] ; # 'from' はかなり無理矢理である。正常な使用の想定外。
  $denom += $o{g} > 0 ? -1 : $o{g} < 0 ? 1 : 0 ; # 1個戻す。
  say STDERR BOLD FAINT " $count denominators have found $ud $denom. ($Script)" ; 
}
exit 0 ;

sub main ( ) { 
  
  my ( @nA , @nB ,@nC) ; # 区間の 閉じた端A と 開いた端B , Cが1の場合。 もしCが0から開区間で、2なら閉区間。
  do { my($A,$B,$C)= realInt ($_) ; push @nA,$A ; push @nB,$B ; push @nC,$C } for @nums ; 

  do { # 出力の1行目
    my @seq = 1 .. $#nums+1 ;
    my @out = qw[denom fit] ; 
    for ( @seq ) { 
      push @out , CYAN $nums[$_-1] if exists $o{D} ; # "f$_:".$nums[$_-1]
      push @out , "numerators_$_" if $o{I} ; # unless $o{v} eq "0" ; 
    }
    push @out , "dividends" if $o{Q} ;
    push @out, BLUE "likelihood ratio" if ($o{L}//'') ne '0' ; 
    say join "\t" , map { UNDERLINE $_ } @out ;
  } ;
  
  $SIG{INT} = sub { say STDERR FAINT BOLD "\$denom=$denom" ; exit } ;
  while ( $count < abs $o{g} ) {  # continue ブロックを用いていることに注意。
    $o{g} < 0 ? last : next if $denom <= 0 ; # 分母$denomが負の場合はまだ上手く動作。0の場合は区間として[0,0]にならずまずい。
    if ( $o{g} > 0 && $denom > 0 ) { # ある時から何も出力しないのに、無限ループとなる事態の回避
      last if exists $o{a} && $ymx < $q && $denom -1 > $roa ;
      last if $ymx < grep { length ($denom -1 ) - 1 >= $_ } @ddg  ; 
    }

    my $kosu = 0 ; # 該当個数(こすう) 
    my @out = () ; # 出力文字列
    my @nu = () ; # numerators 分子の数の集まり ## 
    push @out , "$denom" ; # コロン(:)を以前付与していた
    for my $i ( 0 .. $#nums ) { 
      my ($mA,$mB,$mC) = ( "$nA[$i]" * "$denom" , "$nB[$i]" * "$denom" , $nC[$i] ) ; # 分子の数値に対応
      my @int = numInts ( $mA , $mB , $mC ) ; #区間に含まれる整数の最小と最大。返値の要素数は1の場合も0の場合もある。
      push @nu , $int[0]..$int[-1] if @int ;
      $kosu ++ if @int ;
      push @out , procD( \@int, $nums[$i] , $mA,$mB,$mC ) if exists $o{D} ; 
      push @out , do{ my $str=&sect($mA,$mB,$mC) ; @int ? GREEN $str : $str } if $o{I} ; 
    }
    sub sect($$$){
      return $_[0] < $_[1] ? "[$_[0] $_[1])" : "($_[1] $_[0]]" if $_[2] == 1 ;
      return $_[2] ?  "[$_[0] $_[1]]" : "($_[0] $_[1])" ; #unless $_[2] & 2 ; 
    } ; 

    next unless yfilter ( $kosu ) ;
    state $den1 = $denom ; #print RED $den1;
    my $t = scalar @nums - $kosu ; 
    $kosu = $t==0 ? BRIGHT_RED BOLD $kosu : $t==1 ? YELLOW BOLD $kosu : $t==2 ? $kosu : FAINT $kosu ; 
    splice @out , 1 , 0 , $kosu ; # 出力配列文字列に、個数表記を挿入。
    push @out , procQ( @nu ) if $o{Q} ; # ( $o{Q} ) {    }
    splice @out , @out, 0 , BLUE sprintf '%0.5g', ($den1 / $denom ) ** ( scalar @nums - ($o{L}//0) ) if ($o{L}//'') ne '0' ;
    ( $o{M} // '' ) eq 0? next : ($out[0] .= '.') if @nu && bgcd ($denom, @nu) > 1 ; # 分母にピリオドを付加。
    say join "\t" , map { $_ // '' } @out ; 
    $count ++ ; 
  } continue { 
    $denom += $o{g} < 0 ? -1 : 1 ;