{-# 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  (Applicative (pure, (<*>)), 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
       (Eq (..), Functor (fmap), IO, Maybe (..), Monad (..), Ord (..),
       Show (..), String, fst, id, length, map, min, otherwise, putStrLn,
       replicate, uncurry, ($), (++), (-), (.))

import Data.Foldable    (Foldable, foldr, maximum)
import Data.Monoid      (Monoid (..))
import Data.Semigroup   (Semigroup (..))
import Data.Traversable (Traversable)

#ifdef LIFTED_FUNCTOR_CLASSES
import Text.Show (showListWith)
#else
import Prelude (showChar, showParen, showString)
#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 (SF k v -> SF k v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v. (Eq k, Eq v) => SF k v -> SF k v -> Bool
/= :: SF k v -> SF k v -> Bool
$c/= :: forall k v. (Eq k, Eq v) => SF k v -> SF k v -> Bool
== :: SF k v -> SF k v -> Bool
$c== :: forall k v. (Eq k, Eq v) => SF k v -> SF k v -> Bool
Eq, SF k v -> SF k v -> Bool
SF k v -> SF k v -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {k} {v}. (Ord k, Ord v) => Eq (SF k v)
forall k v. (Ord k, Ord v) => SF k v -> SF k v -> Bool
forall k v. (Ord k, Ord v) => SF k v -> SF k v -> Ordering
forall k v. (Ord k, Ord v) => SF k v -> SF k v -> SF k v
min :: SF k v -> SF k v -> SF k v
$cmin :: forall k v. (Ord k, Ord v) => SF k v -> SF k v -> SF k v
max :: SF k v -> SF k v -> SF k v
$cmax :: forall k v. (Ord k, Ord v) => SF k v -> SF k v -> SF k v
>= :: SF k v -> SF k v -> Bool
$c>= :: forall k v. (Ord k, Ord v) => SF k v -> SF k v -> Bool
> :: SF k v -> SF k v -> Bool
$c> :: forall k v. (Ord k, Ord v) => SF k v -> SF k v -> Bool
<= :: SF k v -> SF k v -> Bool
$c<= :: forall k v. (Ord k, Ord v) => SF k v -> SF k v -> Bool
< :: SF k v -> SF k v -> Bool
$c< :: forall k v. (Ord k, Ord v) => SF k v -> SF k v -> Bool
compare :: SF k v -> SF k v -> Ordering
$ccompare :: forall k v. (Ord k, Ord v) => SF k v -> SF k v -> Ordering
Ord, forall a b. a -> SF k b -> SF k a
forall a b. (a -> b) -> SF k a -> SF k b
forall k a b. a -> SF k b -> SF k a
forall k a b. (a -> b) -> SF k a -> SF k b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> SF k b -> SF k a
$c<$ :: forall k a b. a -> SF k b -> SF k a
fmap :: forall a b. (a -> b) -> SF k a -> SF k b
$cfmap :: forall k a b. (a -> b) -> SF k a -> SF k b
Functor, forall a. SF k a -> Bool
forall k a. Eq a => a -> SF k a -> Bool
forall k a. Num a => SF k a -> a
forall k a. Ord a => SF k a -> a
forall m a. Monoid m => (a -> m) -> SF k a -> m
forall k m. Monoid m => SF k m -> m
forall k a. SF k a -> Bool
forall k a. SF k a -> Int
forall k a. SF k a -> [a]
forall a b. (a -> b -> b) -> b -> SF k a -> b
forall k a. (a -> a -> a) -> SF k a -> a
forall k m a. Monoid m => (a -> m) -> SF k a -> m
forall k b a. (b -> a -> b) -> b -> SF k a -> b
forall k a b. (a -> b -> b) -> b -> SF k a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => SF k a -> a
$cproduct :: forall k a. Num a => SF k a -> a
sum :: forall a. Num a => SF k a -> a
$csum :: forall k a. Num a => SF k a -> a
minimum :: forall a. Ord a => SF k a -> a
$cminimum :: forall k a. Ord a => SF k a -> a
maximum :: forall a. Ord a => SF k a -> a
$cmaximum :: forall k a. Ord a => SF k a -> a
elem :: forall a. Eq a => a -> SF k a -> Bool
$celem :: forall k a. Eq a => a -> SF k a -> Bool
length :: forall a. SF k a -> Int
$clength :: forall k a. SF k a -> Int
null :: forall a. SF k a -> Bool
$cnull :: forall k a. SF k a -> Bool
toList :: forall a. SF k a -> [a]
$ctoList :: forall k a. SF k a -> [a]
foldl1 :: forall a. (a -> a -> a) -> SF k a -> a
$cfoldl1 :: forall k a. (a -> a -> a) -> SF k a -> a
foldr1 :: forall a. (a -> a -> a) -> SF k a -> a
$cfoldr1 :: forall k a. (a -> a -> a) -> SF k a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> SF k a -> b
$cfoldl' :: forall k b a. (b -> a -> b) -> b -> SF k a -> b
foldl :: forall b a. (b -> a -> b) -> b -> SF k a -> b
$cfoldl :: forall k b a. (b -> a -> b) -> b -> SF k a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> SF k a -> b
$cfoldr' :: forall k a b. (a -> b -> b) -> b -> SF k a -> b
foldr :: forall a b. (a -> b -> b) -> b -> SF k a -> b
$cfoldr :: forall k a b. (a -> b -> b) -> b -> SF k a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> SF k a -> m
$cfoldMap' :: forall k m a. Monoid m => (a -> m) -> SF k a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> SF k a -> m
$cfoldMap :: forall k m a. Monoid m => (a -> m) -> SF k a -> m
fold :: forall m. Monoid m => SF k m -> m
$cfold :: forall k m. Monoid m => SF k m -> m
Foldable, forall k. Functor (SF k)
forall k. Foldable (SF k)
forall k (m :: * -> *) a. Monad m => SF k (m a) -> m (SF k a)
forall k (f :: * -> *) a. Applicative f => SF k (f a) -> f (SF k a)
forall k (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SF k a -> m (SF k b)
forall k (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SF k a -> f (SF k b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SF k a -> f (SF k b)
sequence :: forall (m :: * -> *) a. Monad m => SF k (m a) -> m (SF k a)
$csequence :: forall k (m :: * -> *) a. Monad m => SF k (m a) -> m (SF k a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SF k a -> m (SF k b)
$cmapM :: forall k (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SF k a -> m (SF k b)
sequenceA :: forall (f :: * -> *) a. Applicative f => SF k (f a) -> f (SF k a)
$csequenceA :: forall k (f :: * -> *) a. Applicative f => SF k (f a) -> f (SF k a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SF k a -> f (SF k b)
$ctraverse :: forall k (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SF k a -> f (SF k b)
Traversable)

-------------------------------------------------------------------------------
-- Instances
-------------------------------------------------------------------------------

-- | 'pure' is a constant function.
instance Ord k => Applicative (SF k) where
    pure :: forall a. a -> SF k a
pure  = forall a k. a -> SF k a
constant
    <*> :: forall a b. SF k (a -> b) -> SF k a -> SF k b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Ord k => Monad (SF k) where
    return :: forall a. a -> SF k a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure

    SF Map k a
m a
def0 >>= :: forall a b. SF k a -> (a -> SF k b) -> SF k b
>>= a -> SF k b
f = forall k v. Map k v -> v -> SF k v
SF
        (forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList forall a b. (a -> b) -> a -> b
$ forall k b. Ord k => [(k, b)] -> [(k, b)]
mkDistinctAscList forall a b. (a -> b) -> a -> b
$ [(k, b)]
pieces forall a. [a] -> [a] -> [a]
++ [(k, b)]
pieces1)
        b
def1
      where
        pieces :: [(k, b)]
pieces =
            [ (forall a. Ord a => a -> a -> a
min k
k k
k', b
v')
            | (k
k, a
v) <- forall k a. Map k a -> [(k, a)]
Map.toList Map k a
m
            , let SF Map k b
m' b
def = a -> SF k b
f a
v
            , (k
k', b
v') <- forall k a. Map k a -> [(k, a)]
Map.toList Map k b
m' forall a. [a] -> [a] -> [a]
++ [(k
k, b
def)]
            ]
        ([(k, b)]
pieces1, b
def1) = let SF Map k b
m' b
def = a -> SF k b
f a
def0 in (forall k a. Map k a -> [(k, a)]
Map.toList Map k b
m', b
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
    <> :: SF k v -> SF k v -> SF k v
(<>) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>)

instance (Ord k, Monoid v) => Monoid (SF k v) where
    mempty :: SF k v
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
    mappend :: SF k v -> SF k v -> SF k v
mappend = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Monoid a => a -> a -> a
mappend

instance (Ord k, QC.Arbitrary k, QC.Arbitrary v) => QC.Arbitrary (SF k v) where
    arbitrary :: Gen (SF k v)
arbitrary = forall k v. Ord k => [(k, v)] -> v -> SF k v
fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
QC.arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
QC.arbitrary
    shrink :: SF k v -> [SF k v]
shrink (SF Map k v
m v
v) = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall k v. Ord k => [(k, v)] -> v -> SF k v
fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
QC.shrink (forall k a. Map k a -> [(k, a)]
Map.toList Map k v
m, v
v)

instance (NFData k, NFData v) => NFData (SF k v) where
    rnf :: SF k v -> ()
rnf (SF Map k v
m v
v) = forall a. NFData a => a -> ()
rnf (Map k v
m, v
v)

-------------------------------------------------------------------------------
-- Show
-------------------------------------------------------------------------------

#if LIFTED_FUNCTOR_CLASSES
instance Show2 SF where
    liftShowsPrec2 :: forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> SF a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
spk [a] -> ShowS
slk Int -> b -> ShowS
spv [b] -> ShowS
slv Int
d (SF Map a b
m b
v) = forall a b.
(Int -> a -> ShowS)
-> (Int -> b -> ShowS) -> String -> Int -> a -> b -> ShowS
showsBinaryWith
        (\Int
_ -> forall a. (a -> ShowS) -> [a] -> ShowS
showListWith forall a b. (a -> b) -> a -> b
$ forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
spk [a] -> ShowS
slk Int -> b -> ShowS
spv [b] -> ShowS
slv Int
0)
        Int -> b -> ShowS
spv
        String
"fromList" Int
d (forall k a. Map k a -> [(k, a)]
Map.toList Map a b
m) b
v

instance Show k => Show1 (SF k) where
    liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> SF k a -> ShowS
liftShowsPrec = forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 forall a. Show a => Int -> a -> ShowS
showsPrec forall a. Show a => [a] -> ShowS
showList

instance (Show k, Show v) => Show (SF k v) where
    showsPrec :: Int -> SF k v -> ShowS
showsPrec = forall (f :: * -> * -> *) a b.
(Show2 f, Show a, Show b) =>
Int -> f a b -> ShowS
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 :: forall k b. Ord k => [(k, b)] -> [(k, b)]
mkDistinctAscList []            = []
mkDistinctAscList ((k
k, b
v) : [(k, b)]
kv) = (k
k, b
v) forall a. a -> [a] -> [a]
: forall k b. Ord k => k -> [(k, b)] -> [(k, b)]
mkDistinctAscList' k
k [(k, b)]
kv

mkDistinctAscList' :: Ord k => k -> [(k, b)] -> [(k, b)]
mkDistinctAscList' :: forall k b. Ord k => k -> [(k, b)] -> [(k, b)]
mkDistinctAscList' k
_ [] = []
mkDistinctAscList' k
k (p :: (k, b)
p@(k
k', b
_) : [(k, b)]
kv)
    | k
k forall a. Ord a => a -> a -> Bool
< k
k'    = (k, b)
p forall a. a -> [a] -> [a]
: forall k b. Ord k => k -> [(k, b)] -> [(k, b)]
mkDistinctAscList' k
k' [(k, b)]
kv
    | Bool
otherwise =     forall k b. Ord k => k -> [(k, b)] -> [(k, b)]
mkDistinctAscList' k
k  [(k, b)]
kv

-------------------------------------------------------------------------------
-- Operators
-------------------------------------------------------------------------------

infixl 9 !

-- | Apply 'SF'.
--
-- >>> heaviside ! 2
-- 1
(!) :: Ord k => SF k v -> k -> v
SF Map k v
m v
def ! :: forall k v. Ord k => SF k v -> k -> v
! k
x = case forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupGT k
x Map k v
m of
    Maybe (k, v)
Nothing     -> v
def
    Just (k
_, v
v) -> v
v

-------------------------------------------------------------------------------
-- Construction
-------------------------------------------------------------------------------

-- | Constant function
--
-- >>> putSF $ constant 1
-- \_ -> 1
--
constant :: a -> SF k a
constant :: forall a k. a -> SF k a
constant = forall k v. Map k v -> v -> SF k v
SF forall k a. Map k a
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 :: forall k v. k -> v -> v -> SF k v
step k
k = forall k v. Map k v -> v -> SF k v
SF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. k -> a -> Map k a
Map.singleton k
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 :: forall k v. Ord k => [(k, v)] -> v -> SF k v
fromList = forall k v. Map k v -> v -> SF k v
SF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList

-------------------------------------------------------------------------------
-- Conversions to/from list
-------------------------------------------------------------------------------

-- | Possible values of 'SF'
--
-- >>> values heaviside
-- [-1,1]
--
values :: SF k v -> [v]
values :: forall k a. SF k a -> [a]
values (SF Map k v
m v
v) = forall k a. Map k a -> [a]
Map.elems Map k v
m forall a. [a] -> [a] -> [a]
++ [v
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 :: forall v k. Eq v => SF k v -> SF k v
normalise (SF Map k v
m v
v) = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall {k} {p}. [(k, v)] -> p -> SF k v
mk forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {a}. Eq a => (a, a) -> ([(a, a)], a) -> ([(a, a)], a)
go ([], v
v) (forall k a. Map k a -> [(k, a)]
Map.toList Map k v
m) where
    mk :: [(k, v)] -> p -> SF k v
mk [(k, v)]
m' p
_ = forall k v. Map k v -> v -> SF k v
SF (forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList [(k, v)]
m') v
v

    go :: (a, a) -> ([(a, a)], a) -> ([(a, a)], a)
go p :: (a, a)
p@(a
_, a
v') p' :: ([(a, a)], a)
p'@([(a, a)]
m', a
x)
        | a
v' forall a. Eq a => a -> a -> Bool
== a
x   = ([(a, a)], a)
p'
        | Bool
otherwise = ((a, a)
p forall a. a -> [a] -> [a]
: [(a, a)]
m', a
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 :: forall a b. SF a b -> SF a b
toDense (SF Map a b
m b
v) = forall k v. Map (Bound k) v -> v -> SF k v
SF.SF (forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic forall k. k -> Bound k
SF.Open Map a b
m) b
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 :: forall a b. Ord a => (a -> Maybe a) -> SF a b -> SF a b
fromDense a -> Maybe a
next (SF.SF Map (Bound a) b
m b
v) = forall k v. Map k v -> v -> SF k v
SF (forall {a}. Map (Bound a) a -> Map a a
mapKeys Map (Bound a) b
m) b
v where
    mapKeys :: Map (Bound a) a -> Map a a
mapKeys = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith (\a
_ -> forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall (f :: * -> *) a b c.
Functor f =>
(a -> f b) -> (a, c) -> f (b, c)
_1 Bound a -> Maybe a
fk) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList

    fk :: Bound a -> Maybe a
fk (SF.Open a
k)   = forall a. a -> Maybe a
Just a
k
    fk (SF.Closed a
k) = a -> Maybe a
next a
k

    _1 :: Functor f => (a -> f b) -> (a, c) -> f (b, c)
    _1 :: forall (f :: * -> *) a b c.
Functor f =>
(a -> f b) -> (a, c) -> f (b, c)
_1 a -> f b
f (a
a, c
c) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\b
b -> (b
b, c
c)) (a -> f b
f a
a)

-------------------------------------------------------------------------------
-- Pretty-printing
-------------------------------------------------------------------------------

-- | Show 'SF' as Haskell code
showSF :: (Show a, Show b) => SF a b -> String
showSF :: forall k v. (Show k, Show v) => SF k v -> String
showSF (SF Map a b
m b
v) | forall k a. Map k a -> Bool
Map.null Map a b
m = String
"\\_ -> " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show b
v
showSF (SF Map a b
m b
v) = forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" forall a b. (a -> b) -> a -> b
$
    String
"\\x -> if" forall a. a -> [a] -> [a]
: [ String
"    | " forall a. [a] -> [a] -> [a]
++ ShowS
leftPad String
k forall a. [a] -> [a] -> [a]
++ String
" -> " forall a. [a] -> [a] -> [a]
++ String
x | (String
k, String
x) <- [(String, String)]
cases ]
  where
    cases :: [(String, String)]
cases     = [ (String
"x < " forall a. [a] -> [a] -> [a]
++ forall a. Show a => Int -> a -> ShowS
showsPrec Int
5 a
k String
"", forall a. Show a => a -> String
show b
x) | (a
k,b
x) <- forall k a. Map k a -> [(k, a)]
Map.toList Map a b
m ] forall a. [a] -> [a] -> [a]
++
                [ (String
"otherwise", forall a. Show a => a -> String
show b
v) ]
    len :: Int
len       = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(String, String)]
cases)
    leftPad :: ShowS
leftPad String
s = String
s forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
len forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
' '

-- | @'putStrLn' . 'showSF'@
putSF :: (Show a, Show b) => SF a b -> IO ()
putSF :: forall a b. (Show a, Show b) => SF a b -> IO ()
putSF = String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (Show k, Show v) => SF k v -> String
showSF

-- $setup
--
-- >>> import Control.Applicative (liftA2, pure)
-- >>> import qualified Data.Function.Step as SF
-- >>> import Data.Semigroup (Semigroup (..))
--
-- == 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]