module Fold.Pure.Examples
  (
    {- * Monoid -} monoid,
    {- * Length -} null, length,
    {- * Boolean -} and, or, all, any,
    {- * Numeric -} sum, product, mean, variance, standardDeviation,
    {- * Search -} element, notElement, find, lookup,
    {- * Index -} index, findIndex, elementIndex,
    {- * List -} list, reverseList,
  )
  where

import Fold.Pure.Type

import Data.Bool (Bool (False, True), (&&), (||))
import Data.Eq (Eq, (/=), (==))
import Data.Function (id, ($), (.))
import Data.Functor ((<$>))
import Data.Maybe (Maybe)
import Data.Monoid (Monoid, mempty)
import Data.Semigroup ((<>))
import Numeric.Natural (Natural)
import Prelude (Floating, Fractional, Num, sqrt, (*), (+), (-), (/))

import qualified Strict

{-| Start with 'mempty', append each input on the right with ('<>') -}
monoid :: Monoid a => Fold a a
monoid :: forall a. Monoid a => Fold a a
monoid = Fold{ initial :: a
initial = forall a. Monoid a => a
mempty, step :: a -> a -> a
step = forall a. Semigroup a => a -> a -> a
(<>), extract :: a -> a
extract = forall a. a -> a
id }

{-| 'True' if the input contains no inputs -}
null :: Fold a Bool
null :: forall a. Fold a Bool
null = Fold{ initial :: Bool
initial = Bool
True, step :: Bool -> a -> Bool
step = \Bool
_ a
_ -> Bool
False, extract :: Bool -> Bool
extract = forall a. a -> a
id }

{-| The number of inputs -}
length :: Fold a Natural
length :: forall a. Fold a Natural
length = Fold{ initial :: Natural
initial = Natural
0, step :: Natural -> a -> Natural
step = \Natural
n a
_ -> Natural
n forall a. Num a => a -> a -> a
+ Natural
1, extract :: Natural -> Natural
extract = forall a. a -> a
id }

{-| 'True' if all inputs are 'True' -}
and :: Fold Bool Bool
and :: Fold Bool Bool
and = Fold{ initial :: Bool
initial = Bool
True, step :: Bool -> Bool -> Bool
step = Bool -> Bool -> Bool
(&&), extract :: Bool -> Bool
extract = forall a. a -> a
id }

{-| 'True' if any input is 'True' -}
or :: Fold Bool Bool
or :: Fold Bool Bool
or = Fold{ initial :: Bool
initial = Bool
False, step :: Bool -> Bool -> Bool
step = Bool -> Bool -> Bool
(||), extract :: Bool -> Bool
extract = forall a. a -> a
id }

{-| 'True' if all inputs satisfy the predicate -}
all :: (a -> Bool) -> Fold a Bool
all :: forall a. (a -> Bool) -> Fold a Bool
all a -> Bool
predicate =
    Fold{ initial :: Bool
initial = Bool
True, step :: Bool -> a -> Bool
step = \Bool
x a
a -> Bool
x Bool -> Bool -> Bool
&& a -> Bool
predicate a
a, extract :: Bool -> Bool
extract = forall a. a -> a
id }

{-| 'True' if any input satisfies the predicate -}
any :: (a -> Bool) -> Fold a Bool
any :: forall a. (a -> Bool) -> Fold a Bool
any a -> Bool
predicate =
    Fold{ initial :: Bool
initial = Bool
False, step :: Bool -> a -> Bool
step = \Bool
x a
a -> Bool
x Bool -> Bool -> Bool
|| a -> Bool
predicate a
a, extract :: Bool -> Bool
extract = forall a. a -> a
id }

{-| Adds the inputs -}
sum :: Num a => Fold a a
sum :: forall a. Num a => Fold a a
sum = Fold{ initial :: a
initial = a
0, step :: a -> a -> a
step = forall a. Num a => a -> a -> a
(+), extract :: a -> a
extract = forall a. a -> a
id }

{-| Multiplies the inputs -}
product :: Num a => Fold a a
product :: forall a. Num a => Fold a a
product = Fold{ initial :: a
initial = a
1, step :: a -> a -> a
step = forall a. Num a => a -> a -> a
(*), extract :: a -> a
extract = forall a. a -> a
id }

