Implement step function in Haskell

Question

I try to implement a (restricted version of) step function in Haskell. A step functions is a function that is constant on a finite number of half intervals, and mempty everywhere else. (equivalently, one can fill those "everywhere else" by half intervals)

This can be modeled as a StepData a b, which stores a list of the half intervals and the associated value for that half interval. Not all Ord a has a minimum or maximum, I lift it to Bound a, which guaranties it to have a minimum and maximum, this is to make the algorithm clearer.

I implemented eval :: StepData a b -> a -> b to evaluate a step function at a point.

The important part is the ability to make step function a monoid, where <> is defined as pointwise sum of the function. Currently I implemented <> for the StepData a b.

P.S. Whenever I want to find a value, I have to run eval f x. Of course I can define g = eval f, but I can't use <> on the derived function. So I have to pass the data around in order to combine functions, and only call eval when I need to find a value. Are there better ways to handle this?

{-# LANGUAGE NoMonomorphismRestriction #-} 

import Data.List
import Data.Monoid

data Bound a = Minimum | Value a | Maximum  deriving (Eq, Ord, Show)

data StepData x y = StepData [(Bound x, Bound x, y)] 
    deriving (Show, Eq, Ord)

instance (Ord x, Monoid y) => Monoid (StepData x y) where
  mempty = StepData [(Minimum, Maximum, mempty)]
  mappend (StepData a) (StepData b) = StepData (foldl insertInterval b a)
    where
      insertInterval [] _ = []
      insertInterval ((a',b',y'):xs) (a,b,y) 
       | a >= b' = non [(a',b',y')] ++ insertInterval xs (a,b,y) 
       | b >= b' = non [(a',a,y'),(a,b',y <> y')] ++ insertInterval xs (b',b,y) 
       | b <  b' = non [(a',a,y'),(a,b, y <> y'),(b,b',y')] ++ xs
       where non = filter (\(a,b,_)-> a/=b)

      merge (h@(a,_,y):h'@(_,b',y'):xs)
       | y == y'   = merge ((a,b',y):xs)
       | otherwise = h:merge (h':xs)
      merge x = x

eval (StepData xs) t = y
  where (_,_,y) = head $ dropWhile sol xs
        sol (a,b,y)
         | a<=Value t && Value t<b = False
         | otherwise   = True

fromList xs = StepData (map (\(a,b,y)->(Value a, Value b, y)) xs) `mappend` mempty

Answer 1

I might be a little bit late to the party, but better late than never, right?

Type signatures

Your central functions fromList and eval don't have type signatures. This forces the user to check Value and StepData's definition. Better add them:

eval :: Ord a => StepData a
eval = ...

fromList :: (Ord a, Monoid b) => [(a, a, b)]-> StepData a b
fromList  = ...

Remove dead code

merge isn't used in your code. It's dead code and not used in your instance at all. Better remove it.

Make sure the code compiles

That wasn't an issue back in 2013, but nowadays Semigroup is a superclass of Monoid, and you need to implement it too.

Don't encode Bool twice

eval's sol can be simplified a lot if we just use not around the condition:

eval (StepData xs) t = y
  where (_,_,y) = head $ dropWhile sol xs
        sol (a,b,_) = not (a <= Value t && Value t < b)

The function also gets easier to understand if we use filter instead, as we don't need to deal with double negation (drop and not):

eval (StepData xs) t = y
  where (_,_,y) = head $ filter sol xs
        sol (a,b,_) = a <= Value t && Value t < b

Document requirements of data

fromList needs a proper sorted list. That's not documented anywhere and neither enforced in its type nor its logic. We might end up with StepData [(Value 3, Value 1, Maybe 3)] or StepData [(Value 3, Value 4, Maybe 3),(Value 1, Value 2, Maybe 3)], as the list is only maped.

Instead, use foldMap and make sure that the values are ordered properly:

fromList = foldMap go
  where
    go (a, b, y)
      | a < b     = StepData [(Value a, Value b, y)]
      | otherwise = StepData [(Value b, Value a, y)]