step-function (empty) → 0.1.0.0
raw patch · 6 files changed
+262/−0 lines, 6 filesdep +Cabaldep +QuickCheckdep +basesetup-changed
Dependencies added: Cabal, QuickCheck, base, cabal-test-quickcheck, step-function
Files
- LICENSE +30/−0
- README.md +5/−0
- Setup.hs +2/−0
- src/Data/StepFunction.hs +125/−0
- step-function.cabal +50/−0
- test/Merge.hs +50/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Petter Bergman++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Petter Bergman nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,5 @@+# step-function+Step functions, staircase functions or piecewise constant functions.++Implemented as a default value and a series of transitions. Supports+merging two step functions using a supplied merging function.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Data/StepFunction.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE TupleSections #-}+-- | +-- Functions for dealing with step functions++module Data.StepFunction+ ( Transition(..)+ , StepFunction+ , mkStepFunction+ , valAt+ , transitions+ , merge ) where++import Data.List (sort,+ unfoldr,+ mapAccumL,+ groupBy)+import Data.Function (on)+import Data.Maybe (fromMaybe)++-- | A Transition, for a certain value on the x axis, there is a new y value.+data Transition x y =+ Transition + {+ x_val :: x -- ^ The x value where the transition happens+ , y_val :: y -- ^ The new y value+ , left_closed :: Bool -- ^ If True, y_val is for all x >= x_val, otherwise for all x > x_val+ } deriving (Eq,Show)++instance Functor (Transition x) where+ fmap f (Transition x y lc) = Transition x (f y) lc++-- | A StepFunction is implemented as a default value+-- and a sorted list of Transitions+data StepFunction x y =+ StepFunction + {+ def :: y+ , transitions :: [Transition x y]+ } deriving (Eq,Show)++instance (Ord x,Eq y) => Ord (Transition x y) where+ compare t1 t2 | x_val t1 < x_val t2 = LT+ | x_val t1 > x_val t2 = GT+ | x_val t1 == x_val t2 && left_closed t1 && (not $ left_closed t2) = LT+ | x_val t1 == x_val t2 && (not $ left_closed t1) && left_closed t2 = GT+ | otherwise = EQ++-- | Smart constructor sorts and simplifies the list of transitions+mkStepFunction :: (Ord x,Eq y)+ => y+ -> [Transition x y]+ -> StepFunction x y+mkStepFunction x xs = StepFunction x $ simplify $ sort xs++leq :: Ord x+ => Transition x y+ -> x+ -> Bool+leq trans x = x_val trans <= x++-- | Get the y value for a given x+valAt :: Ord x+ => x+ -> StepFunction x y+ -> y+valAt x (StepFunction def trans) =+ case reverse $ takeWhile (`leq` x) trans of+ [] -> def+ [h] -> if left_closed h || x_val h < x then y_val h else def+ (h:h':_) -> if left_closed h || x_val h < x then y_val h else y_val h'++-- | Merge two step function, such that the following should be true:+--+-- > valAt x (merge f sf1 sf2) == f (valAt x sf1) (valAt x sf2)+--+-- The resulting step function will be simplified, transitions that+-- don't change the y value will be eliminated, and transitions that+-- happen on the same x position will be eliminated.+merge :: (Ord x,Eq c)+ => (a -> b -> c)+ -> StepFunction x a+ -> StepFunction x b+ -> StepFunction x c+merge f s1 s2 = + StepFunction newDef $ simplify $ mergeT f (def s1,def s2) (transitions s1) (transitions s2)+ where newDef = f (def s1) (def s2)++x_pos :: Transition x y+ -> (x,Bool)+x_pos t = (x_val t,not $ left_closed t)++mergeT :: Ord x+ => (a -> b -> c)+ -> (a,b)+ -> [Transition x a]+ -> [Transition x b]+ -> [Transition x c]+mergeT _ _ [] [] = []+mergeT f (_,acc) as [] = map (fmap (`f` acc)) as+mergeT f (acc,_) [] bs = map (fmap (acc `f`)) bs+mergeT f acc (a:at) (b:bt) | x_pos a < x_pos b = mergeLeft f acc a at (b:bt)+ | x_pos a > x_pos b = mergeRight f acc b (a:at) bt + | otherwise = mergeBoth f a b at bt++mergeLeft f (a_acc,b_acc) a as bs =+ let nval = f (y_val a) b_acc+ ntrans = Transition (x_val a) nval (left_closed a) in+ ntrans:(mergeT f (y_val a,b_acc) as bs)++mergeRight f (a_acc,b_acc) b as bs =+ let nval = f a_acc (y_val b)+ ntrans = Transition (x_val b) nval (left_closed b) in+ ntrans:(mergeT f (a_acc,y_val b) as bs)++mergeBoth f a b as bs =+ let nval = f (y_val a) (y_val b)+ ntrans = Transition (x_val a) nval (left_closed a) in+ ntrans:(mergeT f (y_val a,y_val b) as bs)++simplify :: (Eq y,Eq x)+ => [Transition x y]+ -> [Transition x y]+simplify = simplifyY . simplifyX+ where simplifyY = concat . map (take 1) . groupBy ((==) `on` y_val)+ simplifyX = concat . map (take 1 . reverse) . groupBy ((==) `on` x_pos)
+ step-function.cabal view
@@ -0,0 +1,50 @@+-- Initial step-function.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: step-function+version: 0.1.0.0+synopsis: Step functions, staircase functions or piecewise constant functions+description: + Step functions, staircase functions or piecewise constant functions.++ Implemented as a default value and a series of transitions. Supports+ merging two step functions using a supplied merging function.+homepage: https://github.com/jonpetterbergman/step-function+bug-reports: https://github.com/jonpetterbergman/step-function/issues+license: BSD3+license-file: LICENSE+author: Petter Bergman+maintainer: jon.petter.bergman@gmail.com+-- copyright: +category: Data+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10+source-repository head+ type: git+ location: http://github.com/jonpetterbergman/step-function++source-repository this+ type: git+ location: http://github.com/jonpetterbergman/step-function+ tag: v0.1.0.0+++library+ exposed-modules: Data.StepFunction+ -- other-modules: + other-extensions: TupleSections+ build-depends: base >=4.8 && <4.9+ hs-source-dirs: src+ default-language: Haskell2010++Test-Suite merge+ type: detailed-0.9+ test-module: Merge+ build-depends: base >=4.8 && <4.9, + Cabal >= 1.10,+ step-function,+ QuickCheck,+ cabal-test-quickcheck+ hs-source-dirs: test+ default-language: Haskell2010
+ test/Merge.hs view
@@ -0,0 +1,50 @@+module Merge (tests) where++import Distribution.TestSuite (Test)+import Distribution.TestSuite.QuickCheck (testProperty)+import Data.StepFunction (StepFunction,+ mkStepFunction,+ Transition(..),+ valAt,+ merge)+import Test.QuickCheck (quickCheck)+import Test.QuickCheck.Arbitrary (Arbitrary(..))+import Test.QuickCheck.Property ((===),+ Property,+ counterexample)++instance (Arbitrary x,Arbitrary y) => Arbitrary (Transition x y) where+ arbitrary = Transition <$> arbitrary <*> arbitrary <*> arbitrary++instance (Arbitrary x,Arbitrary y, Eq y, Ord x) => Arbitrary (StepFunction x y) where+ arbitrary = mkStepFunction <$> arbitrary <*> arbitrary++mergeProp :: (Eq c, Ord x, Show c,Show x)+ => (a -> b -> c)+ -> x+ -> StepFunction x a+ -> StepFunction x b+ -> Property+mergeProp f x sf1 sf2 =+ let merged = merge f sf1 sf2 in+ counterexample ("merged: " ++ show merged) $+ valAt x merged === f (valAt x sf1) (valAt x sf2)++tests :: IO [Test]+tests = return [testProperty "merge: Int addition"+ (mergeProp (+) :: Int -> StepFunction Int Int -> StepFunction Int Int -> Property),+ testProperty "merge: Int subtraction"+ (mergeProp (-) :: Int -> StepFunction Int Int -> StepFunction Int Int -> Property),+ testProperty "merge: Int multiplication"+ (mergeProp (*) :: Int -> StepFunction Int Int -> StepFunction Int Int -> Property),+ testProperty "merge: Bool logical or"+ (mergeProp (||) :: Bool -> StepFunction Bool Bool -> StepFunction Bool Bool -> Property),+ testProperty "merge: Bool logical and"+ (mergeProp (&&) :: Bool -> StepFunction Bool Bool -> StepFunction Bool Bool -> Property),+ testProperty "merge: Double addition"+ (mergeProp (+) :: Double -> StepFunction Double Double -> StepFunction Double Double -> Property),+ testProperty "merge: Double subtraction"+ (mergeProp (-) :: Double -> StepFunction Double Double -> StepFunction Double Double -> Property),+ testProperty "merge: Double multiplication"+ (mergeProp (*) :: Double -> StepFunction Double Double -> StepFunction Double Double -> Property)]+