[Haskell-cafe] An ugly zip3 problem..

Dean Herington heringtonlacey at mindspring.com
Fri Mar 21 11:37:24 EDT 2008


I like Tillmann's cleanup.  Here's another variation (warning: untested code).

filter3 :: (FilterWindow3 -> Double) -> Dataset -> Dataset
filter3 f3 []         = []
filter3 f3 dss@(d:ds) = map f3 $ zip3 (d:dss) dss (shiftForward dss)

-- Given a nonempty list, drops the first element and
-- duplicates the last element at the end.
shiftForward :: [a] -> [a]
shiftForward (x:xs) = sf x xs
   where
     sf last []     = [last]
     sf _    (x:xs) = x : sf x xs

Dean

At 4:12 AM +0100 3/21/08, Tillmann Rendel wrote:
>Michael Feathers wrote:
>>  I'm working on something and it's looking rather ugly. essentially,
>>  it's an application of a low pass filer to a dataset.
>
>I would not consider your code ugly. it can be made shorter, though.
>
>>  type Dataset = [Double]
>>  type FilterWindow3 = (Double,Double,Double)
>>
>>  internalList :: [a] -> [a]
>>  internalList = tail . init
>>
>>  lowPass3 :: FilterWindow3 -> Double
>>  lowPass3 (i, j, k) = (i + 2 * j + k) / 4.0
>>
>>  filter3 :: (FilterWindow3 -> Double) -> Dataset -> Dataset
>>  filter3 f3 ds = [(f3 x) | x <- formWindows ds]
>
>I would prefer this version to the list comprehension:
>
>   filter3 f3 = map f3 . formWindows
>
>I tend to assume list comprehensions are doing something magical I 
>have to figure out while reading a program, so a comprehension for a 
>simple map looks wrong to me. read ahead for more magical list 
>comprehensions.
>
>>  iterFilter :: (Dataset -> Dataset) -> Int -> Dataset -> Dataset
>>  iterFilter f n ds
>>    | n > 0     = iterFilter f (n - 1) (f ds)
>>    | otherwise = ds
>
>You can use iterate and list indexing to iterate a function a 
>specified number of times.
>
>   iterFilter f n = (!! n) . iterate f
>
>Probably
>
>   iterateN :: (a -> a) -> Int -> a
>
>is a better type and name for this function.
>
>>  formWindows :: Dataset -> [FilterWindow3]
>>  formWindows ds =
>>    internalList $ zip3 x y z
>>      where c0 = [head ds]
>>            cn = [last ds]
>>            x  = ds ++ cn ++ cn
>>            y  = c0 ++ ds ++ cn
>>            z  = c0 ++ c0 ++ ds
>
>internalList will delete the first and last element, so why create 
>it at all? there is no problem with different list lengths, the 
>result will be as long as the shortest list.
>
>   formWindows ds = zip3 x y z where
>     x = tail ds ++ [last ds]
>     y = ds
>     z = head ds : ds
>
>if you want to make clear what elements of the lists are used, you can use
>
>   z = head ds : init ds
>
>instead. Note that definition for y clearly states that the middle 
>element is the original list. I would consider swapping x and z to 
>help me imagine a window moving over the dataset. as it is now, i 
>have to imagine a window with an integrated mirror to make it fit.
>
>I don't like the definition of x, because I fear that the (last ds) 
>thunk will hang around and hold the whole list ds in memory, which 
>is unecessary because it's value only depends on the last element of 
>said list. I would therefore consider a different implementation 
>using tails.
>
>   formWindows ds = [(f y z, y, x) | (x : y : z) <- tails (head ds : ds)]
>     where f x [] = x
>           f _ (x : _) = x
>
>the head corner case is taken care of by duplicating the head of ds. 
>the last corner case is taken care of by the call to f, which uses y 
>as default value if z doesn't contain another one. the list 
>comprehension is used here to do three different things:
>
>   * convert lists to tuples
>   * apply f
>   * throw away the last element of tails' result (pattern match
>     failure means "ignore this element" in list comprehensions)
>
>Maybe
>
>   headDefault :: a -> [a] -> a
>
>is a sensible name for f.
>
>>  smooth :: Int -> Dataset -> Dataset
>>  smooth = iterFilter $ filter3 lowPass3
>
>by inlining the definition above, this can be given as a four-liner now:
>
>   smooth n = (!! n) . iterate f where
>     f ds = [(g y z + 2 * y + x) / 4.0 | x:y:z <- tails (head ds : ds)]
>     g x []    = x
>     g _ (x:_) = x
>
>:-)
>
>   Tillmann


More information about the Haskell-Cafe mailing list