1. # stub of this role is also present in Numeric.pm6; be sure to update
  2. # definition there as well, if changing this one
  3. my role Rational[::NuT = Int, ::DeT = ::("NuT")] does Real {
  4. has NuT $.numerator = 0;
  5. has DeT $.denominator = 1;
  6. multi method WHICH(Rational:D:) {
  7. nqp::box_s(
  8. nqp::concat(
  9. nqp::if(
  10. nqp::eqaddr(self.WHAT,Rational),
  11. 'Rational|',
  12. nqp::concat(nqp::unbox_s(self.^name), '|')
  13. ),
  14. nqp::concat(
  15. nqp::tostr_I($!numerator),
  16. nqp::concat('/', nqp::tostr_I($!denominator))
  17. )
  18. ),
  19. ValueObjAt
  20. )
  21. }
  22. method new(NuT \nu = 0, DeT \de = 1) {
  23. my $new := nqp::create(self);
  24. # 0 denominator take it verbatim to support Inf/-Inf/NaN
  25. if de == 0 {
  26. nqp::bindattr($new,::?CLASS,'$!numerator', nqp::decont(nu));
  27. nqp::bindattr($new,::?CLASS,'$!denominator',nqp::decont(de));
  28. }
  29. # normalize
  30. else {
  31. my $gcd := nu gcd de;
  32. my $numerator = nu div $gcd;
  33. my $denominator = de div $gcd;
  34. if $denominator < 0 {
  35. $numerator = -$numerator;
  36. $denominator = -$denominator;
  37. }
  38. nqp::bindattr($new,::?CLASS,'$!numerator', nqp::decont($numerator));
  39. nqp::bindattr($new,::?CLASS,'$!denominator',nqp::decont($denominator));
  40. }
  41. $new
  42. }
  43. method nude() { self.REDUCE-ME; $!numerator, $!denominator }
  44. method Num() {
  45. nqp::p6box_n(nqp::div_In(
  46. nqp::decont($!numerator),
  47. nqp::decont($!denominator)))
  48. }
  49. method floor(Rational:D:) {
  50. $!denominator == 1
  51. ?? $!numerator
  52. !! $!numerator div $!denominator
  53. }
  54. method ceiling(Rational:D:) {
  55. self.REDUCE-ME;
  56. $!denominator == 1
  57. ?? $!numerator
  58. !! ($!numerator div $!denominator + 1)
  59. }
  60. method Int() {
  61. $!denominator
  62. ?? self.truncate
  63. !! fail X::Numeric::DivideByZero.new:
  64. :details('when coercing Rational to Int')
  65. }
  66. multi method Bool(::?CLASS:D:) { nqp::p6bool($!numerator) }
  67. method Bridge() { self.Num }
  68. method Range(::?CLASS:U:) { Range.new(-Inf, Inf) }
  69. method isNaN (--> Bool:D) {
  70. nqp::p6bool(nqp::isfalse($!denominator) && nqp::isfalse($!numerator))
  71. }
  72. method is-prime(--> Bool:D) {
  73. self.REDUCE-ME;
  74. nqp::if($!denominator == 1,$!numerator.is-prime)
  75. }
  76. multi method Str(::?CLASS:D:) {
  77. my $whole = self.abs.floor;
  78. my $fract = self.abs - $whole;
  79. # fight floating point noise issues RT#126016
  80. if $fract.Num == 1e0 { ++$whole; $fract = 0 }
  81. my $result = nqp::if(
  82. nqp::islt_I($!numerator, 0), '-', ''
  83. ) ~ $whole;
  84. if $fract {
  85. my $precision = $!denominator < 100_000
  86. ?? 6 !! $!denominator.Str.chars + 1;
  87. my $fract-result = '';
  88. while $fract and $fract-result.chars < $precision - 1 {
  89. $fract *= 100;
  90. my $f = $fract.floor;
  91. $fract -= $f;
  92. $fract-result ~= $f < 10 ?? "0$f" !!
  93. (!$fract and $f %% 10) ?? ($f / 10).floor !! $f;
  94. }
  95. if $fract and $fract-result.chars < $precision {
  96. $fract *= 10;
  97. given $fract.floor {
  98. $fract-result ~= $_;
  99. $fract -= $_;
  100. }
  101. }
  102. ++$fract-result if 2*$fract >= 1; # round off fractional result
  103. $result ~= '.' ~ $fract-result;
  104. }
  105. $result
  106. }
  107. method base($base, Any $digits? is copy) {
  108. # XXX TODO: this $base check can be delegated to Int.base once Num/0 gives Inf/NaN,
  109. # instead of throwing (which happens in the .log() call before we reach Int.base
  110. 2 <= $base <= 36 or Failure.new(X::OutOfRange.new(
  111. what => "base argument to base", :got($base), :range<2..36>)
  112. );
  113. my $prec;
  114. if $digits ~~ Whatever {
  115. $digits = Nil;
  116. $prec = 2**63;
  117. }
  118. elsif $digits.defined {
  119. $digits = $digits.Int;
  120. if $digits > 0 {
  121. $prec = $digits;
  122. }
  123. elsif $digits == 0 {
  124. return self.round.base($base)
  125. }
  126. else {
  127. fail X::OutOfRange.new(
  128. :what('digits argument to base'), :got($digits),
  129. :range<0..^Inf>,
  130. )
  131. }
  132. }
  133. else {
  134. $prec = ($!denominator < $base**6 ?? 6 !! $!denominator.log($base).ceiling + 1);
  135. }
  136. my $sign = nqp::if( nqp::islt_I($!numerator, 0), '-', '' );
  137. my $whole = self.abs.floor;
  138. my $fract = self.abs - $whole;
  139. # fight floating point noise issues RT#126016
  140. if $fract.Num == 1e0 { $whole++; $fract = 0 }
  141. my $result = $sign ~ $whole.base($base);
  142. my @conversion := <0 1 2 3 4 5 6 7 8 9
  143. A B C D E F G H I J
  144. K L M N O P Q R S T
  145. U V W X Y Z>;
  146. my @fract-digits;
  147. while @fract-digits < $prec and ($digits // $fract) {
  148. $fract *= $base;
  149. my $digit = $fract.floor;
  150. push @fract-digits, $digit;
  151. $fract -= $digit;
  152. }
  153. # Round the final number, based on the remaining fractional part
  154. if 2*$fract >= 1 {
  155. for @fract-digits-1 ... 0 -> $n {
  156. last if ++@fract-digits[$n] < $base;
  157. @fract-digits[$n] = 0;
  158. $result = $sign ~ ($whole+1).base($base) if $n == 0;
  159. }
  160. }
  161. @fract-digits
  162. ?? $result ~ '.' ~ @conversion[@fract-digits].join
  163. !! $result;
  164. }
  165. method base-repeating($base = 10) {
  166. return ~self, '' if self.narrow ~~ Int;
  167. my @quotients;
  168. my @remainders;
  169. my %remainders;
  170. push @quotients, [div] my ($nu, $de) = abs(self).nude;
  171. loop {
  172. push @remainders, $nu %= $de;
  173. last if %remainders{$nu}++ or $nu == 0;
  174. $nu *= $base;
  175. push @quotients, $nu div $de;
  176. }
  177. @quotients .= map(*.base($base));
  178. my @cycle = $nu
  179. ?? splice @quotients, @remainders.first($nu,:k) + 1
  180. !! ();
  181. splice @quotients, 1, 0, '.';
  182. '-' x (self < 0) ~ @quotients.join, @cycle.join;
  183. }
  184. method succ {
  185. self.new($!numerator + $!denominator, $!denominator);
  186. }
  187. method pred {
  188. self.new($!numerator - $!denominator, $!denominator);
  189. }
  190. method norm() { self.REDUCE-ME; self }
  191. method narrow(::?CLASS:D:) {
  192. self.REDUCE-ME;
  193. $!denominator == 1
  194. ?? $!numerator
  195. !! self;
  196. }
  197. method REDUCE-ME(--> Nil) {
  198. if $!denominator > 1 {
  199. my $gcd = $!denominator gcd $!numerator;
  200. if $gcd > 1 {
  201. nqp::bindattr(self,self.WHAT,'$!numerator', $!numerator div $gcd);
  202. nqp::bindattr(self,self.WHAT,'$!denominator',$!denominator div $gcd);
  203. }
  204. }
  205. }
  206. }