Drezil/ibhelper
1
1
Fork 0
Code Issues 12 Pull Requests Projects Releases Wiki Activity

#12 now finally done? ... 😅

Browse Source
This commit is contained in:
Nicole Dresselhaus 2022-08-12 18:52:30 +02:00
parent 32ec058e6b
commit caf588201c
4 changed files with 25 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/AppFiller.hs
View File

@ -74,7 +74,7 @@ handleTickPrice IB_TickPrice{..} = do
IBTickType_Last_Price -> do IBTickType_Last_Price -> do
t <- utcTimeToSeconds <$> liftIO getCurrentTime t <- utcTimeToSeconds <$> liftIO getCurrentTime
let cp = ChartPoint (TimeInterval t t) price (fromIntegral size) [] let cp = ChartPoint (TimeInterval t t) price (fromIntegral size) []
logInfo $ displayShow ("added point", cp) logDebug $ displayShow ("added point", cp)
liftIO $ atomically $ modifyTVar chartVar (\c@Chart{..} -> c { chartData = chartData |> cp, chartDirty = True}) liftIO $ atomically $ modifyTVar chartVar (\c@Chart{..} -> c { chartData = chartData |> cp, chartDirty = True})
_ -> return () _ -> return ()
handleTickPrice _ = error "impossible" handleTickPrice _ = error "impossible"

32
src/Chart.hs
View File

