diff --git a/CHANGELOG.md b/CHANGELOG.md deleted file mode 100644 --- a/CHANGELOG.md +++ /dev/null @@ -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 diff --git a/Changelog.md b/Changelog.md new file mode 100644 --- /dev/null +++ b/Changelog.md @@ -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. diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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. diff --git a/src/Data/Function/Step.hs b/src/Data/Function/Step.hs new file mode 100644 --- /dev/null +++ b/src/Data/Function/Step.hs @@ -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 . +-- +-- @'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] diff --git a/src/Data/Function/Step/Discrete.hs b/src/Data/Function/Step/Discrete.hs new file mode 100644 --- /dev/null +++ b/src/Data/Function/Step/Discrete.hs @@ -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 diff --git a/src/Data/Function/Step/Discrete/Closed.hs b/src/Data/Function/Step/Discrete/Closed.hs new file mode 100644 --- /dev/null +++ b/src/Data/Function/Step/Discrete/Closed.hs @@ -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 . +-- +-- /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] diff --git a/src/Data/Function/Step/Discrete/Open.hs b/src/Data/Function/Step/Discrete/Open.hs new file mode 100644 --- /dev/null +++ b/src/Data/Function/Step/Discrete/Open.hs @@ -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 . +-- +-- /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] diff --git a/src/Data/StepFunction.hs b/src/Data/StepFunction.hs deleted file mode 100644 --- a/src/Data/StepFunction.hs +++ /dev/null @@ -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) diff --git a/step-function.cabal b/step-function.cabal --- a/step-function.cabal +++ b/step-function.cabal @@ -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 , Petter Bergman +maintainer: Oleg Grenrus +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 diff --git a/test/Merge.hs b/test/Merge.hs --- a/test/Merge.hs +++ b/test/Merge.hs @@ -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)