#!/usr/bin/perl

#
# denomfind 
#    小数がいくつか与えられたら、それはどんな(共通する)分母の分数であるかを推定する
#   -- developed by 下野寿之 Toshiyuki Shimono in Tokyo, Japan, 
#   -- first developed probably on 2016-06-20
#   -- one debugging on -% and -c on 2022-10-11 
#   -- heavy implementation added on 2022-10-12, 10-13.  
#

use 5.014 ; use strict ; use warnings ;  # s/のr修飾子は v5.14を要求
use Getopt::Std ; getopts 'a:cD:fg:IM:Qy:%2:5:' , \my%o ; 
use POSIX qw[ ceil floor ] ; 
use Term::ANSIColor qw[ :constants color ] ; $Term::ANSIColor::AUTORESET = 1 ;
use Math::BigInt qw[ bgcd ] ; # -Qの指定時に必要となる。
use List::Util qw [ reduce min max ] ;
use FindBin qw[ $Script ] ; 
my $mpu ; # Math::Prime::Util のモジュールがインストールされているか点検。
CHECK {$mpu = eval 'use Math::Prime::Util qw[ factor factor_exp ]; 1 ' || 0 } # 他にBEGIN INIT UNITCHECK が使える。

HELP_MESSAGE () unless @ARGV ; 
#say BRIGHT_BLUE BOLD join " " , & yparse ( $o{y} ) ; exit ;
$o{g} //= 20 ; # 取得する分母の個数の最大値 なお、コンマ区切りで、取得分母の開始値(最小値)も指定可能。
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 ( & yparse ( $o{y} ) ) ; # y max
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{
  print STDERR BOLD FAINT "Given rates were " . scalar @nums . " pieces." if @nums > 1 && 0 ne ($o{2}//'') ;
  say STDERR BOLD FAINT " $count denominators have printed on each line. Searched until $denom in denominator. ($Script)" ; 
}
exit 0 ;

sub main ( ) { 
  
  my ( @nA , @nB ) ; # 区間の 閉じた端A と 開いた端B
  do { my ( $A , $B ) = realInt ( $_ ) ; push @nA, $A ; push @nB, $B } for @nums ; 

  do { # 出力の1行目
    my @seq = 1 .. $#nums+1 ;
    my @out = qw[denom fit] ; 
    for ( @seq ) { 
      push @out , CYAN "f$_:".$nums[$_-1] if exists $o{D} ;
      push @out , "numerators_$_" if $o{I} ; # unless $o{v} eq "0" ; 
    }
    push @out , "dividends" if $o{Q} ;
    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) = ( "$nA[$i]" * "$denom" , "$nB[$i]" * "$denom" ) ; # 分子の数値に対応
      my @int = numInts ( $mA , $mB ) ; #区間に含まれる整数の最小と最大。返値の要素数は1の場合も0の場合もある。
      push @nu , $int[0]..$int[-1] if @int ;
      $kosu ++ if @int ;
      push @out , CYAN ( @int ? join '~', map { dform ( $_ , $nums[$i] ) } @int : '-' ) if exists $o{D} ; 
      push @out , do{my $str=$mA<$mB?"[$mA $mB)":"($mB $mA]" ; @int?GREEN $str : $str } if $o{I} ; 
    }
    next unless yfilter ( $kosu ) ; 
    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} ) {    }
    ( $o{M} // '' ) eq 0? next : ($out[0] .= '.') if bgcd ($denom, @nu) > 1 ; # 分母にピリオドを付加。
    say join "\t" , map { $_ // '' } @out ; 
    $count ++ ; 
  } continue { 
    $denom += $o{g} < 0 ? -1 : 1 ; 
  }
}