@ -99,7 +99,7 @@ fillChart app contract cVar = runRIO app $ do
threadDelay 1000000 -- sleep 5 seconds threadDelay 1000000 -- sleep 5 seconds
chunkChart :: Int -> Int -> Int -> FingerTree TimeInterval ChartPoint -> [(TimeInterval,[ChartPoint])] chunkChart :: Int -> Int -> Int -> FingerTree TimeInterval ChartPoint -> [(TimeInterval,[ChartPoint])]
chunkChart from until ticks tree = D.trace ("chunking from "<> show from <> " to " <> show until) $ go from ticks interval chunkChart from until ticks tree = go from ticks interval
where where
traceShowCommentId' s a = a -- traceShowCommentId s a traceShowCommentId' s a = a -- traceShowCommentId s a
traceShowComment' s a b = b -- traceShowComment s a b traceShowComment' s a b = b -- traceShowComment s a b
@ -111,11 +111,11 @@ chunkChart from until ticks tree = D.trace ("chunking from "<> show from <> " to
| otherwise = let searchpred start@(TimeInterval x y) end@(TimeInterval a b) | otherwise = let searchpred start@(TimeInterval x y) end@(TimeInterval a b)
| start == mempty = False | start == mempty = False
| end == mempty = True | end == mempty = True
| otherwise = f <= x+i | otherwise = traceShowComment' "search" (f, x, start, end) $ f+i <= x || f+2*i <= y
in case FT.search searchpred t in case FT.search searchpred t
of pos@(FT.Position l x@(ChartPoint{..}) r) of pos@(FT.Position l x@(ChartPoint{..}) r)
| l == mempty && r == mempty && (timeIntervalBegin timeOfDay) < f+i-1 -> (traceShowCommentId' "only 1 left" $ (TimeInterval f (f+i-1), [x])) : go (f+i) i mempty | l == mempty && r == mempty && (timeIntervalBegin timeOfDay) < f+i-1 -> (traceShowCommentId' "only 1 left" $ (TimeInterval f (f+i-1), [x])) : go (f+i) i mempty
| l == mempty -> (traceShowCommentId' "empty" (TimeInterval f (f+i-1), [])) : go (f+i) i (x FT.<| r) | l == mempty -> (traceShowComment' ("empty (" <> show f <> "," <> show (f+i) <> ")") x (TimeInterval f (f+i-1), [])) : go (f+i) i (x FT.<| r)
| otherwise -> (traceShowComment' ("split (" <> show f <> "," <> show (f+i) <> ")") pos (FT.measure l,toList l)) : traceShowComment' "recursive call with " (f+i, i, x FT.<| r) (go (f+i) i (x FT.<| r)) | otherwise -> (traceShowComment' ("split (" <> show f <> "," <> show (f+i) <> ")") pos (FT.measure l,toList l)) : traceShowComment' "recursive call with " (f+i, i, x FT.<| r) (go (f+i) i (x FT.<| r))
x -> if FT.measure t == mempty then (TimeInterval f (f+i-1), []) : go (f+i) i t else traceShowCommentId' ("nosplit EndOfTree - "<> show x) [(FT.measure t, toList t)] x -> if FT.measure t == mempty then (TimeInterval f (f+i-1), []) : go (f+i) i t else traceShowCommentId' ("nosplit EndOfTree - "<> show x) [(FT.measure t, toList t)]
@ -125,7 +125,16 @@ toChartData studytypes chunkedChart = (lastDataPoint, foldedData)
where (!foldedData,lastDataPoint,_) = foldl' folder ([], Nothing, mempty) chunkedChart where (!foldedData,lastDataPoint,_) = foldl' folder ([], Nothing, mempty) chunkedChart
folder :: ([ChartPoint], Maybe ChartPoint, HM.HashMap Int [Float]) -> (TimeInterval, [ChartPoint]) -> ([ChartPoint], Maybe ChartPoint, HM.HashMap Int [Float]) folder :: ([ChartPoint], Maybe ChartPoint, HM.HashMap Int [Float]) -> (TimeInterval, [ChartPoint]) -> ([ChartPoint], Maybe ChartPoint, HM.HashMap Int [Float])
folder (acc, Nothing , smaMap) (tp , []) = (ChartPoint tp 0 0 []:acc, Nothing, smaMap) folder (acc, Nothing , smaMap) (tp , []) = (ChartPoint tp 0 0 []:acc, Nothing, smaMap)
folder (acc, Just lastPoint, smaMap) (tp, []) = (lastPoint{ timeOfDay = tp, pointVolume = 0}:acc, Just lastPoint, smaMap) folder (acc, Just lastPoint, smaMap) (tp , []) = (lastPoint{ timeOfDay = tp, pointVolume = 0}:acc, Just lastPoint, foldl' (.) id smaUpdates smaMap)
where
(studies, smaUpdates) = unzip $ catMaybes $ studytypes <&> \case
ChartStudyTypeOpen -> fmap (\OLHC{..} -> (OLHC olhc_close olhc_close olhc_close olhc_close, id)) . L.find (\case OLHC{..} -> True; _ -> False) . pointExtra $ lastPoint
ChartStudyTypeHigh -> Nothing
ChartStudyTypeLow -> Nothing
ChartStudyTypeClose -> Nothing
ChartStudyTypeDirect -> Nothing
ChartStudyTypeSMA w -> Nothing --TODO: fixme #13, do the calculation & use data inside smaMap and return (SMA x y, smaUpdate)
ChartStudyTypeVolume -> Just (Volume 0,id)
folder (acc, _ , smaMap) (tp@(TimeInterval f t),cdata) = (cp:acc, Just cp, foldl' (.) id smaUpdates smaMap) folder (acc, _ , smaMap) (tp@(TimeInterval f t),cdata) = (cp:acc, Just cp, foldl' (.) id smaUpdates smaMap)
where where
cp = ChartPoint tp m vol studies cp = ChartPoint tp m vol studies
@ -173,9 +182,9 @@ getUpdatedChartCache Chart{..} chartCacheSettings' = do
timePointToIndex' = timePointToIndex (Just $ ChartCacheSettings cRes cTicks) newRange timePointToIndex' = timePointToIndex (Just $ ChartCacheSettings cRes cTicks) newRange
let indexToTimePoint' :: Int -> TimePoint let indexToTimePoint' :: Int -> TimePoint
indexToTimePoint' = indexToTimePoint (Just $ ChartCacheSettings cRes cTicks) newRange indexToTimePoint' = indexToTimePoint (Just $ ChartCacheSettings cRes cTicks) newRange
when (Just newRange /= ccRange) $ logInfo $ displayShow ("range changed:", newRange, ccRange) when (Just newRange /= ccRange) $ logDebug $ displayShow ("range changed:", newRange, ccRange)
logInfo $ displayShow ("shift?" :: Text, shiftNeccessary, shiftInterval) logDebug $ displayShow ("shift?" :: Text, shiftNeccessary, shiftInterval)
logInfo $ displayShow ("now, updateEnd, lUpdate" :: Text, utcTimeToSeconds now, cacheUpdateEnd, lUpdate) logDebug $ displayShow ("now, updateEnd, lUpdate" :: Text, utcTimeToSeconds now, cacheUpdateEnd, lUpdate)
let cacheUpdateStart = max (timeIntervalBegin newRange) (cacheUpdateEnd - (cRes * (cTicks+1))) -- 1 more to get history running inside the chunk-fold for fallbacks in cache if we get no data. let cacheUpdateStart = max (timeIntervalBegin newRange) (cacheUpdateEnd - (cRes * (cTicks+1))) -- 1 more to get history running inside the chunk-fold for fallbacks in cache if we get no data.
-- create data for updates -- create data for updates
let chunks = case (,) <$> ccFill <*> ccRange of let chunks = case (,) <$> ccFill <*> ccRange of
@ -230,9 +239,8 @@ getUpdatedChartCache Chart{..} chartCacheSettings' = do
ChartStudyTypeSMA x -> id --TODO: implement #13 ChartStudyTypeSMA x -> id --TODO: implement #13
ChartStudyTypeVolume -> HM.insert cs (vec' VS.// ((\(i, ChartPoint _ _ _ s) -> (i,volume $ findVolume s)) <$> foldedData)) ChartStudyTypeVolume -> HM.insert cs (vec' VS.// ((\(i, ChartPoint _ _ _ s) -> (i,volume $ findVolume s)) <$> foldedData))
let ccData' = foldl' (.) id updates ccData let ccData' = foldl' (.) id updates ccData
logInfo $ displayShow ccData' logDebug $ displayShow ccData'
let maToMi ma = max 0 $ fromMaybe ma $ (subtract shiftInterval) . fst <$> ccFill let fillRange = case traceShowCommentId' "(ccFill, lastDataPoint)" (ccFill,lastDataPoint) of
fillRange = case traceShowCommentId' "(ccFill, lastDataPoint)" (ccFill,lastDataPoint) of
-- no new data, but different range. shift along. -- no new data, but different range. shift along.
(Just (mi,ma), Nothing) -> if ma - shiftInterval < 0 then Nothing else Just (max 0 $ mi - shiftInterval, ma - shiftInterval) (Just (mi,ma), Nothing) -> if ma - shiftInterval < 0 then Nothing else Just (max 0 $ mi - shiftInterval, ma - shiftInterval)
-- no data saved yet -- no data saved yet
@ -247,7 +255,7 @@ getUpdatedChartCache Chart{..} chartCacheSettings' = do
Just (mi, ma') -> if ma' - shiftInterval < 0 then Just (max 0 $ ma - shiftInterval, ma) Just (mi, ma') -> if ma' - shiftInterval < 0 then Just (max 0 $ ma - shiftInterval, ma)
else Just (max 0 $ mi - shiftInterval, ma) else Just (max 0 $ mi - shiftInterval, ma)
else error $ "impossible #2 Chart.hs - " <> show ma <> ">=" <> show cTicks else error $ "impossible #2 Chart.hs - " <> show ma <> ">=" <> show cTicks
logInfo $ displayShow fillRange logDebug $ displayShow fillRange
return (Just $ TimePoint lUpdate, ChartCacheData ccData' ccAxis' (Just newRange) fillRange) return (Just $ TimePoint lUpdate, ChartCacheData ccData' ccAxis' (Just newRange) fillRange)
getChunkedDay :: Chart -> Maybe Int -> (Maybe TimePoint, [ChartPoint]) getChunkedDay :: Chart -> Maybe Int -> (Maybe TimePoint, [ChartPoint])
@ -257,7 +265,7 @@ getChunkedDay Chart{..} chunkResolution = case toChartData (chartStudySettings c
| timeOfDay == mempty -> (Nothing, x) | timeOfDay == mempty -> (Nothing, x)
| otherwise -> (Just $ TimePoint $ timeIntervalEnd timeOfDay, x) | otherwise -> (Just $ TimePoint $ timeIntervalEnd timeOfDay, x)
where where
chunkedData = chunkChart 0 86400 (fromMaybe (chartCacheResolution chartCacheSettings) chunkResolution) chartData chunkedData = filter (not . null . snd) $ chunkChart 0 86400 (fromMaybe (chartCacheResolution chartCacheSettings) chunkResolution) chartData
indexToTimePoint :: Maybe ChartCacheSettings -> TimeInterval -> Int -> TimePoint indexToTimePoint :: Maybe ChartCacheSettings -> TimeInterval -> Int -> TimePoint
indexToTimePoint ccs (TimeInterval rFrom rTo) i = TimePoint $ rFrom + i*cRes indexToTimePoint ccs (TimeInterval rFrom rTo) i = TimePoint $ rFrom + i*cRes

2
src/Run.hs
View File

@ -55,7 +55,7 @@ shutdownApp = do
c@Chart{..} <- liftIO . readTVarIO $ tc c@Chart{..} <- liftIO . readTVarIO $ tc
today <- liftIO $ utctDay <$> getCurrentTime today <- liftIO $ utctDay <$> getCurrentTime
liftIO $ unlessM (doesDirectoryExist $ "cache/" <> show chartContractID) $ createDirectory $ "cache/" <> show chartContractID liftIO $ unlessM (doesDirectoryExist $ "cache/" <> show chartContractID) $ createDirectory $ "cache/" <> show chartContractID
let chartData' = traceShowCommentId "chartData for saving" $ filter (\ChartPoint{..} -> 0 /= pointVolume) . snd $ getChunkedDay c (Just 5) let chartData' = filter (\ChartPoint{..} -> 0 /= pointVolume) . snd $ getChunkedDay c (Just 5)
newData = HM.toList newData = HM.toList
. fmap (filter (\ChartPoint{..} -> 0 /= pointVolume)) . fmap (filter (\ChartPoint{..} -> 0 /= pointVolume))
. HM.alter (Just . maybe chartData' (<>chartData')) today . HM.alter (Just . maybe chartData' (<>chartData')) today

4
src/Types.hs
View File

@ -185,8 +185,8 @@ data ChartCacheSettings = ChartCacheSettings
} deriving stock (Show, Eq) } deriving stock (Show, Eq)
defChartCacheSettings :: ChartCacheSettings defChartCacheSettings :: ChartCacheSettings
--defChartCacheSettings = ChartCacheSettings 60 1440 defChartCacheSettings = ChartCacheSettings 60 1440
defChartCacheSettings = ChartCacheSettings 5 20 --defChartCacheSettings = ChartCacheSettings 5 20 -- for testing
-- TODO: TimePointFloat? or only 1 entry per second? -- TODO: TimePointFloat? or only 1 entry per second?