finally hopefully fixed #12

This commit is contained in:
Nicole Dresselhaus 2022-08-08 23:04:09 +02:00
parent 42183873d8
commit 32ec058e6b
6 changed files with 165 additions and 103 deletions

View File

@ -107,6 +107,7 @@ library
, dear-implot , dear-implot
, directory , directory
, fingertree , fingertree
, generic-data
, gl , gl
, managed , managed
, microlens-th , microlens-th

View File

@ -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"

View File

@ -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

View File

@ -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

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') = 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 ()

View File

@ -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