# I have created an ugly Haskell program..

7 messages
Open this post in threaded view
|

## I have created an ugly Haskell program..

 .. and I am positive there must be a way of beautifying it, but I am struggling. I bet there is just some lovely way of making this all shrink to three lines.. So here's the problem. I have two lists of tuples: (timestamp, value) What I would like to do in do a kind of 'zip' on two of these lists to make a list of (timestamp, (value1, value2)) with the following rules: - If the timestamps are equal it's easy - make your new element an move on - If one of the lists has a timestamp that the other doesn't, repeat an old value from the other list - If we don't have an old value yet, then don't create an element in the new list. e.g. if I ran my algorithm on these two lists d1 = [ (1,"a"), (2,"b"),  (3,"c")           ] d2 = [          (2,"b'"),          (4,"d'") ]   I would like to get result = [ (2, (b,b')), (3, (c,b')), (4, (c,d')) ]   e.g. there was no data in d2 for our first element so we skipped it. Okay, so here is my code.. It works, but makes me feel a bit dirty. To explain my nomenclature 't' is 'timestamp of', 'v' is 'value of'. vx' and vy' are the 'old' values from the previous iteration in case a repeat is needed. They are Maybes because at the beginning there may be no old value. d1 = [ (1,"a"), (2,"b"),  (3,"c")           ] d2 = [          (2,"b'"),          (4,"d'") ]   t (x,y) = x v (x,y) = y js vx' vy' (x:xs) (y:ys)  | t x == t y  = ( (t x), (v x, v y) )  : js (Just (v x)) (Just (v y)) xs ys  | t x < t y   =      maybe (js (Just (v x)) Nothing xs (y:ys))            (\z -> ( t x, (v x, z ) ) : ( js (Just (v x)) (Just z) xs (y:ys)))            vy'  | t x > t y   =      maybe (js Nothing  (Just (v y)) (x:xs) ys)            (\z -> ( t y, (z, v y ) ) : ( js (Just z) (Just (v y)) (x:xs) ys))            vx' js vx' vy' (x:xs) []   =     maybe []           (\z -> ( t x, (v x, z ) ) : ( js (Just (v x)) (Just z) xs []))           vy' js vx' vy' [] (y:ys)   =     maybe []           (\z -> ( t y, (z, v y ) ) : ( js (Just z) (Just (v y))  [] ys ))           vx' js _ _ [] []   = [] You call it with the first two arguments as Nothing to kick it off (I have a trivial wrapper function to do this) It works fine: > :t js js   :: (Ord t) =>      Maybe a1 -> Maybe a -> [(t, a1)] -> [(t, a)] -> [(t, (a1, a))] > js Nothing Nothing d1 d2 [(2,("b","b'")),(3,("c","b'")),(4,("c","d'"))] But it just feels gross. Any advice on how to tame this beast would be greatly appreciated :) All the best, Philip
Open this post in threaded view
|

