finally hopefully fixed #12
This commit is contained in:
parent
42183873d8
commit
32ec058e6b
@ -107,6 +107,7 @@ library
|
|||||||
, dear-implot
|
, dear-implot
|
||||||
, directory
|
, directory
|
||||||
, fingertree
|
, fingertree
|
||||||
|
, generic-data
|
||||||
, gl
|
, gl
|
||||||
, managed
|
, managed
|
||||||
, microlens-th
|
, microlens-th
|
||||||
|
@ -73,7 +73,8 @@ handleTickPrice IB_TickPrice{..} = do
|
|||||||
case tickType of
|
case tickType of
|
||||||
IBTickType_Last_Price -> do
|
IBTickType_Last_Price -> do
|
||||||
t <- utcTimeToSeconds <$> liftIO getCurrentTime
|
t <- utcTimeToSeconds <$> liftIO getCurrentTime
|
||||||
let cp = ChartPoint (TimePoint t) price (fromIntegral size) []
|
let cp = ChartPoint (TimeInterval t t) price (fromIntegral size) []
|
||||||
|
logInfo $ 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"
|
||||||
|
206
src/Chart.hs
206
src/Chart.hs
@ -29,7 +29,7 @@ import qualified Data.List as L
|
|||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Vector.Storable as VS
|
import qualified Data.Vector.Storable as VS
|
||||||
|
|
||||||
--import qualified Debug.Trace as D
|
import qualified Debug.Trace as D
|
||||||
|
|
||||||
data FillerException = QuitFiller
|
data FillerException = QuitFiller
|
||||||
deriving stock Show
|
deriving stock Show
|
||||||
@ -58,7 +58,7 @@ newChart contract = do
|
|||||||
unless (null cacheErrors) $ forM_ cacheErrors $ \err -> logError (displayShow err)
|
unless (null cacheErrors) $ forM_ cacheErrors $ \err -> logError (displayShow err)
|
||||||
let (unknownDates, cacheData') = partition (isNothing . fst) cacheData
|
let (unknownDates, cacheData') = partition (isNothing . fst) cacheData
|
||||||
unless (null unknownDates) $ logError $ display $ T.pack $ show (length unknownDates) <> " files had no parsable Date."
|
unless (null unknownDates) $ logError $ display $ T.pack $ show (length unknownDates) <> " files had no parsable Date."
|
||||||
let cacheData'' :: HashMap Day (FingerTree TimePoint ChartPoint) = HM.fromList $ bimap (fromMaybe today) FT.fromList <$> cacheData'
|
let cacheData'' :: HashMap Day (FingerTree TimeInterval ChartPoint) = HM.fromList $ bimap (fromMaybe today) FT.fromList <$> cacheData'
|
||||||
logError $ displayShow $ HM.keys cacheData''
|
logError $ displayShow $ HM.keys cacheData''
|
||||||
c <- liftIO $ newTVarIO $ Chart con
|
c <- liftIO $ newTVarIO $ Chart con
|
||||||
(fromMaybe FT.empty $ cacheData'' HM.!? today)
|
(fromMaybe FT.empty $ cacheData'' HM.!? today)
|
||||||
@ -96,84 +96,40 @@ fillChart app contract cVar = runRIO app $ do
|
|||||||
liftIO $ atomically $ modifyTVar cVar (\c' -> c' { chartDirty = False })
|
liftIO $ atomically $ modifyTVar cVar (\c' -> c' { chartDirty = False })
|
||||||
(lUpdate, cachePoints) <- getUpdatedChartCache c Nothing
|
(lUpdate, cachePoints) <- getUpdatedChartCache c Nothing
|
||||||
liftIO $ atomically $ modifyTVar cVar (\c' -> c' { chartCache = cachePoints, lastCacheUpdate = lUpdate })
|
liftIO $ atomically $ modifyTVar cVar (\c' -> c' { chartCache = cachePoints, lastCacheUpdate = lUpdate })
|
||||||
return ()
|
|
||||||
threadDelay 1000000 -- sleep 5 seconds
|
threadDelay 1000000 -- sleep 5 seconds
|
||||||
|
|
||||||
chunkChart :: Int -> Int -> Int -> FingerTree TimePoint ChartPoint -> [(TimePoint,[ChartPoint])]
|
chunkChart :: Int -> Int -> Int -> FingerTree TimeInterval ChartPoint -> [(TimeInterval,[ChartPoint])]
|
||||||
chunkChart from until range tree = go from range interval
|
chunkChart from until ticks tree = D.trace ("chunking from "<> show from <> " to " <> show until) $ go from ticks interval
|
||||||
where
|
where
|
||||||
lastItem = case FT.viewr interval of
|
traceShowCommentId' s a = a -- traceShowCommentId s a
|
||||||
FT.EmptyR -> until
|
traceShowComment' s a b = b -- traceShowComment s a b
|
||||||
(_ FT.:> ChartPoint{..}) -> (\(TimePoint x) -> x) timeOfDay
|
interval = FT.takeUntil (\(TimeInterval x y) -> x > until)
|
||||||
interval = FT.takeUntil (\(TimePoint x) -> x > until)
|
. FT.dropUntil (\(TimeInterval x y) -> x >= from || (x <= from && y <= until && y >= from))
|
||||||
. FT.dropUntil (\(TimePoint x) -> x > from)
|
|
||||||
$ tree
|
$ tree
|
||||||
go f i t
|
go f i t
|
||||||
| f+i >= lastItem = [(TimePoint (f+i), toList t)]
|
| f >= until = traceShowCommentId' "nosplit OverNow" []
|
||||||
| otherwise = let (a, b) = FT.split (\(TimePoint x) -> x > f+i) t
|
| otherwise = let searchpred start@(TimeInterval x y) end@(TimeInterval a b)
|
||||||
in (TimePoint (f+i),toList a) : go (f+i) i b
|
| start == mempty = False
|
||||||
|
| end == mempty = True
|
||||||
|
| otherwise = f <= x+i
|
||||||
|
in case FT.search searchpred t
|
||||||
|
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 -> (traceShowCommentId' "empty" (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))
|
||||||
|
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)]
|
||||||
|
|
||||||
toCachePoint :: (TimePoint,[ChartPoint]) -> ChartPoint
|
-- | converts stuff returned from chunkChart into ([1 point per chunks], last point seen in the input)
|
||||||
toCachePoint (t,[]) = ChartPoint t (-1) 0 []
|
toChartData :: [ChartStudyType] -> [(TimeInterval, [ChartPoint])] -> (Maybe ChartPoint, [ChartPoint])
|
||||||
toCachePoint (t,as) = ChartPoint t m vol [OLHC o l h c]
|
toChartData studytypes chunkedChart = (lastDataPoint, foldedData)
|
||||||
where
|
where (!foldedData,lastDataPoint,_) = foldl' folder ([], Nothing, mempty) chunkedChart
|
||||||
vol = sum $ pointVolume <$> as
|
folder :: ([ChartPoint], Maybe ChartPoint, HM.HashMap Int [Float]) -> (TimeInterval, [ChartPoint]) -> ([ChartPoint], Maybe ChartPoint, HM.HashMap Int [Float])
|
||||||
as' = pointValue <$> as
|
folder (acc, Nothing , smaMap) (tp, []) = (ChartPoint tp 0 0 []:acc, Nothing, smaMap)
|
||||||
ms' = sum $ (\x -> pointValue x * pointVolume x) <$> as
|
folder (acc, Just lastPoint, smaMap) (tp, []) = (lastPoint{ timeOfDay = tp, pointVolume = 0}:acc, Just lastPoint, smaMap)
|
||||||
m = ms' / vol
|
folder (acc, _ , smaMap) (tp@(TimeInterval f t),cdata) = (cp:acc, Just cp, foldl' (.) id smaUpdates smaMap)
|
||||||
o = head as'
|
|
||||||
c = last as'
|
|
||||||
l = minimum as'
|
|
||||||
h = maximum as'
|
|
||||||
|
|
||||||
getUpdatedChartCache :: Chart -> Maybe ChartCacheSettings -> RIO App (Maybe TimePoint, ChartCacheData)
|
|
||||||
getUpdatedChartCache Chart{..} chartCacheSettings' = do
|
|
||||||
let ChartCacheSettings cRes cTicks = fromMaybe chartCacheSettings chartCacheSettings'
|
|
||||||
now <- liftIO getCurrentTime
|
|
||||||
-- - recalculate cacheUpdateStart & cacheUpdateEnd
|
|
||||||
let cacheUpdateEnd = ((utcTimeToSeconds now + cRes) `div` cRes) * cRes
|
|
||||||
cacheUpdateStart = cacheUpdateEnd - (cRes * cTicks)
|
|
||||||
ChartCacheData ccData ccAxis ccRange ccFill = chartCache
|
|
||||||
chunks = case ccFill of
|
|
||||||
Nothing -> [(cacheUpdateStart, cacheUpdateEnd)]
|
|
||||||
Just (mi, ma) -> if
|
|
||||||
-- Interval mi-ma already updated. get remaining intervals
|
|
||||||
-- mi ma cUS cUE
|
|
||||||
| ma < cacheUpdateStart -> [(cacheUpdateStart, cacheUpdateEnd)]
|
|
||||||
-- mi? cUS mi? ma cUE -> [ma,cUE] + rest
|
|
||||||
| ma < cacheUpdateEnd -> [(ma,cacheUpdateEnd)] <> if
|
|
||||||
-- cUS mi ma
|
|
||||||
| mi > cacheUpdateStart -> [(cacheUpdateStart, mi)]
|
|
||||||
| otherwise -> []
|
|
||||||
| otherwise -> []
|
|
||||||
-- - chunk them with chunhChart
|
|
||||||
chunkedChart = L.filter (not . null . snd) $ L.concat $ for chunks $ \(start, end) -> chunkChart (min 0 start) end cRes chartData
|
|
||||||
lUpdate = cacheUpdateEnd - cRes
|
|
||||||
-- - calculate Range and need for shift
|
|
||||||
shiftNeccessary = case ccRange of
|
|
||||||
Nothing -> False
|
|
||||||
Just (_,ma) -> cacheUpdateEnd > ma
|
|
||||||
(newRange, shiftInterval) = if not shiftNeccessary && isJust ccRange then (fromJust ccRange, 0) else
|
|
||||||
let interval = cTicks `div` 20 :: Int
|
|
||||||
iTo = ((cacheUpdateEnd + cRes * interval) `div` (cRes * interval)) * (cRes * interval)
|
|
||||||
iFrom = iTo - 20 * (cRes * interval)
|
|
||||||
in ((iFrom,iTo), interval)
|
|
||||||
ccAxis' = if not shiftNeccessary && isJust ccRange then ccAxis
|
|
||||||
else VS.enumFromStepN (fromIntegral $ fst newRange) (fromIntegral cRes) cTicks
|
|
||||||
logDebug $ displayShow ("now, updateEnd, lUpdate" :: Text, utcTimeToSeconds now, cacheUpdateEnd, lUpdate)
|
|
||||||
-- create data for updates
|
|
||||||
let timePointToIndex' :: TimePoint -> Int
|
|
||||||
timePointToIndex' = timePointToIndex (Just $ ChartCacheSettings cRes cTicks) newRange
|
|
||||||
let indexToTimePoint' :: Int -> TimePoint
|
|
||||||
indexToTimePoint' = indexToTimePoint (Just $ ChartCacheSettings cRes cTicks) newRange
|
|
||||||
-- fold instead of map, so we can carry over cached calculatinos from element to element (for i.e. ema/sma)
|
|
||||||
let (!foldedData,_,_) = foldl' folder ([], ChartPoint 0 0 0 [], mempty) chunkedChart
|
|
||||||
folder :: ([(Int, ChartPoint)], ChartPoint, HM.HashMap Int [Float]) -> (TimePoint, [ChartPoint]) -> ([(Int, ChartPoint)], ChartPoint, HM.HashMap Int [Float])
|
|
||||||
folder old (_,[]) = old
|
|
||||||
folder (acc, lastPoint, smaMap) (tp,cdata) = ((timePointToIndex' tp, cp):acc, cp, foldl' (.) id smaUpdates smaMap)
|
|
||||||
where
|
where
|
||||||
cp = ChartPoint tp m vol studies
|
cp = ChartPoint tp m vol studies
|
||||||
(studies, smaUpdates) = unzip $ catMaybes $ (chartStudySettings chartSettings :: [ChartStudyType]) <&> \case
|
(studies, smaUpdates) = unzip $ catMaybes $ studytypes <&> \case
|
||||||
ChartStudyTypeOpen -> Just (OLHC o l h c, id)
|
ChartStudyTypeOpen -> Just (OLHC o l h c, id)
|
||||||
ChartStudyTypeHigh -> Nothing
|
ChartStudyTypeHigh -> Nothing
|
||||||
ChartStudyTypeLow -> Nothing
|
ChartStudyTypeLow -> Nothing
|
||||||
@ -189,6 +145,59 @@ getUpdatedChartCache Chart{..} chartCacheSettings' = do
|
|||||||
c = last as'
|
c = last as'
|
||||||
l = minimum as'
|
l = minimum as'
|
||||||
h = maximum as'
|
h = maximum as'
|
||||||
|
|
||||||
|
getUpdatedChartCache :: Chart -> Maybe ChartCacheSettings -> RIO App (Maybe TimePoint, ChartCacheData)
|
||||||
|
getUpdatedChartCache Chart{..} chartCacheSettings' = do
|
||||||
|
let ccs@(ChartCacheSettings cRes cTicks) = fromMaybe chartCacheSettings chartCacheSettings'
|
||||||
|
now <- liftIO getCurrentTime
|
||||||
|
let cacheUpdateEnd = ((utcTimeToSeconds now + cRes) `div` cRes) * cRes
|
||||||
|
ChartCacheData ccData ccAxis ccRange ccFill = chartCache
|
||||||
|
let traceShowCommentId' s a = a -- traceShowCommentId s a
|
||||||
|
traceShowComment' s a b = b -- traceShowComment s a b
|
||||||
|
lUpdate = utcTimeToSeconds now
|
||||||
|
-- - calculate Range and need for shift
|
||||||
|
shiftNeccessary = case ccRange of
|
||||||
|
Nothing -> False
|
||||||
|
Just (TimeInterval _ ma) -> cacheUpdateEnd > ma
|
||||||
|
(newRange, shiftInterval) = if not shiftNeccessary && isJust ccRange then (fromJust ccRange, 0) else
|
||||||
|
let interval = cTicks `div` 20 :: Int
|
||||||
|
iTo = ((cacheUpdateEnd + cRes * interval) `div` (cRes * interval)) * (cRes * interval)
|
||||||
|
iFrom = iTo - 20 * (cRes * interval)
|
||||||
|
shift = case ccRange of
|
||||||
|
Nothing -> 0
|
||||||
|
Just (TimeInterval _ ma) -> (iTo - ma) `div` cRes
|
||||||
|
in (TimeInterval iFrom iTo, shift)
|
||||||
|
ccAxis' = if not shiftNeccessary && isJust ccRange then ccAxis
|
||||||
|
else VS.enumFromStepN (fromIntegral $ timeIntervalBegin newRange) (fromIntegral cRes) cTicks
|
||||||
|
let timePointToIndex' :: TimePoint -> Either String Int
|
||||||
|
timePointToIndex' = timePointToIndex (Just $ ChartCacheSettings cRes cTicks) newRange
|
||||||
|
let indexToTimePoint' :: Int -> TimePoint
|
||||||
|
indexToTimePoint' = indexToTimePoint (Just $ ChartCacheSettings cRes cTicks) newRange
|
||||||
|
when (Just newRange /= ccRange) $ logInfo $ displayShow ("range changed:", newRange, ccRange)
|
||||||
|
logInfo $ displayShow ("shift?" :: Text, shiftNeccessary, shiftInterval)
|
||||||
|
logInfo $ 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.
|
||||||
|
-- create data for updates
|
||||||
|
let chunks = case (,) <$> ccFill <*> ccRange of
|
||||||
|
Nothing -> [(cacheUpdateStart, cacheUpdateEnd)]
|
||||||
|
Just ((mi, ma), oldRange) -> let itp = (\(TimePoint p) -> p) . indexToTimePoint (Just ccs) oldRange in if
|
||||||
|
-- Interval mi-ma already updated. get remaining intervals
|
||||||
|
-- mi ma cUS cUE
|
||||||
|
| itp ma < cacheUpdateStart -> [(cacheUpdateStart, cacheUpdateEnd)]
|
||||||
|
-- mi? cUS mi? ma cUE -> [ma,cUE] + rest
|
||||||
|
| itp ma < cacheUpdateEnd -> (<> [(itp ma,cacheUpdateEnd)]) if
|
||||||
|
-- cUS mi ma
|
||||||
|
| itp mi > cacheUpdateStart -> [(cacheUpdateStart, itp mi)]
|
||||||
|
| otherwise -> []
|
||||||
|
| otherwise -> []
|
||||||
|
-- - chunk them with chunhChart
|
||||||
|
chunkedChart = L.concat $ chunks <&> \(start, end) -> chunkChart (max 0 start) end cRes chartData
|
||||||
|
let (lastDataPoint, !foldedData') = toChartData (chartStudySettings chartSettings) (traceShowCommentId' "chunkedChart" chunkedChart)
|
||||||
|
tpToTi (TimeInterval f t) = case timePointToIndex' (TimePoint (t+f) `div` 2) of
|
||||||
|
Left e -> error $ "BUG in Chart.hs. Impossible: " <> e
|
||||||
|
Right ti -> ti
|
||||||
|
-- aggregate data with index into the vectors
|
||||||
|
foldedData = (\cp@ChartPoint{..} -> (tpToTi timeOfDay, cp)) <$> (traceShowCommentId' "foldedData" foldedData')
|
||||||
-- plan the actual work
|
-- plan the actual work
|
||||||
updates = chartStudySettings chartSettings <&> \cs ->
|
updates = chartStudySettings chartSettings <&> \cs ->
|
||||||
-- check if thing is in hashmap
|
-- check if thing is in hashmap
|
||||||
@ -196,10 +205,13 @@ getUpdatedChartCache Chart{..} chartCacheSettings' = do
|
|||||||
Nothing -> VS.replicate cTicks 0
|
Nothing -> VS.replicate cTicks 0
|
||||||
Just a -> a
|
Just a -> a
|
||||||
-- shift if neccessary
|
-- shift if neccessary
|
||||||
vec' = if shiftNeccessary && cs `HM.member` ccData then
|
vec' = if shiftNeccessary && cs `HM.member` ccData && shiftInterval < VS.length vec then
|
||||||
-- TODO: unsafeSlice && unsafeUpdate_ - see #16
|
-- TODO: unsafeSlice && unsafeUpdate_ - see #16
|
||||||
let sliceLength = VS.length vec - shiftInterval
|
let sliceLength = VS.length vec - shiftInterval
|
||||||
in VS.update_ vec (VS.enumFromN 0 sliceLength) (VS.slice shiftInterval sliceLength vec)
|
in VS.update_
|
||||||
|
(VS.update_ vec (VS.enumFromN 0 sliceLength) (VS.slice shiftInterval sliceLength vec))
|
||||||
|
(VS.enumFromN sliceLength (cTicks - sliceLength))
|
||||||
|
(VS.replicate sliceLength 0)
|
||||||
else
|
else
|
||||||
vec
|
vec
|
||||||
-- NOW:
|
-- NOW:
|
||||||
@ -218,29 +230,45 @@ 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 chartCache
|
logInfo $ displayShow ccData'
|
||||||
-- logInfo $ displayShow (cacheUpdateStart, cacheUpdateEnd)
|
let maToMi ma = max 0 $ fromMaybe ma $ (subtract shiftInterval) . fst <$> ccFill
|
||||||
-- logInfo $ displayShow (newRange, chunkedChart)
|
fillRange = case traceShowCommentId' "(ccFill, lastDataPoint)" (ccFill,lastDataPoint) of
|
||||||
let ma = timePointToIndex' $ TimePoint lUpdate
|
-- no new data, but different range. shift along.
|
||||||
mi = fromMaybe ma $ fst <$> ccFill
|
(Just (mi,ma), Nothing) -> if ma - shiftInterval < 0 then Nothing else Just (max 0 $ mi - shiftInterval, ma - shiftInterval)
|
||||||
return (Just $ TimePoint lUpdate, ChartCacheData ccData' ccAxis' (Just newRange) (Just $ (mi, timePointToIndex' $ TimePoint lUpdate)))
|
-- no data saved yet
|
||||||
|
(Nothing, Nothing) -> Nothing
|
||||||
|
-- new data, update fillRange
|
||||||
|
(mima, Just lastDP) -> let lastBlock = let d = timeOfDay lastDP in (intervalTo d + intervalFrom d) `div` 2
|
||||||
|
in case timePointToIndex' $ lastBlock of
|
||||||
|
Left err -> error $ "impossible #1 Chart.hs - " <> err
|
||||||
|
Right ma -> if ma < cTicks
|
||||||
|
then case mima of -- check if we rotated out or have no fill-range set.
|
||||||
|
Nothing -> 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 error $ "impossible #2 Chart.hs - " <> show ma <> ">=" <> show cTicks
|
||||||
|
logInfo $ displayShow 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])
|
||||||
getChunkedDay Chart{..} chunkResolution = (lUpdate, toCachePoint <$> chunkedData)
|
getChunkedDay Chart{..} chunkResolution = case toChartData (chartStudySettings chartSettings) chunkedData of
|
||||||
|
(Nothing, x) -> (Nothing, x)
|
||||||
|
(Just ChartPoint{..}, x)
|
||||||
|
| timeOfDay == mempty -> (Nothing, x)
|
||||||
|
| otherwise -> (Just $ TimePoint $ timeIntervalEnd timeOfDay, x)
|
||||||
where
|
where
|
||||||
chunkedData = chunkChart 0 86400 (fromMaybe (chartCacheResolution chartCacheSettings) chunkResolution) chartData
|
chunkedData = chunkChart 0 86400 (fromMaybe (chartCacheResolution chartCacheSettings) chunkResolution) chartData
|
||||||
lUpdate = fmap fst . lastMaybe $ chunkedData
|
|
||||||
|
|
||||||
indexToTimePoint :: Maybe ChartCacheSettings -> (Int, Int) -> Int -> TimePoint
|
indexToTimePoint :: Maybe ChartCacheSettings -> TimeInterval -> Int -> TimePoint
|
||||||
indexToTimePoint ccs (rFrom, rTo) i = TimePoint $ rFrom + i*cRes
|
indexToTimePoint ccs (TimeInterval rFrom rTo) i = TimePoint $ rFrom + i*cRes
|
||||||
where
|
where
|
||||||
ChartCacheSettings cRes _ = fromMaybe defChartCacheSettings ccs
|
ChartCacheSettings cRes _ = fromMaybe defChartCacheSettings ccs
|
||||||
|
|
||||||
timePointToIndex :: Maybe ChartCacheSettings -> (Int, Int) -> TimePoint -> Int
|
timePointToIndex :: Maybe ChartCacheSettings -> TimeInterval -> TimePoint -> Either String Int
|
||||||
timePointToIndex ccs (rFrom, rTo) (TimePoint p) = if
|
timePointToIndex ccs (TimeInterval rFrom rTo) (TimePoint p) = if
|
||||||
| p < rFrom || p > rTo -> error $ "timePointToIndex " <> show ((cRes, cTicks),(rFrom, rTo),TimePoint p) <> ": " <> show p <> " out of range."
|
| p < rFrom || p > rTo -> Left $ "timePointToIndex " <> show ((cRes, cTicks),(rFrom, rTo),TimePoint p) <> ": " <> show p <> " out of range."
|
||||||
| result < 0 || result >= cTicks -> error $ "timePointToIndex " <> show ((cRes, cTicks),(rFrom, rTo),TimePoint p) <> ": " <> show result <> " is invalid index"
|
| result < 0 || result >= cTicks -> Left $ "timePointToIndex " <> show ((cRes, cTicks),(rFrom, rTo),TimePoint p) <> ": " <> show result <> " is invalid index"
|
||||||
| otherwise -> result
|
| otherwise -> Right result
|
||||||
where
|
where
|
||||||
ChartCacheSettings cRes cTicks = fromMaybe defChartCacheSettings ccs
|
ChartCacheSettings cRes cTicks = fromMaybe defChartCacheSettings ccs
|
||||||
result = (p - rFrom) `div` cRes
|
result = (p - rFrom) `div` cRes
|
||||||
|
@ -11,6 +11,8 @@ module Import
|
|||||||
, getCurrentDay
|
, getCurrentDay
|
||||||
, switchAccountTo
|
, switchAccountTo
|
||||||
, utcTimeToSeconds
|
, utcTimeToSeconds
|
||||||
|
, traceShowComment
|
||||||
|
, traceShowCommentId
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import RIO
|
import RIO
|
||||||
@ -26,6 +28,7 @@ import System.Directory
|
|||||||
import Data.Text as T
|
import Data.Text as T
|
||||||
import Data.Time.Clock
|
import Data.Time.Clock
|
||||||
import Data.Time.Calendar
|
import Data.Time.Calendar
|
||||||
|
import Debug.Trace as D
|
||||||
|
|
||||||
ppShow' :: Show a => a -> Text
|
ppShow' :: Show a => a -> Text
|
||||||
ppShow' = T.pack . ppShow
|
ppShow' = T.pack . ppShow
|
||||||
@ -48,3 +51,9 @@ switchAccountTo a = do
|
|||||||
|
|
||||||
utcTimeToSeconds :: UTCTime -> Int
|
utcTimeToSeconds :: UTCTime -> Int
|
||||||
utcTimeToSeconds = fromInteger . (`div` ((10 :: Integer)^(12 :: Integer))) . diffTimeToPicoseconds . utctDayTime
|
utcTimeToSeconds = fromInteger . (`div` ((10 :: Integer)^(12 :: Integer))) . diffTimeToPicoseconds . utctDayTime
|
||||||
|
|
||||||
|
traceShowComment :: Show a => String -> a -> b -> b
|
||||||
|
traceShowComment s a b = D.trace ("\ESC[1;31m" <> s <> ":\ESC[0m\n"<> show a<>"\n") b
|
||||||
|
|
||||||
|
traceShowCommentId :: Show a => String -> a -> a
|
||||||
|
traceShowCommentId s a = D.trace ("\ESC[1;31m" <> s <> ":\ESC[0m\n"<> show a<>"\n") a
|
||||||
|
@ -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') = getChunkedDay c (Just 5)
|
let chartData' = traceShowCommentId "chartData for saving" $ 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
|
||||||
@ -232,14 +232,15 @@ renderLoop = do
|
|||||||
withPlot "Test" $ do
|
withPlot "Test" $ do
|
||||||
-- TODO: set axes
|
-- TODO: set axes
|
||||||
-- let (x,y) = L.unzip $ (\ChartPoint{..} -> (fromIntegral timeOfDay,pointValue)) <$> chartCache
|
-- let (x,y) = L.unzip $ (\ChartPoint{..} -> (fromIntegral timeOfDay,pointValue)) <$> chartCache
|
||||||
setupAxisLimits (both fromIntegral $ fromMaybe (0,86400) $ chartCacheCurrent chartCache) (-100,2500) Nothing
|
setupAxisLimits (both fromIntegral $ (\(TimeInterval a b) -> (a,b)) $ fromMaybe (TimeInterval 0 86400) $ chartCacheCurrent chartCache) (-100,2500) Nothing
|
||||||
let ChartCacheSettings _ cTicks = chartCacheSettings
|
let ChartCacheSettings _ cTicks = chartCacheSettings
|
||||||
(f, t) = fromMaybe (0, cTicks) $ chartCacheFilledTo chartCache
|
(f, t) = fromMaybe (0, cTicks-1) $ chartCacheFilledTo chartCache
|
||||||
direct = chartCacheData chartCache HM.!? ChartStudyTypeDirect
|
direct = chartCacheData chartCache HM.!? ChartStudyTypeDirect
|
||||||
x = chartCacheAxis chartCache
|
x = chartCacheAxis chartCache
|
||||||
-- t-f == 0 means there is still 1 point in it. VS.slice takes number of points as second argument. Add 1!
|
-- t-f == 0 means there is still 1 point in it. VS.slice takes number of points as second argument. Add 1!
|
||||||
-- dataSlice = VS.slice f (t-f+1)
|
-- dataSlice = VS.slice f (t-f+1)
|
||||||
dataSliceLine = if t-f < 1 then VS.slice (max 0 $ f-1) 2 else VS.slice f (t-f+1) -- need at least 2 points to make a line... duh!
|
dataSliceLine = if t-f < 1 then VS.slice (max 0 $ f-1) 2 else VS.slice f (t-f+1) -- need at least 2 points to make a line... duh!
|
||||||
|
when (t-f < 0 || t-f >= cTicks) $ logError $ displayShow ("t/f", t-f, t, f)
|
||||||
when (isJust direct) $ do
|
when (isJust direct) $ do
|
||||||
plotLine (T.unpack symbol) (dataSliceLine x) (dataSliceLine $ fromJust direct)
|
plotLine (T.unpack symbol) (dataSliceLine x) (dataSliceLine $ fromJust direct)
|
||||||
return ()
|
return ()
|
||||||
|
42
src/Types.hs
42
src/Types.hs
@ -17,6 +17,7 @@ import Data.Types.Injective
|
|||||||
import Data.Time
|
import Data.Time
|
||||||
import Data.FingerTree
|
import Data.FingerTree
|
||||||
import Data.Semigroup
|
import Data.Semigroup
|
||||||
|
import Generic.Data.Microsurgery
|
||||||
import GHC.Generics
|
import GHC.Generics
|
||||||
import SDL (Window)
|
import SDL (Window)
|
||||||
import DearImGui
|
import DearImGui
|
||||||
@ -166,7 +167,7 @@ defChartSettings = ChartSettings 60 Nothing Nothing [ChartStudyTypeDirect]
|
|||||||
|
|
||||||
updateChartStudySettings :: Chart -> [ChartStudyType] -> Chart
|
updateChartStudySettings :: Chart -> [ChartStudyType] -> Chart
|
||||||
updateChartStudySettings Chart{..} s =
|
updateChartStudySettings Chart{..} s =
|
||||||
let chartSettings = chartSettings { chartStudySettings = [] }
|
let chartSettings = chartSettings { chartStudySettings = s }
|
||||||
chartCache = emptyChartCacheData chartCacheSettings
|
chartCache = emptyChartCacheData chartCacheSettings
|
||||||
lastCacheUpdate = Nothing
|
lastCacheUpdate = Nothing
|
||||||
in Chart{..}
|
in Chart{..}
|
||||||
@ -184,14 +185,35 @@ 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
|
||||||
|
|
||||||
-- TODO: TimePointFloat? or only 1 entry per second?
|
-- TODO: TimePointFloat? or only 1 entry per second?
|
||||||
|
|
||||||
|
data TimeInterval = TimeInterval
|
||||||
|
{ timeIntervalBegin :: Int
|
||||||
|
, timeIntervalEnd :: Int
|
||||||
|
}
|
||||||
|
deriving stock (Generic, Eq)
|
||||||
|
deriving anyclass (FromJSON, ToJSON) -- TODO: write own instances with "TimeInterval [a,b]" instead of recods.
|
||||||
|
deriving (Show) via (Surgery Derecordify TimeInterval)
|
||||||
|
instance Semigroup TimeInterval where
|
||||||
|
(TimeInterval mi1 ma1) <> (TimeInterval mi2 ma2)
|
||||||
|
= TimeInterval (getMin $ Min mi1 <> Min mi2) (getMax $ Max ma1 <> Max ma2)
|
||||||
|
instance Monoid TimeInterval where
|
||||||
|
mempty = TimeInterval (getMin mempty) (getMax mempty)
|
||||||
|
|
||||||
|
|
||||||
newtype TimePoint = TimePoint Int
|
newtype TimePoint = TimePoint Int
|
||||||
deriving stock (Generic)
|
deriving stock (Generic, Show)
|
||||||
deriving newtype (Show, Eq, Enum, Real, Ord, Num, Integral, FromJSON, ToJSON)
|
deriving newtype (Eq, Enum, Real, Ord, Num, Integral, FromJSON, ToJSON)
|
||||||
deriving (Semigroup, Monoid) via (Max Int)
|
deriving (Semigroup, Monoid) via (Min Int)
|
||||||
|
|
||||||
|
intervalFrom :: TimeInterval -> TimePoint
|
||||||
|
intervalFrom (TimeInterval a _) = TimePoint a
|
||||||
|
|
||||||
|
intervalTo :: TimeInterval -> TimePoint
|
||||||
|
intervalTo (TimeInterval _ b) = TimePoint b
|
||||||
|
|
||||||
data ChartStudies = SMA { window :: Int, value :: Float }
|
data ChartStudies = SMA { window :: Int, value :: Float }
|
||||||
| OLHC { olhc_open :: Float, olhc_low :: Float, olhc_high :: Float, olhc_close :: Float}
|
| OLHC { olhc_open :: Float, olhc_low :: Float, olhc_high :: Float, olhc_close :: Float}
|
||||||
@ -200,14 +222,14 @@ data ChartStudies = SMA { window :: Int, value :: Float }
|
|||||||
deriving anyclass (FromJSON, ToJSON)
|
deriving anyclass (FromJSON, ToJSON)
|
||||||
|
|
||||||
data ChartPoint = ChartPoint
|
data ChartPoint = ChartPoint
|
||||||
{ timeOfDay :: TimePoint
|
{ timeOfDay :: TimeInterval
|
||||||
, pointValue :: Float
|
, pointValue :: Float
|
||||||
, pointVolume :: Float
|
, pointVolume :: Float
|
||||||
, pointExtra :: [ChartStudies]
|
, pointExtra :: [ChartStudies]
|
||||||
} deriving stock (Show, Eq, Generic)
|
} deriving stock (Show, Eq, Generic)
|
||||||
deriving anyclass (FromJSON, ToJSON)
|
deriving anyclass (FromJSON, ToJSON)
|
||||||
|
|
||||||
instance Measured TimePoint ChartPoint where
|
instance Measured TimeInterval ChartPoint where
|
||||||
measure = timeOfDay
|
measure = timeOfDay
|
||||||
|
|
||||||
-- | Tick-based data
|
-- | Tick-based data
|
||||||
@ -224,7 +246,7 @@ data ChartStudyType = ChartStudyTypeDirect
|
|||||||
data ChartCacheData = ChartCacheData
|
data ChartCacheData = ChartCacheData
|
||||||
{ chartCacheData :: HashMap ChartStudyType (VS.Vector Float)
|
{ chartCacheData :: HashMap ChartStudyType (VS.Vector Float)
|
||||||
, chartCacheAxis :: VS.Vector Float
|
, chartCacheAxis :: VS.Vector Float
|
||||||
, chartCacheCurrent :: Maybe (Int,Int) -- ^ in number of TimePoint, negative meaning "before today"
|
, chartCacheCurrent :: Maybe TimeInterval -- ^ in number of TimeInterval, negative meaning "before today"
|
||||||
, chartCacheFilledTo :: Maybe (Int,Int) -- ^ in index into the vectors given range of "Current"
|
, chartCacheFilledTo :: Maybe (Int,Int) -- ^ in index into the vectors given range of "Current"
|
||||||
} deriving stock (Show, Eq)
|
} deriving stock (Show, Eq)
|
||||||
|
|
||||||
@ -233,8 +255,8 @@ emptyChartCacheData ChartCacheSettings{..} = ChartCacheData mempty (VS.replicate
|
|||||||
|
|
||||||
data Chart = Chart
|
data Chart = Chart
|
||||||
{ chartContractID :: Int
|
{ chartContractID :: Int
|
||||||
, chartData :: FingerTree TimePoint ChartPoint -- ^ raw data (time & sale)
|
, chartData :: FingerTree TimeInterval ChartPoint -- ^ raw data (time & sale)
|
||||||
, chartHistData :: HashMap Day (FingerTree TimePoint ChartPoint) -- ^ raw data (time & sale)
|
, chartHistData :: HashMap Day (FingerTree TimeInterval ChartPoint) -- ^ raw data (time & sale)
|
||||||
, fillerThread :: ThreadId
|
, fillerThread :: ThreadId
|
||||||
, chartSettings :: ChartSettings
|
, chartSettings :: ChartSettings
|
||||||
, chartCacheSettings :: ChartCacheSettings
|
, chartCacheSettings :: ChartCacheSettings
|
||||||
|
Loading…
Reference in New Issue
Block a user