5
\$\begingroup\$

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?

\$\endgroup\$
4
\$\begingroup\$

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 < 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)]
\$\endgroup\$
2
\$\begingroup\$

There are two parts: first, you need to merge two lists with (+), second, you need to traverse the resulting list and accumulate values.

(Variant a) &+ (Variant b) =
    Variant $ snd $ mapAccumL (\r (d, k) -> let r' = r + k in (r', (d, r'))) 0
        $ toList $ Map.unionWith (+)
            (Map.fromDistinctAscList a)
            (Map.fromDistinctAscList b)

This is still O(n), since all involved functions are O(n). The whole code: http://ideone.com/Z9Os4c

\$\endgroup\$
  • \$\begingroup\$ This would be a great answer on SO, but unfortunately, fails to give a proper code review. (For example, you could also address the poor variable names that OP is using as well.) \$\endgroup\$ – RubberDuck Jun 23 '14 at 12:00
  • \$\begingroup\$ I answered this question: "Is there a better way to implement?" So my answer is illegal, only if the question is illegal, but I don't think it is. \$\endgroup\$ – user3237465 Jun 23 '14 at 12:19
  • \$\begingroup\$ It's not an illegal answer, it's just not a very good one. I'm just trying to help you. See ya around. \$\endgroup\$ – RubberDuck Jun 23 '14 at 12:21

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.