Trying Fixed E30 as faster alternative of Rational, but more precise than Double

Author: functora

pub/bfx/src/Bfx/Indicator/Rsi.hs

@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -Wno-deprecations #-}
 {-# OPTIONS_HADDOCK show-extensions #-}
 
 module Bfx.Indicator.Rsi
@@ -14,9 +15,10 @@ import qualified Conduit as C
 import qualified Data.Conduit.List as C
 import Functora.Money
 import Functora.Prelude
+import qualified Prelude
 
 newtype Rsi = Rsi
-  { unRsi :: Double
+  { unRsi :: Fixed E30
   }
   deriving stock
     ( Eq,
@@ -59,12 +61,14 @@ mkRsiConduit mkCandle (RsiPeriod natPer) =
               C.yield
                 ( c2,
                   -- Loss
-                  via @Rational @(Ratio Natural) @Double
+                  fromRational @(Fixed E30)
+                    . from @(Ratio Natural) @Rational
                     $ if p1 >= p2
                       then p1 - p2
                       else 0,
                   -- Gain
-                  via @Rational @(Ratio Natural) @Double
+                  fromRational @(Fixed E30)
+                    . from @(Ratio Natural) @Rational
                     $ if p1 <= p2
                       then p2 - p1
                       else 0
@@ -76,23 +80,26 @@ mkRsiConduit mkCandle (RsiPeriod natPer) =
     .| ( do
           seed <- C.take intPer
           when (length seed == intPer) $ do
-            let initAvgLoss = sum (fmap snd3 seed) / dblPer
-            let initAvgGain = sum (fmap thd3 seed) / dblPer
+            let initAvgLoss = sum (fmap snd3 seed) / fixPer
+            let initAvgGain = sum (fmap thd3 seed) / fixPer
             flip loopM (initAvgLoss, initAvgGain)
               $ \(prevAvgLoss, prevAvgGain) -> do
                 mcandle <- C.await
                 case mcandle of
                   Nothing -> pure $ Right ()
                   Just (c, loss, gain) -> do
-                    let nextAvgLoss = (prevAvgLoss * (dblPer - 1) + loss) / dblPer
-                    let nextAvgGain = (prevAvgGain * (dblPer - 1) + gain) / dblPer
+                    let nextAvgLoss = (prevAvgLoss * (fixPer - 1) + loss) / fixPer
+                    let nextAvgGain = (prevAvgGain * (fixPer - 1) + gain) / fixPer
                     let rs = nextAvgGain / nextAvgLoss
                     let rsi = Rsi $ 100 - (100 / (1 + rs))
                     C.yield (c, rsi)
                     pure $ Left (nextAvgLoss, nextAvgGain)
        )
   where
-    dblPer = unsafeFrom @Natural @Double natPer
+    fixPer :: Fixed E30
+    fixPer =
+      Prelude.fromInteger $ from @Natural @Integer natPer
+    intPer :: Int
     intPer =
       case unsafeFrom @Natural @Int natPer of
         x | x < 2 -> error $ "Bad RSI period " <> inspect natPer

pub/functora-witch/source/library/Functora/Witch/Instances.hs

@@ -936,15 +936,19 @@ instance (Fixed.HasResolution a) => TryFrom.TryFrom Rational (Fixed.Fixed a) whe
 
 -- Fixed
 
--- | Uses 'Fixed.MkFixed'. This means @from \@Integer \@Centi 2@ is @0.02@
--- rather than @2.00@.
-instance From.From Integer (Fixed.Fixed a) where
-  from = Fixed.MkFixed
-
--- | Uses 'Fixed.MkFixed'. This means @from \@Centi \@Integer 3.00@ is @300@
--- rather than @3@.
-instance From.From (Fixed.Fixed a) Integer where
-  from (Fixed.MkFixed t) = t
+--
+-- TODO : update after fix https://github.com/tfausak/witch/issues/121
+--
+
+-- -- | Uses 'Fixed.MkFixed'. This means @from \@Integer \@Centi 2@ is @0.02@
+-- -- rather than @2.00@.
+-- instance From.From Integer (Fixed.Fixed a) where
+--   from = Fixed.MkFixed
+
+-- -- | Uses 'Fixed.MkFixed'. This means @from \@Centi \@Integer 3.00@ is @300@
+-- -- rather than @3@.
+-- instance From.From (Fixed.Fixed a) Integer where
+--   from (Fixed.MkFixed t) = t
 
 -- | Uses 'toRational'.
 instance (Fixed.HasResolution a) => From.From (Fixed.Fixed a) Rational where

pub/functora-witch/source/test-suite/Main.hs

@@ -1660,19 +1660,19 @@ spec = describe "Witch" $ do
         f 12.3 `shouldBe` Just 12.3
         f 0.12 `shouldBe` Nothing
 
-    describe "From Integer (Fixed a)" $ do
-      let f = Witch.from @Integer @Fixed.Deci
-      it "works" $ do
-        f 1 `shouldBe` 0.1
-        f 10 `shouldBe` 1
-        f 120 `shouldBe` 12
-
-    describe "From (Fixed a) Integer" $ do
-      let f = Witch.from @Fixed.Deci @Integer
-      it "works" $ do
-        f 0.1 `shouldBe` 1
-        f 1 `shouldBe` 10
-        f 12 `shouldBe` 120
+    -- describe "From Integer (Fixed a)" $ do
+    --   let f = Witch.from @Integer @Fixed.Deci
+    --   it "works" $ do
+    --     f 1 `shouldBe` 0.1
+    --     f 10 `shouldBe` 1
+    --     f 120 `shouldBe` 12
+
+    -- describe "From (Fixed a) Integer" $ do
+    --   let f = Witch.from @Fixed.Deci @Integer
+    --   it "works" $ do
+    --     f 0.1 `shouldBe` 1
+    --     f 1 `shouldBe` 10
+    --     f 12 `shouldBe` 120
 
     describe "From (Fixed a) Rational" $ do
       let f = Witch.from @Fixed.Deci @Rational

pub/functora/src/prelude/Functora/Prelude.hs

@@ -119,6 +119,7 @@ module Functora.Prelude
     dropAround,
     dropWhileEnd,
     AscOrDesc (..),
+    E30,
 
     -- * DerivingVia
     -- $derivingVia
@@ -1151,6 +1152,11 @@ data AscOrDesc
       Bounded
     )
 
+data E30
+
+instance HasResolution E30 where
+  resolution = const 1_0000000000_0000000000_0000000000
+
 -- $derivingVia
 -- Newtypes to simplify deriving via.
 -- We have to expose default constructors/accessors