quadratic-irrational 0.0.4 → 0.0.5

raw patch · 4 files changed

+72/−2 lines, 4 files

Files

• ChangeLog.md +4/−0
• quadratic-irrational.cabal +1/−1
• src/Numeric/QuadraticIrrational.hs +55/−0
• tests/QuadraticIrrational.hs +12/−1

@@ -1,3 +1,7 @@+# 0.0.5 (2014-03-28)++* Add an `Ord` instance.+ # 0.0.4 (2014-03-27)  * Make the description more precise.

@@ -1,6 +1,6 @@ name: quadratic-irrational category: Math, Algorithms, Data-version: 0.0.4+version: 0.0.5 license: MIT license-file: LICENSE author: Johan Kiviniemi <devel@johan.kiviniemi.name>

@@ -109,6 +109,61 @@    readListPrec = readListPrecDefault +instance Ord QI where+  compare (QI a b c d) (QI a' b' c' d') = res+    where+      -- (a + b √c)/d   ⋛ (a' + b' √c')/d'+      -- (a + b √c) d'  ⋛ (a' + b' √c') d+      -- a d' + b d' √c ⋛ a' d + b' d √c'+      -- a d' − a' d    ⋛ b' d √c' − b d' √c+      --+      -- let i = a d' − a' d+      --     j = b' d √c'+      --     k = b d' √c+      i = a * d' - a' * d+      sqJ = sq b' * sq d  * c'+      sqK = sq b  * sq d' * c++      -- i ⋛ j − k+      --+      -- sign (b' d √c') = sign b' because d  ≥ 0 and c' ≥ 0+      -- sign (b d' √c)  = sign b  because d' ≥ 0 and c  ≥ 0+      --+      -- if j − k < 0 then (sign b') j² − (sign b) k² < 0+      --+      -- (sign i) |i| ⋛ sign ((sign b') j² − (sign b) k²) |j − k|+      --+      -- let snL = sign i+      --     snR = sign ((sign b') j² − (sign b) k²)+      snL = signum i+      snR = signum (signum b' * sqJ - signum b * sqK)++      -- snL |i|                ⋛ snR |j − k|+      -- snL i²                 ⋛ snR (j − k)²+      -- snL i²                 ⋛ snR (j² + k² − 2 j k)+      -- snL i² − snR (j² + k²) ⋛ snR (−2) j k+      -- snL i² − snR (j² + k²) ⋛ snR (−2) b b' d d' √c √c'+      --+      -- let q = snL i² − snR (j² + k²)+      --     r = snR (−2) b b' d d' √c √c'+      q = snL * sq i - snR * (sqJ + sqK)+      sqR = 4 * sq b * sq b' * sq d * sq d' * c * c'++      -- q ⋛ r+      --+      -- sign (snR (−2) b b' d d' √c √c') = sign (snR (−2) b b')+      --+      -- let snL' = sign q+      --     snR' = sign (snR (−2) b b')+      snL' = signum q+      snR' = signum (snR * (-2) * b * b')++      -- snL' |q| ⋛ snR' |r|+      -- snL' q²  ⋛ snR' r²+      res = compare (snL' * sq q) (snR' * sqR)++      sq x = x*x+ type QITuple = (Integer, Integer, Integer, Integer)  -- | Given @a@, @b@, @c@ and @d@ such that @n = (a + b √c)\/d@, constuct a 'QI'

@@ -86,6 +86,17 @@       [ testProperty "qiToFloat" $ \a b (NonNegative c) (NonZero d) ->           approxEq' (qiToFloat (qi a b c d)) (approxQI a b c d) +      , testProperty "compare equals" $ \a ->+          conjoin [ a === a, compare a a === EQ ]+            `const` (a :: QI)++      , testProperty "compare" $ \a b ->+          let a' = qiToFloat a :: RefFloat+              b' = qiToFloat b :: RefFloat+          in  conjoin [ (a == b)    === (a' == b')+                      , compare a b === compare a' b'+                      ]+       , testProperty "qiAddI" $ \n x ->           approxEq' (qiToFloat (qiAddI n x)) (qiToFloat n + fromInteger x) @@ -155,7 +166,7 @@                       (_, Cyc _ _ xs) -> length xs           -- Limit the length of the periodic part for speed.           in (len <= 100) ==>-               approxEq' (qiToFloat n) (qiToFloat (continuedFractionToQI cf))+               n === continuedFractionToQI cf        , testProperty "continuedFractionApproximate" $ \n ->           let cf = qiToContinuedFraction n