{-# LANGUAGE
CPP,
DeriveFunctor,
GeneralizedNewtypeDeriving,
TemplateHaskell,
UnicodeSyntax
#-}
module Data.Function.Memoize (
Memoizable(..),
memoize2, memoize3, memoize4, memoize5, memoize6, memoize7,
memoFix, memoFix2, memoFix3, memoFix4, memoFix5, memoFix6, memoFix7,
traceMemoize,
memoizeFinite,
deriveMemoizable, deriveMemoizableParams, deriveMemoize,
) where
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
import Control.Monad
import Debug.Trace
import Data.Function.Memoize.Class
import Data.Function.Memoize.TH
memoize2 ∷ (Memoizable a, Memoizable b) ⇒
(a → b → v) → a → b → v
memoize2 :: (a -> b -> v) -> a -> b -> v
memoize2 a -> b -> v
v = (a -> b -> v) -> a -> b -> v
forall a v. Memoizable a => (a -> v) -> a -> v
memoize ((b -> v) -> b -> v
forall a v. Memoizable a => (a -> v) -> a -> v
memoize ((b -> v) -> b -> v) -> (a -> b -> v) -> a -> b -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> v
v)
memoize3 ∷ (Memoizable a, Memoizable b, Memoizable c) ⇒
(a → b → c → v) → a → b → c → v
memoize3 :: (a -> b -> c -> v) -> a -> b -> c -> v
memoize3 a -> b -> c -> v
v = (a -> b -> c -> v) -> a -> b -> c -> v
forall a v. Memoizable a => (a -> v) -> a -> v
memoize ((b -> c -> v) -> b -> c -> v
forall a b v.
(Memoizable a, Memoizable b) =>
(a -> b -> v) -> a -> b -> v
memoize2 ((b -> c -> v) -> b -> c -> v)
-> (a -> b -> c -> v) -> a -> b -> c -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c -> v
v)
memoize4 ∷ (Memoizable a, Memoizable b, Memoizable c, Memoizable d) ⇒
(a → b → c → d → v) →
a → b → c → d → v
memoize4 :: (a -> b -> c -> d -> v) -> a -> b -> c -> d -> v
memoize4 a -> b -> c -> d -> v
v = (a -> b -> c -> d -> v) -> a -> b -> c -> d -> v
forall a v. Memoizable a => (a -> v) -> a -> v
memoize ((b -> c -> d -> v) -> b -> c -> d -> v
forall a b c v.
(Memoizable a, Memoizable b, Memoizable c) =>
(a -> b -> c -> v) -> a -> b -> c -> v
memoize3 ((b -> c -> d -> v) -> b -> c -> d -> v)
-> (a -> b -> c -> d -> v) -> a -> b -> c -> d -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c -> d -> v
v)
memoize5 ∷ (Memoizable a, Memoizable b, Memoizable c, Memoizable d,
Memoizable e) ⇒
(a → b → c → d → e → v) →
a → b → c → d → e → v
memoize5 :: (a -> b -> c -> d -> e -> v) -> a -> b -> c -> d -> e -> v
memoize5 a -> b -> c -> d -> e -> v
v = (a -> b -> c -> d -> e -> v) -> a -> b -> c -> d -> e -> v
forall a v. Memoizable a => (a -> v) -> a -> v
memoize ((b -> c -> d -> e -> v) -> b -> c -> d -> e -> v
forall a b c d v.
(Memoizable a, Memoizable b, Memoizable c, Memoizable d) =>
(a -> b -> c -> d -> v) -> a -> b -> c -> d -> v
memoize4 ((b -> c -> d -> e -> v) -> b -> c -> d -> e -> v)
-> (a -> b -> c -> d -> e -> v) -> a -> b -> c -> d -> e -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c -> d -> e -> v
v)
memoize6 ∷ (Memoizable a, Memoizable b, Memoizable c, Memoizable d,
Memoizable e, Memoizable f) ⇒
(a → b → c → d → e → f → v) →
a → b → c → d → e → f → v
memoize6 :: (a -> b -> c -> d -> e -> f -> v)
-> a -> b -> c -> d -> e -> f -> v
memoize6 a -> b -> c -> d -> e -> f -> v
v = (a -> b -> c -> d -> e -> f -> v)
-> a -> b -> c -> d -> e -> f -> v
forall a v. Memoizable a => (a -> v) -> a -> v
memoize ((b -> c -> d -> e -> f -> v) -> b -> c -> d -> e -> f -> v
forall a b c d e v.
(Memoizable a, Memoizable b, Memoizable c, Memoizable d,
Memoizable e) =>
(a -> b -> c -> d -> e -> v) -> a -> b -> c -> d -> e -> v
memoize5 ((b -> c -> d -> e -> f -> v) -> b -> c -> d -> e -> f -> v)
-> (a -> b -> c -> d -> e -> f -> v)
-> a
-> b
-> c
-> d
-> e
-> f
-> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c -> d -> e -> f -> v
v)
memoize7 ∷ (Memoizable a, Memoizable b, Memoizable c, Memoizable d,
Memoizable e, Memoizable f, Memoizable g) ⇒
(a → b → c → d → e → f → g → v) →
a → b → c → d → e → f → g → v
memoize7 :: (a -> b -> c -> d -> e -> f -> g -> v)
-> a -> b -> c -> d -> e -> f -> g -> v
memoize7 a -> b -> c -> d -> e -> f -> g -> v
v = (a -> b -> c -> d -> e -> f -> g -> v)
-> a -> b -> c -> d -> e -> f -> g -> v
forall a v. Memoizable a => (a -> v) -> a -> v
memoize ((b -> c -> d -> e -> f -> g -> v)
-> b -> c -> d -> e -> f -> g -> v
forall a b c d e f v.
(Memoizable a, Memoizable b, Memoizable c, Memoizable d,
Memoizable e, Memoizable f) =>
(a -> b -> c -> d -> e -> f -> v)
-> a -> b -> c -> d -> e -> f -> v
memoize6 ((b -> c -> d -> e -> f -> g -> v)
-> b -> c -> d -> e -> f -> g -> v)
-> (a -> b -> c -> d -> e -> f -> g -> v)
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c -> d -> e -> f -> g -> v
v)
memoFix ∷ Memoizable a ⇒ ((a → v) → a → v) → a → v
memoFix :: ((a -> v) -> a -> v) -> a -> v
memoFix (a -> v) -> a -> v
ff = a -> v
f where f :: a -> v
f = (a -> v) -> a -> v
forall a v. Memoizable a => (a -> v) -> a -> v
memoize ((a -> v) -> a -> v
ff a -> v
f)
memoFix2 ∷ (Memoizable a, Memoizable b) ⇒
((a → b → v) → a → b → v) → a → b → v
memoFix2 :: ((a -> b -> v) -> a -> b -> v) -> a -> b -> v
memoFix2 (a -> b -> v) -> a -> b -> v
ff = a -> b -> v
f where f :: a -> b -> v
f = (a -> b -> v) -> a -> b -> v
forall a b v.
(Memoizable a, Memoizable b) =>
(a -> b -> v) -> a -> b -> v
memoize2 ((a -> b -> v) -> a -> b -> v
ff a -> b -> v
f)
memoFix3 ∷ (Memoizable a, Memoizable b, Memoizable c) ⇒
((a → b → c → v) → a → b → c → v) → a → b → c → v
memoFix3 :: ((a -> b -> c -> v) -> a -> b -> c -> v) -> a -> b -> c -> v
memoFix3 (a -> b -> c -> v) -> a -> b -> c -> v
ff = a -> b -> c -> v
f where f :: a -> b -> c -> v
f = (a -> b -> c -> v) -> a -> b -> c -> v
forall a b c v.
(Memoizable a, Memoizable b, Memoizable c) =>
(a -> b -> c -> v) -> a -> b -> c -> v
memoize3 ((a -> b -> c -> v) -> a -> b -> c -> v
ff a -> b -> c -> v
f)
memoFix4 ∷ (Memoizable a, Memoizable b, Memoizable c, Memoizable d) ⇒
((a → b → c → d → v) → (a → b → c → d → v)) →
a → b → c → d → v
memoFix4 :: ((a -> b -> c -> d -> v) -> a -> b -> c -> d -> v)
-> a -> b -> c -> d -> v
memoFix4 (a -> b -> c -> d -> v) -> a -> b -> c -> d -> v
ff = a -> b -> c -> d -> v
f where f :: a -> b -> c -> d -> v
f = (a -> b -> c -> d -> v) -> a -> b -> c -> d -> v
forall a b c d v.
(Memoizable a, Memoizable b, Memoizable c, Memoizable d) =>
(a -> b -> c -> d -> v) -> a -> b -> c -> d -> v
memoize4 ((a -> b -> c -> d -> v) -> a -> b -> c -> d -> v
ff a -> b -> c -> d -> v
f)
memoFix5 ∷ (Memoizable a, Memoizable b, Memoizable c, Memoizable d,
Memoizable e) ⇒
((a → b → c → d → e → v) → (a → b → c → d → e → v)) →
a → b → c → d → e → v
memoFix5 :: ((a -> b -> c -> d -> e -> v) -> a -> b -> c -> d -> e -> v)
-> a -> b -> c -> d -> e -> v
memoFix5 (a -> b -> c -> d -> e -> v) -> a -> b -> c -> d -> e -> v
ff = a -> b -> c -> d -> e -> v
f where f :: a -> b -> c -> d -> e -> v
f = (a -> b -> c -> d -> e -> v) -> a -> b -> c -> d -> e -> v
forall a b c d e v.
(Memoizable a, Memoizable b, Memoizable c, Memoizable d,
Memoizable e) =>
(a -> b -> c -> d -> e -> v) -> a -> b -> c -> d -> e -> v
memoize5 ((a -> b -> c -> d -> e -> v) -> a -> b -> c -> d -> e -> v
ff a -> b -> c -> d -> e -> v
f)
memoFix6 ∷ (Memoizable a, Memoizable b, Memoizable c, Memoizable d,
Memoizable e, Memoizable f) ⇒
((a → b → c → d → e → f → v) → (a → b → c → d → e → f → v)) →
a → b → c → d → e → f → v
memoFix6 :: ((a -> b -> c -> d -> e -> f -> v)
-> a -> b -> c -> d -> e -> f -> v)
-> a -> b -> c -> d -> e -> f -> v
memoFix6 (a -> b -> c -> d -> e -> f -> v)
-> a -> b -> c -> d -> e -> f -> v
ff = a -> b -> c -> d -> e -> f -> v
f where f :: a -> b -> c -> d -> e -> f -> v
f = (a -> b -> c -> d -> e -> f -> v)
-> a -> b -> c -> d -> e -> f -> v
forall a b c d e f v.
(Memoizable a, Memoizable b, Memoizable c, Memoizable d,
Memoizable e, Memoizable f) =>
(a -> b -> c -> d -> e -> f -> v)
-> a -> b -> c -> d -> e -> f -> v
memoize6 ((a -> b -> c -> d -> e -> f -> v)
-> a -> b -> c -> d -> e -> f -> v
ff a -> b -> c -> d -> e -> f -> v
f)
memoFix7 ∷ (Memoizable a, Memoizable b, Memoizable c, Memoizable d,
Memoizable e, Memoizable f, Memoizable g) ⇒
((a → b → c → d → e → f → g → v) → (a → b → c → d → e → f → g → v)) →
a → b → c → d → e → f → g → v
memoFix7 :: ((a -> b -> c -> d -> e -> f -> g -> v)
-> a -> b -> c -> d -> e -> f -> g -> v)
-> a -> b -> c -> d -> e -> f -> g -> v
memoFix7 (a -> b -> c -> d -> e -> f -> g -> v)
-> a -> b -> c -> d -> e -> f -> g -> v
ff = a -> b -> c -> d -> e -> f -> g -> v
f where f :: a -> b -> c -> d -> e -> f -> g -> v
f = (a -> b -> c -> d -> e -> f -> g -> v)
-> a -> b -> c -> d -> e -> f -> g -> v
forall a b c d e f g v.
(Memoizable a, Memoizable b, Memoizable c, Memoizable d,
Memoizable e, Memoizable f, Memoizable g) =>
(a -> b -> c -> d -> e -> f -> g -> v)
-> a -> b -> c -> d -> e -> f -> g -> v
memoize7 ((a -> b -> c -> d -> e -> f -> g -> v)
-> a -> b -> c -> d -> e -> f -> g -> v
ff a -> b -> c -> d -> e -> f -> g -> v
f)
traceMemoize ∷ (Memoizable a, Show a) ⇒ (a → b) → a → b
traceMemoize :: (a -> b) -> a -> b
traceMemoize a -> b
f = (a -> b) -> a -> b
forall a v. Memoizable a => (a -> v) -> a -> v
memoize (\a
a → a -> b -> b
forall a b. Show a => a -> b -> b
traceShow a
a (a -> b
f a
a))
deriveMemoizable ''()
deriveMemoizable ''Bool
deriveMemoizable ''Ordering
deriveMemoizable ''Maybe
deriveMemoizable ''Either
deriveMemoizable ''[]
deriveMemoizable ''(,)
deriveMemoizable ''(,,)
deriveMemoizable ''(,,,)
deriveMemoizable ''(,,,,)
deriveMemoizable ''(,,,,,)
deriveMemoizable ''(,,,,,,)
deriveMemoizable ''(,,,,,,,)
deriveMemoizable ''(,,,,,,,,)
deriveMemoizable ''(,,,,,,,,,)
deriveMemoizable ''(,,,,,,,,,,)
deriveMemoizable ''(,,,,,,,,,,,)
data BinaryTreeCache v
= BinaryTreeCache {
BinaryTreeCache v -> v
btValue ∷ v,
BinaryTreeCache v -> BinaryTreeCache v
btLeft, BinaryTreeCache v -> BinaryTreeCache v
btRight ∷ BinaryTreeCache v
}
deriving a -> BinaryTreeCache b -> BinaryTreeCache a
(a -> b) -> BinaryTreeCache a -> BinaryTreeCache b
(forall a b. (a -> b) -> BinaryTreeCache a -> BinaryTreeCache b)
-> (forall a b. a -> BinaryTreeCache b -> BinaryTreeCache a)
-> Functor BinaryTreeCache
forall a b. a -> BinaryTreeCache b -> BinaryTreeCache a
forall a b. (a -> b) -> BinaryTreeCache a -> BinaryTreeCache b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> BinaryTreeCache b -> BinaryTreeCache a
$c<$ :: forall a b. a -> BinaryTreeCache b -> BinaryTreeCache a
fmap :: (a -> b) -> BinaryTreeCache a -> BinaryTreeCache b
$cfmap :: forall a b. (a -> b) -> BinaryTreeCache a -> BinaryTreeCache b
Functor
instance Memoizable Integer where
memoize :: (Integer -> v) -> Integer -> v
memoize Integer -> v
f = IntegerCache v -> Integer -> v
forall v. IntegerCache v -> Integer -> v
integerLookup (Integer -> v
f (Integer -> v) -> IntegerCache Integer -> IntegerCache v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntegerCache Integer
theIntegers)
data IntegerCache v
= IntegerCache {
IntegerCache v -> v
icZero ∷ v,
IntegerCache v -> PosIntCache v
icNegative, IntegerCache v -> PosIntCache v
icPositive ∷ PosIntCache v
}
deriving a -> IntegerCache b -> IntegerCache a
(a -> b) -> IntegerCache a -> IntegerCache b
(forall a b. (a -> b) -> IntegerCache a -> IntegerCache b)
-> (forall a b. a -> IntegerCache b -> IntegerCache a)
-> Functor IntegerCache
forall a b. a -> IntegerCache b -> IntegerCache a
forall a b. (a -> b) -> IntegerCache a -> IntegerCache b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> IntegerCache b -> IntegerCache a
$c<$ :: forall a b. a -> IntegerCache b -> IntegerCache a
fmap :: (a -> b) -> IntegerCache a -> IntegerCache b
$cfmap :: forall a b. (a -> b) -> IntegerCache a -> IntegerCache b
Functor
type PosIntCache v = BinaryTreeCache v
theIntegers ∷ IntegerCache Integer
theIntegers :: IntegerCache Integer
theIntegers
= IntegerCache :: forall v. v -> PosIntCache v -> PosIntCache v -> IntegerCache v
IntegerCache {
icZero :: Integer
icZero = Integer
0,
icNegative :: PosIntCache Integer
icNegative = Integer -> Integer
forall a. Num a => a -> a
negate (Integer -> Integer) -> PosIntCache Integer -> PosIntCache Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PosIntCache Integer
thePosInts,
icPositive :: PosIntCache Integer
icPositive = PosIntCache Integer
thePosInts
}
thePosInts ∷ PosIntCache Integer
thePosInts :: PosIntCache Integer
thePosInts =
BinaryTreeCache :: forall v.
v -> BinaryTreeCache v -> BinaryTreeCache v -> BinaryTreeCache v
BinaryTreeCache {
btValue :: Integer
btValue = Integer
1,
btLeft :: PosIntCache Integer
btLeft = (Integer -> Integer) -> PosIntCache Integer -> PosIntCache Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
2) PosIntCache Integer
thePosInts,
btRight :: PosIntCache Integer
btRight = (Integer -> Integer) -> PosIntCache Integer -> PosIntCache Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Integer
forall a. Enum a => a -> a
succ (Integer -> Integer) -> (Integer -> Integer) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
2)) PosIntCache Integer
thePosInts
}
integerLookup ∷ IntegerCache v → Integer → v
integerLookup :: IntegerCache v -> Integer -> v
integerLookup IntegerCache v
cache Integer
n =
case Integer
n Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Integer
0 of
Ordering
EQ → IntegerCache v -> v
forall v. IntegerCache v -> v
icZero IntegerCache v
cache
Ordering
GT → PosIntCache v -> Integer -> v
forall v. PosIntCache v -> Integer -> v
posIntLookup (IntegerCache v -> PosIntCache v
forall v. IntegerCache v -> PosIntCache v
icPositive IntegerCache v
cache) Integer
n
Ordering
LT → PosIntCache v -> Integer -> v
forall v. PosIntCache v -> Integer -> v
posIntLookup (IntegerCache v -> PosIntCache v
forall v. IntegerCache v -> PosIntCache v
icNegative IntegerCache v
cache) (Integer -> Integer
forall a. Num a => a -> a
negate Integer
n)
posIntLookup ∷ PosIntCache v → Integer → v
posIntLookup :: PosIntCache v -> Integer -> v
posIntLookup PosIntCache v
cache Integer
1 = PosIntCache v -> v
forall v. BinaryTreeCache v -> v
btValue PosIntCache v
cache
posIntLookup PosIntCache v
cache Integer
n
| Integer -> Bool
forall a. Integral a => a -> Bool
even Integer
n = PosIntCache v -> Integer -> v
forall v. PosIntCache v -> Integer -> v
posIntLookup (PosIntCache v -> PosIntCache v
forall v. BinaryTreeCache v -> BinaryTreeCache v
btLeft PosIntCache v
cache) (Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
2)
| Bool
otherwise = PosIntCache v -> Integer -> v
forall v. PosIntCache v -> Integer -> v
posIntLookup (PosIntCache v -> PosIntCache v
forall v. BinaryTreeCache v -> BinaryTreeCache v
btRight PosIntCache v
cache) (Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
2)
newtype Finite a = ToFinite { Finite a -> a
fromFinite ∷ a }
deriving (Finite a -> Finite a -> Bool
(Finite a -> Finite a -> Bool)
-> (Finite a -> Finite a -> Bool) -> Eq (Finite a)
forall a. Eq a => Finite a -> Finite a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Finite a -> Finite a -> Bool
$c/= :: forall a. Eq a => Finite a -> Finite a -> Bool
== :: Finite a -> Finite a -> Bool
$c== :: forall a. Eq a => Finite a -> Finite a -> Bool
Eq, Finite a
Finite a -> Finite a -> Bounded (Finite a)
forall a. a -> a -> Bounded a
forall a. Bounded a => Finite a
maxBound :: Finite a
$cmaxBound :: forall a. Bounded a => Finite a
minBound :: Finite a
$cminBound :: forall a. Bounded a => Finite a
Bounded, Int -> Finite a
Finite a -> Int
Finite a -> [Finite a]
Finite a -> Finite a
Finite a -> Finite a -> [Finite a]
Finite a -> Finite a -> Finite a -> [Finite a]
(Finite a -> Finite a)
-> (Finite a -> Finite a)
-> (Int -> Finite a)
-> (Finite a -> Int)
-> (Finite a -> [Finite a])
-> (Finite a -> Finite a -> [Finite a])
-> (Finite a -> Finite a -> [Finite a])
-> (Finite a -> Finite a -> Finite a -> [Finite a])
-> Enum (Finite a)
forall a. Enum a => Int -> Finite a
forall a. Enum a => Finite a -> Int
forall a. Enum a => Finite a -> [Finite a]
forall a. Enum a => Finite a -> Finite a
forall a. Enum a => Finite a -> Finite a -> [Finite a]
forall a. Enum a => Finite a -> Finite a -> Finite a -> [Finite a]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Finite a -> Finite a -> Finite a -> [Finite a]
$cenumFromThenTo :: forall a. Enum a => Finite a -> Finite a -> Finite a -> [Finite a]
enumFromTo :: Finite a -> Finite a -> [Finite a]
$cenumFromTo :: forall a. Enum a => Finite a -> Finite a -> [Finite a]
enumFromThen :: Finite a -> Finite a -> [Finite a]
$cenumFromThen :: forall a. Enum a => Finite a -> Finite a -> [Finite a]
enumFrom :: Finite a -> [Finite a]
$cenumFrom :: forall a. Enum a => Finite a -> [Finite a]
fromEnum :: Finite a -> Int
$cfromEnum :: forall a. Enum a => Finite a -> Int
toEnum :: Int -> Finite a
$ctoEnum :: forall a. Enum a => Int -> Finite a
pred :: Finite a -> Finite a
$cpred :: forall a. Enum a => Finite a -> Finite a
succ :: Finite a -> Finite a
$csucc :: forall a. Enum a => Finite a -> Finite a
Enum)
instance (Bounded a, Enum a) ⇒ Memoizable (Finite a) where
memoize :: (Finite a -> v) -> Finite a -> v
memoize Finite a -> v
f = BinaryTreeCache v -> Finite a -> v
forall a v. (Bounded a, Enum a) => BinaryTreeCache v -> a -> v
finiteLookup (Finite a -> v
f (Finite a -> v) -> BinaryTreeCache (Finite a) -> BinaryTreeCache v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinaryTreeCache (Finite a)
forall a. (Bounded a, Enum a) => BinaryTreeCache a
theFinites)
theFinites ∷ (Bounded a, Enum a) ⇒ BinaryTreeCache a
theFinites :: BinaryTreeCache a
theFinites = a -> a -> BinaryTreeCache a
forall t. (Bounded t, Enum t) => t -> t -> BinaryTreeCache t
loop a
forall a. Bounded a => a
minBound a
forall a. Bounded a => a
maxBound where
loop :: t -> t -> BinaryTreeCache t
loop t
start t
stop =
BinaryTreeCache :: forall v.
v -> BinaryTreeCache v -> BinaryTreeCache v -> BinaryTreeCache v
BinaryTreeCache {
btValue :: t
btValue = t
mean,
btLeft :: BinaryTreeCache t
btLeft = t -> t -> BinaryTreeCache t
loop t
start (t -> t
forall a. Enum a => a -> a
pred t
mean),
btRight :: BinaryTreeCache t
btRight = t -> t -> BinaryTreeCache t
loop (t -> t
forall a. Enum a => a -> a
succ t
mean) t
stop
}
where mean :: t
mean = t -> t -> t
forall a. (Bounded a, Enum a) => a -> a -> a
meanFinite t
start t
stop
finiteLookup ∷ (Bounded a, Enum a) ⇒ BinaryTreeCache v → a → v
finiteLookup :: BinaryTreeCache v -> a -> v
finiteLookup BinaryTreeCache v
cache0 a
a0 =
Int -> Int -> BinaryTreeCache v -> v
forall v. Int -> Int -> BinaryTreeCache v -> v
loop Int
start0 Int
stop0 BinaryTreeCache v
cache0 where
start0 :: Int
start0 = a -> Int
forall a. Enum a => a -> Int
fromEnum (a
forall a. Bounded a => a
minBound a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
a0)
stop0 :: Int
stop0 = a -> Int
forall a. Enum a => a -> Int
fromEnum (a
forall a. Bounded a => a
maxBound a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
a0)
a :: Int
a = a -> Int
forall a. Enum a => a -> Int
fromEnum a
a0
loop :: Int -> Int -> BinaryTreeCache v -> v
loop Int
start Int
stop BinaryTreeCache v
cache =
let mean :: Int
mean = Int -> Int -> Int
forall a. (Bounded a, Enum a) => a -> a -> a
meanFinite Int
start Int
stop in
case Int
a Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
mean of
Ordering
EQ → BinaryTreeCache v -> v
forall v. BinaryTreeCache v -> v
btValue BinaryTreeCache v
cache
Ordering
LT → Int -> Int -> BinaryTreeCache v -> v
loop Int
start (Int -> Int
forall a. Enum a => a -> a
pred Int
mean) (BinaryTreeCache v -> BinaryTreeCache v
forall v. BinaryTreeCache v -> BinaryTreeCache v
btLeft BinaryTreeCache v
cache)
Ordering
GT → Int -> Int -> BinaryTreeCache v -> v
loop (Int -> Int
forall a. Enum a => a -> a
succ Int
mean) Int
stop (BinaryTreeCache v -> BinaryTreeCache v
forall v. BinaryTreeCache v -> BinaryTreeCache v
btRight BinaryTreeCache v
cache)
meanFinite ∷ (Bounded a, Enum a) ⇒ a → a → a
meanFinite :: a -> a -> a
meanFinite a
a a
b = Int -> a
forall a. Enum a => Int -> a
toEnum (Int
ia Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ib Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+
if Int -> Bool
forall a. Integral a => a -> Bool
odd Int
ia Bool -> Bool -> Bool
&& Int -> Bool
forall a. Integral a => a -> Bool
odd Int
ib then Int
1 else Int
0)
where
ia :: Int
ia = a -> Int
forall a. Enum a => a -> Int
fromEnum a
a
ib :: Int
ib = a -> Int
forall a. Enum a => a -> Int
fromEnum a
b
memoizeFinite ∷ (Enum a, Bounded a) ⇒ (a → v) → a → v
memoizeFinite :: (a -> v) -> a -> v
memoizeFinite a -> v
f = (Finite a -> v) -> Finite a -> v
forall a v. Memoizable a => (a -> v) -> a -> v
memoize (a -> v
f (a -> v) -> (Finite a -> a) -> Finite a -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Finite a -> a
forall a. Finite a -> a
fromFinite) (Finite a -> v) -> (a -> Finite a) -> a -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Finite a
forall a. a -> Finite a
ToFinite
instance Memoizable Int where memoize :: (Int -> v) -> Int -> v
memoize = (Int -> v) -> Int -> v
forall a v. (Enum a, Bounded a) => (a -> v) -> a -> v
memoizeFinite
instance Memoizable Char where memoize :: (Char -> v) -> Char -> v
memoize = (Char -> v) -> Char -> v
forall a v. (Enum a, Bounded a) => (a -> v) -> a -> v
memoizeFinite
instance (Eq a, Bounded a, Enum a, Memoizable b) ⇒ Memoizable (a → b) where
memoize :: ((a -> b) -> v) -> (a -> b) -> v
memoize = FunctionCache b v -> (a -> b) -> v
forall a b v.
(Eq a, Bounded a, Enum a, Memoizable b) =>
FunctionCache b v -> (a -> b) -> v
functionLookup (FunctionCache b v -> (a -> b) -> v)
-> (((a -> b) -> v) -> FunctionCache b v)
-> ((a -> b) -> v)
-> (a -> b)
-> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> b) -> v) -> FunctionCache b v
forall a b v.
(Eq a, Bounded a, Enum a, Memoizable b) =>
((a -> b) -> v) -> FunctionCache b v
theFunctions
functionLookup ∷ (Eq a, Bounded a, Enum a, Memoizable b) ⇒
FunctionCache b v → (a → b) → v
functionLookup :: FunctionCache b v -> (a -> b) -> v
functionLookup FunctionCache b v
cache a -> b
f =
FunctionCache b v -> v
forall b v. FunctionCache b v -> v
fcNil ((FunctionCache b v -> b -> FunctionCache b v)
-> FunctionCache b v -> [b] -> FunctionCache b v
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl FunctionCache b v -> b -> FunctionCache b v
forall b v. FunctionCache b v -> b -> FunctionCache b v
fcCons FunctionCache b v
cache (a -> b
f (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a
forall a. Bounded a => a
minBound .. a
forall a. Bounded a => a
maxBound]))
theFunctions ∷ (Eq a, Bounded a, Enum a, Memoizable b) ⇒
((a → b) → v) → FunctionCache b v
theFunctions :: ((a -> b) -> v) -> FunctionCache b v
theFunctions (a -> b) -> v
f =
FunctionCache :: forall b v. v -> (b -> FunctionCache b v) -> FunctionCache b v
FunctionCache {
fcNil :: v
fcNil = (a -> b) -> v
f a -> b
forall a. HasCallStack => a
undefined,
fcCons :: b -> FunctionCache b v
fcCons = (b -> FunctionCache b v) -> b -> FunctionCache b v
forall a v. Memoizable a => (a -> v) -> a -> v
memoize (\b
b → ((a -> b) -> v) -> FunctionCache b v
forall a b v.
(Eq a, Bounded a, Enum a, Memoizable b) =>
((a -> b) -> v) -> FunctionCache b v
theFunctions ((a -> b) -> v
f ((a -> b) -> v) -> ((a -> b) -> a -> b) -> (a -> b) -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> (a -> b) -> a -> b
forall t p. (Eq t, Bounded t, Enum t) => p -> (t -> p) -> t -> p
extend b
b))
}
where
extend :: p -> (t -> p) -> t -> p
extend p
b t -> p
g t
a
| t
a t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
forall a. Bounded a => a
minBound = p
b
| Bool
otherwise = t -> p
g (t -> t
forall a. Enum a => a -> a
pred t
a)
data FunctionCache b v
= FunctionCache {
FunctionCache b v -> v
fcNil ∷ v,
FunctionCache b v -> b -> FunctionCache b v
fcCons ∷ b → FunctionCache b v
}
_fib ∷ Integer → Integer
_fib :: Integer -> Integer
_fib = ((Integer -> Integer) -> Integer -> Integer) -> Integer -> Integer
forall a v. Memoizable a => ((a -> v) -> a -> v) -> a -> v
memoFix (((Integer -> Integer) -> Integer -> Integer)
-> Integer -> Integer)
-> ((Integer -> Integer) -> Integer -> Integer)
-> Integer
-> Integer
forall a b. (a -> b) -> a -> b
$ \Integer -> Integer
fib Integer
n → case Integer
n of
Integer
0 → Integer
1
Integer
1 → Integer
1
Integer
_ → Integer -> Integer
fib (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer -> Integer
fib (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
2)
_isNot ∷ (Bool → Bool) → Bool
_isNot :: (Bool -> Bool) -> Bool
_isNot = ((Bool -> Bool) -> Bool) -> (Bool -> Bool) -> Bool
forall a v. Memoizable a => (a -> v) -> a -> v
memoize (((Bool -> Bool) -> Bool) -> (Bool -> Bool) -> Bool)
-> ((Bool -> Bool) -> Bool) -> (Bool -> Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ \Bool -> Bool
f →
String -> Bool -> Bool
forall a. String -> a -> a
trace String
"_isNot" (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
Bool -> Bool
f Bool
True Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
False Bool -> Bool -> Bool
&& Bool -> Bool
f Bool
False Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True
_countTrue ∷ (Bool → Bool → Bool) → Integer
_countTrue :: (Bool -> Bool -> Bool) -> Integer
_countTrue = ((Bool -> Bool -> Bool) -> Integer)
-> (Bool -> Bool -> Bool) -> Integer
forall a v. Memoizable a => (a -> v) -> a -> v
memoize (((Bool -> Bool -> Bool) -> Integer)
-> (Bool -> Bool -> Bool) -> Integer)
-> ((Bool -> Bool -> Bool) -> Integer)
-> (Bool -> Bool -> Bool)
-> Integer
forall a b. (a -> b) -> a -> b
$ \Bool -> Bool -> Bool
f →
String -> Integer -> Integer
forall a. String -> a -> a
trace String
"_countTrue" (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$
Int -> Integer
forall a. Integral a => a -> Integer
toInteger ([()] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Bool -> Bool -> Bool
f (Bool -> Bool -> Bool) -> [Bool] -> [Bool -> Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bool
False,Bool
True] [Bool -> Bool] -> [Bool] -> [Bool]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Bool
False,Bool
True] [Bool] -> (Bool -> [()]) -> [()]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard))