diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,10 @@ # Revision history for dataframe +## 0.3.4.1 +* Faster sum operation (now does a reduction instead of collecting the vector and aggregating) +* Update the fixity of comparison operations. Before `(x + y) .<= 10`. Now: `x + y ,<= 10`. +* Revert sort for groupby back to mergesort. + ## 0.3.4.0 * Fix right join - previously erased some values in the key. * Change sort API so we can sort on different rows. diff --git a/dataframe.cabal b/dataframe.cabal --- a/dataframe.cabal +++ b/dataframe.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: dataframe -version: 0.3.4.0 +version: 0.3.4.1 synopsis: A fast, safe, and intuitive DataFrame library. @@ -44,6 +44,7 @@ exposed-modules: DataFrame, DataFrame.Lazy, DataFrame.Functions, + DataFrame.Synthesis, DataFrame.Display.Web.Plot, DataFrame.Internal.Types, DataFrame.Internal.Expression, diff --git a/src/DataFrame/Functions.hs b/src/DataFrame/Functions.hs --- a/src/DataFrame/Functions.hs +++ b/src/DataFrame/Functions.hs @@ -17,49 +17,37 @@ import DataFrame.Internal.Column import DataFrame.Internal.DataFrame ( DataFrame (..), - columnAsDoubleVector, unsafeGetColumn, ) import DataFrame.Internal.Expression ( Expr (..), NamedExpr, 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 Control.Monad.IO.Class import qualified Data.Char as Char -import Data.Containers.ListUtils import Data.Function import Data.Functor import qualified Data.List as L import qualified Data.Map as M import Data.Maybe (catMaybes, fromMaybe, isJust, listToMaybe) -import qualified Data.Set as S import qualified Data.Text as T -import qualified Data.Text.IO as T import Data.Time -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) import Language.Haskell.TH import qualified Language.Haskell.TH.Syntax as TH import Text.Regex.TDFA -import Type.Reflection (typeRep) import Prelude hiding (maximum, minimum) import Prelude as P +infix 4 .==, .<, .<=, .>=, .> +infixr 3 .&& +infixr 2 .|| + name :: (Show a) => Expr a -> T.Text name (Col n) = n name other = @@ -167,8 +155,8 @@ maximum :: (Columnable a, Ord a) => Expr a -> Expr a maximum expr = AggReduce expr "maximum" Prelude.max -sum :: forall a. (Columnable a, Num a, VU.Unbox a) => Expr a -> Expr a -sum expr = AggNumericVector expr "sum" VG.sum +sum :: forall a. (Columnable a, Num a) => Expr a -> Expr a +sum expr = AggReduce expr "sum" (+) sumMaybe :: forall a. (Columnable a, Num a) => Expr (Maybe a) -> Expr a sumMaybe expr = AggVector expr "sumMaybe" (P.sum . catMaybes . V.toList) @@ -185,6 +173,9 @@ median :: (Columnable a, Real a, VU.Unbox a) => Expr a -> Expr Double median expr = AggNumericVector expr "median" median' +medianMaybe :: (Columnable a, Real a) => Expr (Maybe a) -> Expr Double +medianMaybe expr = AggVector expr "meanMaybe" (median' . optionalToDoubleVector) + optionalToDoubleVector :: (Real a) => V.Vector (Maybe a) -> VU.Vector Double optionalToDoubleVector = VU.fromList @@ -276,447 +267,6 @@ (a -> m b) -> Expr (m a) -> Expr (m b) bind f = lift (>>= f) -generateConditions :: - TypedColumn Double -> [Expr Bool] -> [Expr Double] -> DataFrame -> [Expr Bool] -generateConditions labels conds ps df = - let - newConds = - [ p .<= q - | p <- ps - , q <- ps - , p /= q - ] - ++ [ DataFrame.Functions.not p - | p <- conds - ] - expandedConds = - conds - ++ newConds - ++ [p .&& q | p <- newConds, q <- conds, p /= q] - ++ [p .|| q | p <- newConds, q <- conds, p /= q] - in - pickTopNBool df labels (deduplicate df expandedConds) - -generatePrograms :: - Bool -> - [Expr Bool] -> - [Expr Double] -> - [Expr Double] -> - [Expr Double] -> - [Expr Double] -generatePrograms _ _ vars' constants [] = vars' ++ constants -generatePrograms includeConds conds vars constants ps = - let - existingPrograms = ps ++ vars ++ constants - in - existingPrograms - ++ [ transform p - | p <- ps ++ vars - , transform <- - [ sqrt - , abs - , log . (+ Lit 1) - , exp - , sin - , cos - , relu - , signum - ] - ] - ++ [ pow i p - | p <- existingPrograms - , i <- [2 .. 6] - ] - ++ [ p + q - | (i, p) <- zip [0 ..] existingPrograms - , (j, q) <- zip [0 ..] existingPrograms - , Prelude.not (isLiteral p && isLiteral q) - , i >= j - ] - ++ ( if includeConds - then - [ DataFrame.Functions.min p q - | (i, p) <- zip [0 ..] existingPrograms - , (j, q) <- zip [0 ..] existingPrograms - , Prelude.not (isLiteral p && isLiteral q) - , p /= q - , i > j - ] - ++ [ DataFrame.Functions.max p q - | (i, p) <- zip [0 ..] existingPrograms - , (j, q) <- zip [0 ..] existingPrograms - , Prelude.not (isLiteral p && isLiteral q) - , p /= q - , i > j - ] - ++ [ ifThenElse cond r s - | cond <- conds - , r <- existingPrograms - , s <- existingPrograms - , r /= s - ] - else [] - ) - ++ [ p - q - | (i, p) <- zip [0 ..] existingPrograms - , (j, q) <- zip [0 ..] existingPrograms - , Prelude.not (isLiteral p && isLiteral q) - , i /= j - ] - ++ [ p * q - | (i, p) <- zip [0 ..] existingPrograms - , (j, q) <- zip [0 ..] existingPrograms - , Prelude.not (isLiteral p && isLiteral q) - , i >= j - ] - ++ [ p / q - | p <- existingPrograms - , q <- existingPrograms - , Prelude.not (isLiteral p && isLiteral q) - , p /= q - ] - -isLiteral :: Expr a -> Bool -isLiteral (Lit _) = True -isLiteral _ = False - -deduplicate :: - forall a. - (Columnable a) => - DataFrame -> - [Expr a] -> - [(Expr a, TypedColumn a)] -deduplicate df = go S.empty . nubOrd . L.sortBy (\e1 e2 -> compare (eSize e1) (eSize e2)) - where - go _ [] = [] - go seen (x : xs) - | hasInvalid = go seen xs - | S.member res seen = go seen xs - | otherwise = (x, res) : go (S.insert res seen) xs - where - res = case interpret @a df x of - Left e -> throw e - Right v -> v - hasInvalid = case res of - (TColumn (UnboxedColumn (col :: VU.Vector b))) -> case testEquality (typeRep @Double) (typeRep @b) of - Just Refl -> VU.any (\n -> isNaN n || isInfinite n) col - Nothing -> False - _ -> False - --- | Checks if two programs generate the same outputs given all the same inputs. -equivalent :: DataFrame -> Expr Double -> Expr Double -> Bool -equivalent df p1 p2 = case (==) <$> interpret df p1 <*> interpret df p2 of - Left e -> throw e - Right v -> v - -synthesizeFeatureExpr :: - -- | Target expression - T.Text -> - BeamConfig -> - DataFrame -> - Either String (Expr Double) -synthesizeFeatureExpr target cfg df = - let - df' = exclude [target] df - t = case interpret df (Col target) of - Left e -> throw e - Right v -> v - in - case beamSearch - df' - cfg - t - (percentiles df') - [] - [] of - Nothing -> Left "No programs found" - Just p -> Right p - -f1FromBinary :: VU.Vector Double -> VU.Vector Double -> Maybe Double -f1FromBinary trues preds = - let (!tp, !fp, !fn) = - VU.foldl' step (0 :: Int, 0 :: Int, 0 :: Int) $ - VU.zip (VU.map (> 0) preds) (VU.map (> 0) trues) - in f1FromCounts tp fp fn - where - step (!tp, !fp, !fn) (!p, !t) = - case (p, t) of - (True, True) -> (tp + 1, fp, fn) - (True, False) -> (tp, fp + 1, fn) - (False, True) -> (tp, fp, fn + 1) - (False, False) -> (tp, fp, fn) - -f1FromCounts :: Int -> Int -> Int -> Maybe Double -f1FromCounts tp fp fn = - let tp' = fromIntegral tp - fp' = fromIntegral fp - fn' = fromIntegral fn - precision = if tp' + fp' == 0 then 0 else tp' / (tp' + fp') - recall = if tp' + fn' == 0 then 0 else tp' / (tp' + fn') - in if precision + recall == 0 - then Nothing - else Just (2 * precision * recall / (precision + recall)) - -fitClassifier :: - -- | Target expression - T.Text -> - -- | Depth of search (Roughly, how many terms in the final expression) - Int -> - -- | Beam size - the number of candidate expressions to consider at a time. - Int -> - DataFrame -> - Either String (Expr Int) -fitClassifier target d b df = - let - df' = exclude [target] df - t = case interpret df (Col target) of - Left e -> throw e - Right v -> v - in - case beamSearch - df' - (BeamConfig d b F1 True) - t - (percentiles df' ++ [lit 1, lit 0, lit (-1)]) - [] - [] of - Nothing -> Left "No programs found" - Just p -> Right (ifThenElse (p .> 0) 1 0) - -percentiles :: DataFrame -> [Expr Double] -percentiles df = - let - doubleColumns = map (either throw id . (`columnAsDoubleVector` df)) (D.columnNames df) - in - concatMap - (\c -> map (lit . roundTo2SigDigits . (`percentile'` c)) [1, 25, 75, 99]) - doubleColumns - ++ map (lit . roundTo2SigDigits . variance') doubleColumns - ++ map (lit . roundTo2SigDigits . sqrt . variance') doubleColumns - -roundToSigDigits :: Int -> Double -> Double -roundToSigDigits n x - | x == 0 = 0 - | otherwise = - let magnitude = floor (logBase 10 (abs x)) - scale = 10 ** fromIntegral (n - 1 - magnitude) - in fromIntegral (round (x * scale)) / scale - -roundTo2SigDigits :: Double -> Double -roundTo2SigDigits = roundToSigDigits 2 - -fitRegression :: - -- | Target expression - T.Text -> - -- | Depth of search (Roughly, how many terms in the final expression) - Int -> - -- | Beam size - the number of candidate expressions to consider at a time. - Int -> - DataFrame -> - Either String (Expr Double) -fitRegression target d b df = - let - df' = exclude [target] df - targetMean = Stats.mean (Col @Double target) df - t = case interpret df (Col target) of - Left e -> throw e - Right v -> v - in - case beamSearch - df' - ( BeamConfig - d - b - MutualInformation - False - ) - t - (percentiles df') - [] - [] of - Nothing -> Left "No programs found" - Just p -> - trace (show p) $ - let - in case beamSearch - ( D.derive "_generated_regression_feature_" p df - & select ["_generated_regression_feature_"] - ) - (BeamConfig d b MeanSquaredError False) - t - (percentiles df' ++ [lit targetMean, lit 10]) - [] - [Col "_generated_regression_feature_"] of - Nothing -> Left "Could not find coefficients" - Just p' -> Right (replaceExpr p (Col @Double "_generated_regression_feature_") p') - -data LossFunction - = PearsonCorrelation - | MutualInformation - | MeanSquaredError - | F1 - -getLossFunction :: - LossFunction -> (VU.Vector Double -> VU.Vector Double -> Maybe Double) -getLossFunction f = case f of - MutualInformation -> - ( \l r -> - mutualInformationBinned - (Prelude.max 10 (ceiling (sqrt (fromIntegral (VU.length l))))) - l - r - ) - PearsonCorrelation -> (\l r -> (^ 2) <$> correlation' l r) - MeanSquaredError -> (\l r -> fmap negate (meanSquaredError l r)) - F1 -> f1FromBinary - -data BeamConfig = BeamConfig - { searchDepth :: Int - , beamLength :: Int - , lossFunction :: LossFunction - , includeConditionals :: Bool - } - -defaultBeamConfig :: BeamConfig -defaultBeamConfig = BeamConfig 2 100 PearsonCorrelation False - -beamSearch :: - DataFrame -> - -- | Parameters of the beam search. - BeamConfig -> - -- | Examples - TypedColumn Double -> - -- | Constants - [Expr Double] -> - -- | Conditions - [Expr Bool] -> - -- | Programs - [Expr Double] -> - Maybe (Expr Double) -beamSearch df cfg outputs constants conds programs - | searchDepth cfg == 0 = case ps of - [] -> Nothing - (x : _) -> Just x - | otherwise = - beamSearch - df - (cfg{searchDepth = searchDepth cfg - 1}) - outputs - constants - conditions - (generatePrograms (includeConditionals cfg) conditions vars constants ps) - where - vars = map col names - conditions = generateConditions outputs conds (vars ++ constants ++ ps) df - ps = pickTopN df outputs cfg $ deduplicate df programs - names = (map fst . L.sortBy (compare `on` snd) . M.toList . columnIndices) df - -pickTopN :: - DataFrame -> - TypedColumn Double -> - BeamConfig -> - [(Expr Double, TypedColumn a)] -> - [Expr Double] -pickTopN _ _ _ [] = [] -pickTopN df (TColumn col) cfg ps = - let - l = case toVector @Double @VU.Vector col of - Left e -> throw e - Right v -> v - ordered = - Prelude.take - (beamLength cfg) - ( map fst $ - L.sortBy - ( \(_, c2) (_, c1) -> - if maybe False isInfinite c1 - || maybe False isInfinite c2 - || maybe False isNaN c1 - || maybe False isNaN c2 - then LT - else compare c1 c2 - ) - ( map - (\(e, res) -> (e, getLossFunction (lossFunction cfg) l (asDoubleVector res))) - ps - ) - ) - asDoubleVector c = - let - (TColumn col') = c - in - case toVector @Double @VU.Vector col' of - Left e -> throw e - Right v -> VU.convert v - interpretDoubleVector e = - let - (TColumn col') = case interpret df e of - Left e -> throw e - Right v -> v - in - case toVector @Double @VU.Vector col' of - Left e -> throw e - Right v -> VU.convert v - in - trace - ( "Best loss: " - ++ show - ( getLossFunction (lossFunction cfg) l . interpretDoubleVector - <$> listToMaybe ordered - ) - ++ " " - ++ (if null ordered then "empty" else show (listToMaybe ordered)) - ) - ordered - -pickTopNBool :: - DataFrame -> - TypedColumn Double -> - [(Expr Bool, TypedColumn Bool)] -> - [Expr Bool] -pickTopNBool _ _ [] = [] -pickTopNBool df (TColumn col) ps = - let - l = case toVector @Double @VU.Vector col of - Left e -> throw e - Right v -> v - ordered = - Prelude.take - 10 - ( map fst $ - L.sortBy - ( \(_, c2) (_, c1) -> - if maybe False isInfinite c1 - || maybe False isInfinite c2 - || maybe False isNaN c1 - || maybe False isNaN c2 - then LT - else compare c1 c2 - ) - ( map - (\(e, res) -> (e, getLossFunction MutualInformation l (asDoubleVector res))) - ps - ) - ) - asDoubleVector c = - let - (TColumn col') = c - in - case toVector @Bool @VU.Vector col' of - Left e -> throw e - Right v -> VU.map (fromIntegral @Int @Double . fromEnum) v - in - ordered - -satisfiesExamples :: DataFrame -> TypedColumn Double -> Expr Double -> Bool -satisfiesExamples df col expr = - let - result = case interpret df expr of - Left e -> throw e - Right v -> v - in - result == col - -- See Section 2.4 of the Haskell Report https://www.haskell.org/definition/haskell2010.pdf isReservedId :: T.Text -> Bool isReservedId t = case t of @@ -817,7 +367,7 @@ in fmap concat $ forM specs $ \(raw, nm, tyStr) -> do ty <- typeFromString (words tyStr) - liftIO $ T.putStrLn (nm <> " :: Expr " <> T.pack tyStr) + trace (T.unpack (nm <> " :: Expr " <> T.pack tyStr)) pure () let n = mkName (T.unpack nm) sig <- sigD n [t|Expr $(pure ty)|] val <- valD (varP n) (normalB [|col $(TH.lift raw)|]) [] diff --git a/src/DataFrame/Internal/Expression.hs b/src/DataFrame/Internal/Expression.hs --- a/src/DataFrame/Internal/Expression.hs +++ b/src/DataFrame/Internal/Expression.hs @@ -1,4 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -14,6 +15,7 @@ module DataFrame.Internal.Expression where +import Control.Monad.ST (runST) import qualified Data.Map as M import Data.Maybe (fromMaybe, isJust) import Data.String @@ -21,7 +23,9 @@ import Data.Type.Equality (TestEquality (testEquality), type (:~:) (Refl)) import qualified Data.Vector as V import qualified Data.Vector.Generic as VG +import qualified Data.Vector.Mutable as VM import qualified Data.Vector.Unboxed as VU +import qualified Data.Vector.Unboxed.Mutable as VUM import DataFrame.Errors import DataFrame.Internal.Column import DataFrame.Internal.DataFrame @@ -69,7 +73,7 @@ (Columnable a) => Expr a -> T.Text -> -- Operation name - (forall a. (Columnable a) => a -> a -> a) -> + (a -> a -> a) -> Expr a AggNumericVector :: ( Columnable a @@ -290,7 +294,7 @@ , errorColumnName = Nothing } ) -interpret df expression@(AggReduce expr op (f :: forall a. (Columnable a) => a -> a -> a)) = case interpret @a df expr of +interpret df expression@(AggReduce expr op (f :: a -> a -> a)) = case interpret @a df expr of Left (TypeMismatchException context) -> Left $ TypeMismatchException @@ -473,6 +477,68 @@ f (VU.unsafeSlice (start i) (n i) sorted) ) +mkReducedColumnUnboxed :: + forall a. + (VU.Unbox a) => + VU.Vector a -> + VU.Vector Int -> + VU.Vector Int -> + (a -> a -> a) -> + VU.Vector a +mkReducedColumnUnboxed col os indices f = runST $ do + let len = VU.length os - 1 + mvec <- VUM.unsafeNew len + + let loopOut i + | i == len = return () + | otherwise = do + let start = os `VU.unsafeIndex` i + let end = os `VU.unsafeIndex` (i + 1) + let initVal = col `VU.unsafeIndex` (indices `VU.unsafeIndex` start) + + let loopIn !acc idx + | idx == end = acc + | otherwise = + let val = col `VU.unsafeIndex` (indices `VU.unsafeIndex` idx) + in loopIn (f acc val) (idx + 1) + let !finalVal = loopIn initVal (start + 1) + VUM.unsafeWrite mvec i finalVal + loopOut (i + 1) + + loopOut 0 + VU.unsafeFreeze mvec +{-# INLINE mkReducedColumnUnboxed #-} + +mkReducedColumnBoxed :: + V.Vector a -> + VU.Vector Int -> + VU.Vector Int -> + (a -> a -> a) -> + V.Vector a +mkReducedColumnBoxed col os indices f = runST $ do + let len = VU.length os - 1 + mvec <- VM.unsafeNew len + + let loopOut i + | i == len = return () + | otherwise = do + let start = os `VU.unsafeIndex` i + let end = os `VU.unsafeIndex` (i + 1) + let initVal = col `V.unsafeIndex` (indices `VU.unsafeIndex` start) + + let loopIn !acc idx + | idx == end = acc + | otherwise = + let val = col `V.unsafeIndex` (indices `VU.unsafeIndex` idx) + in loopIn (f acc val) (idx + 1) + let !finalVal = loopIn initVal (start + 1) + VM.unsafeWrite mvec i finalVal + loopOut (i + 1) + + loopOut 0 + V.unsafeFreeze mvec +{-# INLINE mkReducedColumnBoxed #-} + nestedTypeException :: forall a b. (Typeable a, Typeable b) => String -> DataFrameException nestedTypeException expression = case typeRep @a of @@ -861,7 +927,34 @@ , errorColumnName = Just (show expr) } ) -interpretAggregation gdf@(Grouped df names indices os) expression@(AggReduce expr op (f :: forall a. (Columnable a) => a -> a -> a)) = +interpretAggregation gdf@(Grouped df names indices os) expression@(AggReduce (Col name) op (f :: a -> a -> a)) = + case getColumn name df of + Nothing -> Left $ ColumnNotFoundException name "" (M.keys $ columnIndices df) + Just (BoxedColumn (col :: V.Vector d)) -> case testEquality (typeRep @a) (typeRep @d) of + Nothing -> error "Type mismatch" + Just Refl -> + Right $ + Aggregated $ + TColumn $ + fromVector $ + mkReducedColumnBoxed col os indices f + Just (OptionalColumn (col :: V.Vector d)) -> case testEquality (typeRep @a) (typeRep @d) of + Nothing -> error "Type mismatch" + Just Refl -> + Right $ + Aggregated $ + TColumn $ + fromVector $ + mkReducedColumnBoxed col os indices f + Just (UnboxedColumn (col :: VU.Vector d)) -> case testEquality (typeRep @a) (typeRep @d) of + Just Refl -> + Right $ + Aggregated $ + TColumn $ + fromUnboxedVector $ + mkReducedColumnUnboxed col os indices f + Nothing -> error "Type mismatch" +interpretAggregation gdf@(Grouped df names indices os) expression@(AggReduce expr op (f :: a -> a -> a)) = case interpretAggregation @a gdf expr of (Left (TypeMismatchException context)) -> Left $ diff --git a/src/DataFrame/Operations/Aggregation.hs b/src/DataFrame/Operations/Aggregation.hs --- a/src/DataFrame/Operations/Aggregation.hs +++ b/src/DataFrame/Operations/Aggregation.hs @@ -1,6 +1,7 @@ {-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -12,11 +13,13 @@ import qualified Data.Map as M import qualified Data.Text as T import qualified Data.Vector as V -import qualified Data.Vector.Algorithms.Radix as VA +import qualified Data.Vector.Algorithms.Merge as VA import qualified Data.Vector.Generic as VG import qualified Data.Vector.Unboxed as VU +import qualified Data.Vector.Unboxed.Mutable as VUM import Control.Exception (throw) +import Control.Monad import Control.Monad.ST (runST) import Data.Hashable import Data.Type.Equality (TestEquality (..), type (:~:) (Refl)) @@ -59,11 +62,7 @@ valueIndices = runST $ do withIndexes <- VG.thaw $ VG.indexed rowRepresentations - VA.sortBy - (VA.passes @Int 0) - (VA.size @Int 0) - (\p e -> VA.radix 0 (snd e)) - withIndexes + VA.sortBy (\(a, b) (a', b') -> compare b' b) withIndexes VG.unsafeFreeze withIndexes changingPoints :: (Eq a, VU.Unbox a) => VU.Vector (Int, a) -> [Int] @@ -75,36 +74,91 @@ | otherwise = (index : offsets, newVal) computeRowHashes :: [Int] -> DataFrame -> VU.Vector Int -computeRowHashes indices df = - L.foldl' combineCol initialHashes selectedCols - where - n = fst (dimensions df) - initialHashes = VU.replicate n 0 +computeRowHashes indices df = runST $ do + let n = fst (dimensions df) + mv <- VUM.new n - selectedCols = map (columns df V.!) indices + let selectedCols = map (columns df V.!) indices - combineCol :: VU.Vector Int -> Column -> VU.Vector Int - combineCol acc col = case col of - UnboxedColumn (v :: VU.Vector a) -> case testEquality (typeRep @a) (typeRep @Int) of - Just Refl -> VU.zipWith hashWithSalt acc v - Nothing -> case testEquality (typeRep @a) (typeRep @Double) of - Just Refl -> VU.zipWith (\h d -> hashWithSalt h (doubleToInt d)) acc v - Nothing -> case sIntegral @a of - STrue -> VU.zipWith (\h d -> hashWithSalt h (fromIntegral @a @Int d)) acc v - SFalse -> case sFloating @a of - STrue -> VU.zipWith (\h d -> hashWithSalt h ((doubleToInt . realToFrac) d)) acc v - SFalse -> VU.zipWith (\h d -> hashWithSalt h (hash (show d))) acc v - BoxedColumn (v :: V.Vector a) -> case testEquality (typeRep @a) (typeRep @T.Text) of - Just Refl -> VG.convert (V.zipWith hashWithSalt (VG.convert acc) v) - Nothing -> - VG.convert - (V.zipWith (\h d -> hashWithSalt h (hash (show d))) (VG.convert acc) v) + forM_ selectedCols $ \case + UnboxedColumn (v :: VU.Vector a) -> + case testEquality (typeRep @a) (typeRep @Int) of + Just Refl -> + VU.imapM_ + ( \i (x :: Int) -> do + h <- VUM.unsafeRead mv i + VUM.unsafeWrite mv i (hashWithSalt h x) + ) + v + Nothing -> + case testEquality (typeRep @a) (typeRep @Double) of + Just Refl -> + VU.imapM_ + ( \i (d :: Double) -> do + h <- VUM.unsafeRead mv i + VUM.unsafeWrite mv i (hashWithSalt h (doubleToInt d)) + ) + v + Nothing -> + case sIntegral @a of + STrue -> + VU.imapM_ + ( \i d -> do + let x :: Int + x = fromIntegral @a @Int d + h <- VUM.unsafeRead mv i + VUM.unsafeWrite mv i (hashWithSalt h x) + ) + v + SFalse -> + case sFloating @a of + STrue -> + VU.imapM_ + ( \i d -> do + let x :: Int + x = doubleToInt (realToFrac d :: Double) + h <- VUM.unsafeRead mv i + VUM.unsafeWrite mv i (hashWithSalt h x) + ) + v + SFalse -> + VU.imapM_ + ( \i d -> do + let x = hash (show d) + h <- VUM.unsafeRead mv i + VUM.unsafeWrite mv i (hashWithSalt h x) + ) + v + BoxedColumn (v :: V.Vector a) -> + case testEquality (typeRep @a) (typeRep @T.Text) of + Just Refl -> + V.imapM_ + ( \i (t :: T.Text) -> do + h <- VUM.unsafeRead mv i + VUM.unsafeWrite mv i (hashWithSalt h t) + ) + v + Nothing -> + V.imapM_ + ( \i d -> do + let x = hash (show d) + h <- VUM.unsafeRead mv i + VUM.unsafeWrite mv i (hashWithSalt h x) + ) + v OptionalColumn v -> - VG.convert - (V.zipWith (\h d -> hashWithSalt h (hash (show d))) (VG.convert acc) v) + V.imapM_ + ( \i d -> do + let x = hash (show d) + h <- VUM.unsafeRead mv i + VUM.unsafeWrite mv i (hashWithSalt h x) + ) + v + VU.unsafeFreeze mv + where doubleToInt :: Double -> Int - doubleToInt = floor + doubleToInt = floor . (* 1000) {- | Aggregate a grouped dataframe using the expressions given. All ungrouped columns will be dropped. diff --git a/src/DataFrame/Synthesis.hs b/src/DataFrame/Synthesis.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Synthesis.hs @@ -0,0 +1,486 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE UndecidableInstances #-} + +module DataFrame.Synthesis where + +import qualified DataFrame.Functions as F +import DataFrame.Internal.Column +import DataFrame.Internal.DataFrame ( + DataFrame (..), + columnAsDoubleVector, + ) +import DataFrame.Internal.Expression ( + Expr (..), + 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 Data.Containers.ListUtils +import Data.Function +import qualified Data.List as L +import qualified Data.Map as M +import Data.Maybe (listToMaybe) +import qualified Data.Set as S +import qualified Data.Text as T +import Data.Type.Equality +import qualified Data.Vector.Unboxed as VU +import DataFrame.Functions ((.&&), (.<=), (.>), (.||)) +import qualified DataFrame.Operations.Core as D +import qualified DataFrame.Operations.Transformations as D +import Debug.Trace (trace) +import Type.Reflection (typeRep) + +generateConditions :: + TypedColumn Double -> [Expr Bool] -> [Expr Double] -> DataFrame -> [Expr Bool] +generateConditions labels conds ps df = + let + newConds = + [ p .<= q + | p <- ps + , q <- ps + , p /= q + ] + ++ [ F.not p + | p <- conds + ] + expandedConds = + conds + ++ newConds + ++ [p .&& q | p <- newConds, q <- conds, p /= q] + ++ [p .|| q | p <- newConds, q <- conds, p /= q] + in + pickTopNBool df labels (deduplicate df expandedConds) + +generatePrograms :: + Bool -> + [Expr Bool] -> + [Expr Double] -> + [Expr Double] -> + [Expr Double] -> + [Expr Double] +generatePrograms _ _ vars' constants [] = vars' ++ constants +generatePrograms includeConds conds vars constants ps = + let + existingPrograms = ps ++ vars ++ constants + in + existingPrograms + ++ [ transform p + | p <- ps ++ vars + , transform <- + [ sqrt + , abs + , log . (+ Lit 1) + , exp + , sin + , cos + , F.relu + , signum + ] + ] + ++ [ F.pow i p + | p <- existingPrograms + , i <- [2 .. 6] + ] + ++ [ p + q + | (i, p) <- zip [0 ..] existingPrograms + , (j, q) <- zip [0 ..] existingPrograms + , Prelude.not (isLiteral p && isLiteral q) + , i >= j + ] + ++ ( if includeConds + then + [ F.min p q + | (i, p) <- zip [0 ..] existingPrograms + , (j, q) <- zip [0 ..] existingPrograms + , Prelude.not (isLiteral p && isLiteral q) + , p /= q + , i > j + ] + ++ [ F.max p q + | (i, p) <- zip [0 ..] existingPrograms + , (j, q) <- zip [0 ..] existingPrograms + , Prelude.not (isLiteral p && isLiteral q) + , p /= q + , i > j + ] + ++ [ F.ifThenElse cond r s + | cond <- conds + , r <- existingPrograms + , s <- existingPrograms + , r /= s + ] + else [] + ) + ++ [ p - q + | (i, p) <- zip [0 ..] existingPrograms + , (j, q) <- zip [0 ..] existingPrograms + , Prelude.not (isLiteral p && isLiteral q) + , i /= j + ] + ++ [ p * q + | (i, p) <- zip [0 ..] existingPrograms + , (j, q) <- zip [0 ..] existingPrograms + , Prelude.not (isLiteral p && isLiteral q) + , i >= j + ] + ++ [ p / q + | p <- existingPrograms + , q <- existingPrograms + , Prelude.not (isLiteral p && isLiteral q) + , p /= q + ] + +isLiteral :: Expr a -> Bool +isLiteral (Lit _) = True +isLiteral _ = False + +deduplicate :: + forall a. + (Columnable a) => + DataFrame -> + [Expr a] -> + [(Expr a, TypedColumn a)] +deduplicate df = go S.empty . nubOrd . L.sortBy (\e1 e2 -> compare (eSize e1) (eSize e2)) + where + go _ [] = [] + go seen (x : xs) + | hasInvalid = go seen xs + | S.member res seen = go seen xs + | otherwise = (x, res) : go (S.insert res seen) xs + where + res = case interpret @a df x of + Left e -> throw e + Right v -> v + hasInvalid = case res of + (TColumn (UnboxedColumn (col :: VU.Vector b))) -> case testEquality (typeRep @Double) (typeRep @b) of + Just Refl -> VU.any (\n -> isNaN n || isInfinite n) col + Nothing -> False + _ -> False + +-- | Checks if two programs generate the same outputs given all the same inputs. +equivalent :: DataFrame -> Expr Double -> Expr Double -> Bool +equivalent df p1 p2 = case (==) <$> interpret df p1 <*> interpret df p2 of + Left e -> throw e + Right v -> v + +synthesizeFeatureExpr :: + -- | Target expression + T.Text -> + BeamConfig -> + DataFrame -> + Either String (Expr Double) +synthesizeFeatureExpr target cfg df = + let + df' = exclude [target] df + t = case interpret df (Col target) of + Left e -> throw e + Right v -> v + in + case beamSearch + df' + cfg + t + (percentiles df') + [] + [] of + Nothing -> Left "No programs found" + Just p -> Right p + +f1FromBinary :: VU.Vector Double -> VU.Vector Double -> Maybe Double +f1FromBinary trues preds = + let (!tp, !fp, !fn) = + VU.foldl' step (0 :: Int, 0 :: Int, 0 :: Int) $ + VU.zip (VU.map (> 0) preds) (VU.map (> 0) trues) + in f1FromCounts tp fp fn + where + step (!tp, !fp, !fn) (!p, !t) = + case (p, t) of + (True, True) -> (tp + 1, fp, fn) + (True, False) -> (tp, fp + 1, fn) + (False, True) -> (tp, fp, fn + 1) + (False, False) -> (tp, fp, fn) + +f1FromCounts :: Int -> Int -> Int -> Maybe Double +f1FromCounts tp fp fn = + let tp' = fromIntegral tp + fp' = fromIntegral fp + fn' = fromIntegral fn + precision = if tp' + fp' == 0 then 0 else tp' / (tp' + fp') + recall = if tp' + fn' == 0 then 0 else tp' / (tp' + fn') + in if precision + recall == 0 + then Nothing + else Just (2 * precision * recall / (precision + recall)) + +fitClassifier :: + -- | Target expression + T.Text -> + -- | Depth of search (Roughly, how many terms in the final expression) + Int -> + -- | Beam size - the number of candidate expressions to consider at a time. + Int -> + DataFrame -> + Either String (Expr Int) +fitClassifier target d b df = + let + df' = exclude [target] df + t = case interpret df (Col target) of + Left e -> throw e + Right v -> v + in + case beamSearch + df' + (BeamConfig d b F1 True) + t + (percentiles df' ++ [Lit 1, Lit 0, Lit (-1)]) + [] + [] of + Nothing -> Left "No programs found" + Just p -> Right (F.ifThenElse (p .> 0) 1 0) + +percentiles :: DataFrame -> [Expr Double] +percentiles df = + let + doubleColumns = map (either throw id . (`columnAsDoubleVector` df)) (D.columnNames df) + in + concatMap + (\c -> map (Lit . roundTo2SigDigits . (`percentile'` c)) [1, 25, 75, 99]) + doubleColumns + ++ map (Lit . roundTo2SigDigits . variance') doubleColumns + ++ map (Lit . roundTo2SigDigits . sqrt . variance') doubleColumns + +roundToSigDigits :: Int -> Double -> Double +roundToSigDigits n x + | x == 0 = 0 + | otherwise = + let magnitude = floor (logBase 10 (abs x)) + scale = 10 ** fromIntegral (n - 1 - magnitude) + in fromIntegral (round (x * scale)) / scale + +roundTo2SigDigits :: Double -> Double +roundTo2SigDigits = roundToSigDigits 2 + +fitRegression :: + -- | Target expression + T.Text -> + -- | Depth of search (Roughly, how many terms in the final expression) + Int -> + -- | Beam size - the number of candidate expressions to consider at a time. + Int -> + DataFrame -> + Either String (Expr Double) +fitRegression target d b df = + let + df' = exclude [target] df + targetMean = Stats.mean (Col @Double target) df + t = case interpret df (Col target) of + Left e -> throw e + Right v -> v + in + case beamSearch + df' + ( BeamConfig + d + b + MutualInformation + False + ) + t + (percentiles df') + [] + [] of + Nothing -> Left "No programs found" + Just p -> + trace (show p) $ + let + in case beamSearch + ( D.derive "_generated_regression_feature_" p df + & select ["_generated_regression_feature_"] + ) + (BeamConfig d b MeanSquaredError False) + t + (percentiles df' ++ [Lit targetMean, Lit 10]) + [] + [Col "_generated_regression_feature_"] of + Nothing -> Left "Could not find coefficients" + Just p' -> Right (replaceExpr p (Col @Double "_generated_regression_feature_") p') + +data LossFunction + = PearsonCorrelation + | MutualInformation + | MeanSquaredError + | F1 + +getLossFunction :: + LossFunction -> (VU.Vector Double -> VU.Vector Double -> Maybe Double) +getLossFunction f = case f of + MutualInformation -> + ( \l r -> + mutualInformationBinned + (Prelude.max 10 (ceiling (sqrt (fromIntegral (VU.length l))))) + l + r + ) + PearsonCorrelation -> (\l r -> (^ 2) <$> correlation' l r) + MeanSquaredError -> (\l r -> fmap negate (meanSquaredError l r)) + F1 -> f1FromBinary + +data BeamConfig = BeamConfig + { searchDepth :: Int + , beamLength :: Int + , lossFunction :: LossFunction + , includeConditionals :: Bool + } + +defaultBeamConfig :: BeamConfig +defaultBeamConfig = BeamConfig 2 100 PearsonCorrelation False + +beamSearch :: + DataFrame -> + -- | Parameters of the beam search. + BeamConfig -> + -- | Examples + TypedColumn Double -> + -- | Constants + [Expr Double] -> + -- | Conditions + [Expr Bool] -> + -- | Programs + [Expr Double] -> + Maybe (Expr Double) +beamSearch df cfg outputs constants conds programs + | searchDepth cfg == 0 = case ps of + [] -> Nothing + (x : _) -> Just x + | otherwise = + beamSearch + df + (cfg{searchDepth = searchDepth cfg - 1}) + outputs + constants + conditions + (generatePrograms (includeConditionals cfg) conditions vars constants ps) + where + vars = map Col names + conditions = generateConditions outputs conds (vars ++ constants ++ ps) df + ps = pickTopN df outputs cfg $ deduplicate df programs + names = (map fst . L.sortBy (compare `on` snd) . M.toList . columnIndices) df + +pickTopN :: + DataFrame -> + TypedColumn Double -> + BeamConfig -> + [(Expr Double, TypedColumn a)] -> + [Expr Double] +pickTopN _ _ _ [] = [] +pickTopN df (TColumn col) cfg ps = + let + l = case toVector @Double @VU.Vector col of + Left e -> throw e + Right v -> v + ordered = + Prelude.take + (beamLength cfg) + ( map fst $ + L.sortBy + ( \(_, c2) (_, c1) -> + if maybe False isInfinite c1 + || maybe False isInfinite c2 + || maybe False isNaN c1 + || maybe False isNaN c2 + then LT + else compare c1 c2 + ) + ( map + (\(e, res) -> (e, getLossFunction (lossFunction cfg) l (asDoubleVector res))) + ps + ) + ) + asDoubleVector c = + let + (TColumn col') = c + in + case toVector @Double @VU.Vector col' of + Left e -> throw e + Right v -> VU.convert v + interpretDoubleVector e = + let + (TColumn col') = case interpret df e of + Left e -> throw e + Right v -> v + in + case toVector @Double @VU.Vector col' of + Left e -> throw e + Right v -> VU.convert v + in + trace + ( "Best loss: " + ++ show + ( getLossFunction (lossFunction cfg) l . interpretDoubleVector + <$> listToMaybe ordered + ) + ++ " " + ++ (if null ordered then "empty" else show (listToMaybe ordered)) + ) + ordered + +pickTopNBool :: + DataFrame -> + TypedColumn Double -> + [(Expr Bool, TypedColumn Bool)] -> + [Expr Bool] +pickTopNBool _ _ [] = [] +pickTopNBool df (TColumn col) ps = + let + l = case toVector @Double @VU.Vector col of + Left e -> throw e + Right v -> v + ordered = + Prelude.take + 10 + ( map fst $ + L.sortBy + ( \(_, c2) (_, c1) -> + if maybe False isInfinite c1 + || maybe False isInfinite c2 + || maybe False isNaN c1 + || maybe False isNaN c2 + then LT + else compare c1 c2 + ) + ( map + (\(e, res) -> (e, getLossFunction MutualInformation l (asDoubleVector res))) + ps + ) + ) + asDoubleVector c = + let + (TColumn col') = c + in + case toVector @Bool @VU.Vector col' of + Left e -> throw e + Right v -> VU.map (fromIntegral @Int @Double . fromEnum) v + in + ordered + +satisfiesExamples :: DataFrame -> TypedColumn Double -> Expr Double -> Bool +satisfiesExamples df col expr = + let + result = case interpret df expr of + Left e -> throw e + Right v -> v + in + result == col diff --git a/tests/Functions.hs b/tests/Functions.hs --- a/tests/Functions.hs +++ b/tests/Functions.hs @@ -5,9 +5,9 @@ import DataFrame.Functions ( col, - generatePrograms, sanitize, ) +import DataFrame.Synthesis (generatePrograms) import Test.HUnit -- Test cases for the sanitize function