sub procQ () { 
  my $str = reduce{$a=~/(\d+)$/;if($b-$1==1){$a=~s/~\d+$//;"$a~$b"}else{"$a,$b"} } @_ ;
  if ( @_ >= 2 ) { 
    my $gcd = bgcd map { $_ - $_[0] } @_ [ 1 .. $#_ ] ; 
    my $rem = $_[0] % $gcd ;
    $str .= ' (' . "${gcd}q" . ( $rem ? "+$rem" : '') . ')' if $gcd > 1 ; 
  } elsif ( @_ == 1 ) {
    $str .= ' = '.join' x ', map {$_->[1]>1?"$_->[0]^$_->[1]":$_->[0] } factor_exp ( $_[0] ) if $mpu ;
  }
  return $str ;
}

sub dform ( $$ ) { 
  return "$_[0]/$denom=" . (sprintf "%0.$o{D}f" , $_[0]/$denom ) =~ s/^0+//r if $o{D} > 0 ; 
  return "$_[0]/$denom" if $o{D} == 0 ; 
  my $d = -$o{D} ; 
  "$_[0]/$denom" . sprintf "%+0.${d}f" , $_[1] - $_[0]/$denom  ;
}

sub npack ( @ )  { 
  return reduce {  $a =~ /(\d+)$/ ; if( $b-$1==1 ){ "$a~$b" }else{ "$a:$b" } }  @_ ;
}

sub yfilter ( $ ) { 
  state @y = exists $o{y} ? &yparse ( $o{y} ) : () ;
  state @F = map { my $t = $_ ; ( grep { $y[$_] == $t } 0 .. $#y ) ? 1 : 0 } 0 .. scalar @nums ; 
  return ! exists $o{y} || $F[ $_[0] ] ; 

  sub yparse ( $ ) { 
    # オプション -y で与えられたパラメータ文字列 を
    # まず、コンマ(,)で各セクション切り分ける。
    # そして各セクションは .. がある場合は 整数の並びと見なす。
    # ただし .. の前に数値が無い場合はそこに0、..の後に数値が無い場合は、scalar @num の値があると見なす。
    # .. も無くて、数値も無い場合は、 scalar @num の値が1個だけある見なす。
    # 各数値について、負の数(0より小さな数)が与えられた場合は、その値に scalar @num を加算する。
    # このことで、 -y ..2 で 0から2、 -y 5.. で5以上を表す。-y -2.. により、scalar @num -2 以上の値全体を意味する。
    return $q if $_[0] eq '' ; # あまり使わない方が良いかも。zshで、-y '' なら良いが、-y'' でエラーになるため。
    my @sec = map { [split/\.\./, $_, -1 ] } split /,/, $_[0],-1 ; 
    for ( @sec ) { 
      my @t = map { $_ eq '' ? undef : $_ } map { m/^-/ ? $_+$q : $_ } @{$_} ;
      $_ = @t ==2 ? [ $t[0]//0 , $t[1]//$q ] : [ $t[0]//$q ] ;
    }
    return map { my @t=@{$_} ; $t[0]..$t[-1] } @sec ; 
  }
}

# 半区間 [ $x , $y ) when $x<$y または ( $y , $x ] when $y<$x に、何個の整数が含まれるか。
sub numInts ( $$ ) { 
  my ( $x, $y ) = @_  ;
  my $n =  $x < $y ? ceil($y) - ceil($x) : floor($x) - floor($y) ; #print STDERR RED $n ;
  return () if $n == 0 ;
  my @Z =  $x < $y ? (ceil($x) , ceil($x) + $n - 1 ) : ( floor($x) - $n + 1 , floor($x) ) ;
  @Z = ( $Z[0] ) if $Z[0] == $Z[1] ;   #print STDERR RED "[@Z]";
  return @Z ; 
}

sub decDig ( $ ) { # 「小数点以下に数が何桁あるか」を小数点の位置から算出して返す
  my $pos = rindex $_[0] , '.' ; 
  return $pos == -1 ? 0 : length ( $_[0] ) - ( $pos + 1 ) ; 
}

sub realInt ( $ ) { # 1個の数に対し、区間表記 [A,B) または B<Aなら(B,A] のつもりで、AとBの順に返す。<-- - 
  return $_[0] - $o{a} , $_[0] + $o{a} if exists $o{a} ; 
  # 返す値は2の配列の要素であり、、意図する半開区間に対して、1番目は閉じた方であり、2番目は開いた方である。
  my $e10 = "0.1" ** decDig $_[0] ; # 10進数文字列を使っている。これで、内部2進数の問題を回避。
  return $_[0] , "$_[0]" - "$e10" if $o{c} ; # 切り上げの場合
  return $_[0] , "$_[0]" + "$e10" if $o{f} ; # 切り捨ての場合
  my $e05  = "$e10" * "0.5" ;   # 区間の半分の幅である。
  return "$_[0]" - "$e05"  , "$_[0]" + "$e05" if ! exists $o{5} ; # 単純な四捨五入の場合
  my $e055 = "$e10" * ( '0.' . 5 x $o{5} ) ; # 既に四捨五入された数の最下位を ↓
  return "$_[0]" - "$e055" , "$_[0]" + "$e05" ; # さらに何度も四捨五入した場合に対応。
}

sub readNums ( ) { 
  my @nums = () ; 
  while ( <> ) { chomp ; push @nums , $_ } ; # 以前は既に使わないオプション-iで標準入力から読み取ることもしていた。
  s/^-// for @nums ; # 負の値は、実質的に(-1)倍される。
  if ( $o{'%'} ) { ## 百分率の場合の処理 
    for ( @nums ) {
      my $d = 2 + decDig $_ ;
      $_ = "$_" * "0.01" ; 
      $_ = sprintf "%0.${d}f" , $_ ;
    }
  } 
  return @nums ; 
}

sub VERSION_MESSAGE {}
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 ;
}


=encoding utf8

=head1

 $0 

   小数がA個与えられたら、それらがどんな共通する分母の、分数であったかの推定を
   するための数値計算プログラム。切り捨てと切り上げも仮定できるが、未指定なら四捨五入を仮定。

 出力の読み方: 
   1列目:  N  Nは共通する分母を表す。(見つかった分子候補全てとNの全てに対して、1以外の約数かあれば、ピリオドを付加。)
   2列目:  B  Nが分母と仮定した場合の、分子が整数になり得る場合の個数を数える。4通りの色で着色(最大,最大-1,最大-2,それ以外)。
   3列目以降: 
     -D の指定により、各列は与えられた数値を近似する割り算の式である。候補が複数ある場合は最小と最大を;で区切って示す。
     -I の指定により、分子になり得る数値の範囲を半区間表記で示す。整数を含む区間の場合は、緑色に着色する。
     -Q の指定により、分子となる値を列挙する。-Dや-Iよりも簡便な表示となるが、情報が落ちる場合がある。

 使用例: 
    $0 -g 50 0.25 0.33 
     # 四捨五入して、0.25 と 0.33 になるような分数で同じ分母を持つものを見つける。
     # 出力される各行の最終行が 2 となるものを探せば良い。

 オプション: 

  -c : 入力された数は、切り上げられた数であるとみなす。(ceil)
  -f : 入力された数は、切り捨てられた数であると見なす。(floor)
  -g num : 何個の出力を得るかの指定。未指定なら20。"Inf" も指定可能。(get, greatest)
  -g start,num : コロンを使うと、分母をどの数から始めるかを指定が可能。
  -g start,-num : numにマイナスの符号を付加すると、start から 1ずつ減少させながら 最大 num個探索する。
  -y EVAL : fit値(整数を区間内に持つ対応する分子の個数)がどの値の場合に出力するかを指定する。,や..を使って指定。
  -y , : fit値が最大の場合(引数として与えた割合の近似値の個数)のみ出力。( -y のパラメタは書式はやや複雑。)
  -a num : 与えられた数値との差の絶対値が num 以下である 分数表示を見つける。(実験的実装。)
  -5 2 : 既に四捨五入された値の最下位1桁をさらに四捨五入していたことを仮定する。(例. 0.45 → 0.5 → 1)
  -5 num : 既に四捨五入された値のさらに何度も最下位1桁を四捨五入したことを仮定。計num回四捨五入をしたと仮定する。
  -% : 入力された数はパーセンテージ表記(百分率)であると見なし、内部的には100分の1倍される。

  -D num : 除算の式を出力。numは小数点以下の桁数。四捨五入で除算結果を出力。num=0の場合は、除算結果は見せず式のみ。
  -D -num : 除算の式と共に、ずれが分かるように、小数点以下num桁の誤差とともに示す。
  -I : 分子の数値を知るべくその半区間を表示す。(Interval)
  -Q : 分子の候補となる値を全て出す。簡便な表示となる。さらに 2q+1とか5q+3 などと出力(奇数とか1のくらいが3または8などが分かる。)
  -2 0 : 二次情報の出力を抑制する。
  -M 0 : ある分母に対して、全ての候補の分子が分母と同じ整数で割れる場合(≒約分可能)は、出力を抑制。
  --help : このヘルプを表示する。(ただしPod::PerldocJp を一度インストールすると perldoc $0 でも可能。)

  補足 : 
   * 半区間とは、数学的な区間[x,y)または(x,y]のような、それぞれ、x以上y未満、x超y以下のような数全体を表す。
   * 負の数を入力に与えた場合は、その動作によく注意せよ。また 0 や 0.0 を与えた場合も動作に注意。要試行。

  開発メモ: 
     * ただ1個だけの小数点以下8桁の数が渡された場合の良いアルゴリズムを考えたい。
     * -Qの指定による出力については、さらに洗練の余地がある。
     * 最大公約数を計算するために、普段使わない Math::BigInt を用いている。
     * 入力の0に対して、-0.000が発生する謎
     * 同じ数値が与えられたときに different piece で fit も反映させたい。 -s 0 でそれを解除したい。
     * 偶数丸め ( JIS Z 8401 と ISO 31-0 ) に対応したい。-50を割り当てたい。しかし、大幅な改装が必要。
     * 各分母に対して、対数尤度を表示する -Lのオプションを作りたい。

=cut
