step-function 0.1.1.2 → 0.2
raw patch · 11 files changed
+1235/−231 lines, 11 filesdep +base-compat-batteriesdep +containersdep +deepseqdep −Cabaldep −cabal-test-quickcheckdep ~QuickCheckdep ~basenew-uploader
Dependencies added: base-compat-batteries, containers, deepseq, transformers, transformers-compat
Dependencies removed: Cabal, cabal-test-quickcheck
Dependency ranges changed: QuickCheck, base
Files
- CHANGELOG.md +0/−12
- Changelog.md +31/−0
- LICENSE +2/−2
- README.md +1/−3
- src/Data/Function/Step.hs +382/−0
- src/Data/Function/Step/Discrete.hs +6/−0
- src/Data/Function/Step/Discrete/Closed.hs +354/−0
- src/Data/Function/Step/Discrete/Open.hs +353/−0
- src/Data/StepFunction.hs +0/−128
- step-function.cabal +68/−40
- test/Merge.hs +38/−46
− CHANGELOG.md
@@ -1,12 +0,0 @@-# v0.1.0.0-First import of package.-# v0.1.0.1-Documentation fixes.-# v0.1.0.2-Build with ghc 7.8.4.-# v0.1.1.0-StepFunction is now an instance of Functor.-# v0.1.1.1-Build with GHC 8.0.1.-# v0.1.1.2-Build with GHC 8.2.2
+ Changelog.md view
@@ -0,0 +1,31 @@+# 0.2++**Complete rewrite**.++- Uses 'Map' for the internal representation to be more effecient.+- Added discrete variants.+- GHC-8.4 support++# 0.1.1.2++- Build with GHC 8.2.2++# 0.1.1.1++Build with GHC 8.0.1.++# 0.1.1.0++StepFunction is now an instance of Functor.++# 0.1.0.2++Build with ghc 7.8.4.++# 0.1.0.1++Documentation fixes.++# 0.1.0.0++First import of package.
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2015, Petter Bergman+Copyright (c) 2018 Oleg Grenrus All rights reserved. @@ -13,7 +13,7 @@ disclaimer in the documentation and/or other materials provided with the distribution. - * Neither the name of Petter Bergman nor the names of other+ * Neither the name of Oleg Grenrus nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission.
README.md view
@@ -1,5 +1,3 @@ # 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.+Step functions, staircase functions or piecewise constant functions.
+ src/Data/Function/Step.hs view
@@ -0,0 +1,382 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-}++{-# LANGUAGE Safe #-}++#ifndef MIN_VERSION_transformers+#define MIN_VERSION_transformers(x,y,z) 0+#endif++#ifndef MIN_VERSION_transformers_compat+#define MIN_VERSION_transformers_compat(x,y,z) 0+#endif++#if MIN_VERSION_base(4,9,0)+#define LIFTED_FUNCTOR_CLASSES 1++#elif MIN_VERSION_transformers(0,5,0)+#define LIFTED_FUNCTOR_CLASSES 1++#elif MIN_VERSION_transformers_compat(0,5,0) && !MIN_VERSION_transformers(0,4,0)+#define LIFTED_FUNCTOR_CLASSES 1+#endif++module Data.Function.Step (+ -- * Step Function+ -- $setup+ SF (..),+ Bound (..),+ -- * Construction+ constant,+ step,+ fromList,+ -- * Normalisation+ normalise,+ -- * Operators+ (!),+ values,+ -- * Debug+ showSF,+ putSF,+ ) where++import Control.Applicative (liftA2)+import Control.DeepSeq (NFData (..))+import Control.Monad (ap)+import Data.Functor.Classes+import Data.List (intercalate)+import Data.Map (Map)+import Prelude ()+import Prelude.Compat++#ifdef LIFTED_FUNCTOR_CLASSES+import Text.Show (showListWith)+#endif++import qualified Data.Map as Map+import qualified Test.QuickCheck as QC++-- | Step function. Piecewise constant function, having finitely many pieces.+-- See <https://en.wikipedia.org/wiki/Step_function>.+--+-- @'SF' (fromList [('Open' k1, v1), ('Closed' k2, v2)]) v3 :: 'SF' k v@ describes a piecewise constant function \(f : k \to v\):+--+-- \[+-- f\,x = \begin{cases}+-- v_1, \quad x < k_1 \newline+-- v_2, \quad k_1 \le x \le k_2 \newline+-- v_3, \quad k_2 < x+-- \end{cases}+-- \]+--+-- or as you would write in Haskell+--+-- @+-- f x | x < k1 = v1+-- | x <= k2 = v2+-- | otherwise = v3+-- @+--+-- /Note:/ [total-map](https://hackage.haskell.org/package/total-map-0.0.6/docs/Data-TotalMap.html) package,+-- which provides /function with finite support/.+--+-- Constructor is exposed as you cannot construct non-valid 'SF'.+--+-- === Merging+--+-- You can use 'Applicative' instance to /merge/ 'SF'.+--+-- >>> putSF $ liftA2 (+) (step 0 0 1) (step 1 0 1)+-- \x -> if+-- | x < 0 -> 0+-- | x < 1 -> 1+-- | otherwise -> 2+--+-- Following property holds, i.e. 'SF' and ordinary function 'Applicative' instances+-- are compatible (and '!' is a homomorphism).+--+-- prop> liftA2 f g h ! x == liftA2 f (g !) (h !) x+--+-- Recall that for ordinary functions @'liftA2' f g h x = f (g x) (h x)@.+--+-- === Dense?+--+-- This dense variant is useful with [dense ordered](https://en.wikipedia.org/wiki/Dense_order) domains, e.g. 'Rational'.+-- 'Integer' is not dense, so you could use "Data.Function.Step.Discrete" variant instead.+--+-- >>> let s = fromList [(Open 0, -1),(Closed 0, 0)] 1 :: SF Rational Int+-- >>> putSF s+-- \x -> if+-- | x < 0 % 1 -> -1+-- | x <= 0 % 1 -> 0+-- | otherwise -> 1+--+-- >>> import Data.Ratio ((%))+-- >>> map (s !) [-1, -0.5, 0, 0.5, 1]+-- [-1,-1,0,1,1]+--+data SF k v = SF !(Map (Bound k) v) !v+ deriving (Eq, Ord, Functor, Foldable, Traversable)++-- | Bound operations+data Bound k+ = Open k -- ^ less-than, @<@+ | Closed k -- ^ less-than-or-equal, @≤@.+ deriving (Eq, Show, Functor, Foldable, Traversable)++-- | Order is like @'Open' k = (k, False)@, @'Closed' k = (k, True)@.+--+instance Ord k => Ord (Bound k) where+ compare (Open k) (Open k') = compare k k'+ compare (Closed k) (Closed k') = compare k k'+ compare (Open k) (Closed k') = case compare k k' of+ LT -> LT+ EQ -> LT+ GT -> GT+ compare (Closed k) (Open k') = case compare k k' of+ LT -> LT+ EQ -> GT+ GT -> GT++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++-- | 'pure' is a constant function.+instance Ord k => Applicative (SF k) where+ pure = constant+ (<*>) = ap++instance Ord k => Monad (SF k) where+ return = pure++ SF m def0 >>= f = SF+ (Map.fromDistinctAscList $ mkDistinctAscList $ pieces ++ pieces1)+ def1+ where+ pieces =+ [ (min k k', v')+ | (k, v) <- Map.toList m+ , let SF m' def = f v+ , (k', v') <- Map.toList m' ++ [(k, def)]+ ]+ (pieces1, def1) = let SF m' def = f def0 in (Map.toList m', def)++-- | Piecewise '<>'.+--+-- >>> putSF $ step 0 "a" "b" <> step 1 "c" "d"+-- \x -> if+-- | x < 0 -> "ac"+-- | x < 1 -> "bc"+-- | otherwise -> "bd"+--+instance (Ord k, Semigroup v) => Semigroup (SF k v) where+ (<>) = liftA2 (<>)++instance (Ord k, Monoid v) => Monoid (SF k v) where+ mempty = pure mempty+ mappend = liftA2 mappend++instance (Ord k, QC.Arbitrary k, QC.Arbitrary v) => QC.Arbitrary (SF k v) where+ arbitrary = fromList <$> QC.arbitrary <*> QC.arbitrary+ shrink (SF m v) = uncurry fromList <$> QC.shrink (Map.toList m, v)++instance QC.Arbitrary k => QC.Arbitrary (Bound k) where+ arbitrary = QC.oneof [Open <$> QC.arbitrary, Closed <$> QC.arbitrary]++instance NFData k => NFData (Bound k) where+ rnf (Open k) = rnf k+ rnf (Closed k) = rnf k++instance (NFData k, NFData v) => NFData (SF k v) where+ rnf (SF m v) = rnf (m, v)++-------------------------------------------------------------------------------+-- Show+-------------------------------------------------------------------------------++#if LIFTED_FUNCTOR_CLASSES++instance Show2 SF where+ liftShowsPrec2 spk slk spv slv d (SF m v) = showsBinaryWith+ (\_ -> showListWith $ liftShowsPrec2 (liftShowsPrec spk slk) (liftShowList spk slk) spv slv 0)+ spv+ "fromList" d (Map.toList m) v++instance Show k => Show1 (SF k) where+ liftShowsPrec = liftShowsPrec2 showsPrec showList++instance (Show k, Show v) => Show (SF k v) where+ showsPrec = showsPrec2++instance Show1 Bound where+ liftShowsPrec sp _ d (Open k) = showsUnaryWith sp "Open" d k+ liftShowsPrec sp _ d (Closed k) = showsUnaryWith sp "Closed" d k++#else++instance (Show k, Show v) => Show (SF k v) where+ showsPrec d (SF m v) = showParen (d > 10)+ $ showString "fromList"+ . showsPrec 11 (Map.toList m)+ . showChar ' '+ . showsPrec 11 v++instance Show k => Show1 (SF k) where showsPrec1 = showsPrec+instance Show1 Bound where showsPrec1 = showsPrec++#endif+-------------------------------------------------------------------------------+-- Helpers+-------------------------------------------------------------------------------++mkDistinctAscList :: Ord k => [(k, b)] -> [(k, b)]+mkDistinctAscList [] = []+mkDistinctAscList ((k, v) : kv) = (k, v) : mkDistinctAscList' k kv++mkDistinctAscList' :: Ord k => k -> [(k, b)] -> [(k, b)]+mkDistinctAscList' _ [] = []+mkDistinctAscList' k (p@(k', _) : kv)+ | k < k' = p : mkDistinctAscList' k' kv+ | otherwise = mkDistinctAscList' k kv++-------------------------------------------------------------------------------+-- Operators+-------------------------------------------------------------------------------++infixl 9 !++-- | Apply 'SF'.+--+-- >>> heaviside ! 2+-- 1+(!) :: Ord k => SF k v -> k -> v+SF m def ! x = case Map.lookupGE (Closed x) m of+ Nothing -> def+ Just (_, v) -> v++-------------------------------------------------------------------------------+-- Construction+-------------------------------------------------------------------------------++-- | Constant function+--+-- >>> putSF $ constant 1+-- \_ -> 1+--+constant :: a -> SF k a+constant = SF Map.empty++-- | Step function.+--+-- @'step' k v1 v2 = \\ x -> if x < k then v1 else v2@.+--+-- >>> putSF $ step 1 2 3+-- \x -> if+-- | x < 1 -> 2+-- | otherwise -> 3+--+step :: k -> v -> v -> SF k v+step k = SF . Map.singleton (Open k)++-- | Create function from list of cases and default value.+--+-- >>> let f = fromList [(Open 1,2),(Closed 3,4),(Open 4,5)] 6+-- >>> putSF f+-- \x -> if+-- | x < 1 -> 2+-- | x <= 3 -> 4+-- | x < 4 -> 5+-- | otherwise -> 6+--+-- >>> map (f !) [0..10]+-- [2,4,4,4,6,6,6,6,6,6,6]+--+fromList :: Ord k => [(Bound k, v)] -> v -> SF k v+fromList = SF . Map.fromList++-------------------------------------------------------------------------------+-- Conversions to/from list+-------------------------------------------------------------------------------++-- | Possible values of 'SF'+--+-- >>> values heaviside+-- [-1,1]+--+values :: SF k v -> [v]+values (SF m v) = Map.elems m ++ [v]++-------------------------------------------------------------------------------+-- Normalise+-------------------------------------------------------------------------------++-- | Merge adjustent pieces with same values.+--+-- /Note:/ 'SF' isn't normalised on construction.+-- Values don't necessarily are 'Eq'.+--+-- >>> putSF $ normalise heaviside+-- \x -> if+-- | x < 0 -> -1+-- | otherwise -> 1+--+-- >>> putSF $ normalise $ step 0 1 1+-- \_ -> 1+--+-- prop> normalise (liftA2 (+) p (fmap negate p)) == (pure 0 :: SF Int Int)+--+normalise :: Eq v => SF k v -> SF k v+normalise (SF m v) = uncurry mk $ foldr go ([], v) (Map.toList m) where+ mk m' _ = SF (Map.fromDistinctAscList m') v++ go p@(_, v') p'@(m', x)+ | v' == x = p'+ | otherwise = (p : m', v')++-------------------------------------------------------------------------------+-- Pretty-printing+-------------------------------------------------------------------------------++-- | Show 'SF' as Haskell code+showSF :: (Show a, Show b) => SF a b -> String+showSF (SF m v) | Map.null m = "\\_ -> " ++ show v+showSF (SF m v) = intercalate "\n" $+ "\\x -> if" : [ " | " ++ leftPad k ++ " -> " ++ x | (k, x) <- cases ]+ where+ cases = cases' ++ [ ("otherwise", show v) ]++ m' = Map.toList m++ cases' = case traverse fromOpen m' of+ Nothing -> [ ("x " ++ showBound k, show x) | (k, x) <- m' ]+ Just m'' -> [ ("x < " ++ show k, show x) | (k, x) <- m'' ]++ fromOpen (Open k, x) = Just (k, x)+ fromOpen _ = Nothing++ len = maximum (map (length . fst) cases)+ leftPad s = s ++ replicate (len - length s) ' '++showBound :: Show k => Bound k -> String+showBound (Open k) = "< " ++ showsPrec 5 k ""+showBound (Closed k) = "<= " ++ showsPrec 5 k ""++-- | @'putStrLn' . 'showSF'@+putSF :: (Show a, Show b) => SF a b -> IO ()+putSF = putStrLn . showSF++-- $setup+--+-- == Examples+--+-- >>> let heaviside = step 0 (-1) 1 :: SF Int Int+-- >>> putSF heaviside+-- \x -> if+-- | x < 0 -> -1+-- | otherwise -> 1+--+-- >>> map (heaviside !) [-3, 0, 4]+-- [-1,1,1]
+ src/Data/Function/Step/Discrete.hs view
@@ -0,0 +1,6 @@+-- | This module re-exports "Function.Step.Discrete.Open"+module Data.Function.Step.Discrete (+ module Data.Function.Step.Discrete.Open,+ ) where++import Data.Function.Step.Discrete.Open
+ src/Data/Function/Step/Discrete/Closed.hs view
@@ -0,0 +1,354 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-}++{-# LANGUAGE Safe #-}++#ifndef MIN_VERSION_transformers+#define MIN_VERSION_transformers(x,y,z) 0+#endif++#ifndef MIN_VERSION_transformers_compat+#define MIN_VERSION_transformers_compat(x,y,z) 0+#endif++#if MIN_VERSION_base(4,9,0)+#define LIFTED_FUNCTOR_CLASSES 1++#elif MIN_VERSION_transformers(0,5,0)+#define LIFTED_FUNCTOR_CLASSES 1++#elif MIN_VERSION_transformers_compat(0,5,0) && !MIN_VERSION_transformers(0,4,0)+#define LIFTED_FUNCTOR_CLASSES 1+#endif++module Data.Function.Step.Discrete.Closed (+ -- * Step Function+ -- $setup+ SF (..),+ -- * Construction+ constant,+ step,+ fromList,+ -- * Normalisation+ normalise,+ -- * Operators+ (!),+ values,+ -- * Conversions+ toDense,+ fromDense,+ -- * Debug+ showSF,+ putSF,+ ) where++import Control.Applicative (liftA2)+import Control.DeepSeq (NFData (..))+import Control.Monad (ap)+import Data.Maybe (mapMaybe)+import Data.Functor.Classes+import Data.List (intercalate)+import Data.Map (Map)+import Prelude ()+import Prelude.Compat++#ifdef LIFTED_FUNCTOR_CLASSES+import Text.Show (showListWith)+#endif++import qualified Data.Function.Step as SF+import qualified Data.Map as Map+import qualified Test.QuickCheck as QC++-- | Step function. Piecewise constant function, having finitely many pieces.+-- See <https://en.wikipedia.org/wiki/Step_function>.+--+-- /Note:/ this variant has discrete domain.+-- It's enough to have only @<@$, without @≤@, as there is a /next/ element+-- without any others in between.+--+-- @'SF' (fromList [(k1, v1), (k2, v2)]) v3 :: 'SF' k v@ describes a piecewise constant function \(f : k \to v\):+--+-- \[+-- f\,x = \begin{cases}+-- v_1, \quad x \le k_1 \newline+-- v_2, \quad k_1 < x \le k_2 \newline+-- v_3, \quad k_2 < x+-- \end{cases}+-- \]+--+-- or as you would write in Haskell+--+-- @+-- f x | x <= k1 = v1+-- | x <= k2 = v2+-- | otherwise = v3+-- @+--+-- Constructor is exposed as you cannot construct non-valid 'SF'.+--+data SF k v = SF !(Map k v) !v+ deriving (Eq, Ord, Functor, Foldable, Traversable)++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++-- | 'pure' is a constant function.+instance Ord k => Applicative (SF k) where+ pure = constant+ (<*>) = ap++instance Ord k => Monad (SF k) where+ return = pure++ SF m def0 >>= f = SF+ (Map.fromDistinctAscList $ mkDistinctAscList $ pieces ++ pieces1)+ def1+ where+ pieces =+ [ (min k k', v')+ | (k, v) <- Map.toList m+ , let SF m' def = f v+ , (k', v') <- Map.toList m' ++ [(k, def)]+ ]+ (pieces1, def1) = let SF m' def = f def0 in (Map.toList m', def)++-- | Piecewise '<>'.+--+-- >>> putSF $ step 0 "a" "b" <> step 1 "c" "d"+-- \x -> if+-- | x <= 0 -> "ac"+-- | x <= 1 -> "bc"+-- | otherwise -> "bd"+--+instance (Ord k, Semigroup v) => Semigroup (SF k v) where+ (<>) = liftA2 (<>)++instance (Ord k, Monoid v) => Monoid (SF k v) where+ mempty = pure mempty+ mappend = liftA2 mappend++instance (Ord k, QC.Arbitrary k, QC.Arbitrary v) => QC.Arbitrary (SF k v) where+ arbitrary = fromList <$> QC.arbitrary <*> QC.arbitrary+ shrink (SF m v) = uncurry fromList <$> QC.shrink (Map.toList m, v)++instance (NFData k, NFData v) => NFData (SF k v) where+ rnf (SF m v) = rnf (m, v)++-------------------------------------------------------------------------------+-- Show+-------------------------------------------------------------------------------++#if LIFTED_FUNCTOR_CLASSES+instance Show2 SF where+ liftShowsPrec2 spk slk spv slv d (SF m v) = showsBinaryWith+ (\_ -> showListWith $ liftShowsPrec2 spk slk spv slv 0)+ spv+ "fromList" d (Map.toList m) v++instance Show k => Show1 (SF k) where+ liftShowsPrec = liftShowsPrec2 showsPrec showList++instance (Show k, Show v) => Show (SF k v) where+ showsPrec = showsPrec2++#else++instance (Show k, Show v) => Show (SF k v) where+ showsPrec d (SF m v) = showParen (d > 10)+ $ showString "fromList"+ . showsPrec 11 (Map.toList m)+ . showChar ' '+ . showsPrec 11 v++instance Show k => Show1 (SF k) where showsPrec1 = showsPrec++#endif++-------------------------------------------------------------------------------+-- Helpers+-------------------------------------------------------------------------------++mkDistinctAscList :: Ord k => [(k, b)] -> [(k, b)]+mkDistinctAscList [] = []+mkDistinctAscList ((k, v) : kv) = (k, v) : mkDistinctAscList' k kv++mkDistinctAscList' :: Ord k => k -> [(k, b)] -> [(k, b)]+mkDistinctAscList' _ [] = []+mkDistinctAscList' k (p@(k', _) : kv)+ | k < k' = p : mkDistinctAscList' k' kv+ | otherwise = mkDistinctAscList' k kv++-------------------------------------------------------------------------------+-- Operators+-------------------------------------------------------------------------------++infixl 9 !++-- | Apply 'SF'.+--+-- >>> heaviside ! 2+-- 1+(!) :: Ord k => SF k v -> k -> v+SF m def ! x = case Map.lookupGE x m of+ Nothing -> def+ Just (_, v) -> v++-------------------------------------------------------------------------------+-- Construction+-------------------------------------------------------------------------------++-- | Constant function+--+-- >>> putSF $ constant 1+-- \_ -> 1+--+constant :: a -> SF k a+constant = SF Map.empty++-- | Step function.+--+-- @'step' k v1 v2 = \\ x -> if x < k then v1 else v2@.+--+-- >>> putSF $ step 1 2 3+-- \x -> if+-- | x <= 1 -> 2+-- | otherwise -> 3+--+step :: k -> v -> v -> SF k v+step k = SF . Map.singleton k++-- | Create function from list of cases and default value.+--+-- >>> let f = fromList [(1,2),(3,4)] 5+-- >>> putSF f+-- \x -> if+-- | x <= 1 -> 2+-- | x <= 3 -> 4+-- | otherwise -> 5+--+-- >>> map (f !) [0..10]+-- [2,2,4,4,5,5,5,5,5,5,5]+--+fromList :: Ord k => [(k, v)] -> v -> SF k v+fromList = SF . Map.fromList++-------------------------------------------------------------------------------+-- Conversions to/from list+-------------------------------------------------------------------------------++-- | Possible values of 'SF'+--+-- >>> values heaviside+-- [-1,1]+--+values :: SF k v -> [v]+values (SF m v) = Map.elems m ++ [v]++-------------------------------------------------------------------------------+-- Normalise+-------------------------------------------------------------------------------++-- | Merge adjustent pieces with same values.+--+-- /Note:/ 'SF' isn't normalised on construction.+-- Values don't necessarily are 'Eq'.+--+-- >>> putSF $ normalise heaviside+-- \x -> if+-- | x <= 0 -> -1+-- | otherwise -> 1+--+-- >>> putSF $ normalise $ step 0 1 1+-- \_ -> 1+--+-- prop> normalise (liftA2 (+) p (fmap negate p)) == (pure 0 :: SF Int Int)+--+normalise :: Eq v => SF k v -> SF k v+normalise (SF m v) = uncurry mk $ foldr go ([], v) (Map.toList m) where+ mk m' _ = SF (Map.fromDistinctAscList m') v++ go p@(_, v') p'@(m', x)+ | v' == x = p'+ | otherwise = (p : m', v')++-------------------------------------------------------------------------------+-- Conversions+-------------------------------------------------------------------------------++-- | Convert from discrete variant to more "dense"+--+-- >>> SF.putSF $ toDense $ fromList [(1,2),(3,4)] 5+-- \x -> if+-- | x <= 1 -> 2+-- | x <= 3 -> 4+-- | otherwise -> 5+--+toDense :: SF a b -> SF.SF a b+toDense (SF m v) = SF.SF (Map.mapKeysMonotonic SF.Closed m) v++-- | Convert from "dense" variant. @<= k@ pieces will be converted to @< 'succ' k@.+-- There might be less pieces in the ressult 'SF', than in the original.+--+-- >>> let f = SF.fromList [(SF.Open 1,2),(SF.Closed 3,4),(SF.Open 4,5)] 6+-- >>> SF.putSF f+-- \x -> if+-- | x < 1 -> 2+-- | x <= 3 -> 4+-- | x < 4 -> 5+-- | otherwise -> 6+--+-- >>> putSF $ fromDense (Just . pred) f+-- \x -> if+-- | x <= 0 -> 2+-- | x <= 3 -> 4+-- | otherwise -> 6+--+fromDense+ :: Ord a+ => (a -> Maybe a) -- ^ previous key, if exists+ -> SF.SF a b+ -> SF a b+fromDense prev (SF.SF m v) = SF (mapKeys m) v where+ mapKeys = Map.fromListWith (\_ -> id) . mapMaybe (_1 fk) . Map.toList++ fk (SF.Open k) = prev k+ fk (SF.Closed k) = Just k++ _1 :: Functor f => (a -> f b) -> (a, c) -> f (b, c)+ _1 f (a, c) = fmap (\b -> (b, c)) (f a)++-------------------------------------------------------------------------------+-- Pretty-printing+-------------------------------------------------------------------------------++-- | Show 'SF' as Haskell code+showSF :: (Show a, Show b) => SF a b -> String+showSF (SF m v) | Map.null m = "\\_ -> " ++ show v+showSF (SF m v) = intercalate "\n" $+ "\\x -> if" : [ " | " ++ leftPad k ++ " -> " ++ x | (k, x) <- cases ]+ where+ cases = [ ("x <= " ++ showsPrec 5 k "", show x) | (k,x) <- Map.toList m ] +++ [ ("otherwise", show v) ]+ len = maximum (map (length . fst) cases)+ leftPad s = s ++ replicate (len - length s) ' '++-- | @'putStrLn' . 'showSF'@+putSF :: (Show a, Show b) => SF a b -> IO ()+putSF = putStrLn . showSF++-- $setup+--+-- == Examples+--+-- >>> let heaviside = step 0 (-1) 1 :: SF Int Int+-- >>> putSF heaviside+-- \x -> if+-- | x <= 0 -> -1+-- | otherwise -> 1+--+-- >>> map (heaviside !) [-3, 0, 4]+-- [-1,-1,1]
+ src/Data/Function/Step/Discrete/Open.hs view
@@ -0,0 +1,353 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-}++{-# LANGUAGE Safe #-}++#ifndef MIN_VERSION_transformers+#define MIN_VERSION_transformers(x,y,z) 0+#endif++#ifndef MIN_VERSION_transformers_compat+#define MIN_VERSION_transformers_compat(x,y,z) 0+#endif++#if MIN_VERSION_base(4,9,0)+#define LIFTED_FUNCTOR_CLASSES 1++#elif MIN_VERSION_transformers(0,5,0)+#define LIFTED_FUNCTOR_CLASSES 1++#elif MIN_VERSION_transformers_compat(0,5,0) && !MIN_VERSION_transformers(0,4,0)+#define LIFTED_FUNCTOR_CLASSES 1+#endif++module Data.Function.Step.Discrete.Open (+ -- * Step Function+ -- $setup+ SF (..),+ -- * Construction+ constant,+ step,+ fromList,+ -- * Normalisation+ normalise,+ -- * Operators+ (!),+ values,+ -- * Conversions+ toDense,+ fromDense,+ -- * Debug+ showSF,+ putSF,+ ) where++import Control.Applicative (liftA2)+import Control.DeepSeq (NFData (..))+import Control.Monad (ap)+import Data.Functor.Classes+import Data.List (intercalate)+import Data.Map (Map)+import Data.Maybe (mapMaybe)+import Prelude ()+import Prelude.Compat++#ifdef LIFTED_FUNCTOR_CLASSES+import Text.Show (showListWith)+#endif++import qualified Data.Function.Step as SF+import qualified Data.Map as Map+import qualified Test.QuickCheck as QC++-- | Step function. Piecewise constant function, having finitely many pieces.+-- See <https://en.wikipedia.org/wiki/Step_function>.+--+-- /Note:/ this variant has discrete domain.+-- It's enough to have only @<@$, without @≤@, as there is a /next/ element+-- without any others in between.+--+-- @'SF' (fromList [(k1, v1), (k2, v2)]) v3 :: 'SF' k v@ describes a piecewise constant function \(f : k \to v\):+--+-- \[+-- f\,x = \begin{cases}+-- v_1, \quad x < k_1 \newline+-- v_2, \quad k_1 \le x < k_2 \newline+-- v_3, \quad k_2 \le x+-- \end{cases}+-- \]+--+-- or as you would write in Haskell+--+-- @+-- f x | x < k1 = v1+-- | x < k2 = v2+-- | otherwise = v3+-- @+--+-- Constructor is exposed as you cannot construct non-valid 'SF'.+--+data SF k v = SF !(Map k v) !v+ deriving (Eq, Ord, Functor, Foldable, Traversable)++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++-- | 'pure' is a constant function.+instance Ord k => Applicative (SF k) where+ pure = constant+ (<*>) = ap++instance Ord k => Monad (SF k) where+ return = pure++ SF m def0 >>= f = SF+ (Map.fromDistinctAscList $ mkDistinctAscList $ pieces ++ pieces1)+ def1+ where+ pieces =+ [ (min k k', v')+ | (k, v) <- Map.toList m+ , let SF m' def = f v+ , (k', v') <- Map.toList m' ++ [(k, def)]+ ]+ (pieces1, def1) = let SF m' def = f def0 in (Map.toList m', def)++-- | Piecewise '<>'.+--+-- >>> putSF $ step 0 "a" "b" <> step 1 "c" "d"+-- \x -> if+-- | x < 0 -> "ac"+-- | x < 1 -> "bc"+-- | otherwise -> "bd"+--+instance (Ord k, Semigroup v) => Semigroup (SF k v) where+ (<>) = liftA2 (<>)++instance (Ord k, Monoid v) => Monoid (SF k v) where+ mempty = pure mempty+ mappend = liftA2 mappend++instance (Ord k, QC.Arbitrary k, QC.Arbitrary v) => QC.Arbitrary (SF k v) where+ arbitrary = fromList <$> QC.arbitrary <*> QC.arbitrary+ shrink (SF m v) = uncurry fromList <$> QC.shrink (Map.toList m, v)++instance (NFData k, NFData v) => NFData (SF k v) where+ rnf (SF m v) = rnf (m, v)++-------------------------------------------------------------------------------+-- Show+-------------------------------------------------------------------------------++#if LIFTED_FUNCTOR_CLASSES+instance Show2 SF where+ liftShowsPrec2 spk slk spv slv d (SF m v) = showsBinaryWith+ (\_ -> showListWith $ liftShowsPrec2 spk slk spv slv 0)+ spv+ "fromList" d (Map.toList m) v++instance Show k => Show1 (SF k) where+ liftShowsPrec = liftShowsPrec2 showsPrec showList++instance (Show k, Show v) => Show (SF k v) where+ showsPrec = showsPrec2++#else++instance (Show k, Show v) => Show (SF k v) where+ showsPrec d (SF m v) = showParen (d > 10)+ $ showString "fromList"+ . showsPrec 11 (Map.toList m)+ . showChar ' '+ . showsPrec 11 v++instance Show k => Show1 (SF k) where showsPrec1 = showsPrec++#endif++-------------------------------------------------------------------------------+-- Helpers+-------------------------------------------------------------------------------++mkDistinctAscList :: Ord k => [(k, b)] -> [(k, b)]+mkDistinctAscList [] = []+mkDistinctAscList ((k, v) : kv) = (k, v) : mkDistinctAscList' k kv++mkDistinctAscList' :: Ord k => k -> [(k, b)] -> [(k, b)]+mkDistinctAscList' _ [] = []+mkDistinctAscList' k (p@(k', _) : kv)+ | k < k' = p : mkDistinctAscList' k' kv+ | otherwise = mkDistinctAscList' k kv++-------------------------------------------------------------------------------+-- Operators+-------------------------------------------------------------------------------++infixl 9 !++-- | Apply 'SF'.+--+-- >>> heaviside ! 2+-- 1+(!) :: Ord k => SF k v -> k -> v+SF m def ! x = case Map.lookupGT x m of+ Nothing -> def+ Just (_, v) -> v++-------------------------------------------------------------------------------+-- Construction+-------------------------------------------------------------------------------++-- | Constant function+--+-- >>> putSF $ constant 1+-- \_ -> 1+--+constant :: a -> SF k a+constant = SF Map.empty++-- | Step function.+--+-- @'step' k v1 v2 = \\ x -> if x < k then v1 else v2@.+--+-- >>> putSF $ step 1 2 3+-- \x -> if+-- | x < 1 -> 2+-- | otherwise -> 3+--+step :: k -> v -> v -> SF k v+step k = SF . Map.singleton k++-- | Create function from list of cases and default value.+--+-- >>> putSF $ fromList [(1,2),(3,4)] 5+-- \x -> if+-- | x < 1 -> 2+-- | x < 3 -> 4+-- | otherwise -> 5+--+-- >>> map (fromList [(1,2),(3,4)] 5 !) [0..10]+-- [2,4,4,5,5,5,5,5,5,5,5]+--+fromList :: Ord k => [(k, v)] -> v -> SF k v+fromList = SF . Map.fromList++-------------------------------------------------------------------------------+-- Conversions to/from list+-------------------------------------------------------------------------------++-- | Possible values of 'SF'+--+-- >>> values heaviside+-- [-1,1]+--+values :: SF k v -> [v]+values (SF m v) = Map.elems m ++ [v]++-------------------------------------------------------------------------------+-- Normalise+-------------------------------------------------------------------------------++-- | Merge adjustent pieces with same values.+--+-- /Note:/ 'SF' isn't normalised on construction.+-- Values don't necessarily are 'Eq'.+--+-- >>> putSF $ normalise heaviside+-- \x -> if+-- | x < 0 -> -1+-- | otherwise -> 1+--+-- >>> putSF $ normalise $ step 0 1 1+-- \_ -> 1+--+-- prop> normalise (liftA2 (+) p (fmap negate p)) == (pure 0 :: SF Int Int)+--+normalise :: Eq v => SF k v -> SF k v+normalise (SF m v) = uncurry mk $ foldr go ([], v) (Map.toList m) where+ mk m' _ = SF (Map.fromDistinctAscList m') v++ go p@(_, v') p'@(m', x)+ | v' == x = p'+ | otherwise = (p : m', v')++-------------------------------------------------------------------------------+-- Conversions+-------------------------------------------------------------------------------++-- | Convert from discrete variant to more "dense"+--+-- >>> SF.putSF $ toDense $ fromList [(1,2),(3,4)] 5+-- \x -> if+-- | x < 1 -> 2+-- | x < 3 -> 4+-- | otherwise -> 5+--+toDense :: SF a b -> SF.SF a b+toDense (SF m v) = SF.SF (Map.mapKeysMonotonic SF.Open m) v++-- | Convert from "dense" variant. @<= k@ pieces will be converted to @< 'succ' k@.+-- There might be less pieces in the ressult 'SF', than in the original.+--+-- >>> let f = SF.fromList [(SF.Open 1,2),(SF.Closed 3,4),(SF.Open 4,5)] 6+-- >>> SF.putSF f+-- \x -> if+-- | x < 1 -> 2+-- | x <= 3 -> 4+-- | x < 4 -> 5+-- | otherwise -> 6+--+-- >>> putSF $ fromDense (Just . succ) f+-- \x -> if+-- | x < 1 -> 2+-- | x < 4 -> 4+-- | otherwise -> 6+--+fromDense+ :: Ord a+ => (a -> Maybe a) -- ^ next key, if exists+ -> SF.SF a b+ -> SF a b+fromDense next (SF.SF m v) = SF (mapKeys m) v where+ mapKeys = Map.fromListWith (\_ -> id) . mapMaybe (_1 fk) . Map.toList++ fk (SF.Open k) = Just k+ fk (SF.Closed k) = next k++ _1 :: Functor f => (a -> f b) -> (a, c) -> f (b, c)+ _1 f (a, c) = fmap (\b -> (b, c)) (f a)++-------------------------------------------------------------------------------+-- Pretty-printing+-------------------------------------------------------------------------------++-- | Show 'SF' as Haskell code+showSF :: (Show a, Show b) => SF a b -> String+showSF (SF m v) | Map.null m = "\\_ -> " ++ show v+showSF (SF m v) = intercalate "\n" $+ "\\x -> if" : [ " | " ++ leftPad k ++ " -> " ++ x | (k, x) <- cases ]+ where+ cases = [ ("x < " ++ showsPrec 5 k "", show x) | (k,x) <- Map.toList m ] +++ [ ("otherwise", show v) ]+ len = maximum (map (length . fst) cases)+ leftPad s = s ++ replicate (len - length s) ' '++-- | @'putStrLn' . 'showSF'@+putSF :: (Show a, Show b) => SF a b -> IO ()+putSF = putStrLn . showSF++-- $setup+--+-- == Examples+--+-- >>> let heaviside = step 0 (-1) 1 :: SF Int Int+-- >>> putSF heaviside+-- \x -> if+-- | x < 0 -> -1+-- | otherwise -> 1+--+-- >>> map (heaviside !) [-3, 0, 4]+-- [-1,1,1]
− src/Data/StepFunction.hs
@@ -1,128 +0,0 @@-{-# 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 -- ^ The default value.- , transitions :: [Transition x y] -- ^ The transitions. - } deriving (Eq,Show)--instance Functor (StepFunction x) where- fmap f (StepFunction d ts) = StepFunction (f d) (map (fmap f) ts)--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
@@ -1,50 +1,78 @@--- Initial step-function.cabal generated by cabal init. For further --- documentation, see http://haskell.org/cabal/users-guide/+cabal-version: >= 1.10+name: step-function+version: 0.2 -name: step-function-version: 0.1.1.2-synopsis: Step functions, staircase functions or piecewise constant functions-description: +synopsis: Staircase functions or piecewise constant functions+category: Text+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.+ . - 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, CHANGELOG.md-cabal-version: >=1.22-source-repository head- type: git- location: http://github.com/jonpetterbergman/step-function+homepage: https://github.com/jonpetterbergman/step-function+bug-reports: https://github.com/jonpetterbergman/stepfunction/issues+author: Oleg Grenrus <oleg.grenrus@iki.fi>, Petter Bergman <jon.petter.bergman@gmail.com>+maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ Changelog.md -source-repository this- type: git- location: http://github.com/jonpetterbergman/step-function- tag: v0.1.1.2+tested-with:+ GHC==7.6.3+ GHC==7.8.4+ GHC==7.10.3+ GHC==8.0.2+ GHC==8.2.2+ GHC==8.4.2 +source-repository head+ type: git+ location: https://github.com/jonpetterbergman/step-function library- exposed-modules: Data.StepFunction- -- other-modules: - other-extensions: TupleSections- build-depends: base >=4.7 && <4.11- hs-source-dirs: src- default-language: Haskell2010+ default-language: Haskell2010+ ghc-options: -Wall+ hs-source-dirs: src+ build-depends:+ base >=4.6 && <4.12,+ base-compat-batteries >=0.10.1 && <0.11,+ deepseq >=1.3.0.1 && <1.5,+ containers >=0.5.0.0 && <0.6,+ QuickCheck >=2.11.3 && <2.12 -Test-Suite merge- type: detailed-0.9- test-module: Merge- build-depends: base >=4.7 && <4.11, - Cabal >= 1.22,- step-function,- QuickCheck,- cabal-test-quickcheck+ if !impl(ghc >= 8.0)+ -- We enforce the fact that with GHC-7.10+ -- we have at least transformers-0.4.2.0 (the bundled one)+ -- which has 'Data.Functor.Classes' module. (transformers-0.3 doesn't have)+ if impl(ghc >= 7.10)+ build-depends:+ transformers >=0.4.2.0 && <0.6+ else+ build-depends:+ transformers >=0.3.0.0 && <0.6,+ transformers-compat >=0.6.2 && <0.7++ other-extensions:+ DeriveFunctor+ DeriveFoldable+ DeriveTraversable+ OverloadedStrings+ exposed-modules:+ Data.Function.Step+ Data.Function.Step.Discrete+ Data.Function.Step.Discrete.Open+ Data.Function.Step.Discrete.Closed++test-suite merge+ type: exitcode-stdio-1.0+ main-is: Merge.hs+ build-depends:+ base,+ step-function,+ QuickCheck hs-source-dirs: test default-language: Haskell2010
test/Merge.hs view
@@ -1,51 +1,43 @@-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)-import Control.Applicative ((<*>),(<$>))+module Main (main) where -instance (Arbitrary x,Arbitrary y) => Arbitrary (Transition x y) where- arbitrary = Transition <$> arbitrary <*> arbitrary <*> arbitrary+import Control.Applicative (liftA2)+import Data.Function.Step+ (SF, (!))+import Test.QuickCheck (quickCheck)+import Test.QuickCheck.Arbitrary (Arbitrary (..))+import Test.QuickCheck.Property (Property, counterexample, (===)) -instance (Arbitrary x,Arbitrary y, Eq y, Ord x) => Arbitrary (StepFunction x y) where- arbitrary = mkStepFunction <$> arbitrary <*> arbitrary+merge :: Ord x => (a -> b -> c) -> SF x a -> SF x b -> SF x c+merge = liftA2 -mergeProp :: (Eq c, Ord x, Show c,Show x)- => (a -> b -> c)- -> x- -> StepFunction x a- -> StepFunction x b- -> Property+mergeProp+ :: (Eq c, Ord x, Show c,Show x)+ => (a -> b -> c)+ -> x+ -> SF x a+ -> SF 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)]+ counterexample ("merged: " ++ show merged) $+ merged ! x === f (sf1 ! x) (sf2 ! x)+ where+ merged = merge f sf1 sf2 +main :: IO ()+main = do+ -- "merge: Int addition"+ quickCheck (mergeProp (+) :: Int -> SF Int Int -> SF Int Int -> Property)+ -- "merge: Int subtraction"+ quickCheck (mergeProp (-) :: Int -> SF Int Int -> SF Int Int -> Property)+ -- "merge: Int multiplication"+ quickCheck (mergeProp (*) :: Int -> SF Int Int -> SF Int Int -> Property)+ -- "merge: Bool logical or"+ quickCheck (mergeProp (||) :: Bool -> SF Bool Bool -> SF Bool Bool -> Property)+ -- "merge: Bool logical and"+ quickCheck (mergeProp (&&) :: Bool -> SF Bool Bool -> SF Bool Bool -> Property)+ -- "merge: Double addition"+ quickCheck (mergeProp (+) :: Double -> SF Double Double -> SF Double Double -> Property)+ -- "merge: Double subtraction"+ quickCheck (mergeProp (-) :: Double -> SF Double Double -> SF Double Double -> Property)+ -- "merge: Double multiplication"+ quickCheck (mergeProp (*) :: Double -> SF Double Double -> SF Double Double -> Property)