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.

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
share|improve this question
add comment

Your Answer

 
discard

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

Browse other questions tagged or ask your own question.