Take the 2-minute tour ×
Code Review Stack Exchange is a question and answer site for peer programmer code reviews. It's 100% free, no registration required.

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?

share|improve this question
    
Do not cross-post for the sake of "gaining a wider audience" or anything like that. Only post it on the site to which it belongs. It is on-topic here, and but it's off-topic on Stack Overflow, so it should eventually get closed over there. –  Jamal Jun 23 at 5:26
add comment

2 Answers 2

up vote 4 down vote accepted

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)]
share|improve this answer
add comment

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

share|improve this answer
    
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.) –  ckuhn203 Jun 23 at 12:00
    
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. –  user3237465 Jun 23 at 12:19
    
It's not an illegal answer, it's just not a very good one. I'm just trying to help you. See ya around. –  ckuhn203 Jun 23 at 12:21
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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