RSI indicator wip

Author: functora

pub/bfx/bfx.cabal

@@ -131,6 +131,7 @@ library
     Bfx.Data.Web
     Bfx.Indicator.Atr
     Bfx.Indicator.Ma
+    Bfx.Indicator.Rsi
     Bfx.Indicator.Tr
     Bfx.Math
     Bfx.Parser
@@ -180,6 +181,7 @@ test-suite bfx-test
       Bfx.Data.Web
       Bfx.Indicator.Atr
       Bfx.Indicator.Ma
+      Bfx.Indicator.Rsi
       Bfx.Indicator.Tr
       Bfx.Math
       Bfx.Parser

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

@@ -0,0 +1,97 @@
+{-# OPTIONS_HADDOCK show-extensions #-}
+
+module Bfx.Indicator.Rsi
+  ( Rsi (..),
+    RsiPeriod (..),
+    defRsiPeriod,
+    mkRsiConduit,
+  )
+where
+
+import Bfx.Data.Type
+import Conduit ((.|))
+import qualified Conduit as C
+import qualified Data.Conduit.List as C
+import Functora.Money
+import Functora.Prelude
+
+newtype Rsi = Rsi
+  { unRsi :: Ratio Natural
+  }
+  deriving stock
+    ( Eq,
+      Ord,
+      Show,
+      Read,
+      Data,
+      Generic
+    )
+
+newtype RsiPeriod = RsiPeriod
+  { unRsiPeriod :: Natural
+  }
+  deriving stock
+    ( Eq,
+      Ord,
+      Show,
+      Read,
+      Data,
+      Generic
+    )
+
+defRsiPeriod :: RsiPeriod
+defRsiPeriod = RsiPeriod 14
+
+mkRsiConduit ::
+  ( Monad m
+  ) =>
+  (a -> Candle) ->
+  RsiPeriod ->
+  C.ConduitT a (a, Rsi) m ()
+mkRsiConduit mkCandle (RsiPeriod natPer) =
+  C.slidingWindowC 2
+    .| ( whileM $ do
+          mcandles <- fmap (>>= nonEmpty) C.await
+          case mcandles of
+            Just [c1, c2] -> do
+              let p1 = mkCandle c1 ^. #candleClose . #unQuotePerBase
+              let p2 = mkCandle c2 ^. #candleClose . #unQuotePerBase
+              C.yield
+                ( c2,
+                  -- Loss
+                  if p1 >= p2
+                    then p1 - p2
+                    else 0,
+                  -- Gain
+                  if p1 <= p2
+                    then p2 - p1
+                    else 0
+                )
+              pure True
+            _ ->
+              pure False
+       )
+    .| ( do
+          seed <- C.take intPer
+          when (length seed == intPer) $ do
+            let initAvgLoss = sum (fmap snd3 seed) / ratPer
+            let initAvgGain = sum (fmap thd3 seed) / ratPer
+            flip loopM (initAvgLoss, initAvgGain)
+              $ \(prevAvgLoss, prevAvgGain) -> do
+                mcandle <- C.await
+                case mcandle of
+                  Nothing -> pure $ Right ()
+                  Just (c, loss, gain) -> do
+                    let nextAvgLoss = prevAvgLoss * (ratPer - 1) + loss / ratPer
+                    let nextAvgGain = prevAvgGain * (ratPer - 1) + gain / ratPer
+                    let rs = nextAvgGain / nextAvgLoss
+                    let rsi = Rsi $ 100 - (100 / (1 + rs))
+                    C.yield (c, rsi)
+                    pure $ Left (nextAvgLoss, nextAvgGain)
+       )
+  where
+    ratPer = from @Natural @(Ratio Natural) natPer
+    intPer =
+      case unsafeFrom @Natural @Int natPer of
+        x | x < 2 -> error $ "Bad RSI period " <> inspect natPer
+        x -> x

pub/bfx/test/BfxSpec.hs

@@ -148,12 +148,12 @@ spec = before sysEnv $ do
     buyDef <- Bfx.mkOrder req
     SubmitOrder.baseAmount buyDef `shouldBe` MoneyAmount 4.00400401
     sellDef <- Bfx.mkOrder req {Bfx.mkOrderBuyOrSell = Sell}
-    SubmitOrder.baseAmount sellDef `shouldBe` MoneyAmount 4
+    SubmitOrder.baseAmount sellDef `shouldBe` MoneyAmount 3.99999999
     let reqBase = req {Bfx.mkOrderNetBaseAmt = Just $ MoneyAmount 10}
     buyBase <- Bfx.mkOrder reqBase
     SubmitOrder.baseAmount buyBase `shouldBe` MoneyAmount 10.01001002
     sellBase <- Bfx.mkOrder reqBase {Bfx.mkOrderBuyOrSell = Sell}
-    SubmitOrder.baseAmount sellBase `shouldBe` MoneyAmount 10
+    SubmitOrder.baseAmount sellBase `shouldBe` MoneyAmount 9.99999999
 
 --  describe "End2End" $ do
 --    itRight "submitOrderMaker" $ \env -> do