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