3
\$\begingroup\$

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
asked Aug 3, 2013 at 23:15
\$\endgroup\$

1 Answer 1

1
\$\begingroup\$

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)]
answered Jul 1, 2020 at 20:17
\$\endgroup\$

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.