{-| Numerically stable arithmetic mean of the inputs -}
mean :: Fractional a => Fold a a
mean :: forall a. Fractional a => Fold a a
mean = Fold
    { initial :: Tuple2 a a
initial = forall a b. a -> b -> Tuple2 a b
Strict.Tuple2 a
0 a
0
    , step :: Tuple2 a a -> a -> Tuple2 a a
step = \(Strict.Tuple2 a
x a
n) a
y ->
        let n' :: a
n' = a
n forall a. Num a => a -> a -> a
+ a
1 in
        forall a b. a -> b -> Tuple2 a b
Strict.Tuple2 (a
x forall a. Num a => a -> a -> a
+ (a
y forall a. Num a => a -> a -> a
- a
x) forall a. Fractional a => a -> a -> a
/ a
n') a
n'
    , extract :: Tuple2 a a -> a
extract = \(Strict.Tuple2 a
x a
_) -> a
x
    }

{-| Numerically stable (population) variance over the inputs -}
variance :: Fractional a => Fold a a
variance :: forall a. Fractional a => Fold a a
variance = Fold
    { initial :: Tuple3 a a a
initial = forall a b c. a -> b -> c -> Tuple3 a b c
Strict.Tuple3 a
0 a
0 a
0
    , step :: Tuple3 a a a -> a -> Tuple3 a a a
step = \(Strict.Tuple3 a
n a
mean_ a
m2) a
x ->
        let
          n' :: a
n'     = a
n forall a. Num a => a -> a -> a
+ a
1
          mean' :: a
mean'  = (a
n forall a. Num a => a -> a -> a
* a
mean_ forall a. Num a => a -> a -> a
+ a
x) forall a. Fractional a => a -> a -> a
/ (a
n forall a. Num a => a -> a -> a
+ a
1)
          delta :: a
delta  = a
x forall a. Num a => a -> a -> a
- a
mean_
          m2' :: a
m2'    = a
m2 forall a. Num a => a -> a -> a
+ a
delta forall a. Num a => a -> a -> a
* a
delta forall a. Num a => a -> a -> a
* a
n forall a. Fractional a => a -> a -> a
/ (a
n forall a. Num a => a -> a -> a
+ a
1)
        in
          forall a b c. a -> b -> c -> Tuple3 a b c
Strict.Tuple3 a
n' a
mean' a
m2'
    , extract :: Tuple3 a a a -> a
extract = \(Strict.Tuple3 a
n a
_ a
m2) -> a
m2 forall a. Fractional a => a -> a -> a
/ a
n
    }

{-| Numerically stable (population) standard deviation over the inputs -}
standardDeviation :: Floating a => Fold a a
standardDeviation :: forall a. Floating a => Fold a a
standardDeviation = forall a. Floating a => a -> a
sqrt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Fractional a => Fold a a
variance

{-| 'True' if any input is equal to the given value -}
element :: Eq a => a -> Fold a Bool
element :: forall a. Eq a => a -> Fold a Bool
element a
a = forall a. (a -> Bool) -> Fold a Bool
any (a
a ==)

{-| 'False' if any input is equal to the given value -}
notElement :: Eq a => a -> Fold a Bool
notElement :: forall a. Eq a => a -> Fold a Bool
notElement a
a = forall a. (a -> Bool) -> Fold a Bool
all (a
a /=)

{-| The first input that satisfies the predicate, if any -}
find :: (a -> Bool) -> Fold a (Maybe a)
find :: forall a. (a -> Bool) -> Fold a (Maybe a)
find a -> Bool
ok = Fold
    { initial :: Maybe a
initial = forall a. Maybe a
Strict.Nothing
    , step :: Maybe a -> a -> Maybe a
step = \Maybe a
x a
a -> case Maybe a
x of
        Maybe a
Strict.Nothing -> if a -> Bool
ok a
a then forall a. a -> Maybe a
Strict.Just a
a else forall a. Maybe a
Strict.Nothing
        Maybe a
_ -> Maybe a
x
    , extract :: Maybe a -> Maybe a
extract = forall a. Maybe a -> Maybe a
Strict.lazy
    }

