{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
module DataFrame.Functions where
import DataFrame.Internal.Column
import DataFrame.Internal.DataFrame (
DataFrame (..),
columnAsDoubleVector,
unsafeGetColumn,
)
import DataFrame.Internal.Expression (
Expr (..),
UExpr (..),
eSize,
interpret,
replaceExpr,
)
import DataFrame.Internal.Statistics
import qualified DataFrame.Operations.Statistics as Stats
import DataFrame.Operations.Subset (exclude, select)
import Control.Exception (throw)
import Control.Monad
import qualified Data.Char as Char
import Data.Containers.ListUtils
import Data.Function
import qualified Data.List as L
import qualified Data.Map as M
import Data.Maybe (fromMaybe, listToMaybe)
import qualified Data.Set as S
import qualified Data.Text as T
import Data.Type.Equality
import qualified Data.Vector as V
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Unboxed as VU
import qualified DataFrame.Operations.Core as D
import qualified DataFrame.Operations.Transformations as D
import Debug.Trace (trace, traceShow)
import Language.Haskell.TH
import qualified Language.Haskell.TH.Syntax as TH
import Type.Reflection (typeRep)
import Prelude hiding (maximum, minimum, sum)
name :: (Show a) => Expr a -> T.Text
name :: forall a. Show a => Expr a -> Text
name (Col Text
n) = Text
n
name Expr a
other =
[Char] -> Text
forall a. HasCallStack => [Char] -> a
error ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$
[Char]
"You must call `name` on a column reference. Not the expression: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Expr a -> [Char]
forall a. Show a => a -> [Char]
show Expr a
other
col :: (Columnable a) => T.Text -> Expr a
col :: forall a. Columnable a => Text -> Expr a
col = Text -> Expr a
forall a. Columnable a => Text -> Expr a
Col
as :: (Columnable a) => Expr a -> T.Text -> (T.Text, UExpr)
as :: forall a. Columnable a => Expr a -> Text -> (Text, UExpr)
as Expr a
expr Text
name = (Text
name, Expr a -> UExpr
forall a. Columnable a => Expr a -> UExpr
Wrap Expr a
expr)
ifThenElse :: (Columnable a) => Expr Bool -> Expr a -> Expr a -> Expr a
ifThenElse :: forall a. Columnable a => Expr Bool -> Expr a -> Expr a -> Expr a
ifThenElse = Expr Bool -> Expr a -> Expr a -> Expr a
forall a. Columnable a => Expr Bool -> Expr a -> Expr a -> Expr a
If
lit :: (Columnable a) => a -> Expr a
lit :: forall a. Columnable a => a -> Expr a
lit = a -> Expr a
forall a. Columnable a => a -> Expr a
Lit
lift :: (Columnable a, Columnable b) => (a -> b) -> Expr a -> Expr b
lift :: forall a b.
(Columnable a, Columnable b) =>
(a -> b) -> Expr a -> Expr b
lift = Text -> (a -> b) -> Expr a -> Expr b
forall a b.
(Columnable a, Columnable b) =>
Text -> (b -> a) -> Expr b -> Expr a
UnaryOp Text
"udf"
lift2 ::
(Columnable c, Columnable b, Columnable a) =>
(c -> b -> a) -> Expr c -> Expr b -> Expr a
lift2 :: forall c b a.
(Columnable c, Columnable b, Columnable a) =>
(c -> b -> a) -> Expr c -> Expr b -> Expr a
lift2 = Text -> (c -> b -> a) -> Expr c -> Expr b -> Expr a
forall c b a.
(Columnable c, Columnable b, Columnable a) =>
Text -> (c -> b -> a) -> Expr c -> Expr b -> Expr a
BinaryOp Text
"udf"
toDouble :: (Columnable a, Real a) => Expr a -> Expr Double
toDouble :: forall a. (Columnable a, Real a) => Expr a -> Expr Double
toDouble = Text -> (a -> Double) -> Expr a -> Expr Double
forall a b.
(Columnable a, Columnable b) =>
Text -> (b -> a) -> Expr b -> Expr a
UnaryOp Text
"toDouble" a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
div :: (Integral a, Columnable a) => Expr a -> Expr a -> Expr a
div :: forall a. (Integral a, Columnable a) => Expr a -> Expr a -> Expr a
div = Text -> (a -> a -> a) -> Expr a -> Expr a -> Expr a
forall c b a.
(Columnable c, Columnable b, Columnable a) =>
Text -> (c -> b -> a) -> Expr c -> Expr b -> Expr a
BinaryOp Text
"div" a -> a -> a
forall a. Integral a => a -> a -> a
Prelude.div
mod :: (Integral a, Columnable a) => Expr a -> Expr a -> Expr a
mod :: forall a. (Integral a, Columnable a) => Expr a -> Expr a -> Expr a
mod = Text -> (a -> a -> a) -> Expr a -> Expr a -> Expr a
forall c b a.
(Columnable c, Columnable b, Columnable a) =>
Text -> (c -> b -> a) -> Expr c -> Expr b -> Expr a
BinaryOp Text
"mod" a -> a -> a
forall a. Integral a => a -> a -> a
Prelude.mod
(==) :: (Columnable a, Eq a) => Expr a -> Expr a -> Expr Bool
== :: forall a. (Columnable a, Eq a) => Expr a -> Expr a -> Expr Bool
(==) = Text -> (a -> a -> Bool) -> Expr a -> Expr a -> Expr Bool
forall c b a.
(Columnable c, Columnable b, Columnable a) =>
Text -> (c -> b -> a) -> Expr c -> Expr b -> Expr a
BinaryOp Text
"eq" a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==)
eq :: (Columnable a, Eq a) => Expr a -> Expr a -> Expr Bool
eq :: forall a. (Columnable a, Eq a) => Expr a -> Expr a -> Expr Bool
eq = Text -> (a -> a -> Bool) -> Expr a -> Expr a -> Expr Bool
forall c b a.
(Columnable c, Columnable b, Columnable a) =>
Text -> (c -> b -> a) -> Expr c -> Expr b -> Expr a
BinaryOp Text
"eq" a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==)
(<) :: (Columnable a, Ord a) => Expr a -> Expr a -> Expr Bool
< :: forall a. (Columnable a, Ord a) => Expr a -> Expr a -> Expr Bool
(<) = Text -> (a -> a -> Bool) -> Expr a -> Expr a -> Expr Bool
forall c b a.
(Columnable c, Columnable b, Columnable a) =>
Text -> (c -> b -> a) -> Expr c -> Expr b -> Expr a
BinaryOp Text
"lt" a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(Prelude.<)
lt :: (Columnable a, Ord a) => Expr a -> Expr a -> Expr Bool
lt :: forall a. (Columnable a, Ord a) => Expr a -> Expr a -> Expr Bool
lt = Text -> (a -> a -> Bool) -> Expr a -> Expr a -> Expr Bool
forall c b a.
(Columnable c, Columnable b, Columnable a) =>
Text -> (c -> b -> a) -> Expr c -> Expr b -> Expr a
BinaryOp Text
"lt" a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(Prelude.<)
(>) :: (Columnable a, Ord a) => Expr a -> Expr a -> Expr Bool
> :: forall a. (Columnable a, Ord a) => Expr a -> Expr a -> Expr Bool
(>) = Text -> (a -> a -> Bool) -> Expr a -> Expr a -> Expr Bool
forall c b a.
(Columnable c, Columnable b, Columnable a) =>
Text -> (c -> b -> a) -> Expr c -> Expr b -> Expr a
BinaryOp Text
"gt" a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(Prelude.>)
gt :: (Columnable a, Ord a) => Expr a -> Expr a -> Expr Bool
gt :: forall a. (Columnable a, Ord a) => Expr a -> Expr a -> Expr Bool
gt = Text -> (a -> a -> Bool) -> Expr a -> Expr a -> Expr Bool
forall c b a.
(Columnable c, Columnable b, Columnable a) =>
Text -> (c -> b -> a) -> Expr c -> Expr b -> Expr a
BinaryOp Text
"gt" a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(Prelude.>)
(<=) :: (Columnable a, Ord a, Eq a) => Expr a -> Expr a -> Expr Bool
<= :: forall a.
(Columnable a, Ord a, Eq a) =>
Expr a -> Expr a -> Expr Bool
(<=) = Text -> (a -> a -> Bool) -> Expr a -> Expr a -> Expr Bool
forall c b a.
(Columnable c, Columnable b, Columnable a) =>
Text -> (c -> b -> a) -> Expr c -> Expr b -> Expr a
BinaryOp Text
"leq" a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(Prelude.<=)
leq :: (Columnable a, Ord a, Eq a) => Expr a -> Expr a -> Expr Bool
leq :: forall a.
(Columnable a, Ord a, Eq a) =>
Expr a -> Expr a -> Expr Bool
leq = Text -> (a -> a -> Bool) -> Expr a -> Expr a -> Expr Bool
forall c b a.
(Columnable c, Columnable b, Columnable a) =>
Text -> (c -> b -> a) -> Expr c -> Expr b -> Expr a
BinaryOp Text
"leq" a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(Prelude.<=)
(>=) :: (Columnable a, Ord a, Eq a) => Expr a -> Expr a -> Expr Bool
>= :: forall a.
(Columnable a, Ord a, Eq a) =>
Expr a -> Expr a -> Expr Bool
(>=) = Text -> (a -> a -> Bool) -> Expr a -> Expr a -> Expr Bool
forall c b a.
(Columnable c, Columnable b, Columnable a) =>
Text -> (c -> b -> a) -> Expr c -> Expr b -> Expr a
BinaryOp Text
"geq" a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(Prelude.>=)
geq :: (Columnable a, Ord a, Eq a) => Expr a -> Expr a -> Expr Bool
geq :: forall a.
(Columnable a, Ord a, Eq a) =>
Expr a -> Expr a -> Expr Bool
geq = Text -> (a -> a -> Bool) -> Expr a -> Expr a -> Expr Bool
forall c b a.
(Columnable c, Columnable b, Columnable a) =>
Text -> (c -> b -> a) -> Expr c -> Expr b -> Expr a
BinaryOp Text
"geq" a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(Prelude.>=)
and :: Expr Bool -> Expr Bool -> Expr Bool
and :: Expr Bool -> Expr Bool -> Expr Bool
and = Text
-> (Bool -> Bool -> Bool) -> Expr Bool -> Expr Bool -> Expr Bool
forall c b a.
(Columnable c, Columnable b, Columnable a) =>
Text -> (c -> b -> a) -> Expr c -> Expr b -> Expr a
BinaryOp Text
"and" Bool -> Bool -> Bool
(&&)
or :: Expr Bool -> Expr Bool -> Expr Bool
or :: Expr Bool -> Expr Bool -> Expr Bool
or = Text
-> (Bool -> Bool -> Bool) -> Expr Bool -> Expr Bool -> Expr Bool
forall c b a.
(Columnable c, Columnable b, Columnable a) =>
Text -> (c -> b -> a) -> Expr c -> Expr b -> Expr a
BinaryOp Text
"or" Bool -> Bool -> Bool
(||)
not :: Expr Bool -> Expr Bool
not :: Expr Bool -> Expr Bool
not = Text -> (Bool -> Bool) -> Expr Bool -> Expr Bool
forall a b.
(Columnable a, Columnable b) =>
Text -> (b -> a) -> Expr b -> Expr a
UnaryOp Text
"not" Bool -> Bool
Prelude.not
count :: (Columnable a) => Expr a -> Expr Int
count :: forall a. Columnable a => Expr a -> Expr Int
count Expr a
expr = Expr a -> Text -> Int -> (Int -> a -> Int) -> Expr Int
forall a b.
(Columnable a, Columnable b) =>
Expr b -> Text -> a -> (a -> b -> a) -> Expr a
AggFold Expr a
expr Text
"count" Int
0 (\Int
acc a
_ -> Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
mode :: (Columnable a, Eq a) => Expr a -> Expr a
mode :: forall a. (Columnable a, Eq a) => Expr a -> Expr a
mode Expr a
expr =
Expr a -> Text -> (Vector a -> a) -> Expr a
forall (v :: * -> *) b a.
(Vector v b, Typeable v, Columnable a, Columnable b) =>
Expr b -> Text -> (v b -> a) -> Expr a
AggVector
Expr a
expr
Text
"mode"
( (a, Integer) -> a
forall a b. (a, b) -> a
fst
((a, Integer) -> a) -> (Vector a -> (a, Integer)) -> Vector a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Integer) -> (a, Integer) -> Ordering)
-> [(a, Integer)] -> (a, Integer)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
L.maximumBy (Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Integer -> Integer -> Ordering)
-> ((a, Integer) -> Integer)
-> (a, Integer)
-> (a, Integer)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (a, Integer) -> Integer
forall a b. (a, b) -> b
snd)
([(a, Integer)] -> (a, Integer))
-> (Vector a -> [(a, Integer)]) -> Vector a -> (a, Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a Integer -> [(a, Integer)]
forall k a. Map k a -> [(k, a)]
M.toList
(Map a Integer -> [(a, Integer)])
-> (Vector a -> Map a Integer) -> Vector a -> [(a, Integer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map a Integer -> a -> Map a Integer)
-> Map a Integer -> Vector a -> Map a Integer
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl' (\Map a Integer
m a
e -> (Integer -> Integer -> Integer)
-> a -> Integer -> Map a Integer -> Map a Integer
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+) a
e Integer
1 Map a Integer
m) Map a Integer
forall k a. Map k a
M.empty
)
minimum :: (Columnable a, Ord a) => Expr a -> Expr a
minimum :: forall a. (Columnable a, Ord a) => Expr a -> Expr a
minimum Expr a
expr = Expr a
-> Text -> (forall a1. Columnable a1 => a1 -> a1 -> a1) -> Expr a
forall a.
Columnable a =>
Expr a
-> Text -> (forall a1. Columnable a1 => a1 -> a1 -> a1) -> Expr a
AggReduce Expr a
expr Text
"minimum" a1 -> a1 -> a1
forall a. Ord a => a -> a -> a
forall a1. Columnable a1 => a1 -> a1 -> a1
Prelude.min
maximum :: (Columnable a, Ord a) => Expr a -> Expr a
maximum :: forall a. (Columnable a, Ord a) => Expr a -> Expr a
maximum Expr a
expr = Expr a
-> Text -> (forall a1. Columnable a1 => a1 -> a1 -> a1) -> Expr a
forall a.
Columnable a =>
Expr a
-> Text -> (forall a1. Columnable a1 => a1 -> a1 -> a1) -> Expr a
AggReduce Expr a
expr Text
"maximum" a1 -> a1 -> a1
forall a. Ord a => a -> a -> a
forall a1. Columnable a1 => a1 -> a1 -> a1
Prelude.max
sum :: forall a. (Columnable a, Num a, VU.Unbox a) => Expr a -> Expr a
sum :: forall a. (Columnable a, Num a, Unbox a) => Expr a -> Expr a
sum Expr a
expr = Expr a -> Text -> (Vector a -> a) -> Expr a
forall a b.
(Columnable a, Columnable b, Unbox a, Unbox b, Num a, Num b) =>
Expr b -> Text -> (Vector b -> a) -> Expr a
AggNumericVector Expr a
expr Text
"sum" Vector a -> a
forall (v :: * -> *) a. (Vector v a, Num a) => v a -> a
VG.sum
mean :: (Columnable a, Real a, VU.Unbox a) => Expr a -> Expr Double
mean :: forall a. (Columnable a, Real a, Unbox a) => Expr a -> Expr Double
mean Expr a
expr = Expr a -> Text -> (Vector a -> Double) -> Expr Double
forall a b.
(Columnable a, Columnable b, Unbox a, Unbox b, Num a, Num b) =>
Expr b -> Text -> (Vector b -> a) -> Expr a
AggNumericVector Expr a
expr Text
"mean" Vector a -> Double
forall a. (Real a, Unbox a) => Vector a -> Double
mean'
variance :: (Columnable a, Real a, VU.Unbox a) => Expr a -> Expr Double
variance :: forall a. (Columnable a, Real a, Unbox a) => Expr a -> Expr Double
variance Expr a
expr = Expr a -> Text -> (Vector a -> Double) -> Expr Double
forall a b.
(Columnable a, Columnable b, Unbox a, Unbox b, Num a, Num b) =>
Expr b -> Text -> (Vector b -> a) -> Expr a
AggNumericVector Expr a
expr Text
"variance" Vector a -> Double
forall a. (Real a, Unbox a) => Vector a -> Double
variance'
median :: (Columnable a, Real a, VU.Unbox a) => Expr a -> Expr Double
median :: forall a. (Columnable a, Real a, Unbox a) => Expr a -> Expr Double
median Expr a
expr = Expr a -> Text -> (Vector a -> Double) -> Expr Double
forall a b.
(Columnable a, Columnable b, Unbox a, Unbox b, Num a, Num b) =>
Expr b -> Text -> (Vector b -> a) -> Expr a
AggNumericVector Expr a
expr Text
"median" Vector a -> Double
forall a. (Real a, Unbox a) => Vector a -> Double
median'
percentile :: Int -> Expr Double -> Expr Double
percentile :: Int -> Expr Double -> Expr Double
percentile Int
n Expr Double
expr =
Expr Double -> Text -> (Vector Double -> Double) -> Expr Double
forall a b.
(Columnable a, Columnable b, Unbox a, Unbox b, Num a, Num b) =>
Expr b -> Text -> (Vector b -> a) -> Expr a
AggNumericVector
Expr Double
expr
([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"percentile " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n)
(Int -> Vector Double -> Double
percentile' Int
n)
stddev :: (Columnable a, Real a, VU.Unbox a) => Expr a -> Expr Double
stddev :: forall a. (Columnable a, Real a, Unbox a) => Expr a -> Expr Double
stddev Expr a
expr = Expr a -> Text -> (Vector a -> Double) -> Expr Double
forall a b.
(Columnable a, Columnable b, Unbox a, Unbox b, Num a, Num b) =>
Expr b -> Text -> (Vector b -> a) -> Expr a
AggNumericVector Expr a
expr Text
"stddev" (Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double) -> (Vector a -> Double) -> Vector a -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> Double
forall a. (Real a, Unbox a) => Vector a -> Double
variance')
zScore :: Expr Double -> Expr Double
zScore :: Expr Double -> Expr Double
zScore Expr Double
c = (Expr Double
c Expr Double -> Expr Double -> Expr Double
forall a. Num a => a -> a -> a
- Expr Double -> Expr Double
forall a. (Columnable a, Real a, Unbox a) => Expr a -> Expr Double
mean Expr Double
c) Expr Double -> Expr Double -> Expr Double
forall a. Fractional a => a -> a -> a
/ Expr Double -> Expr Double
forall a. (Columnable a, Real a, Unbox a) => Expr a -> Expr Double
stddev Expr Double
c
pow :: (Columnable a, Num a) => Int -> Expr a -> Expr a
pow :: forall a. (Columnable a, Num a) => Int -> Expr a -> Expr a
pow Int
0 Expr a
_ = a -> Expr a
forall a. Columnable a => a -> Expr a
Lit a
1
pow Int
1 Expr a
expr = Expr a
expr
pow Int
i Expr a
expr = Text -> (a -> a) -> Expr a -> Expr a
forall a b.
(Columnable a, Columnable b) =>
Text -> (b -> a) -> Expr b -> Expr a
UnaryOp (Text
"pow " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i)) (a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
i) Expr a
expr
relu :: (Columnable a, Num a) => Expr a -> Expr a
relu :: forall a. (Columnable a, Num a) => Expr a -> Expr a
relu = Text -> (a -> a) -> Expr a -> Expr a
forall a b.
(Columnable a, Columnable b) =>
Text -> (b -> a) -> Expr b -> Expr a
UnaryOp Text
"relu" (a -> a -> a
forall a. Ord a => a -> a -> a
Prelude.max a
0)
min :: (Columnable a, Ord a) => Expr a -> Expr a -> Expr a
min :: forall a. (Columnable a, Ord a) => Expr a -> Expr a -> Expr a
min = Text -> (a -> a -> a) -> Expr a -> Expr a -> Expr a
forall c b a.
(Columnable c, Columnable b, Columnable a) =>
Text -> (c -> b -> a) -> Expr c -> Expr b -> Expr a
BinaryOp Text
"min" a -> a -> a
forall a. Ord a => a -> a -> a
Prelude.min
max :: (Columnable a, Ord a) => Expr a -> Expr a -> Expr a
max :: forall a. (Columnable a, Ord a) => Expr a -> Expr a -> Expr a
max = Text -> (a -> a -> a) -> Expr a -> Expr a -> Expr a
forall c b a.
(Columnable c, Columnable b, Columnable a) =>
Text -> (c -> b -> a) -> Expr c -> Expr b -> Expr a
BinaryOp Text
"max" a -> a -> a
forall a. Ord a => a -> a -> a
Prelude.max
reduce ::
forall a b.
(Columnable a, Columnable b) => Expr b -> a -> (a -> b -> a) -> Expr a
reduce :: forall a b.
(Columnable a, Columnable b) =>
Expr b -> a -> (a -> b -> a) -> Expr a
reduce Expr b
expr = Expr b -> Text -> a -> (a -> b -> a) -> Expr a
forall a b.
(Columnable a, Columnable b) =>
Expr b -> Text -> a -> (a -> b -> a) -> Expr a
AggFold Expr b
expr Text
"foldUdf"
generateConditions ::
TypedColumn Double -> [Expr Bool] -> [Expr Double] -> DataFrame -> [Expr Bool]
generateConditions :: TypedColumn Double
-> [Expr Bool] -> [Expr Double] -> DataFrame -> [Expr Bool]
generateConditions TypedColumn Double
labels [Expr Bool]
conds [Expr Double]
ps DataFrame
df =
let
newConds :: [Expr Bool]
newConds =
[ Expr Double
p Expr Double -> Expr Double -> Expr Bool
forall a.
(Columnable a, Ord a, Eq a) =>
Expr a -> Expr a -> Expr Bool
DataFrame.Functions.<= Expr Double
q
| Expr Double
p <- [Expr Double]
ps
, Expr Double
q <- [Expr Double]
ps
, Expr Double
p Expr Double -> Expr Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Expr Double
q
]
[Expr Bool] -> [Expr Bool] -> [Expr Bool]
forall a. [a] -> [a] -> [a]
++ [ Expr Bool -> Expr Bool
DataFrame.Functions.not Expr Bool
p
| Expr Bool
p <- [Expr Bool]
conds
]
expandedConds :: [Expr Bool]
expandedConds =
[Expr Bool]
conds
[Expr Bool] -> [Expr Bool] -> [Expr Bool]
forall a. [a] -> [a] -> [a]
++ [Expr Bool]
newConds
[Expr Bool] -> [Expr Bool] -> [Expr Bool]
forall a. [a] -> [a] -> [a]
++ [Expr Bool
p Expr Bool -> Expr Bool -> Expr Bool
`DataFrame.Functions.and` Expr Bool
q | Expr Bool
p <- [Expr Bool]
newConds, Expr Bool
q <- [Expr Bool]
conds, Expr Bool
p Expr Bool -> Expr Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Expr Bool
q]
[Expr Bool] -> [Expr Bool] -> [Expr Bool]
forall a. [a] -> [a] -> [a]
++ [Expr Bool
p Expr Bool -> Expr Bool -> Expr Bool
`DataFrame.Functions.or` Expr Bool
q | Expr Bool
p <- [Expr Bool]
newConds, Expr Bool
q <- [Expr Bool]
conds, Expr Bool
p Expr Bool -> Expr Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Expr Bool
q]
in
DataFrame
-> TypedColumn Double
-> [(Expr Bool, TypedColumn Bool)]
-> [Expr Bool]
pickTopNBool DataFrame
df TypedColumn Double
labels (DataFrame -> [Expr Bool] -> [(Expr Bool, TypedColumn Bool)]
forall a.
Columnable a =>
DataFrame -> [Expr a] -> [(Expr a, TypedColumn a)]
deduplicate DataFrame
df [Expr Bool]
expandedConds)
generatePrograms ::
[Expr Bool] -> [Expr Double] -> [Expr Double] -> [Expr Double] -> [Expr Double]
generatePrograms :: [Expr Bool]
-> [Expr Double] -> [Expr Double] -> [Expr Double] -> [Expr Double]
generatePrograms [Expr Bool]
conds [Expr Double]
vars' [Expr Double]
constants [] =
let
vars :: [Expr Double]
vars = [Expr Double]
vars' [Expr Double] -> [Expr Double] -> [Expr Double]
forall a. [a] -> [a] -> [a]
++ [Expr Double]
constants
in
[Expr Double] -> [Expr Double]
forall a. Ord a => [a] -> [a]
nubOrd ([Expr Double] -> [Expr Double]) -> [Expr Double] -> [Expr Double]
forall a b. (a -> b) -> a -> b
$
[Expr Double]
vars
[Expr Double] -> [Expr Double] -> [Expr Double]
forall a. [a] -> [a] -> [a]
++ [ Expr Double -> Expr Double
transform Expr Double
p
| Expr Double
p <- [Expr Double]
vars'
, Expr Double -> Expr Double
transform <-
[ Expr Double -> Expr Double
forall a. Num a => a -> a
abs
, Expr Double -> Expr Double
forall a. Floating a => a -> a
sqrt
, Expr Double -> Expr Double
forall a. Floating a => a -> a
log (Expr Double -> Expr Double)
-> (Expr Double -> Expr Double) -> Expr Double -> Expr Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr Double -> Expr Double -> Expr Double
forall a. Num a => a -> a -> a
+ Double -> Expr Double
forall a. Columnable a => a -> Expr a
Lit Double
1)
, Expr Double -> Expr Double
forall a. Floating a => a -> a
exp
, Expr Double -> Expr Double
forall a. Floating a => a -> a
sin
, Expr Double -> Expr Double
forall a. Floating a => a -> a
cos
, Expr Double -> Expr Double
forall a. (Columnable a, Num a) => Expr a -> Expr a
relu
, Expr Double -> Expr Double
forall a. Num a => a -> a
signum
]
]
[Expr Double] -> [Expr Double] -> [Expr Double]
forall a. [a] -> [a] -> [a]
++ [ Int -> Expr Double -> Expr Double
forall a. (Columnable a, Num a) => Int -> Expr a -> Expr a
pow Int
i Expr Double
p
| Expr Double
p <- [Expr Double]
vars
, Int
i <- [Int
2 .. Int
6]
]
[Expr Double] -> [Expr Double] -> [Expr Double]
forall a. [a] -> [a] -> [a]
++ [ Expr Double
p Expr Double -> Expr Double -> Expr Double
forall a. Num a => a -> a -> a
+ Expr Double
q
| (Integer
i, Expr Double
p) <- [Integer] -> [Expr Double] -> [(Integer, Expr Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0 ..] [Expr Double]
vars
, (Integer
j, Expr Double
q) <- [Integer] -> [Expr Double] -> [(Integer, Expr Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0 ..] [Expr Double]
vars
, Bool -> Bool
Prelude.not (Expr Double -> Bool
forall a. Expr a -> Bool
isLiteral Expr Double
p Bool -> Bool -> Bool
&& Expr Double -> Bool
forall a. Expr a -> Bool
isLiteral Expr Double
q)
, Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
Prelude.> Integer
j
]
[Expr Double] -> [Expr Double] -> [Expr Double]
forall a. [a] -> [a] -> [a]
++ [ Expr Double -> Expr Double -> Expr Double
forall a. (Columnable a, Ord a) => Expr a -> Expr a -> Expr a
DataFrame.Functions.min Expr Double
p Expr Double
q
| (Integer
i, Expr Double
p) <- [Integer] -> [Expr Double] -> [(Integer, Expr Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0 ..] [Expr Double]
vars
, (Integer
j, Expr Double
q) <- [Integer] -> [Expr Double] -> [(Integer, Expr Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0 ..] [Expr Double]
vars
, Expr Double
p Expr Double -> Expr Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Expr Double
q
, Bool -> Bool
Prelude.not (Expr Double -> Bool
forall a. Expr a -> Bool
isLiteral Expr Double
p Bool -> Bool -> Bool
&& Expr Double -> Bool
forall a. Expr a -> Bool
isLiteral Expr Double
q)
, Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
Prelude.> Integer
j
]
[Expr Double] -> [Expr Double] -> [Expr Double]
forall a. [a] -> [a] -> [a]
++ [ Expr Double -> Expr Double -> Expr Double
forall a. (Columnable a, Ord a) => Expr a -> Expr a -> Expr a
DataFrame.Functions.max Expr Double
p Expr Double
q
| (Integer
i, Expr Double
p) <- [Integer] -> [Expr Double] -> [(Integer, Expr Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0 ..] [Expr Double]
vars
, (Integer
j, Expr Double
q) <- [Integer] -> [Expr Double] -> [(Integer, Expr Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0 ..] [Expr Double]
vars
, Expr Double
p Expr Double -> Expr Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Expr Double
q
, Bool -> Bool
Prelude.not (Expr Double -> Bool
forall a. Expr a -> Bool
isLiteral Expr Double
p Bool -> Bool -> Bool
&& Expr Double -> Bool
forall a. Expr a -> Bool
isLiteral Expr Double
q)
, Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
Prelude.> Integer
j
]
[Expr Double] -> [Expr Double] -> [Expr Double]
forall a. [a] -> [a] -> [a]
++ [ Expr Bool -> Expr Double -> Expr Double -> Expr Double
forall a. Columnable a => Expr Bool -> Expr a -> Expr a -> Expr a
ifThenElse Expr Bool
cond Expr Double
r Expr Double
s
| Expr Bool
cond <- [Expr Bool]
conds
, Expr Double
r <- [Expr Double]
vars
, Expr Double
s <- [Expr Double]
vars
, Expr Double
r Expr Double -> Expr Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Expr Double
s
]
[Expr Double] -> [Expr Double] -> [Expr Double]
forall a. [a] -> [a] -> [a]
++ [ Expr Double
p Expr Double -> Expr Double -> Expr Double
forall a. Num a => a -> a -> a
- Expr Double
q
| (Integer
i, Expr Double
p) <- [Integer] -> [Expr Double] -> [(Integer, Expr Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0 ..] [Expr Double]
vars
, (Integer
j, Expr Double
q) <- [Integer] -> [Expr Double] -> [(Integer, Expr Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0 ..] [Expr Double]
vars
, Bool -> Bool
Prelude.not (Expr Double -> Bool
forall a. Expr a -> Bool
isLiteral Expr Double
p Bool -> Bool -> Bool
&& Expr Double -> Bool
forall a. Expr a -> Bool
isLiteral Expr Double
q)
, Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
j
]
[Expr Double] -> [Expr Double] -> [Expr Double]
forall a. [a] -> [a] -> [a]
++ [ Expr Double
p Expr Double -> Expr Double -> Expr Double
forall a. Num a => a -> a -> a
* Expr Double
q
| (Integer
i, Expr Double
p) <- [Integer] -> [Expr Double] -> [(Integer, Expr Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0 ..] [Expr Double]
vars
, (Integer
j, Expr Double
q) <- [Integer] -> [Expr Double] -> [(Integer, Expr Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0 ..] [Expr Double]
vars
, Bool -> Bool
Prelude.not (Expr Double -> Bool
forall a. Expr a -> Bool
isLiteral Expr Double
p Bool -> Bool -> Bool
&& Expr Double -> Bool
forall a. Expr a -> Bool
isLiteral Expr Double
q)
, Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
Prelude.>= Integer
j
]
[Expr Double] -> [Expr Double] -> [Expr Double]
forall a. [a] -> [a] -> [a]
++ [ Expr Double
p Expr Double -> Expr Double -> Expr Double
forall a. Fractional a => a -> a -> a
/ Expr Double
q
| (Integer
i, Expr Double
p) <- [Integer] -> [Expr Double] -> [(Integer, Expr Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0 ..] [Expr Double]
vars
, (Integer
j, Expr Double
q) <- [Integer] -> [Expr Double] -> [(Integer, Expr Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0 ..] [Expr Double]
vars
, Bool -> Bool
Prelude.not (Expr Double -> Bool
forall a. Expr a -> Bool
isLiteral Expr Double
p Bool -> Bool -> Bool
&& Expr Double -> Bool
forall a. Expr a -> Bool
isLiteral Expr Double
q)
, Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
j
]
generatePrograms [Expr Bool]
conds [Expr Double]
vars [Expr Double]
constants [Expr Double]
ps =
let
existingPrograms :: [Expr Double]
existingPrograms = [Expr Double]
ps [Expr Double] -> [Expr Double] -> [Expr Double]
forall a. [a] -> [a] -> [a]
++ [Expr Double]
vars [Expr Double] -> [Expr Double] -> [Expr Double]
forall a. [a] -> [a] -> [a]
++ [Expr Double]
constants
in
[Expr Double]
existingPrograms
[Expr Double] -> [Expr Double] -> [Expr Double]
forall a. [a] -> [a] -> [a]
++ [ Expr Double -> Expr Double
transform Expr Double
p
| Expr Double
p <- [Expr Double]
ps [Expr Double] -> [Expr Double] -> [Expr Double]
forall a. [a] -> [a] -> [a]
++ [Expr Double]
vars
, Expr Double -> Expr Double
transform <-
[ Expr Double -> Expr Double
forall a. Floating a => a -> a
sqrt
, Expr Double -> Expr Double
forall a. Num a => a -> a
abs
, Expr Double -> Expr Double
forall a. Floating a => a -> a
log (Expr Double -> Expr Double)
-> (Expr Double -> Expr Double) -> Expr Double -> Expr Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr Double -> Expr Double -> Expr Double
forall a. Num a => a -> a -> a
+ Double -> Expr Double
forall a. Columnable a => a -> Expr a
Lit Double
1)
, Expr Double -> Expr Double
forall a. Floating a => a -> a
exp
, Expr Double -> Expr Double
forall a. Floating a => a -> a
sin
, Expr Double -> Expr Double
forall a. Floating a => a -> a
cos
, Expr Double -> Expr Double
forall a. (Columnable a, Num a) => Expr a -> Expr a
relu
, Expr Double -> Expr Double
forall a. Num a => a -> a
signum
]
]
[Expr Double] -> [Expr Double] -> [Expr Double]
forall a. [a] -> [a] -> [a]
++ [ Int -> Expr Double -> Expr Double
forall a. (Columnable a, Num a) => Int -> Expr a -> Expr a
pow Int
i Expr Double
p
| Expr Double
p <- [Expr Double]
existingPrograms
, Int
i <- [Int
2 .. Int
6]
]
[Expr Double] -> [Expr Double] -> [Expr Double]
forall a. [a] -> [a] -> [a]
++ [ Expr Double
p Expr Double -> Expr Double -> Expr Double
forall a. Num a => a -> a -> a
+ Expr Double
q
| (Integer
i, Expr Double
p) <- [Integer] -> [Expr Double] -> [(Integer, Expr Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0 ..] [Expr Double]
existingPrograms
, (Integer
j, Expr Double
q) <- [Integer] -> [Expr Double] -> [(Integer, Expr Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0 ..] [Expr Double]
existingPrograms
, Bool -> Bool
Prelude.not (Expr Double -> Bool
forall a. Expr a -> Bool
isLiteral Expr Double
p Bool -> Bool -> Bool
&& Expr Double -> Bool
forall a. Expr a -> Bool
isLiteral Expr Double
q)
, Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
Prelude.>= Integer
j
]
[Expr Double] -> [Expr Double] -> [Expr Double]
forall a. [a] -> [a] -> [a]
++ [ Expr Double -> Expr Double -> Expr Double
forall a. (Columnable a, Ord a) => Expr a -> Expr a -> Expr a
DataFrame.Functions.min Expr Double
p Expr Double
q
| (Integer
i, Expr Double
p) <- [Integer] -> [Expr Double] -> [(Integer, Expr Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0 ..] [Expr Double]
existingPrograms
, (Integer
j, Expr Double
q) <- [Integer] -> [Expr Double] -> [(Integer, Expr Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0 ..] [Expr Double]
existingPrograms
, Bool -> Bool
Prelude.not (Expr Double -> Bool
forall a. Expr a -> Bool
isLiteral Expr Double
p Bool -> Bool -> Bool
&& Expr Double -> Bool
forall a. Expr a -> Bool
isLiteral Expr Double
q)
, Expr Double
p Expr Double -> Expr Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Expr Double
q
, Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
Prelude.> Integer
j
]
[Expr Double] -> [Expr Double] -> [Expr Double]
forall a. [a] -> [a] -> [a]
++ [ Expr Double -> Expr Double -> Expr Double
forall a. (Columnable a, Ord a) => Expr a -> Expr a -> Expr a
DataFrame.Functions.max Expr Double
p Expr Double
q
| (Integer
i, Expr Double
p) <- [Integer] -> [Expr Double] -> [(Integer, Expr Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0 ..] [Expr Double]
existingPrograms
, (Integer
j, Expr Double
q) <- [Integer] -> [Expr Double] -> [(Integer, Expr Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0 ..] [Expr Double]
existingPrograms
, Bool -> Bool
Prelude.not (Expr Double -> Bool
forall a. Expr a -> Bool
isLiteral Expr Double
p Bool -> Bool -> Bool
&& Expr Double -> Bool
forall a. Expr a -> Bool
isLiteral Expr Double
q)
, Expr Double
p Expr Double -> Expr Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Expr Double
q
, Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
Prelude.> Integer
j
]
[Expr Double] -> [Expr Double] -> [Expr Double]
forall a. [a] -> [a] -> [a]
++ [ Expr Bool -> Expr Double -> Expr Double -> Expr Double
forall a. Columnable a => Expr Bool -> Expr a -> Expr a -> Expr a
ifThenElse Expr Bool
cond Expr Double
r Expr Double
s
| Expr Bool
cond <- [Expr Bool]
conds
, Expr Double
r <- [Expr Double]
existingPrograms
, Expr Double
s <- [Expr Double]
existingPrograms
, Expr Double
r Expr Double -> Expr Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Expr Double
s
]
[Expr Double] -> [Expr Double] -> [Expr Double]
forall a. [a] -> [a] -> [a]
++ [ Expr Double
p Expr Double -> Expr Double -> Expr Double
forall a. Num a => a -> a -> a
- Expr Double
q
| (Integer
i, Expr Double
p) <- [Integer] -> [Expr Double] -> [(Integer, Expr Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0 ..] [Expr Double]
existingPrograms
, (Integer
j, Expr Double
q) <- [Integer] -> [Expr Double] -> [(Integer, Expr Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0 ..] [Expr Double]
existingPrograms
, Bool -> Bool
Prelude.not (Expr Double -> Bool
forall a. Expr a -> Bool
isLiteral Expr Double
p Bool -> Bool -> Bool
&& Expr Double -> Bool
forall a. Expr a -> Bool
isLiteral Expr Double
q)
, Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
j
]
[Expr Double] -> [Expr Double] -> [Expr Double]
forall a. [a] -> [a] -> [a]
++ [ Expr Double
p Expr Double -> Expr Double -> Expr Double
forall a. Num a => a -> a -> a
* Expr Double
q
| (Integer
i, Expr Double
p) <- [Integer] -> [Expr Double] -> [(Integer, Expr Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0 ..] [Expr Double]
existingPrograms
, (Integer
j, Expr Double
q) <- [Integer] -> [Expr Double] -> [(Integer, Expr Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0 ..] [Expr Double]
existingPrograms
, Bool -> Bool
Prelude.not (Expr Double -> Bool
forall a. Expr a -> Bool
isLiteral Expr Double
p Bool -> Bool -> Bool
&& Expr Double -> Bool
forall a. Expr a -> Bool
isLiteral Expr Double
q)
, Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
Prelude.>= Integer
j
]
[Expr Double] -> [Expr Double] -> [Expr Double]
forall a. [a] -> [a] -> [a]
++ [ Expr Double
p Expr Double -> Expr Double -> Expr Double
forall a. Fractional a => a -> a -> a
/ Expr Double
q
| Expr Double
p <- [Expr Double]
existingPrograms
, Expr Double
q <- [Expr Double]
existingPrograms
, Bool -> Bool
Prelude.not (Expr Double -> Bool
forall a. Expr a -> Bool
isLiteral Expr Double
p Bool -> Bool -> Bool
&& Expr Double -> Bool
forall a. Expr a -> Bool
isLiteral Expr Double
q)
, Expr Double
p Expr Double -> Expr Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Expr Double
q
]
isLiteral :: Expr a -> Bool
isLiteral :: forall a. Expr a -> Bool
isLiteral (Lit a
_) = Bool
True
isLiteral Expr a
_ = Bool
False
deduplicate ::
forall a.
(Columnable a) =>
DataFrame ->
[Expr a] ->
[(Expr a, TypedColumn a)]
deduplicate :: forall a.
Columnable a =>
DataFrame -> [Expr a] -> [(Expr a, TypedColumn a)]
deduplicate DataFrame
df = Set (TypedColumn a) -> [Expr a] -> [(Expr a, TypedColumn a)]
go Set (TypedColumn a)
forall a. Set a
S.empty ([Expr a] -> [(Expr a, TypedColumn a)])
-> ([Expr a] -> [Expr a]) -> [Expr a] -> [(Expr a, TypedColumn a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expr a] -> [Expr a]
forall a. Ord a => [a] -> [a]
nubOrd ([Expr a] -> [Expr a])
-> ([Expr a] -> [Expr a]) -> [Expr a] -> [Expr a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr a -> Expr a -> Ordering) -> [Expr a] -> [Expr a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (\Expr a
e1 Expr a
e2 -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Expr a -> Int
forall a. Expr a -> Int
eSize Expr a
e1) (Expr a -> Int
forall a. Expr a -> Int
eSize Expr a
e2))
where
go :: Set (TypedColumn a) -> [Expr a] -> [(Expr a, TypedColumn a)]
go Set (TypedColumn a)
_ [] = []
go Set (TypedColumn a)
seen (Expr a
x : [Expr a]
xs)
| Bool
hasInvalid = Set (TypedColumn a) -> [Expr a] -> [(Expr a, TypedColumn a)]
go Set (TypedColumn a)
seen [Expr a]
xs
| TypedColumn a -> Set (TypedColumn a) -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member TypedColumn a
res Set (TypedColumn a)
seen = Set (TypedColumn a) -> [Expr a] -> [(Expr a, TypedColumn a)]
go Set (TypedColumn a)
seen [Expr a]
xs
| Bool
otherwise = (Expr a
x, TypedColumn a
res) (Expr a, TypedColumn a)
-> [(Expr a, TypedColumn a)] -> [(Expr a, TypedColumn a)]
forall a. a -> [a] -> [a]
: Set (TypedColumn a) -> [Expr a] -> [(Expr a, TypedColumn a)]
go (TypedColumn a -> Set (TypedColumn a) -> Set (TypedColumn a)
forall a. Ord a => a -> Set a -> Set a
S.insert TypedColumn a
res Set (TypedColumn a)
seen) [Expr a]
xs
where
res :: TypedColumn a
res = case forall a.
Columnable a =>
DataFrame -> Expr a -> Either DataFrameException (TypedColumn a)
interpret @a DataFrame
df Expr a
x of
Left DataFrameException
e -> DataFrameException -> TypedColumn a
forall a e. Exception e => e -> a
throw DataFrameException
e
Right TypedColumn a
v -> TypedColumn a
v
hasInvalid :: Bool
hasInvalid = case TypedColumn a
res of
(TColumn (UnboxedColumn (Vector a
col :: VU.Vector b))) -> case TypeRep Double -> TypeRep a -> Maybe (Double :~: a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Double) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b) of
Just Double :~: a
Refl -> (a -> Bool) -> Vector a -> Bool
forall a. Unbox a => (a -> Bool) -> Vector a -> Bool
VU.any (\a
n -> a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
n Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
n) Vector a
col
Maybe (Double :~: a)
Nothing -> Bool
False
TypedColumn a
_ -> Bool
False
equivalent :: DataFrame -> Expr Double -> Expr Double -> Bool
equivalent :: DataFrame -> Expr Double -> Expr Double -> Bool
equivalent DataFrame
df Expr Double
p1 Expr Double
p2 = case TypedColumn Double -> TypedColumn Double -> Bool
forall a. Eq a => a -> a -> Bool
(Prelude.==) (TypedColumn Double -> TypedColumn Double -> Bool)
-> Either DataFrameException (TypedColumn Double)
-> Either DataFrameException (TypedColumn Double -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DataFrame
-> Expr Double -> Either DataFrameException (TypedColumn Double)
forall a.
Columnable a =>
DataFrame -> Expr a -> Either DataFrameException (TypedColumn a)
interpret DataFrame
df Expr Double
p1 Either DataFrameException (TypedColumn Double -> Bool)
-> Either DataFrameException (TypedColumn Double)
-> Either DataFrameException Bool
forall a b.
Either DataFrameException (a -> b)
-> Either DataFrameException a -> Either DataFrameException b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DataFrame
-> Expr Double -> Either DataFrameException (TypedColumn Double)
forall a.
Columnable a =>
DataFrame -> Expr a -> Either DataFrameException (TypedColumn a)
interpret DataFrame
df Expr Double
p2 of
Left DataFrameException
e -> DataFrameException -> Bool
forall a e. Exception e => e -> a
throw DataFrameException
e
Right Bool
v -> Bool
v
synthesizeFeatureExpr ::
T.Text ->
BeamConfig ->
DataFrame ->
Either String (Expr Double)
synthesizeFeatureExpr :: Text -> BeamConfig -> DataFrame -> Either [Char] (Expr Double)
synthesizeFeatureExpr Text
target BeamConfig
cfg DataFrame
df =
let
df' :: DataFrame
df' = [Text] -> DataFrame -> DataFrame
exclude [Text
target] DataFrame
df
t :: TypedColumn Double
t = case DataFrame
-> Expr Double -> Either DataFrameException (TypedColumn Double)
forall a.
Columnable a =>
DataFrame -> Expr a -> Either DataFrameException (TypedColumn a)
interpret DataFrame
df (Text -> Expr Double
forall a. Columnable a => Text -> Expr a
Col Text
target) of
Left DataFrameException
e -> DataFrameException -> TypedColumn Double
forall a e. Exception e => e -> a
throw DataFrameException
e
Right TypedColumn Double
v -> TypedColumn Double
v
in
case DataFrame
-> BeamConfig
-> TypedColumn Double
-> [Expr Double]
-> [Expr Bool]
-> [Expr Double]
-> Maybe (Expr Double)
beamSearch
DataFrame
df'
BeamConfig
cfg
TypedColumn Double
t
(DataFrame -> [Expr Double]
percentiles DataFrame
df')
[]
[] of
Maybe (Expr Double)
Nothing -> [Char] -> Either [Char] (Expr Double)
forall a b. a -> Either a b
Left [Char]
"No programs found"
Just Expr Double
p -> Expr Double -> Either [Char] (Expr Double)
forall a b. b -> Either a b
Right Expr Double
p
f1FromBinary :: VU.Vector Double -> VU.Vector Double -> Maybe Double
f1FromBinary :: Vector Double -> Vector Double -> Maybe Double
f1FromBinary Vector Double
trues Vector Double
preds =
let (!Int
tp, !Int
fp, !Int
fn) =
((Int, Int, Int) -> (Bool, Bool) -> (Int, Int, Int))
-> (Int, Int, Int) -> Vector (Bool, Bool) -> (Int, Int, Int)
forall b a. Unbox b => (a -> b -> a) -> a -> Vector b -> a
VU.foldl' (Int, Int, Int) -> (Bool, Bool) -> (Int, Int, Int)
forall {a} {b} {c}.
(Num a, Num b, Num c) =>
(a, b, c) -> (Bool, Bool) -> (a, b, c)
step (Int
0 :: Int, Int
0 :: Int, Int
0 :: Int) (Vector (Bool, Bool) -> (Int, Int, Int))
-> Vector (Bool, Bool) -> (Int, Int, Int)
forall a b. (a -> b) -> a -> b
$
Vector Bool -> Vector Bool -> Vector (Bool, Bool)
forall a b.
(Unbox a, Unbox b) =>
Vector a -> Vector b -> Vector (a, b)
VU.zip ((Double -> Bool) -> Vector Double -> Vector Bool
forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
VU.map (Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
Prelude.> Double
0) Vector Double
preds) ((Double -> Bool) -> Vector Double -> Vector Bool
forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
VU.map (Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
Prelude.> Double
0) Vector Double
trues)
in Int -> Int -> Int -> Maybe Double
f1FromCounts Int
tp Int
fp Int
fn
where
step :: (a, b, c) -> (Bool, Bool) -> (a, b, c)
step (!a
tp, !b
fp, !c
fn) (!Bool
p, !Bool
t) =
case (Bool
p, Bool
t) of
(Bool
True, Bool
True) -> (a
tp a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, b
fp, c
fn)
(Bool
True, Bool
False) -> (a
tp, b
fp b -> b -> b
forall a. Num a => a -> a -> a
+ b
1, c
fn)
(Bool
False, Bool
True) -> (a
tp, b
fp, c
fn c -> c -> c
forall a. Num a => a -> a -> a
+ c
1)
(Bool
False, Bool
False) -> (a
tp, b
fp, c
fn)
f1FromCounts :: Int -> Int -> Int -> Maybe Double
f1FromCounts :: Int -> Int -> Int -> Maybe Double
f1FromCounts Int
tp Int
fp Int
fn =
let tp' :: Double
tp' = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tp
fp' :: Double
fp' = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fp
fn' :: Double
fn' = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fn
precision :: Double
precision = if Double
tp' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
fp' Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
Prelude.== Double
0 then Double
0 else Double
tp' Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
tp' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
fp')
recall :: Double
recall = if Double
tp' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
fn' Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
Prelude.== Double
0 then Double
0 else Double
tp' Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
tp' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
fn')
in if Double
precision Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
recall Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
Prelude.== Double
0
then Maybe Double
forall a. Maybe a
Nothing
else Double -> Maybe Double
forall a. a -> Maybe a
Just (Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
precision Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
recall Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
precision Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
recall))
fitClassifier ::
T.Text ->
Int ->
Int ->
DataFrame ->
Either String (Expr Int)
fitClassifier :: Text -> Int -> Int -> DataFrame -> Either [Char] (Expr Int)
fitClassifier Text
target Int
d Int
b DataFrame
df =
let
df' :: DataFrame
df' = [Text] -> DataFrame -> DataFrame
exclude [Text
target] DataFrame
df
t :: TypedColumn Double
t = case DataFrame
-> Expr Double -> Either DataFrameException (TypedColumn Double)
forall a.
Columnable a =>
DataFrame -> Expr a -> Either DataFrameException (TypedColumn a)
interpret DataFrame
df (Text -> Expr Double
forall a. Columnable a => Text -> Expr a
Col Text
target) of
Left DataFrameException
e -> DataFrameException -> TypedColumn Double
forall a e. Exception e => e -> a
throw DataFrameException
e
Right TypedColumn Double
v -> TypedColumn Double
v
in
case DataFrame
-> BeamConfig
-> TypedColumn Double
-> [Expr Double]
-> [Expr Bool]
-> [Expr Double]
-> Maybe (Expr Double)
beamSearch
DataFrame
df'
(Int -> Int -> LossFunction -> BeamConfig
BeamConfig Int
d Int
b LossFunction
F1)
TypedColumn Double
t
(DataFrame -> [Expr Double]
percentiles DataFrame
df' [Expr Double] -> [Expr Double] -> [Expr Double]
forall a. [a] -> [a] -> [a]
++ [Double -> Expr Double
forall a. Columnable a => a -> Expr a
lit Double
1, Double -> Expr Double
forall a. Columnable a => a -> Expr a
lit Double
0, Double -> Expr Double
forall a. Columnable a => a -> Expr a
lit (-Double
1)])
[]
[] of
Maybe (Expr Double)
Nothing -> [Char] -> Either [Char] (Expr Int)
forall a b. a -> Either a b
Left [Char]
"No programs found"
Just Expr Double
p -> Expr Int -> Either [Char] (Expr Int)
forall a b. b -> Either a b
Right (Expr Bool -> Expr Int -> Expr Int -> Expr Int
forall a. Columnable a => Expr Bool -> Expr a -> Expr a -> Expr a
ifThenElse (Expr Double
p Expr Double -> Expr Double -> Expr Bool
forall a. (Columnable a, Ord a) => Expr a -> Expr a -> Expr Bool
DataFrame.Functions.> Expr Double
0) Expr Int
1 Expr Int
0)
percentiles :: DataFrame -> [Expr Double]
percentiles :: DataFrame -> [Expr Double]
percentiles DataFrame
df =
let
doubleColumns :: [Vector Double]
doubleColumns = (Text -> Vector Double) -> [Text] -> [Vector Double]
forall a b. (a -> b) -> [a] -> [b]
map ((DataFrameException -> Vector Double)
-> (Vector Double -> Vector Double)
-> Either DataFrameException (Vector Double)
-> Vector Double
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either DataFrameException -> Vector Double
forall a e. Exception e => e -> a
throw Vector Double -> Vector Double
forall a. a -> a
id (Either DataFrameException (Vector Double) -> Vector Double)
-> (Text -> Either DataFrameException (Vector Double))
-> Text
-> Vector Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> DataFrame -> Either DataFrameException (Vector Double)
`columnAsDoubleVector` DataFrame
df)) (DataFrame -> [Text]
D.columnNames DataFrame
df)
in
(Vector Double -> [Expr Double])
-> [Vector Double] -> [Expr Double]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Vector Double
c -> (Int -> Expr Double) -> [Int] -> [Expr Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Expr Double
forall a. Columnable a => a -> Expr a
lit (Double -> Expr Double) -> (Int -> Double) -> Int -> Expr Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Vector Double -> Double
`percentile'` Vector Double
c)) [Int
1, Int
23, Int
75, Int
99]) [Vector Double]
doubleColumns
[Expr Double] -> [Expr Double] -> [Expr Double]
forall a. [a] -> [a] -> [a]
++ (Vector Double -> Expr Double) -> [Vector Double] -> [Expr Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Expr Double
forall a. Columnable a => a -> Expr a
lit (Double -> Expr Double)
-> (Vector Double -> Double) -> Vector Double -> Expr Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Double -> Double
forall a. (Real a, Unbox a) => Vector a -> Double
variance') [Vector Double]
doubleColumns
[Expr Double] -> [Expr Double] -> [Expr Double]
forall a. [a] -> [a] -> [a]
++ (Vector Double -> Expr Double) -> [Vector Double] -> [Expr Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Expr Double
forall a. Columnable a => a -> Expr a
lit (Double -> Expr Double)
-> (Vector Double -> Double) -> Vector Double -> Expr Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double)
-> (Vector Double -> Double) -> Vector Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Double -> Double
forall a. (Real a, Unbox a) => Vector a -> Double
variance') [Vector Double]
doubleColumns
fitRegression ::
T.Text ->
Int ->
Int ->
DataFrame ->
Either String (Expr Double)
fitRegression :: Text -> Int -> Int -> DataFrame -> Either [Char] (Expr Double)
fitRegression Text
target Int
d Int
b DataFrame
df =
let
df' :: DataFrame
df' = [Text] -> DataFrame -> DataFrame
exclude [Text
target] DataFrame
df
targetMean :: Double
targetMean = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0 (Maybe Double -> Double) -> Maybe Double -> Double
forall a b. (a -> b) -> a -> b
$ Text -> DataFrame -> Maybe Double
Stats.mean Text
target DataFrame
df
t :: TypedColumn Double
t = case DataFrame
-> Expr Double -> Either DataFrameException (TypedColumn Double)
forall a.
Columnable a =>
DataFrame -> Expr a -> Either DataFrameException (TypedColumn a)
interpret DataFrame
df (Text -> Expr Double
forall a. Columnable a => Text -> Expr a
Col Text
target) of
Left DataFrameException
e -> DataFrameException -> TypedColumn Double
forall a e. Exception e => e -> a
throw DataFrameException
e
Right TypedColumn Double
v -> TypedColumn Double
v
in
case DataFrame
-> BeamConfig
-> TypedColumn Double
-> [Expr Double]
-> [Expr Bool]
-> [Expr Double]
-> Maybe (Expr Double)
beamSearch
DataFrame
df'
( Int -> Int -> LossFunction -> BeamConfig
BeamConfig
Int
d
Int
b
LossFunction
MutualInformation
)
TypedColumn Double
t
(DataFrame -> [Expr Double]
percentiles DataFrame
df')
[]
[] of
Maybe (Expr Double)
Nothing -> [Char] -> Either [Char] (Expr Double)
forall a b. a -> Either a b
Left [Char]
"No programs found"
Just Expr Double
p ->
[Char]
-> Either [Char] (Expr Double) -> Either [Char] (Expr Double)
forall a. [Char] -> a -> a
trace (Expr Double -> [Char]
forall a. Show a => a -> [Char]
show Expr Double
p) (Either [Char] (Expr Double) -> Either [Char] (Expr Double))
-> Either [Char] (Expr Double) -> Either [Char] (Expr Double)
forall a b. (a -> b) -> a -> b
$
let
in case DataFrame
-> BeamConfig
-> TypedColumn Double
-> [Expr Double]
-> [Expr Bool]
-> [Expr Double]
-> Maybe (Expr Double)
beamSearch
( Text -> Expr Double -> DataFrame -> DataFrame
forall a. Columnable a => Text -> Expr a -> DataFrame -> DataFrame
D.derive Text
"_generated_regression_feature_" Expr Double
p DataFrame
df
DataFrame -> (DataFrame -> DataFrame) -> DataFrame
forall a b. a -> (a -> b) -> b
& [Text] -> DataFrame -> DataFrame
select [Text
"_generated_regression_feature_"]
)
(Int -> Int -> LossFunction -> BeamConfig
BeamConfig Int
d Int
b LossFunction
MeanSquaredError)
TypedColumn Double
t
(DataFrame -> [Expr Double]
percentiles DataFrame
df' [Expr Double] -> [Expr Double] -> [Expr Double]
forall a. [a] -> [a] -> [a]
++ [Double -> Expr Double
forall a. Columnable a => a -> Expr a
lit Double
targetMean, Double -> Expr Double
forall a. Columnable a => a -> Expr a
lit Double
10])
[]
[Text -> Expr Double
forall a. Columnable a => Text -> Expr a
Col Text
"_generated_regression_feature_"] of
Maybe (Expr Double)
Nothing -> [Char] -> Either [Char] (Expr Double)
forall a b. a -> Either a b
Left [Char]
"Could not find coefficients"
Just Expr Double
p' -> Expr Double -> Either [Char] (Expr Double)
forall a b. b -> Either a b
Right (Expr Double -> Expr Double -> Expr Double -> Expr Double
forall a b c.
(Columnable a, Columnable b, Columnable c) =>
Expr a -> Expr b -> Expr c -> Expr c
replaceExpr Expr Double
p (forall a. Columnable a => Text -> Expr a
Col @Double Text
"_generated_regression_feature_") Expr Double
p')
data LossFunction
= PearsonCorrelation
| MutualInformation
| MeanSquaredError
| F1
getLossFunction ::
LossFunction -> (VU.Vector Double -> VU.Vector Double -> Maybe Double)
getLossFunction :: LossFunction -> Vector Double -> Vector Double -> Maybe Double
getLossFunction LossFunction
f = case LossFunction
f of
LossFunction
MutualInformation ->
( \Vector Double
l Vector Double
r ->
Int -> Vector Double -> Vector Double -> Maybe Double
mutualInformationBinned
(Int -> Int -> Int
forall a. Ord a => a -> a -> a
Prelude.max Int
10 (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> Double
forall a. Floating a => a -> a
sqrt (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Double -> Int
forall a. Unbox a => Vector a -> Int
VU.length Vector Double
l)))))
Vector Double
l
Vector Double
r
)
LossFunction
PearsonCorrelation -> (\Vector Double
l Vector Double
r -> (Double -> Integer -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
2) (Double -> Double) -> Maybe Double -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Double -> Vector Double -> Maybe Double
forall a b.
(Real a, Unbox a, Real b, Unbox b) =>
Vector a -> Vector b -> Maybe Double
correlation' Vector Double
l Vector Double
r)
LossFunction
MeanSquaredError -> (\Vector Double
l Vector Double
r -> (Double -> Double) -> Maybe Double -> Maybe Double
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Double
forall a. Num a => a -> a
negate (Vector Double -> Vector Double -> Maybe Double
meanSquaredError Vector Double
l Vector Double
r))
LossFunction
F1 -> Vector Double -> Vector Double -> Maybe Double
f1FromBinary
data BeamConfig = BeamConfig
{ BeamConfig -> Int
searchDepth :: Int
, BeamConfig -> Int
beamLength :: Int
, BeamConfig -> LossFunction
lossFunction :: LossFunction
}
defaultBeamConfig :: BeamConfig
defaultBeamConfig :: BeamConfig
defaultBeamConfig = Int -> Int -> LossFunction -> BeamConfig
BeamConfig Int
2 Int
100 LossFunction
PearsonCorrelation
beamSearch ::
DataFrame ->
BeamConfig ->
TypedColumn Double ->
[Expr Double] ->
[Expr Bool] ->
[Expr Double] ->
Maybe (Expr Double)
beamSearch :: DataFrame
-> BeamConfig
-> TypedColumn Double
-> [Expr Double]
-> [Expr Bool]
-> [Expr Double]
-> Maybe (Expr Double)
beamSearch DataFrame
df BeamConfig
cfg TypedColumn Double
outputs [Expr Double]
constants [Expr Bool]
conds [Expr Double]
programs
| BeamConfig -> Int
searchDepth BeamConfig
cfg Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
Prelude.== Int
0 = case [Expr Double]
ps of
[] -> Maybe (Expr Double)
forall a. Maybe a
Nothing
(Expr Double
x : [Expr Double]
_) -> Expr Double -> Maybe (Expr Double)
forall a. a -> Maybe a
Just Expr Double
x
| Bool
otherwise =
DataFrame
-> BeamConfig
-> TypedColumn Double
-> [Expr Double]
-> [Expr Bool]
-> [Expr Double]
-> Maybe (Expr Double)
beamSearch
DataFrame
df
(BeamConfig
cfg{searchDepth = searchDepth cfg - 1})
TypedColumn Double
outputs
[Expr Double]
constants
[Expr Bool]
conditions
([Expr Bool]
-> [Expr Double] -> [Expr Double] -> [Expr Double] -> [Expr Double]
generatePrograms [Expr Bool]
conditions [Expr Double]
vars [Expr Double]
constants [Expr Double]
ps)
where
vars :: [Expr Double]
vars = (Text -> Expr Double) -> [Text] -> [Expr Double]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Expr Double
forall a. Columnable a => Text -> Expr a
col [Text]
names
conditions :: [Expr Bool]
conditions = TypedColumn Double
-> [Expr Bool] -> [Expr Double] -> DataFrame -> [Expr Bool]
generateConditions TypedColumn Double
outputs [Expr Bool]
conds ([Expr Double]
vars [Expr Double] -> [Expr Double] -> [Expr Double]
forall a. [a] -> [a] -> [a]
++ [Expr Double]
constants [Expr Double] -> [Expr Double] -> [Expr Double]
forall a. [a] -> [a] -> [a]
++ [Expr Double]
ps) DataFrame
df
ps :: [Expr Double]
ps = DataFrame
-> TypedColumn Double
-> BeamConfig
-> [(Expr Double, TypedColumn Double)]
-> [Expr Double]
forall a.
DataFrame
-> TypedColumn Double
-> BeamConfig
-> [(Expr Double, TypedColumn a)]
-> [Expr Double]
pickTopN DataFrame
df TypedColumn Double
outputs BeamConfig
cfg ([(Expr Double, TypedColumn Double)] -> [Expr Double])
-> [(Expr Double, TypedColumn Double)] -> [Expr Double]
forall a b. (a -> b) -> a -> b
$ DataFrame -> [Expr Double] -> [(Expr Double, TypedColumn Double)]
forall a.
Columnable a =>
DataFrame -> [Expr a] -> [(Expr a, TypedColumn a)]
deduplicate DataFrame
df [Expr Double]
programs
names :: [Text]
names = (((Text, Int) -> Text) -> [(Text, Int)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Int) -> Text
forall a b. (a, b) -> a
fst ([(Text, Int)] -> [Text])
-> (DataFrame -> [(Text, Int)]) -> DataFrame -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Int) -> (Text, Int) -> Ordering)
-> [(Text, Int)] -> [(Text, Int)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> ((Text, Int) -> Int) -> (Text, Int) -> (Text, Int) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Text, Int) -> Int
forall a b. (a, b) -> b
snd) ([(Text, Int)] -> [(Text, Int)])
-> (DataFrame -> [(Text, Int)]) -> DataFrame -> [(Text, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Int -> [(Text, Int)]
forall k a. Map k a -> [(k, a)]
M.toList (Map Text Int -> [(Text, Int)])
-> (DataFrame -> Map Text Int) -> DataFrame -> [(Text, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataFrame -> Map Text Int
columnIndices) DataFrame
df
pickTopN ::
DataFrame ->
TypedColumn Double ->
BeamConfig ->
[(Expr Double, TypedColumn a)] ->
[Expr Double]
pickTopN :: forall a.
DataFrame
-> TypedColumn Double
-> BeamConfig
-> [(Expr Double, TypedColumn a)]
-> [Expr Double]
pickTopN DataFrame
_ TypedColumn Double
_ BeamConfig
_ [] = []
pickTopN DataFrame
df (TColumn Column
col) BeamConfig
cfg [(Expr Double, TypedColumn a)]
ps =
let
l :: Vector Double
l = case forall a (v :: * -> *).
(Vector v a, Columnable a) =>
Column -> Either DataFrameException (v a)
toVector @Double @VU.Vector Column
col of
Left DataFrameException
e -> DataFrameException -> Vector Double
forall a e. Exception e => e -> a
throw DataFrameException
e
Right Vector Double
v -> Vector Double
v
ordered :: [Expr Double]
ordered =
Int -> [Expr Double] -> [Expr Double]
forall a. Int -> [a] -> [a]
Prelude.take
(BeamConfig -> Int
beamLength BeamConfig
cfg)
( ((Expr Double, Maybe Double) -> Expr Double)
-> [(Expr Double, Maybe Double)] -> [Expr Double]
forall a b. (a -> b) -> [a] -> [b]
map (Expr Double, Maybe Double) -> Expr Double
forall a b. (a, b) -> a
fst ([(Expr Double, Maybe Double)] -> [Expr Double])
-> [(Expr Double, Maybe Double)] -> [Expr Double]
forall a b. (a -> b) -> a -> b
$
((Expr Double, Maybe Double)
-> (Expr Double, Maybe Double) -> Ordering)
-> [(Expr Double, Maybe Double)] -> [(Expr Double, Maybe Double)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy
( \(Expr Double
_, Maybe Double
c2) (Expr Double
_, Maybe Double
c1) ->
if Bool -> (Double -> Bool) -> Maybe Double -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Maybe Double
c1
Bool -> Bool -> Bool
|| Bool -> (Double -> Bool) -> Maybe Double -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Maybe Double
c2
Bool -> Bool -> Bool
|| Bool -> (Double -> Bool) -> Maybe Double -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Maybe Double
c1
Bool -> Bool -> Bool
|| Bool -> (Double -> Bool) -> Maybe Double -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Maybe Double
c2
then Ordering
LT
else Maybe Double -> Maybe Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Maybe Double
c1 Maybe Double
c2
)
( ((Expr Double, TypedColumn a) -> (Expr Double, Maybe Double))
-> [(Expr Double, TypedColumn a)] -> [(Expr Double, Maybe Double)]
forall a b. (a -> b) -> [a] -> [b]
map
(\(Expr Double
e, TypedColumn a
res) -> (Expr Double
e, LossFunction -> Vector Double -> Vector Double -> Maybe Double
getLossFunction (BeamConfig -> LossFunction
lossFunction BeamConfig
cfg) Vector Double
l (TypedColumn a -> Vector Double
forall {w :: * -> *} {a}.
Vector w Double =>
TypedColumn a -> w Double
asDoubleVector TypedColumn a
res)))
[(Expr Double, TypedColumn a)]
ps
)
)
asDoubleVector :: TypedColumn a -> w Double
asDoubleVector TypedColumn a
c =
let
(TColumn Column
col') = TypedColumn a
c
in
case forall a (v :: * -> *).
(Vector v a, Columnable a) =>
Column -> Either DataFrameException (v a)
toVector @Double @VU.Vector Column
col' of
Left DataFrameException
e -> DataFrameException -> w Double
forall a e. Exception e => e -> a
throw DataFrameException
e
Right Vector Double
v -> Vector Double -> w Double
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
VU.convert Vector Double
v
interpretDoubleVector :: Expr Double -> Vector Double
interpretDoubleVector Expr Double
e =
let
(TColumn Column
col') = case DataFrame
-> Expr Double -> Either DataFrameException (TypedColumn Double)
forall a.
Columnable a =>
DataFrame -> Expr a -> Either DataFrameException (TypedColumn a)
interpret DataFrame
df Expr Double
e of
Left DataFrameException
e -> DataFrameException -> TypedColumn Double
forall a e. Exception e => e -> a
throw DataFrameException
e
Right TypedColumn Double
v -> TypedColumn Double
v
in
case forall a (v :: * -> *).
(Vector v a, Columnable a) =>
Column -> Either DataFrameException (v a)
toVector @Double @VU.Vector Column
col' of
Left DataFrameException
e -> DataFrameException -> Vector Double
forall a e. Exception e => e -> a
throw DataFrameException
e
Right Vector Double
v -> Vector Double -> Vector Double
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
VU.convert Vector Double
v
in
[Char] -> [Expr Double] -> [Expr Double]
forall a. [Char] -> a -> a
trace
( [Char]
"Best loss: "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Maybe (Maybe Double) -> [Char]
forall a. Show a => a -> [Char]
show
( LossFunction -> Vector Double -> Vector Double -> Maybe Double
getLossFunction (BeamConfig -> LossFunction
lossFunction BeamConfig
cfg) Vector Double
l (Vector Double -> Maybe Double)
-> (Expr Double -> Vector Double) -> Expr Double -> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr Double -> Vector Double
interpretDoubleVector
(Expr Double -> Maybe Double)
-> Maybe (Expr Double) -> Maybe (Maybe Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expr Double] -> Maybe (Expr Double)
forall a. [a] -> Maybe a
listToMaybe [Expr Double]
ordered
)
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (if [Expr Double] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Expr Double]
ordered then [Char]
"empty" else Maybe (Expr Double) -> [Char]
forall a. Show a => a -> [Char]
show ([Expr Double] -> Maybe (Expr Double)
forall a. [a] -> Maybe a
listToMaybe [Expr Double]
ordered))
)
[Expr Double]
ordered
pickTopNBool ::
DataFrame ->
TypedColumn Double ->
[(Expr Bool, TypedColumn Bool)] ->
[Expr Bool]
pickTopNBool :: DataFrame
-> TypedColumn Double
-> [(Expr Bool, TypedColumn Bool)]
-> [Expr Bool]
pickTopNBool DataFrame
_ TypedColumn Double
_ [] = []
pickTopNBool DataFrame
df (TColumn Column
col) [(Expr Bool, TypedColumn Bool)]
ps =
let
l :: Vector Double
l = case forall a (v :: * -> *).
(Vector v a, Columnable a) =>
Column -> Either DataFrameException (v a)
toVector @Double @VU.Vector Column
col of
Left DataFrameException
e -> DataFrameException -> Vector Double
forall a e. Exception e => e -> a
throw DataFrameException
e
Right Vector Double
v -> Vector Double
v
ordered :: [Expr Bool]
ordered =
Int -> [Expr Bool] -> [Expr Bool]
forall a. Int -> [a] -> [a]
Prelude.take
Int
100
( ((Expr Bool, Maybe Double) -> Expr Bool)
-> [(Expr Bool, Maybe Double)] -> [Expr Bool]
forall a b. (a -> b) -> [a] -> [b]
map (Expr Bool, Maybe Double) -> Expr Bool
forall a b. (a, b) -> a
fst ([(Expr Bool, Maybe Double)] -> [Expr Bool])
-> [(Expr Bool, Maybe Double)] -> [Expr Bool]
forall a b. (a -> b) -> a -> b
$
((Expr Bool, Maybe Double)
-> (Expr Bool, Maybe Double) -> Ordering)
-> [(Expr Bool, Maybe Double)] -> [(Expr Bool, Maybe Double)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy
( \(Expr Bool
_, Maybe Double
c2) (Expr Bool
_, Maybe Double
c1) ->
if Bool -> (Double -> Bool) -> Maybe Double -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Maybe Double
c1
Bool -> Bool -> Bool
|| Bool -> (Double -> Bool) -> Maybe Double -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Maybe Double
c2
Bool -> Bool -> Bool
|| Bool -> (Double -> Bool) -> Maybe Double -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Maybe Double
c1
Bool -> Bool -> Bool
|| Bool -> (Double -> Bool) -> Maybe Double -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Maybe Double
c2
then Ordering
LT
else Maybe Double -> Maybe Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Maybe Double
c1 Maybe Double
c2
)
( ((Expr Bool, TypedColumn Bool) -> (Expr Bool, Maybe Double))
-> [(Expr Bool, TypedColumn Bool)] -> [(Expr Bool, Maybe Double)]
forall a b. (a -> b) -> [a] -> [b]
map
(\(Expr Bool
e, TypedColumn Bool
res) -> (Expr Bool
e, LossFunction -> Vector Double -> Vector Double -> Maybe Double
getLossFunction LossFunction
MutualInformation Vector Double
l (TypedColumn Bool -> Vector Double
forall {a}. TypedColumn a -> Vector Double
asDoubleVector TypedColumn Bool
res)))
[(Expr Bool, TypedColumn Bool)]
ps
)
)
asDoubleVector :: TypedColumn a -> Vector Double
asDoubleVector TypedColumn a
c =
let
(TColumn Column
col') = TypedColumn a
c
in
case forall a (v :: * -> *).
(Vector v a, Columnable a) =>
Column -> Either DataFrameException (v a)
toVector @Bool @VU.Vector Column
col' of
Left DataFrameException
e -> DataFrameException -> Vector Double
forall a e. Exception e => e -> a
throw DataFrameException
e
Right Vector Bool
v -> (Bool -> Double) -> Vector Bool -> Vector Double
forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
VU.map (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Double (Int -> Double) -> (Bool -> Int) -> Bool -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Vector Bool
v
in
[Expr Bool]
ordered
satisfiesExamples :: DataFrame -> TypedColumn Double -> Expr Double -> Bool
satisfiesExamples :: DataFrame -> TypedColumn Double -> Expr Double -> Bool
satisfiesExamples DataFrame
df TypedColumn Double
col Expr Double
expr =
let
result :: TypedColumn Double
result = case DataFrame
-> Expr Double -> Either DataFrameException (TypedColumn Double)
forall a.
Columnable a =>
DataFrame -> Expr a -> Either DataFrameException (TypedColumn a)
interpret DataFrame
df Expr Double
expr of
Left DataFrameException
e -> DataFrameException -> TypedColumn Double
forall a e. Exception e => e -> a
throw DataFrameException
e
Right TypedColumn Double
v -> TypedColumn Double
v
in
TypedColumn Double
result TypedColumn Double -> TypedColumn Double -> Bool
forall a. Eq a => a -> a -> Bool
Prelude.== TypedColumn Double
col
isReservedId :: T.Text -> Bool
isReservedId :: Text -> Bool
isReservedId Text
t = case Text
t of
Text
"case" -> Bool
True
Text
"class" -> Bool
True
Text
"data" -> Bool
True
Text
"default" -> Bool
True
Text
"deriving" -> Bool
True
Text
"do" -> Bool
True
Text
"else" -> Bool
True
Text
"foreign" -> Bool
True
Text
"if" -> Bool
True
Text
"import" -> Bool
True
Text
"in" -> Bool
True
Text
"infix" -> Bool
True
Text
"infixl" -> Bool
True
Text
"infixr" -> Bool
True
Text
"instance" -> Bool
True
Text
"let" -> Bool
True
Text
"module" -> Bool
True
Text
"newtype" -> Bool
True
Text
"of" -> Bool
True
Text
"then" -> Bool
True
Text
"type" -> Bool
True
Text
"where" -> Bool
True
Text
_ -> Bool
False
isVarId :: T.Text -> Bool
isVarId :: Text -> Bool
isVarId Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
Just (Char
c, Text
_) -> Char -> Bool
Char.isLower Char
c Bool -> Bool -> Bool
&& Char -> Bool
Char.isAlpha Char
c
Maybe (Char, Text)
Nothing -> Bool
False
isHaskellIdentifier :: T.Text -> Bool
isHaskellIdentifier :: Text -> Bool
isHaskellIdentifier Text
t = Bool -> Bool
Prelude.not (Text -> Bool
isVarId Text
t) Bool -> Bool -> Bool
|| Text -> Bool
isReservedId Text
t
sanitize :: T.Text -> T.Text
sanitize :: Text -> Text
sanitize Text
t
| Bool
isValid = Text
t
| Text -> Bool
isHaskellIdentifier Text
t' = Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_"
| Bool
otherwise = Text
t'
where
isValid :: Bool
isValid =
Bool -> Bool
Prelude.not (Text -> Bool
isHaskellIdentifier Text
t)
Bool -> Bool -> Bool
&& Text -> Bool
isVarId Text
t
Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
Char.isAlphaNum Text
t
t' :: Text
t' = (Char -> Char) -> Text -> Text
T.map Char -> Char
replaceInvalidCharacters (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.filter (Bool -> Bool
Prelude.not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
parentheses) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
t
replaceInvalidCharacters :: Char -> Char
replaceInvalidCharacters Char
c
| Char -> Bool
Char.isUpper Char
c = Char -> Char
Char.toLower Char
c
| Char -> Bool
Char.isSpace Char
c = Char
'_'
| Char -> Bool
Char.isPunctuation Char
c = Char
'_'
| Char -> Bool
Char.isSymbol Char
c = Char
'_'
| Char -> Bool
Char.isAlphaNum Char
c = Char
c
| Bool
otherwise = Char
'_'
parentheses :: Char -> Bool
parentheses Char
c = case Char
c of
Char
'(' -> Bool
True
Char
')' -> Bool
True
Char
'{' -> Bool
True
Char
'}' -> Bool
True
Char
'[' -> Bool
True
Char
']' -> Bool
True
Char
_ -> Bool
False
typeFromString :: [String] -> Q Type
typeFromString :: [[Char]] -> Q Type
typeFromString [] = [Char] -> Q Type
forall a. [Char] -> Q a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"No type specified"
typeFromString [[Char]
t] = do
Maybe Name
maybeType <- [Char] -> Q (Maybe Name)
lookupTypeName [Char]
t
case Maybe Name
maybeType of
Just Name
name -> Type -> Q Type
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Type
ConT Name
name)
Maybe Name
Nothing -> [Char] -> Q Type
forall a. [Char] -> Q a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Q Type) -> [Char] -> Q Type
forall a b. (a -> b) -> a -> b
$ [Char]
"Unsupported type: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
t
typeFromString [[Char]
tycon, [Char]
t1] = do
Type
outer <- [[Char]] -> Q Type
typeFromString [[Char]
tycon]
Type
inner <- [[Char]] -> Q Type
typeFromString [[Char]
t1]
Type -> Q Type
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Type -> Type
AppT Type
outer Type
inner)
typeFromString [[Char]
tycon, [Char]
t1, [Char]
t2] = do
Type
outer <- [[Char]] -> Q Type
typeFromString [[Char]
tycon]
Type
lhs <- [[Char]] -> Q Type
typeFromString [[Char]
t1]
Type
rhs <- [[Char]] -> Q Type
typeFromString [[Char]
t2]
Type -> Q Type
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Type -> Type
AppT (Type -> Type -> Type
AppT Type
outer Type
lhs) Type
rhs)
typeFromString [[Char]]
s = [Char] -> Q Type
forall a. [Char] -> Q a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Q Type) -> [Char] -> Q Type
forall a b. (a -> b) -> a -> b
$ [Char]
"Unsupported type: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unwords [[Char]]
s
declareColumns :: DataFrame -> DecsQ
declareColumns :: DataFrame -> DecsQ
declareColumns DataFrame
df =
let
names :: [Text]
names = (((Text, Int) -> Text) -> [(Text, Int)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Int) -> Text
forall a b. (a, b) -> a
fst ([(Text, Int)] -> [Text])
-> (DataFrame -> [(Text, Int)]) -> DataFrame -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Int) -> (Text, Int) -> Ordering)
-> [(Text, Int)] -> [(Text, Int)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> ((Text, Int) -> Int) -> (Text, Int) -> (Text, Int) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Text, Int) -> Int
forall a b. (a, b) -> b
snd) ([(Text, Int)] -> [(Text, Int)])
-> (DataFrame -> [(Text, Int)]) -> DataFrame -> [(Text, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Int -> [(Text, Int)]
forall k a. Map k a -> [(k, a)]
M.toList (Map Text Int -> [(Text, Int)])
-> (DataFrame -> Map Text Int) -> DataFrame -> [(Text, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataFrame -> Map Text Int
columnIndices) DataFrame
df
types :: [[Char]]
types = (Text -> [Char]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Column -> [Char]
columnTypeString (Column -> [Char]) -> (Text -> Column) -> Text -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> DataFrame -> Column
`unsafeGetColumn` DataFrame
df)) [Text]
names
specs :: [(Text, Text, [Char])]
specs = (Text -> [Char] -> (Text, Text, [Char]))
-> [Text] -> [[Char]] -> [(Text, Text, [Char])]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Text
name [Char]
type_ -> (Text
name, Text -> Text
sanitize Text
name, [Char]
type_)) [Text]
names [[Char]]
types
in
([[Dec]] -> [Dec]) -> Q [[Dec]] -> DecsQ
forall a b. (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Dec]] -> [Dec]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Q [[Dec]] -> DecsQ) -> Q [[Dec]] -> DecsQ
forall a b. (a -> b) -> a -> b
$ [(Text, Text, [Char])]
-> ((Text, Text, [Char]) -> DecsQ) -> Q [[Dec]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Text, Text, [Char])]
specs (((Text, Text, [Char]) -> DecsQ) -> Q [[Dec]])
-> ((Text, Text, [Char]) -> DecsQ) -> Q [[Dec]]
forall a b. (a -> b) -> a -> b
$ \(Text
raw, Text
nm, [Char]
tyStr) -> do
Type
ty <- [[Char]] -> Q Type
typeFromString ([Char] -> [[Char]]
words [Char]
tyStr)
Text -> Q () -> Q ()
forall a b. Show a => a -> b -> b
traceShow (Text
nm Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" :: Expr " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack [Char]
tyStr) (() -> Q ()
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
let n :: Name
n = [Char] -> Name
mkName (Text -> [Char]
T.unpack Text
nm)
Dec
sig <- Name -> Q Type -> Q Dec
forall (m :: * -> *). Quote m => Name -> m Type -> m Dec
sigD Name
n [t|Expr $(Type -> Q Type
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
ty)|]
Dec
val <- Q Pat -> Q Body -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Pat -> m Body -> [m Dec] -> m Dec
valD (Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
n) (Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB [|col $(Text -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Text -> m Exp
TH.lift Text
raw)|]) []
[Dec] -> DecsQ
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Dec
sig, Dec
val]