{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Redundant lambda" #-}
{-# HLINT ignore "Avoid lambda" #-}
{-# HLINT ignore "Use foldr" #-}
{-# HLINT ignore "Use sum" #-}
module Perf.Algos
(
Example (..),
allExamples,
parseExample,
ExamplePattern (..),
examplePattern,
exampleLabel,
testExample,
statExamples,
SumPattern (..),
allSums,
testSum,
statSums,
sumTail,
sumTailLazy,
sumFlip,
sumFlipLazy,
sumCo,
sumCoGo,
sumCoCase,
sumAux,
sumFoldr,
sumCata,
sumSum,
sumMono,
sumPoly,
sumLambda,
sumF,
sumFuse,
sumFusePoly,
sumFuseFoldl',
sumFuseFoldr,
LengthPattern (..),
allLengths,
testLength,
statLengths,
lengthTail,
lengthTailLazy,
lengthFlip,
lengthFlipLazy,
lengthCo,
lengthCoCase,
lengthAux,
lengthFoldr,
lengthFoldrConst,
lengthF,
lengthFMono,
recurseTail,
recurseTailLazy,
recurseFlip,
recurseFlipLazy,
recurseCo,
recurseCoLazy,
recurseCata,
mapInc,
constFuse,
splitHalf,
)
where
import Control.Monad (void)
import Control.Monad.IO.Class (MonadIO (..))
import Data.Bifunctor
import Data.Foldable
import Data.Functor.Foldable
import qualified Data.Map.Strict as Map
import Data.Text (Text)
import Options.Applicative
import Perf.Types
data Example = ExampleSumFuse | ExampleSum | ExampleLengthF | ExampleConstFuse | ExampleMapInc | ExampleNoOp deriving (Example -> Example -> Bool
(Example -> Example -> Bool)
-> (Example -> Example -> Bool) -> Eq Example
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Example -> Example -> Bool
$c/= :: Example -> Example -> Bool
== :: Example -> Example -> Bool
$c== :: Example -> Example -> Bool
Eq, Int -> Example -> ShowS
[Example] -> ShowS
Example -> String
(Int -> Example -> ShowS)
-> (Example -> String) -> ([Example] -> ShowS) -> Show Example
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Example] -> ShowS
$cshowList :: [Example] -> ShowS
show :: Example -> String
$cshow :: Example -> String
showsPrec :: Int -> Example -> ShowS
$cshowsPrec :: Int -> Example -> ShowS
Show)
allExamples :: [Example]
allExamples :: [Example]
allExamples =
[ Example
ExampleSumFuse,
Example
ExampleSum,
Example
ExampleLengthF,
Example
ExampleConstFuse,
Example
ExampleMapInc,
Example
ExampleNoOp
]
parseExample :: Parser Example
parseExample :: Parser Example
parseExample =
Example -> Mod FlagFields Example -> Parser Example
forall a. a -> Mod FlagFields a -> Parser a
flag' Example
ExampleSumFuse (String -> Mod FlagFields Example
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"sumFuse" Mod FlagFields Example
-> Mod FlagFields Example -> Mod FlagFields Example
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Example
forall (f :: * -> *) a. String -> Mod f a
help String
"fused sum pipeline")
Parser Example -> Parser Example -> Parser Example
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Example -> Mod FlagFields Example -> Parser Example
forall a. a -> Mod FlagFields a -> Parser a
flag' Example
ExampleSum (String -> Mod FlagFields Example
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"sum" Mod FlagFields Example
-> Mod FlagFields Example -> Mod FlagFields Example
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Example
forall (f :: * -> *) a. String -> Mod f a
help String
"sum")
Parser Example -> Parser Example -> Parser Example
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Example -> Mod FlagFields Example -> Parser Example
forall a. a -> Mod FlagFields a -> Parser a
flag' Example
ExampleLengthF (String -> Mod FlagFields Example
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"lengthF" Mod FlagFields Example
-> Mod FlagFields Example -> Mod FlagFields Example
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Example
forall (f :: * -> *) a. String -> Mod f a
help String
"foldr id length")
Parser Example -> Parser Example -> Parser Example
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Example -> Mod FlagFields Example -> Parser Example
forall a. a -> Mod FlagFields a -> Parser a
flag' Example
ExampleConstFuse (String -> Mod FlagFields Example
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"constFuse" Mod FlagFields Example
-> Mod FlagFields Example -> Mod FlagFields Example
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Example
forall (f :: * -> *) a. String -> Mod f a
help String
"fused const pipeline")
Parser Example -> Parser Example -> Parser Example
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Example -> Mod FlagFields Example -> Parser Example
forall a. a -> Mod FlagFields a -> Parser a
flag' Example
ExampleMapInc (String -> Mod FlagFields Example
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"mapInc" Mod FlagFields Example
-> Mod FlagFields Example -> Mod FlagFields Example
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Example
forall (f :: * -> *) a. String -> Mod f a
help String
"fmap (+1)")
Parser Example -> Parser Example -> Parser Example
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Example -> Mod FlagFields Example -> Parser Example
forall a. a -> Mod FlagFields a -> Parser a
flag' Example
ExampleNoOp (String -> Mod FlagFields Example
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"noOp" Mod FlagFields Example
-> Mod FlagFields Example -> Mod FlagFields Example
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Example
forall (f :: * -> *) a. String -> Mod f a
help String
"const ()")
Parser Example -> Parser Example -> Parser Example
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Example -> Parser Example
forall (f :: * -> *) a. Applicative f => a -> f a
pure Example
ExampleSum
data ExamplePattern a
= PatternSumFuse Text ((Num a) => (a -> a)) a
| PatternSum Text ((Num a) => [a] -> a) [a]
| PatternLengthF Text ([a] -> Int) [a]
| PatternConstFuse Text (Int -> ()) Int
| PatternMapInc Text ([Int] -> [Int]) [Int]
| PatternNoOp Text (() -> ()) ()
exampleLabel :: ExamplePattern a -> Text
exampleLabel :: ExamplePattern a -> Text
exampleLabel (PatternSumFuse Text
l Num a => a -> a
_ a
_) = Text
l
exampleLabel (PatternSum Text
l Num a => [a] -> a
_ [a]
_) = Text
l
exampleLabel (PatternLengthF Text
l [a] -> Int
_ [a]
_) = Text
l
exampleLabel (PatternConstFuse Text
l Int -> ()
_ Int
_) = Text
l
exampleLabel (PatternMapInc Text
l [Int] -> [Int]
_ [Int]
_) = Text
l
exampleLabel (PatternNoOp Text
l () -> ()
_ ()
_) = Text
l
examplePattern :: Example -> Int -> ExamplePattern Int
examplePattern :: Example -> Int -> ExamplePattern Int
examplePattern Example
ExampleSumFuse Int
l = Text -> (Num Int => Int -> Int) -> Int -> ExamplePattern Int
forall a. Text -> (Num a => a -> a) -> a -> ExamplePattern a
PatternSumFuse Text
"sumFuse" Num Int => Int -> Int
Int -> Int
sumFuse Int
l
examplePattern Example
ExampleSum Int
l = Text -> (Num Int => [Int] -> Int) -> [Int] -> ExamplePattern Int
forall a. Text -> (Num a => [a] -> a) -> [a] -> ExamplePattern a
PatternSum Text
"sum" Num Int => [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int
1 .. Int
l]
examplePattern Example
ExampleLengthF Int
l = Text -> ([Int] -> Int) -> [Int] -> ExamplePattern Int
forall a. Text -> ([a] -> Int) -> [a] -> ExamplePattern a
PatternLengthF Text
"lengthF" [Int] -> Int
forall a. [a] -> Int
lengthF [Int
1 .. Int
l]
examplePattern Example
ExampleConstFuse Int
l = Text -> (Int -> ()) -> Int -> ExamplePattern Int
forall a. Text -> (Int -> ()) -> Int -> ExamplePattern a
PatternConstFuse Text
"constFuse" Int -> ()
constFuse Int
l
examplePattern Example
ExampleMapInc Int
l = Text -> ([Int] -> [Int]) -> [Int] -> ExamplePattern Int
forall a. Text -> ([Int] -> [Int]) -> [Int] -> ExamplePattern a
PatternMapInc Text
"mapInc" [Int] -> [Int]
mapInc [Int
1 .. Int
l]
examplePattern Example
ExampleNoOp Int
_ = Text -> (() -> ()) -> () -> ExamplePattern Int
forall a. Text -> (() -> ()) -> () -> ExamplePattern a
PatternNoOp Text
"noop" (() -> () -> ()
forall a b. a -> b -> a
const ()) ()
testExample :: (Semigroup a, MonadIO m) => ExamplePattern Int -> PerfT m a ()
testExample :: ExamplePattern Int -> PerfT m a ()
testExample (PatternSumFuse Text
label Num Int => Int -> Int
f Int
a) = PerfT m a Int -> PerfT m a ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (PerfT m a Int -> PerfT m a ()) -> PerfT m a Int -> PerfT m a ()
forall a b. (a -> b) -> a -> b
$ Text -> (Int -> Int) -> Int -> PerfT m a Int
forall (m :: * -> *) t a b.
(MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
fap Text
label Num Int => Int -> Int
Int -> Int
f Int
a
testExample (PatternSum Text
label Num Int => [Int] -> Int
f [Int]
a) = PerfT m a Int -> PerfT m a ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (PerfT m a Int -> PerfT m a ()) -> PerfT m a Int -> PerfT m a ()
forall a b. (a -> b) -> a -> b
$ Text -> ([Int] -> Int) -> [Int] -> PerfT m a Int
forall (m :: * -> *) t a b.
(MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
fap Text
label Num Int => [Int] -> Int
[Int] -> Int
f [Int]
a
testExample (PatternLengthF Text
label [Int] -> Int
f [Int]
a) = PerfT m a Int -> PerfT m a ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (PerfT m a Int -> PerfT m a ()) -> PerfT m a Int -> PerfT m a ()
forall a b. (a -> b) -> a -> b
$ Text -> ([Int] -> Int) -> [Int] -> PerfT m a Int
forall (m :: * -> *) t a b.
(MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
fap Text
label [Int] -> Int
f [Int]
a
testExample (PatternConstFuse Text
label Int -> ()
f Int
a) = PerfT m a () -> PerfT m a ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (PerfT m a () -> PerfT m a ()) -> PerfT m a () -> PerfT m a ()
forall a b. (a -> b) -> a -> b
$ Text -> (Int -> ()) -> Int -> PerfT m a ()
forall (m :: * -> *) t a b.
(MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
fap Text
label Int -> ()
f Int
a
testExample (PatternMapInc Text
label [Int] -> [Int]
f [Int]
a) = PerfT m a [Int] -> PerfT m a ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (PerfT m a [Int] -> PerfT m a ())
-> PerfT m a [Int] -> PerfT m a ()
forall a b. (a -> b) -> a -> b
$ Text -> ([Int] -> [Int]) -> [Int] -> PerfT m a [Int]
forall (m :: * -> *) t a b.
(MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
fap Text
label [Int] -> [Int]
f [Int]
a
testExample (PatternNoOp Text
label () -> ()
f ()
a) = PerfT m a () -> PerfT m a ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (PerfT m a () -> PerfT m a ()) -> PerfT m a () -> PerfT m a ()
forall a b. (a -> b) -> a -> b
$ Text -> (() -> ()) -> () -> PerfT m a ()
forall (m :: * -> *) t a b.
(MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
fap Text
label () -> ()
f ()
a
statExamples :: (MonadIO m) => Int -> Int -> (Int -> Measure m [a]) -> m (Map.Map Text [a])
statExamples :: Int -> Int -> (Int -> Measure m [a]) -> m (Map Text [a])
statExamples Int
n Int
l Int -> Measure m [a]
m = Measure m [a] -> PerfT m [a] () -> m (Map Text [a])
forall (m :: * -> *) t a.
Monad m =>
Measure m t -> PerfT m t a -> m (Map Text t)
execPerfT (Int -> Measure m [a]
m Int
n) (PerfT m [a] () -> m (Map Text [a]))
-> PerfT m [a] () -> m (Map Text [a])
forall a b. (a -> b) -> a -> b
$ (ExamplePattern Int -> PerfT m [a] ())
-> [ExamplePattern Int] -> PerfT m [a] ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ExamplePattern Int -> PerfT m [a] ()
forall a (m :: * -> *).
(Semigroup a, MonadIO m) =>
ExamplePattern Int -> PerfT m a ()
testExample ((Example -> Int -> ExamplePattern Int
`examplePattern` Int
l) (Example -> ExamplePattern Int)
-> [Example] -> [ExamplePattern Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Example]
allExamples)
data SumPattern a
= SumFuse Text (Int -> Int) Int
| SumFusePoly Text ((Enum a, Num a) => a -> a) a
| SumPoly Text ((Num a) => [a] -> a) [a]
| SumMono Text ([Int] -> Int) [Int]
allSums :: Int -> [SumPattern Int]
allSums :: Int -> [SumPattern Int]
allSums Int
l =
[ Text -> (Num Int => [Int] -> Int) -> [Int] -> SumPattern Int
forall a. Text -> (Num a => [a] -> a) -> [a] -> SumPattern a
SumPoly Text
"sumTail" Num Int => [Int] -> Int
forall a. Num a => [a] -> a
sumTail [Int
1 .. Int
l],
Text -> (Num Int => [Int] -> Int) -> [Int] -> SumPattern Int
forall a. Text -> (Num a => [a] -> a) -> [a] -> SumPattern a
SumPoly Text
"sumTailLazy" Num Int => [Int] -> Int
forall a. Num a => [a] -> a
sumTailLazy [Int
1 .. Int
l],
Text -> (Num Int => [Int] -> Int) -> [Int] -> SumPattern Int
forall a. Text -> (Num a => [a] -> a) -> [a] -> SumPattern a
SumPoly Text
"sumFlip" Num Int => [Int] -> Int
forall a. Num a => [a] -> a
sumFlip [Int
1 .. Int
l],
Text -> (Num Int => [Int] -> Int) -> [Int] -> SumPattern Int
forall a. Text -> (Num a => [a] -> a) -> [a] -> SumPattern a
SumPoly Text
"sumFlipLazy" Num Int => [Int] -> Int
forall a. Num a => [a] -> a
sumFlipLazy [Int
1 .. Int
l],
Text -> (Num Int => [Int] -> Int) -> [Int] -> SumPattern Int
forall a. Text -> (Num a => [a] -> a) -> [a] -> SumPattern a
SumPoly Text
"sumCo" Num Int => [Int] -> Int
forall a. Num a => [a] -> a
sumCo [Int
1 .. Int
l],
Text -> (Num Int => [Int] -> Int) -> [Int] -> SumPattern Int
forall a. Text -> (Num a => [a] -> a) -> [a] -> SumPattern a
SumPoly Text
"sumCoGo" Num Int => [Int] -> Int
forall a. Num a => [a] -> a
sumCoGo [Int
1 .. Int
l],
Text -> (Num Int => [Int] -> Int) -> [Int] -> SumPattern Int
forall a. Text -> (Num a => [a] -> a) -> [a] -> SumPattern a
SumPoly Text
"sumCoCase" Num Int => [Int] -> Int
forall a. Num a => [a] -> a
sumCoCase [Int
1 .. Int
l],
Text -> (Num Int => [Int] -> Int) -> [Int] -> SumPattern Int
forall a. Text -> (Num a => [a] -> a) -> [a] -> SumPattern a
SumPoly Text
"sumAux" Num Int => [Int] -> Int
forall a. Num a => [a] -> a
sumAux [Int
1 .. Int
l],
Text -> (Num Int => [Int] -> Int) -> [Int] -> SumPattern Int
forall a. Text -> (Num a => [a] -> a) -> [a] -> SumPattern a
SumPoly Text
"sumFoldr" Num Int => [Int] -> Int
forall a. Num a => [a] -> a
sumFoldr [Int
1 .. Int
l],
Text -> (Num Int => [Int] -> Int) -> [Int] -> SumPattern Int
forall a. Text -> (Num a => [a] -> a) -> [a] -> SumPattern a
SumPoly Text
"sumCata" Num Int => [Int] -> Int
forall a. Num a => [a] -> a
sumCata [Int
1 .. Int
l],
Text -> (Num Int => [Int] -> Int) -> [Int] -> SumPattern Int
forall a. Text -> (Num a => [a] -> a) -> [a] -> SumPattern a
SumPoly Text
"sumSum" Num Int => [Int] -> Int
forall a. Num a => [a] -> a
sumSum [Int
1 .. Int
l],
Text -> ([Int] -> Int) -> [Int] -> SumPattern Int
forall a. Text -> ([Int] -> Int) -> [Int] -> SumPattern a
SumMono Text
"sumMono" [Int] -> Int
sumMono [Int
1 .. Int
l],
Text -> (Num Int => [Int] -> Int) -> [Int] -> SumPattern Int
forall a. Text -> (Num a => [a] -> a) -> [a] -> SumPattern a
SumPoly Text
"sumPoly" Num Int => [Int] -> Int
forall a. Num a => [a] -> a
sumPoly [Int
1 .. Int
l],
Text -> (Num Int => [Int] -> Int) -> [Int] -> SumPattern Int
forall a. Text -> (Num a => [a] -> a) -> [a] -> SumPattern a
SumPoly Text
"sumLambda" Num Int => [Int] -> Int
forall a. Num a => [a] -> a
sumLambda [Int
1 .. Int
l],
Text -> (Num Int => [Int] -> Int) -> [Int] -> SumPattern Int
forall a. Text -> (Num a => [a] -> a) -> [a] -> SumPattern a
SumPoly Text
"sumF" Num Int => [Int] -> Int
forall a. Num a => [a] -> a
sumF [Int
1 .. Int
l],
Text -> (Int -> Int) -> Int -> SumPattern Int
forall a. Text -> (Int -> Int) -> Int -> SumPattern a
SumFuse Text
"sumFuse" Int -> Int
sumFuse Int
l,
Text
-> ((Enum Int, Num Int) => Int -> Int) -> Int -> SumPattern Int
forall a. Text -> ((Enum a, Num a) => a -> a) -> a -> SumPattern a
SumFusePoly Text
"sumFusePoly" (Enum Int, Num Int) => Int -> Int
forall a. (Enum a, Num a) => a -> a
sumFusePoly Int
l,
Text -> (Int -> Int) -> Int -> SumPattern Int
forall a. Text -> (Int -> Int) -> Int -> SumPattern a
SumFuse Text
"sumFuseFoldl'" Int -> Int
sumFuseFoldl' Int
l,
Text -> (Int -> Int) -> Int -> SumPattern Int
forall a. Text -> (Int -> Int) -> Int -> SumPattern a
SumFuse Text
"sumFuseFoldr" Int -> Int
sumFuseFoldr Int
l
]
testSum :: (Semigroup a, MonadIO m) => SumPattern Int -> PerfT m a Int
testSum :: SumPattern Int -> PerfT m a Int
testSum (SumFuse Text
label Int -> Int
f Int
a) = Text -> (Int -> Int) -> Int -> PerfT m a Int
forall (m :: * -> *) t a b.
(MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
fap Text
label Int -> Int
f Int
a
testSum (SumFusePoly Text
label (Enum Int, Num Int) => Int -> Int
f Int
a) = Text -> (Int -> Int) -> Int -> PerfT m a Int
forall (m :: * -> *) t a b.
(MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
fap Text
label (Enum Int, Num Int) => Int -> Int
Int -> Int
f Int
a
testSum (SumMono Text
label [Int] -> Int
f [Int]
a) = Text -> ([Int] -> Int) -> [Int] -> PerfT m a Int
forall (m :: * -> *) t a b.
(MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
fap Text
label [Int] -> Int
f [Int]
a
testSum (SumPoly Text
label Num Int => [Int] -> Int
f [Int]
a) = Text -> ([Int] -> Int) -> [Int] -> PerfT m a Int
forall (m :: * -> *) t a b.
(MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
fap Text
label Num Int => [Int] -> Int
[Int] -> Int
f [Int]
a
statSums :: (MonadIO m) => Int -> Int -> (Int -> Measure m [a]) -> m (Map.Map Text [a])
statSums :: Int -> Int -> (Int -> Measure m [a]) -> m (Map Text [a])
statSums Int
n Int
l Int -> Measure m [a]
m = Measure m [a] -> PerfT m [a] () -> m (Map Text [a])
forall (m :: * -> *) t a.
Monad m =>
Measure m t -> PerfT m t a -> m (Map Text t)
execPerfT (Int -> Measure m [a]
m Int
n) (PerfT m [a] () -> m (Map Text [a]))
-> PerfT m [a] () -> m (Map Text [a])
forall a b. (a -> b) -> a -> b
$ (SumPattern Int -> PerfT m [a] Int)
-> [SumPattern Int] -> PerfT m [a] ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SumPattern Int -> PerfT m [a] Int
forall a (m :: * -> *).
(Semigroup a, MonadIO m) =>
SumPattern Int -> PerfT m a Int
testSum (Int -> [SumPattern Int]
allSums Int
l)
sumTail :: (Num a) => [a] -> a
sumTail :: [a] -> a
sumTail = a -> [a] -> a
forall t. Num t => t -> [t] -> t
go a
0
where
go :: t -> [t] -> t
go t
acc [] = t
acc
go t
acc (t
x : [t]
xs) = t -> [t] -> t
go (t
x t -> t -> t
forall a. Num a => a -> a -> a
+ t
acc) ([t] -> t) -> [t] -> t
forall a b. (a -> b) -> a -> b
$! [t]
xs
sumTailLazy :: (Num a) => [a] -> a
sumTailLazy :: [a] -> a
sumTailLazy = a -> [a] -> a
forall t. Num t => t -> [t] -> t
go a
0
where
go :: t -> [t] -> t
go t
acc [] = t
acc
go t
acc (t
x : [t]
xs) = t -> [t] -> t
go (t
x t -> t -> t
forall a. Num a => a -> a -> a
+ t
acc) ([t] -> t) -> [t] -> t
forall a b. (a -> b) -> a -> b
$! [t]
xs
sumFlip :: (Num a) => [a] -> a
sumFlip :: [a] -> a
sumFlip [a]
xs0 = [a] -> a -> a
forall a. Num a => [a] -> a -> a
go [a]
xs0 a
0
where
go :: [a] -> a -> a
go [] a
s = a
s
go (a
x : [a]
xs) a
s = [a] -> a -> a
go [a]
xs (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$! a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
s
sumFlipLazy :: (Num a) => [a] -> a
sumFlipLazy :: [a] -> a
sumFlipLazy [a]
xs0 = [a] -> a -> a
forall a. Num a => [a] -> a -> a
go [a]
xs0 a
0
where
go :: [t] -> t -> t
go [] t
s = t
s
go (t
x : [t]
xs) t
s = [t] -> t -> t
go [t]
xs (t -> t) -> t -> t
forall a b. (a -> b) -> a -> b
$ t
x t -> t -> t
forall a. Num a => a -> a -> a
+ t
s
sumCo :: (Num a) => [a] -> a
sumCo :: [a] -> a
sumCo [] = a
0
sumCo (a
x : [a]
xs) = a
x a -> a -> a
forall a. Num a => a -> a -> a
+ [a] -> a
forall a. Num a => [a] -> a
sumCo [a]
xs
sumCoGo :: (Num a) => [a] -> a
sumCoGo :: [a] -> a
sumCoGo = [a] -> a
forall a. Num a => [a] -> a
go
where
go :: [p] -> p
go [] = p
0
go (p
x : [p]
xs) = p
x p -> p -> p
forall a. Num a => a -> a -> a
+ [p] -> p
go [p]
xs
sumCoCase :: (Num a) => [a] -> a
sumCoCase :: [a] -> a
sumCoCase = \case
[] -> a
0
(a
x : [a]
xs) -> a
x a -> a -> a
forall a. Num a => a -> a -> a
+ [a] -> a
forall a. Num a => [a] -> a
sumCoCase [a]
xs
sumAux :: (Num a) => [a] -> a
sumAux :: [a] -> a
sumAux = \case
[] -> a
b
(a
x : [a]
xs) -> a -> a -> a
forall a. Num a => a -> a -> a
f a
x ([a] -> a
forall a. Num a => [a] -> a
sumAux [a]
xs)
where
b :: a
b = a
0
f :: a -> a -> a
f a
x a
xs = a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
xs
sumFoldr :: (Num a) => [a] -> a
sumFoldr :: [a] -> a
sumFoldr [a]
xs = (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0 [a]
xs
sumCata :: (Num a) => [a] -> a
sumCata :: [a] -> a
sumCata = (Base [a] a -> a) -> [a] -> a
forall t a. Recursive t => (Base t a -> a) -> t -> a
cata ((Base [a] a -> a) -> [a] -> a) -> (Base [a] a -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ \case
Base [a] a
Nil -> a
0
Cons x acc -> a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
acc
sumSum :: (Num a) => [a] -> a
sumSum :: [a] -> a
sumSum [a]
xs = [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [a]
xs
sumMono :: [Int] -> Int
sumMono :: [Int] -> Int
sumMono [Int]
xs = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 [Int]
xs
sumPoly :: (Num a) => [a] -> a
sumPoly :: [a] -> a
sumPoly [a]
xs = (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0 [a]
xs
sumLambda :: (Num a) => [a] -> a
sumLambda :: [a] -> a
sumLambda = \[a]
xs -> (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0 [a]
xs
sumF' :: (Num a) => a -> (a -> a) -> a -> a
sumF' :: a -> (a -> a) -> a -> a
sumF' a
x a -> a
r = \ !a
a -> a -> a
r (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
a)
sumF :: (Num a) => [a] -> a
sumF :: [a] -> a
sumF [a]
xs = (a -> (a -> a) -> a -> a) -> (a -> a) -> [a] -> a -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> (a -> a) -> a -> a
forall a. Num a => a -> (a -> a) -> a -> a
sumF' a -> a
forall a. a -> a
id [a]
xs a
0
sumFuse :: Int -> Int
sumFuse :: Int -> Int
sumFuse Int
x = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int
1 .. Int
x]
sumFusePoly :: (Enum a, Num a) => a -> a
sumFusePoly :: a -> a
sumFusePoly a
x = [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [a
1 .. a
x]
sumFuseFoldl' :: Int -> Int
sumFuseFoldl' :: Int -> Int
sumFuseFoldl' Int
x = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 [Int
1 .. Int
x]
sumFuseFoldr :: Int -> Int
sumFuseFoldr :: Int -> Int
sumFuseFoldr Int
x = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 [Int
1 .. Int
x]
data LengthPattern a
= LengthPoly Text ([a] -> Int) [a]
| LengthMono Text ([Int] -> Int) [Int]
allLengths :: Int -> [LengthPattern Int]
allLengths :: Int -> [LengthPattern Int]
allLengths Int
l =
[ Text -> ([Int] -> Int) -> [Int] -> LengthPattern Int
forall a. Text -> ([a] -> Int) -> [a] -> LengthPattern a
LengthPoly Text
"lengthTail" [Int] -> Int
forall a. [a] -> Int
lengthTail [Int
1 .. Int
l],
Text -> ([Int] -> Int) -> [Int] -> LengthPattern Int
forall a. Text -> ([a] -> Int) -> [a] -> LengthPattern a
LengthPoly Text
"lengthTailLazy" [Int] -> Int
forall a. [a] -> Int
lengthTailLazy [Int
1 .. Int
l],
Text -> ([Int] -> Int) -> [Int] -> LengthPattern Int
forall a. Text -> ([a] -> Int) -> [a] -> LengthPattern a
LengthPoly Text
"lengthFlip" [Int] -> Int
forall a. [a] -> Int
lengthFlip [Int
1 .. Int
l],
Text -> ([Int] -> Int) -> [Int] -> LengthPattern Int
forall a. Text -> ([a] -> Int) -> [a] -> LengthPattern a
LengthPoly Text
"lengthFlipLazy" [Int] -> Int
forall a. [a] -> Int
lengthFlipLazy [Int
1 .. Int
l],
Text -> ([Int] -> Int) -> [Int] -> LengthPattern Int
forall a. Text -> ([a] -> Int) -> [a] -> LengthPattern a
LengthPoly Text
"lengthCo" [Int] -> Int
forall a. [a] -> Int
lengthCo [Int
1 .. Int
l],
Text -> ([Int] -> Int) -> [Int] -> LengthPattern Int
forall a. Text -> ([a] -> Int) -> [a] -> LengthPattern a
LengthPoly Text
"lengthCoCase" [Int] -> Int
forall a. [a] -> Int
lengthCoCase [Int
1 .. Int
l],
Text -> ([Int] -> Int) -> [Int] -> LengthPattern Int
forall a. Text -> ([a] -> Int) -> [a] -> LengthPattern a
LengthPoly Text
"lengthAux" [Int] -> Int
forall a. [a] -> Int
lengthAux [Int
1 .. Int
l],
Text -> ([Int] -> Int) -> [Int] -> LengthPattern Int
forall a. Text -> ([a] -> Int) -> [a] -> LengthPattern a
LengthPoly Text
"lengthFoldr" [Int] -> Int
forall a. [a] -> Int
lengthFoldr [Int
1 .. Int
l],
Text -> ([Int] -> Int) -> [Int] -> LengthPattern Int
forall a. Text -> ([a] -> Int) -> [a] -> LengthPattern a
LengthPoly Text
"lengthFoldrConst" [Int] -> Int
forall a. [a] -> Int
lengthFoldrConst [Int
1 .. Int
l],
Text -> ([Int] -> Int) -> [Int] -> LengthPattern Int
forall a. Text -> ([a] -> Int) -> [a] -> LengthPattern a
LengthPoly Text
"lengthF" [Int] -> Int
forall a. [a] -> Int
lengthF [Int
1 .. Int
l],
Text -> ([Int] -> Int) -> [Int] -> LengthPattern Int
forall a. Text -> ([Int] -> Int) -> [Int] -> LengthPattern a
LengthMono Text
"lengthFMono" [Int] -> Int
lengthFMono [Int
1 .. Int
l]
]
testLength :: (Semigroup a, MonadIO m) => LengthPattern Int -> PerfT m a Int
testLength :: LengthPattern Int -> PerfT m a Int
testLength (LengthMono Text
label [Int] -> Int
f [Int]
a) = Text -> ([Int] -> Int) -> [Int] -> PerfT m a Int
forall (m :: * -> *) t a b.
(MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
fap Text
label [Int] -> Int
f [Int]
a
testLength (LengthPoly Text
label [Int] -> Int
f [Int]
a) = Text -> ([Int] -> Int) -> [Int] -> PerfT m a Int
forall (m :: * -> *) t a b.
(MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
fap Text
label [Int] -> Int
f [Int]
a
statLengths :: (MonadIO m) => Int -> Int -> (Int -> Measure m [a]) -> m (Map.Map Text [a])
statLengths :: Int -> Int -> (Int -> Measure m [a]) -> m (Map Text [a])
statLengths Int
n Int
l Int -> Measure m [a]
m = Measure m [a] -> PerfT m [a] () -> m (Map Text [a])
forall (m :: * -> *) t a.
Monad m =>
Measure m t -> PerfT m t a -> m (Map Text t)
execPerfT (Int -> Measure m [a]
m Int
n) (PerfT m [a] () -> m (Map Text [a]))
-> PerfT m [a] () -> m (Map Text [a])
forall a b. (a -> b) -> a -> b
$ (LengthPattern Int -> PerfT m [a] Int)
-> [LengthPattern Int] -> PerfT m [a] ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LengthPattern Int -> PerfT m [a] Int
forall a (m :: * -> *).
(Semigroup a, MonadIO m) =>
LengthPattern Int -> PerfT m a Int
testLength (Int -> [LengthPattern Int]
allLengths Int
l)
lengthTail :: [a] -> Int
lengthTail :: [a] -> Int
lengthTail [a]
xs0 = Int -> [a] -> Int
forall t a. Num t => t -> [a] -> t
go Int
0 [a]
xs0
where
go :: t -> [a] -> t
go t
s [] = t
s
go t
s (a
_ : [a]
xs) = t -> [a] -> t
go (t
s t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) ([a] -> t) -> [a] -> t
forall a b. (a -> b) -> a -> b
$! [a]
xs
lengthTailLazy :: [a] -> Int
lengthTailLazy :: [a] -> Int
lengthTailLazy [a]
xs0 = Int -> [a] -> Int
forall t a. Num t => t -> [a] -> t
go Int
0 [a]
xs0
where
go :: t -> [a] -> t
go t
s [] = t
s
go t
s (a
_ : [a]
xs) = t -> [a] -> t
go (t
s t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) [a]
xs
lengthFlip :: [a] -> Int
lengthFlip :: [a] -> Int
lengthFlip [a]
xs0 = [a] -> Int -> Int
forall a a. Num a => [a] -> a -> a
go [a]
xs0 Int
0
where
go :: [a] -> a -> a
go [] a
s = a
s
go (a
_ : [a]
xs) a
s = [a] -> a -> a
go [a]
xs (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$! a
s a -> a -> a
forall a. Num a => a -> a -> a
+ a
1
lengthFlipLazy :: [a] -> Int
lengthFlipLazy :: [a] -> Int
lengthFlipLazy [a]
xs0 = [a] -> Int -> Int
forall a a. Num a => [a] -> a -> a
go [a]
xs0 Int
0
where
go :: [a] -> t -> t
go [] t
s = t
s
go (a
_ : [a]
xs) t
s = [a] -> t -> t
go [a]
xs (t -> t) -> t -> t
forall a b. (a -> b) -> a -> b
$ t
s t -> t -> t
forall a. Num a => a -> a -> a
+ t
1
lengthCo :: [a] -> Int
lengthCo :: [a] -> Int
lengthCo [] = Int
0
lengthCo (a
_ : [a]
xs) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [a] -> Int
forall a. [a] -> Int
lengthCo [a]
xs
lengthCoCase :: [a] -> Int
lengthCoCase :: [a] -> Int
lengthCoCase = \case
[] -> Int
0
(a
_ : [a]
xs) -> Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [a] -> Int
forall a. [a] -> Int
lengthCoCase [a]
xs
lengthAux :: [a] -> Int
lengthAux :: [a] -> Int
lengthAux = \case
[] -> Int
b
(a
x : [a]
xs) -> a -> Int -> Int
forall a p. Num a => p -> a -> a
f a
x ([a] -> Int
forall a. [a] -> Int
lengthAux [a]
xs)
where
b :: Int
b = Int
0
f :: p -> a -> a
f p
_ a
xs = a
1 a -> a -> a
forall a. Num a => a -> a -> a
+ a
xs
lengthFoldr :: [a] -> Int
lengthFoldr :: [a] -> Int
lengthFoldr = (a -> Int -> Int) -> Int -> [a] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> Int -> Int
forall a p. Num a => p -> a -> a
f Int
b
where
b :: Int
b = Int
0
f :: p -> a -> a
f p
_ a
xs = a
1 a -> a -> a
forall a. Num a => a -> a -> a
+ a
xs
lengthFoldrConst :: [a] -> Int
lengthFoldrConst :: [a] -> Int
lengthFoldrConst = (a -> Int -> Int) -> Int -> [a] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Int -> Int) -> a -> Int -> Int
forall a b. a -> b -> a
const (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+)) Int
0
lengthF' :: (Num a) => x -> (a -> a) -> a -> a
lengthF' :: x -> (a -> a) -> a -> a
lengthF' x
_ a -> a
r = \ !a
a -> a -> a
r (a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
1)
lengthF :: [a] -> Int
lengthF :: [a] -> Int
lengthF [a]
xs0 = (a -> (Int -> Int) -> Int -> Int)
-> (Int -> Int) -> [a] -> Int -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> (Int -> Int) -> Int -> Int
forall a x. Num a => x -> (a -> a) -> a -> a
lengthF' Int -> Int
forall a. a -> a
id [a]
xs0 Int
0
lengthFMono :: [Int] -> Int
lengthFMono :: [Int] -> Int
lengthFMono [Int]
xs0 = (Int -> (Int -> Int) -> Int -> Int)
-> (Int -> Int) -> [Int] -> Int -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> (Int -> Int) -> Int -> Int
forall a x. Num a => x -> (a -> a) -> a -> a
lengthF' Int -> Int
forall a. a -> a
id [Int]
xs0 Int
0
recurseTail :: (a -> b -> b) -> b -> [a] -> b
recurseTail :: (a -> b -> b) -> b -> [a] -> b
recurseTail a -> b -> b
f = b -> [a] -> b
go
where
go :: b -> [a] -> b
go b
s [] = b
s
go b
s (a
x : [a]
xs) = b -> [a] -> b
go (a -> b -> b
f a
x b
s) ([a] -> b) -> [a] -> b
forall a b. (a -> b) -> a -> b
$! [a]
xs
recurseTailLazy :: (a -> b -> b) -> b -> [a] -> b
recurseTailLazy :: (a -> b -> b) -> b -> [a] -> b
recurseTailLazy a -> b -> b
f = b -> [a] -> b
go
where
go :: b -> [a] -> b
go b
s [] = b
s
go b
s (a
x : [a]
xs) = b -> [a] -> b
go (a -> b -> b
f a
x b
s) [a]
xs
recurseFlip :: (a -> b -> b) -> b -> [a] -> b
recurseFlip :: (a -> b -> b) -> b -> [a] -> b
recurseFlip a -> b -> b
f b
s0 [a]
xs0 = [a] -> b -> b
go [a]
xs0 b
s0
where
go :: [a] -> b -> b
go [] b
s = b
s
go (a
x : [a]
xs) b
s = [a] -> b -> b
go [a]
xs (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
x b
s
recurseFlipLazy :: (a -> b -> b) -> b -> [a] -> b
recurseFlipLazy :: (a -> b -> b) -> b -> [a] -> b
recurseFlipLazy a -> b -> b
f b
s0 [a]
xs0 = [a] -> b -> b
go [a]
xs0 b
s0
where
go :: [a] -> b -> b
go [] b
s = b
s
go (a
x : [a]
xs) b
s = [a] -> b -> b
go [a]
xs (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ a -> b -> b
f a
x b
s
recurseCo :: (a -> b -> b) -> b -> [a] -> b
recurseCo :: (a -> b -> b) -> b -> [a] -> b
recurseCo a -> b -> b
f b
s0 = [a] -> b
go
where
go :: [a] -> b
go [] = b
s0
go (a
x : [a]
xs) = a -> b -> b
f a
x (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! [a] -> b
go [a]
xs
recurseCoLazy :: (a -> b -> b) -> b -> [a] -> b
recurseCoLazy :: (a -> b -> b) -> b -> [a] -> b
recurseCoLazy a -> b -> b
f b
s0 = [a] -> b
go
where
go :: [a] -> b
go [] = b
s0
go (a
x : [a]
xs) = a -> b -> b
f a
x (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ [a] -> b
go [a]
xs
recurseCata :: (a -> b -> b) -> b -> [a] -> b
recurseCata :: (a -> b -> b) -> b -> [a] -> b
recurseCata a -> b -> b
f b
s0 = (Base [a] b -> b) -> [a] -> b
forall t a. Recursive t => (Base t a -> a) -> t -> a
cata ((Base [a] b -> b) -> [a] -> b) -> (Base [a] b -> b) -> [a] -> b
forall a b. (a -> b) -> a -> b
$ \case
Base [a] b
Nil -> b
s0
Cons x acc -> a -> b -> b
f a
x b
acc
constFuse :: Int -> ()
constFuse :: Int -> ()
constFuse Int
x = (() -> Int -> ()) -> () -> [Int] -> ()
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' () -> Int -> ()
forall a b. a -> b -> a
const () [Int
1 .. Int
x]
mapInc :: [Int] -> [Int]
mapInc :: [Int] -> [Int]
mapInc [Int]
xs = (Int -> Int) -> [Int] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Int]
xs
splitHalf :: [a] -> ([a], [a])
splitHalf :: [a] -> ([a], [a])
splitHalf [a]
xs = [a] -> [a] -> ([a], [a])
forall a a. [a] -> [a] -> ([a], [a])
go [a]
xs [a]
xs
where
go :: [a] -> [a] -> ([a], [a])
go (a
y : [a]
ys) (a
_ : a
_ : [a]
zs) = ([a] -> [a]) -> ([a], [a]) -> ([a], [a])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a] -> ([a], [a])
go [a]
ys [a]
zs)
go [a]
ys [a]
_ = ([], [a]
ys)