patternMinor
Merging time series
Viewed 0 times
seriestimemerging
Problem
Is there a better way to do this?
A time series,
... where type
Some example data,
Now, merge two time series such that the "total balance" is additive,
So,
Now, I believe
A time series,
data Model a where
Variant :: [(Day, a)] -> Model a
deriving (Show)... where type
a in [(Day, a)] basically represents the "total balance" e.g. bank account.Some example data,
day1 = fromGregorian 1987 10 17
day2 = fromGregorian 1987 10 18
day3 = fromGregorian 1987 10 19
day4 = fromGregorian 1987 10 20
day5 = fromGregorian 1987 10 21
day6 = fromGregorian 1987 10 22
m1 = Variant [(day1, 1), (day3, 3), (day5, 5)] :: Model Integer
m2 = Variant [(day1, 1), (day2, 2), (day4, 4), (day6, 6)] :: Model IntegerNow, merge two time series such that the "total balance" is additive,
(&+) :: Num a => Model a -> Model a -> Model a
(Variant a) &+ (Variant b) = Variant $ reverse $ fst $ go a b ([],0)
where
go [] [] (xs, c) = (xs, c)
go ((da,va):as) [] (xs, c) = go as [] (((da,va+c):xs), va+c)
go [] ((db,vb):bs) (xs, c) = go [] bs (((db,vb+c):xs), vb+c)
go a@((da,va):as) b@((db,vb):bs) (xs, c)
| da > db = go a bs (((db,vb+c):xs), vb+c)
| da < db = go as b (((da,va+c):xs), va+c)
| da == db = go as bs (((da,va+vb+c):xs), va+vb+c)So,
what = m1 &+ m2
Variant [(1987-10-17,2),(1987-10-18,4),(1987-10-19,7),(1987-10-20,11),(1987-10-21,16),(1987-10-22,22)]Now, I believe
(&+) to be correct, but I have a feeling that the implementation could be more elegant. I would describe it as merging two lists of pairs where the snd is accumulated. Is there a better way to implement?Solution
I think the issue is you are doing two things at once: merging the two day lists, and calculating an accumulation of a list. Note that I'm going to assume the Variant is always in order, as it will make everything much more efficient.
Firstly, to join two variants, I used this:
This is pretty straightforward. If either list is empty, the result is the other. Otherwise, check the first value of each list. Put the value with the oldest date (
Next, it is trivial to make
With Traverable, we have access to the function
This gives the same answer as your old code. Full listing:
Firstly, to join two variants, I used this:
(Variant v1) `concatModels` (Variant v2) = Variant $ joinVariants v1 v2 where
joinVariants x [] = x
joinVariants [] y = y
joinVariants (x:xs) (y:ys)
| (fst x < fst y) = x : joinVariants xs (y:ys)
| (fst x == fst y) = (fst x, (snd x) + (snd y)) : joinVariants xs ys
| otherwise = y : joinVariants (x:xs) ysThis is pretty straightforward. If either list is empty, the result is the other. Otherwise, check the first value of each list. Put the value with the oldest date (
fst x) first. If they are equal, combine the values by adding them together.Next, it is trivial to make
Model an instance of Functor, Foldable, and Traversable. So trivial in fact that haskell can generate the code itself:deriving (Show, Eq, Functor, Foldable, Traversable)With Traverable, we have access to the function
mapAccumL, which will let us map over the Model using an accumulator to update. this makes the problem simple to solve:modelAccumulation :: Num a => Model a -> Model a
modelAccumulation = snd . mapAccumL accumF 0 where
accumF acc v = let newAcc = acc + v in (newAcc, newAcc)
(&+) :: Num a => Model a -> Model a -> Model a
m1 &+ m2 = modelAccumulation $ concatModels m1 m2This gives the same answer as your old code. Full listing:
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
module Main where
import Data.Time.Calendar
import Data.Function
import Data.Traversable
import Data.Foldable
data Model a = Variant [(Day, a)]
deriving (Show, Eq, Functor, Foldable, Traversable)
(Variant v1) `concatModels` (Variant v2) = Variant $ joinVariants v1 v2 where
joinVariants x [] = x
joinVariants [] y = y
joinVariants (x:xs) (y:ys)
| (fst x Model a -> Model a
modelAccumulation = snd . mapAccumL accumF 0 where
accumF acc v = let newAcc = acc + v in (newAcc, newAcc)
(&+) :: Num a => Model a -> Model a -> Model a
m1 &+ m2 = modelAccumulation $ concatModels m1 m2
day1 = fromGregorian 1987 10 17
day2 = fromGregorian 1987 10 18
day3 = fromGregorian 1987 10 19
day4 = fromGregorian 1987 10 20
day5 = fromGregorian 1987 10 21
day6 = fromGregorian 1987 10 22
m1 = Variant [(day1, 1), (day3, 3), (day5, 5)] :: Model Integer
m2 = Variant [(day1, 1), (day2, 2), (day4, 4), (day6, 6)] :: Model Integer
what = m1 &+ m2
expected = Variant [(fromGregorian 1987 10 17,2),(fromGregorian 1987 10 18,4),(fromGregorian 1987 10 19,7),(fromGregorian 1987 10 20,11),(fromGregorian 1987 10 21,16),(fromGregorian 1987 10 22,22)]Code Snippets
(Variant v1) `concatModels` (Variant v2) = Variant $ joinVariants v1 v2 where
joinVariants x [] = x
joinVariants [] y = y
joinVariants (x:xs) (y:ys)
| (fst x < fst y) = x : joinVariants xs (y:ys)
| (fst x == fst y) = (fst x, (snd x) + (snd y)) : joinVariants xs ys
| otherwise = y : joinVariants (x:xs) ysderiving (Show, Eq, Functor, Foldable, Traversable)modelAccumulation :: Num a => Model a -> Model a
modelAccumulation = snd . mapAccumL accumF 0 where
accumF acc v = let newAcc = acc + v in (newAcc, newAcc)
(&+) :: Num a => Model a -> Model a -> Model a
m1 &+ m2 = modelAccumulation $ concatModels m1 m2{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
module Main where
import Data.Time.Calendar
import Data.Function
import Data.Traversable
import Data.Foldable
data Model a = Variant [(Day, a)]
deriving (Show, Eq, Functor, Foldable, Traversable)
(Variant v1) `concatModels` (Variant v2) = Variant $ joinVariants v1 v2 where
joinVariants x [] = x
joinVariants [] y = y
joinVariants (x:xs) (y:ys)
| (fst x < fst y) = x : joinVariants xs (y:ys)
| (fst x == fst y) = (fst x, (snd x) + (snd y)) : joinVariants xs ys
| otherwise = y : joinVariants (x:xs) ys
modelAccumulation :: Num a => Model a -> Model a
modelAccumulation = snd . mapAccumL accumF 0 where
accumF acc v = let newAcc = acc + v in (newAcc, newAcc)
(&+) :: Num a => Model a -> Model a -> Model a
m1 &+ m2 = modelAccumulation $ concatModels m1 m2
day1 = fromGregorian 1987 10 17
day2 = fromGregorian 1987 10 18
day3 = fromGregorian 1987 10 19
day4 = fromGregorian 1987 10 20
day5 = fromGregorian 1987 10 21
day6 = fromGregorian 1987 10 22
m1 = Variant [(day1, 1), (day3, 3), (day5, 5)] :: Model Integer
m2 = Variant [(day1, 1), (day2, 2), (day4, 4), (day6, 6)] :: Model Integer
what = m1 &+ m2
expected = Variant [(fromGregorian 1987 10 17,2),(fromGregorian 1987 10 18,4),(fromGregorian 1987 10 19,7),(fromGregorian 1987 10 20,11),(fromGregorian 1987 10 21,16),(fromGregorian 1987 10 22,22)]Context
StackExchange Code Review Q#54993, answer score: 4
Revisions (0)
No revisions yet.