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

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.