HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Merging time series

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
seriestimemerging

Problem

Is there a better way to do this?

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 Integer


Now, 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:

(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


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 (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 m2


This 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) ys
deriving (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.