shithub: MicroHs

Download patch

ref: 1ed82e6130d4732fa042833d91c14b906dfc1005
parent: 6007c49911b042c24c8a996a11c49a75e2264643
author: Lennart Augustsson <lennart@augustsson.net>
date: Thu Sep 26 06:57:22 EDT 2024

Add missing function

--- a/lib/Data/Ratio.hs
+++ b/lib/Data/Ratio.hs
@@ -2,6 +2,7 @@
   Ratio, Rational,
   (%),
   numerator, denominator,
+  approxRational,
   rationalInfinity,
   rationalNaN,
   rationalMinusZero,
@@ -112,3 +113,30 @@
           (EQ, False) -> n
           (EQ, True) -> n + x
           (GT, _) -> n + x
+
+approxRational :: (RealFrac a) => a -> a -> Rational
+approxRational rat eps =
+    simplest (toRational rat - toRational eps) (toRational rat + toRational eps)
+  where
+    simplest x y
+      | y < x      =  simplest y x
+      | x == y     =  xr
+      | x > 0      =  simplest' n d n' d'
+      | y < 0      =  - simplest' (-n') d' (-n) d
+      | otherwise  =  0 :% 1
+      where xr  = toRational x
+            n   = numerator xr
+            d   = denominator xr
+            nd' = toRational y
+            n'  = numerator nd'
+            d'  = denominator nd'
+
+    simplest' n d n' d'       -- assumes 0 < n%d < n'%d'
+      | r == 0     =  q :% 1
+      | q /= q'    =  (q+1) :% 1
+      | otherwise  =  (q*n''+d'') :% n''
+      where (q,r)      =  quotRem n d
+            (q',r')    =  quotRem n' d'
+            nd''       =  simplest' d' r' d r
+            n''        =  numerator nd''
+            d''        =  denominator nd''