{-| The /n/th input, where n=0 is the first input, if the index is in bounds -}
index :: Natural -> Fold a (Maybe a)
index :: forall a. Natural -> Fold a (Maybe a)
index Natural
i = Fold
    { initial :: Either Natural a
initial = forall a b. a -> Either a b
Strict.Left Natural
0
    , step :: Either Natural a -> a -> Either Natural a
step = \Either Natural a
x a
a -> case Either Natural a
x of
        Strict.Left Natural
j -> if Natural
i forall a. Eq a => a -> a -> Bool
== Natural
j then forall a b. b -> Either a b
Strict.Right a
a else forall a b. a -> Either a b
Strict.Left (Natural
j forall a. Num a => a -> a -> a
+ Natural
1)
        Either Natural a
_ -> Either Natural a
x
    , extract :: Either Natural a -> Maybe a
extract = forall a b. Either a b -> Maybe b
Strict.hush
    }

{-| The index of the first input that matches the given value, if any -}
elementIndex :: Eq a => a -> Fold a (Maybe Natural)
elementIndex :: forall a. Eq a => a -> Fold a (Maybe Natural)
elementIndex a
a = forall a. (a -> Bool) -> Fold a (Maybe Natural)
findIndex (a
a ==)

{-| The index of the first input that satisfies the predicate, if any -}
findIndex :: (a -> Bool) -> Fold a (Maybe Natural)
findIndex :: forall a. (a -> Bool) -> Fold a (Maybe Natural)
findIndex a -> Bool
ok = Fold
    { initial :: Either Natural Natural
initial = forall a b. a -> Either a b
Strict.Left Natural
0
    , step :: Either Natural Natural -> a -> Either Natural Natural
step = \Either Natural Natural
x a
a -> case Either Natural Natural
x of
        Strict.Left Natural
i -> if a -> Bool
ok a
a then forall a b. b -> Either a b
Strict.Right Natural
i else forall a b. a -> Either a b
Strict.Left (Natural
i forall a. Num a => a -> a -> a
+ Natural
1)
        Either Natural Natural
_ -> Either Natural Natural
x
    , extract :: Either Natural Natural -> Maybe Natural
extract = forall a b. Either a b -> Maybe b
Strict.hush
    }

{-| The @b@ from the first tuple where @a@ equals the given value, if any -}
lookup :: Eq a => a -> Fold (a, b) (Maybe b)
lookup :: forall a b. Eq a => a -> Fold (a, b) (Maybe b)
lookup a
a0 = Fold
    { initial :: Maybe b
initial = forall a. Maybe a
Strict.Nothing
    , step :: Maybe b -> (a, b) -> Maybe b
step = \Maybe b
x (a
a, b
b) -> case Maybe b
x of
        Maybe b
Strict.Nothing -> if a
a forall a. Eq a => a -> a -> Bool
== a
a0 then forall a. a -> Maybe a
Strict.Just b
b else forall a. Maybe a
Strict.Nothing
        Maybe b
_ -> Maybe b
x
    , extract :: Maybe b -> Maybe b
extract = forall a. Maybe a -> Maybe a
Strict.lazy
    }

{-| All the inputs -}
list :: Fold a [a]
list :: forall a. Fold a [a]
list = Fold{ initial :: [a] -> [a]
initial = forall a. a -> a
id, step :: ([a] -> [a]) -> a -> [a] -> [a]
step = \[a] -> [a]
x a
a -> [a] -> [a]
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
a :), extract :: ([a] -> [a]) -> [a]
extract = (forall a b. (a -> b) -> a -> b
$ []) }

{-| All the inputs in reverse order -}
reverseList :: Fold a [a]
reverseList :: forall a. Fold a [a]
reverseList = Fold{ initial :: [a]
initial = [], step :: [a] -> a -> [a]
step = \[a]
x a
a -> a
a forall a. a -> [a] -> [a]
: [a]
x, extract :: [a] -> [a]
extract = forall a. a -> a
id }