## I have created an ugly Haskell program..

 Function you seek is 'specialZip' below. 'fluff' and 'decapitate' are helpers. Not extensively tested. -- Given a list of ints that "should" all have values, fill in missing -- values using the "last" value as default. fluff :: String -> [Int] -> [(Int,String)] -> [(Int,String)] fluff last (i:is) pss@((t,s):ps)        | i == t = (i,s) : fluff s is ps        | i < t  = (i,last) : fluff last is pss fluff last is [] = zip is (repeat last) -- Given two lists, remove enough from the front to get to two equal keys. decapitate [] _ = ([],[]) decapitate _ [] = ([],[]) decapitate xss@((tx,_):xs) yss@((ty,_):ys)      | tx < ty  = decapitate xs yss      | ty < tx  = decapitate xss ys      | ty == tx = (xss,yss) specialZip d1 d2 =      let (dd1,dd2) = decapitate d1 d2          -- build set of every key that should be in final list          s = S.toAscList . S.fromList \$ (map fst dd1) ++ (map fst dd2)      in case (dd1,dd2) of           ([],[]) -> []           (xs1,xs2) ->               let f1 = fluff "" s xs1 -- use this set to fluff                   f2 = fluff "" s xs2 -- each list               -- so final answer can be a simple zipWith               in zipWith (\(t1,s1) (t2,s2) -> (t1,(s1,s2))) f1 f2 Philip Scott wrote: > .. and I am positive there must be a way of beautifying it, but I am > struggling. I bet there is just some lovely way of making this all shrink to > three lines.. > > So here's the problem. I have two lists of tuples: (timestamp, value) > > What I would like to do in do a kind of 'zip' on two of these lists to make a > list of (timestamp, (value1, value2)) with the following rules: > > - If the timestamps are equal it's easy - make your new element an move on > - If one of the lists has a timestamp that the other doesn't, repeat an old > value from the other list > - If we don't have an old value yet, then don't create an element in the new > list. > > e.g. if I ran my algorithm on these two lists > > d1 = [ (1,"a"), (2,"b"),  (3,"c")           ] > d2 = [          (2,"b'"),          (4,"d'") ]   > > I would like to get > > result = [ (2, (b,b')), (3, (c,b')), (4, (c,d')) ]   > > e.g. there was no data in d2 for our first element so we skipped it. > > Okay, so here is my code.. It works, but makes me feel a bit dirty. To explain > my nomenclature 't' is 'timestamp of', 'v' is 'value of'. vx' and vy' are the > 'old' values from the previous iteration in case a repeat is needed. They are > Maybes because at the beginning there may be no old value. > > d1 = [ (1,"a"), (2,"b"),  (3,"c")           ] > d2 = [          (2,"b'"),          (4,"d'") ]   > > t (x,y) = x > v (x,y) = y > > js vx' vy' (x:xs) (y:ys) >  | t x == t y  = ( (t x), (v x, v y) )  : js (Just (v x)) (Just (v y)) xs ys >  | t x < t y   = >      maybe (js (Just (v x)) Nothing xs (y:ys)) >            (\z -> ( t x, (v x, z ) ) : ( js (Just (v x)) (Just z) xs (y:ys))) >            vy' >  | t x > t y   = >      maybe (js Nothing  (Just (v y)) (x:xs) ys) >            (\z -> ( t y, (z, v y ) ) : ( js (Just z) (Just (v y)) (x:xs) ys)) >            vx' > js vx' vy' (x:xs) []   = >     maybe [] >           (\z -> ( t x, (v x, z ) ) : ( js (Just (v x)) (Just z) xs [])) >           vy' > js vx' vy' [] (y:ys)   = >     maybe [] >           (\z -> ( t y, (z, v y ) ) : ( js (Just z) (Just (v y))  [] ys )) >           vx' > js _ _ [] []   = [] > > You call it with the first two arguments as Nothing to kick it off (I have a > trivial wrapper function to do this) > > It works fine: > >> :t js > js >   :: (Ord t) => >      Maybe a1 -> Maybe a -> [(t, a1)] -> [(t, a)] -> [(t, (a1, a))] > >> js Nothing Nothing d1 d2 > [(2,("b","b'")),(3,("c","b'")),(4,("c","d'"))] > > But it just feels gross. Any advice on how to tame this beast would be greatly > appreciated :) > > All the best, > > Philip > _______________________________________________ > Beginners mailing list > [hidden email] > http://www.haskell.org/mailman/listinfo/beginners
Open this post in threaded view
|

## I have created an ugly Haskell program..

 Michael Mossey wrote: > > Function you seek is 'specialZip' below. 'fluff' and 'decapitate' are > helpers. Not extensively tested. Thanks Michael, that looks much better than mine :)
Open this post in threaded view
|

## I have created an ugly Haskell program..

 Another solution here. The inspiration is to try to use Data.Map's fromListWith to do the main work. Notice that you can "decapitate" the useless head of each list with the single line         dropWhile (not . both) . M.toAscList \$ neated import Control.Arrow import qualified Data.Map as M data Combine v = LeftOnly v                 | RightOnly v                 | BothOfThem v v                   deriving (Show) cmb :: Combine a -> Combine a -> Combine a cmb (LeftOnly x) (RightOnly y) = BothOfThem x y cmb (RightOnly y) (LeftOnly x) = BothOfThem x y both (_,(BothOfThem _ _ )) = True both _ = False chain _ last2 ((t,LeftOnly v):xs) = (t,(v,last2)) : chain v last2 xs chain last1 _ ((t,RightOnly v):xs) = (t,(last1,v)) : chain last1 v xs chain _ _     ((t,BothOfThem v w):xs) = (t,(v,w)) : chain v w xs chain _ _     [] = [] specialZip d1 d2 =      let neated = M.fromListWith cmb \$ map (second LeftOnly) d1                   ++ map (second RightOnly) d2          dr = dropWhile (not . both) . M.toAscList \$ neated      in chain "" "" dr Philip Scott wrote: > Michael Mossey wrote: >> >> Function you seek is 'specialZip' below. 'fluff' and 'decapitate' are >> helpers. Not extensively tested. > > Thanks Michael, that looks much better than mine :) > >
Open this post in threaded view
|