packages feed

dataframe-core 1.0.1.1 → 1.0.2.0

raw patch · 8 files changed

+770/−97 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- DataFrame.Internal.Expression: data BinaryOp a b c
- DataFrame.Internal.Expression: data UnaryOp a b
+ DataFrame.Internal.Expression: binaryCommutative :: BinaryOp op => op a b c -> Bool
+ DataFrame.Internal.Expression: binaryFn :: BinaryOp op => op a b c -> a -> b -> c
+ DataFrame.Internal.Expression: binaryName :: BinaryOp op => op a b c -> Text
+ DataFrame.Internal.Expression: binaryPrecedence :: BinaryOp op => op a b c -> Int
+ DataFrame.Internal.Expression: binarySymbol :: BinaryOp op => op a b c -> Maybe Text
+ DataFrame.Internal.Expression: class Typeable op => BinaryOp (op :: Type -> Type -> Type -> Type)
+ DataFrame.Internal.Expression: class Typeable op => UnaryOp (op :: Type -> Type -> Type)
+ DataFrame.Internal.Expression: data BinUDF a b c
+ DataFrame.Internal.Expression: data UnUDF a b
+ DataFrame.Internal.Expression: instance DataFrame.Internal.Expression.BinaryOp DataFrame.Internal.Expression.BinUDF
+ DataFrame.Internal.Expression: instance DataFrame.Internal.Expression.UnaryOp DataFrame.Internal.Expression.UnUDF
+ DataFrame.Internal.Expression: unaryFn :: UnaryOp op => op a b -> a -> b
+ DataFrame.Internal.Expression: unaryName :: UnaryOp op => op a b -> Text
+ DataFrame.Internal.Expression: unarySymbol :: UnaryOp op => op a b -> Maybe Text
+ DataFrame.Internal.Hash: nullSalt :: Int
+ DataFrame.Internal.Row: [Null] :: Any
+ DataFrame.Internal.Row: cellAny :: Columnable a => Maybe Bitmap -> Int -> a -> Any
+ DataFrame.Internal.Simplify: data PredFact
+ DataFrame.Internal.Simplify: entails :: [PredFact] -> Expr Bool -> Maybe Bool
+ DataFrame.Internal.Simplify: factFalse :: Expr Bool -> Maybe PredFact
+ DataFrame.Internal.Simplify: factTrue :: Expr Bool -> Maybe PredFact
+ DataFrame.Internal.Simplify: instance GHC.Classes.Eq DataFrame.Internal.Simplify.Cmp
+ DataFrame.Internal.Simplify: instance GHC.Classes.Eq DataFrame.Internal.Simplify.NullK
+ DataFrame.Internal.Simplify: simplify :: Columnable a => Expr a -> Expr a
+ DataFrame.Internal.Simplify: simplifyPredicatePair :: Columnable a => Bool -> Expr a -> Expr a -> Maybe (Expr a)
+ DataFrame.Operators: [NullAnd] :: forall a b. (NullableCmpOp a b (NullCmpResult a b), BaseType a ~ Bool) => NullAnd a b (NullCmpResult a b)
+ DataFrame.Operators: [NullEq] :: forall a b. (NumericWidenOp (BaseType a) (BaseType b), NullLift2Op a b Bool (NullCmpResult a b), Eq (Promote (BaseType a) (BaseType b))) => NullEq a b (NullCmpResult a b)
+ DataFrame.Operators: [NullGeq] :: forall a b. (NumericWidenOp (BaseType a) (BaseType b), NullLift2Op a b Bool (NullCmpResult a b), Ord (Promote (BaseType a) (BaseType b))) => NullGeq a b (NullCmpResult a b)
+ DataFrame.Operators: [NullGt] :: forall a b. (NumericWidenOp (BaseType a) (BaseType b), NullLift2Op a b Bool (NullCmpResult a b), Ord (Promote (BaseType a) (BaseType b))) => NullGt a b (NullCmpResult a b)
+ DataFrame.Operators: [NullLeq] :: forall a b. (NumericWidenOp (BaseType a) (BaseType b), NullLift2Op a b Bool (NullCmpResult a b), Ord (Promote (BaseType a) (BaseType b))) => NullLeq a b (NullCmpResult a b)
+ DataFrame.Operators: [NullLt] :: forall a b. (NumericWidenOp (BaseType a) (BaseType b), NullLift2Op a b Bool (NullCmpResult a b), Ord (Promote (BaseType a) (BaseType b))) => NullLt a b (NullCmpResult a b)
+ DataFrame.Operators: [NullNeq] :: forall a b. (NumericWidenOp (BaseType a) (BaseType b), NullLift2Op a b Bool (NullCmpResult a b), Eq (Promote (BaseType a) (BaseType b))) => NullNeq a b (NullCmpResult a b)
+ DataFrame.Operators: [NullOr] :: forall a b. (NullableCmpOp a b (NullCmpResult a b), BaseType a ~ Bool) => NullOr a b (NullCmpResult a b)
+ DataFrame.Operators: data NullAnd a b c
+ DataFrame.Operators: data NullEq a b c
+ DataFrame.Operators: data NullGeq a b c
+ DataFrame.Operators: data NullGt a b c
+ DataFrame.Operators: data NullLeq a b c
+ DataFrame.Operators: data NullLt a b c
+ DataFrame.Operators: data NullNeq a b c
+ DataFrame.Operators: data NullOr a b c
+ DataFrame.Operators: instance DataFrame.Internal.Expression.BinaryOp DataFrame.Operators.NullAnd
+ DataFrame.Operators: instance DataFrame.Internal.Expression.BinaryOp DataFrame.Operators.NullEq
+ DataFrame.Operators: instance DataFrame.Internal.Expression.BinaryOp DataFrame.Operators.NullGeq
+ DataFrame.Operators: instance DataFrame.Internal.Expression.BinaryOp DataFrame.Operators.NullGt
+ DataFrame.Operators: instance DataFrame.Internal.Expression.BinaryOp DataFrame.Operators.NullLeq
+ DataFrame.Operators: instance DataFrame.Internal.Expression.BinaryOp DataFrame.Operators.NullLt
+ DataFrame.Operators: instance DataFrame.Internal.Expression.BinaryOp DataFrame.Operators.NullNeq
+ DataFrame.Operators: instance DataFrame.Internal.Expression.BinaryOp DataFrame.Operators.NullOr
- DataFrame.Internal.Expression: MkBinaryOp :: (a -> b -> c) -> Text -> Maybe Text -> Bool -> Int -> BinaryOp a b c
+ DataFrame.Internal.Expression: MkBinaryOp :: (a -> b -> c) -> Text -> Maybe Text -> Bool -> Int -> BinUDF a b c
- DataFrame.Internal.Expression: MkUnaryOp :: (a -> b) -> Text -> Maybe Text -> UnaryOp a b
+ DataFrame.Internal.Expression: MkUnaryOp :: (a -> b) -> Text -> Maybe Text -> UnUDF a b
- DataFrame.Internal.Expression: [Binary] :: forall c b a. (Columnable c, Columnable b, Columnable a) => BinaryOp c b a -> Expr c -> Expr b -> Expr a
+ DataFrame.Internal.Expression: [Binary] :: forall (op :: Type -> Type -> Type -> Type) c b a. (BinaryOp op, Columnable c, Columnable b, Columnable a) => op c b a -> Expr c -> Expr b -> Expr a
- DataFrame.Internal.Expression: [Unary] :: forall a b. (Columnable a, Columnable b) => UnaryOp b a -> Expr b -> Expr a
+ DataFrame.Internal.Expression: [Unary] :: forall (op :: Type -> Type -> Type) a b. (UnaryOp op, Columnable a, Columnable b) => op b a -> Expr b -> Expr a
- DataFrame.Internal.Expression: [binaryCommutative] :: BinaryOp a b c -> Bool
+ DataFrame.Internal.Expression: [binaryCommutative] :: BinUDF a b c -> Bool
- DataFrame.Internal.Expression: [binaryFn] :: BinaryOp a b c -> a -> b -> c
+ DataFrame.Internal.Expression: [binaryFn] :: BinUDF a b c -> a -> b -> c
- DataFrame.Internal.Expression: [binaryName] :: BinaryOp a b c -> Text
+ DataFrame.Internal.Expression: [binaryName] :: BinUDF a b c -> Text
- DataFrame.Internal.Expression: [binaryPrecedence] :: BinaryOp a b c -> Int
+ DataFrame.Internal.Expression: [binaryPrecedence] :: BinUDF a b c -> Int
- DataFrame.Internal.Expression: [binarySymbol] :: BinaryOp a b c -> Maybe Text
+ DataFrame.Internal.Expression: [binarySymbol] :: BinUDF a b c -> Maybe Text
- DataFrame.Internal.Expression: [unaryFn] :: UnaryOp a b -> a -> b
+ DataFrame.Internal.Expression: [unaryFn] :: UnUDF a b -> a -> b
- DataFrame.Internal.Expression: [unaryName] :: UnaryOp a b -> Text
+ DataFrame.Internal.Expression: [unaryName] :: UnUDF a b -> Text
- DataFrame.Internal.Expression: [unarySymbol] :: UnaryOp a b -> Maybe Text
+ DataFrame.Internal.Expression: [unarySymbol] :: UnUDF a b -> Maybe Text
- DataFrame.Internal.Interpreter: [Flat] :: forall a. Columnable a => Column -> Value a
+ DataFrame.Internal.Interpreter: [Flat] :: forall a. Columnable a => !Column -> Value a
- DataFrame.Internal.Interpreter: [Group] :: forall a. Columnable a => Vector Column -> Value a
+ DataFrame.Internal.Interpreter: [Group] :: forall a. Columnable a => !Vector Column -> Value a
- DataFrame.Internal.Interpreter: [Scalar] :: forall a. Columnable a => a -> Value a
+ DataFrame.Internal.Interpreter: [Scalar] :: forall a. Columnable a => !a -> Value a

Files

dataframe-core.cabal view
@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               dataframe-core-version:            1.0.1.1+version:            1.0.2.0  synopsis:           Core data structures for the dataframe library. description:@@ -17,7 +17,7 @@ license-file:       LICENSE author:             Michael Chavinda maintainer:         mschavinda@gmail.com-copyright:          (c) 2024-2025 Michael Chavinda+copyright:          (c) 2024-2026 Michael Chavinda category:           Data tested-with:        GHC ==9.4.8 || ==9.6.7 || ==9.8.4 || ==9.10.3 || ==9.12.2 @@ -44,6 +44,7 @@                         DataFrame.Internal.Interpreter                         DataFrame.Internal.Nullable                         DataFrame.Internal.Row+                        DataFrame.Internal.Simplify                         DataFrame.Internal.Types                         DataFrame.Typed.Freeze                         DataFrame.Typed.Generic
src/DataFrame/Internal/Expression.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}@@ -10,6 +11,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE NoFieldSelectors #-}  module DataFrame.Internal.Expression where @@ -20,13 +22,35 @@ import DataFrame.Internal.Column import Type.Reflection (Typeable, typeOf, typeRep) -data UnaryOp a b = MkUnaryOp+{- | Operators are an open typeclass: built-ins get their own 'Typeable' type so+the simplifier can match them by 'cast', and users can add @instance@s. The+generic 'UnUDF'/'BinUDF' carriers cover UDFs, dynamic-named, and arithmetic ops.+Method names match the carrier record fields ('NoFieldSelectors' frees them), so+existing construction and read sites are unchanged.+-}+class (Typeable op) => UnaryOp op where+    unaryFn :: op a b -> a -> b+    unaryName :: op a b -> T.Text+    unarySymbol :: op a b -> Maybe T.Text+    unarySymbol _ = Nothing++class (Typeable op) => BinaryOp op where+    binaryFn :: op a b c -> a -> b -> c+    binaryName :: op a b c -> T.Text+    binarySymbol :: op a b c -> Maybe T.Text+    binarySymbol _ = Nothing+    binaryCommutative :: op a b c -> Bool+    binaryCommutative _ = False+    binaryPrecedence :: op a b c -> Int+    binaryPrecedence _ = 9++data UnUDF a b = MkUnaryOp     { unaryFn :: a -> b     , unaryName :: T.Text     , unarySymbol :: Maybe T.Text     } -data BinaryOp a b c = MkBinaryOp+data BinUDF a b c = MkBinaryOp     { binaryFn :: a -> b -> c     , binaryName :: T.Text     , binarySymbol :: Maybe T.Text@@ -34,6 +58,18 @@     , binaryPrecedence :: Int     } +instance UnaryOp UnUDF where+    unaryFn (MkUnaryOp{unaryFn = f}) = f+    unaryName (MkUnaryOp{unaryName = n}) = n+    unarySymbol (MkUnaryOp{unarySymbol = s}) = s++instance BinaryOp BinUDF where+    binaryFn (MkBinaryOp{binaryFn = f}) = f+    binaryName (MkBinaryOp{binaryName = n}) = n+    binarySymbol (MkBinaryOp{binarySymbol = s}) = s+    binaryCommutative (MkBinaryOp{binaryCommutative = c}) = c+    binaryPrecedence (MkBinaryOp{binaryPrecedence = p}) = p+ data MeanAcc = MeanAcc {-# UNPACK #-} !Double {-# UNPACK #-} !Int     deriving (Show, Eq, Ord, Read) @@ -66,10 +102,10 @@         Expr b     Lit :: (Columnable a) => a -> Expr a     Unary ::-        (Columnable a, Columnable b) => UnaryOp b a -> Expr b -> Expr a+        (UnaryOp op, Columnable a, Columnable b) => op b a -> Expr b -> Expr a     Binary ::-        (Columnable c, Columnable b, Columnable a) =>-        BinaryOp c b a -> Expr c -> Expr b -> Expr a+        (BinaryOp op, Columnable c, Columnable b, Columnable a) =>+        op c b a -> Expr c -> Expr b -> Expr a     If :: (Columnable a) => Expr Bool -> Expr a -> Expr a -> Expr a     Agg :: (Columnable a, Columnable b) => AggStrategy a b -> Expr b -> Expr a     Over :: (Columnable a) => [T.Text] -> Expr a -> Expr a
src/DataFrame/Internal/Grouping.hs view
@@ -23,10 +23,11 @@  import Control.Exception (throw) import Control.Monad-import Control.Monad.ST (runST)+import Control.Monad.ST (ST, runST) import Data.Type.Equality (TestEquality (..), type (:~:) (Refl)) import DataFrame.Errors import DataFrame.Internal.Column (+    Bitmap,     Column (..),     bitmapTestBit,  )@@ -78,49 +79,22 @@         mh <- VUM.replicate n fnvOffset         let selectedCols = map (columns df V.!) indicesToGroup         forM_ selectedCols $ \case-            UnboxedColumn _ (v :: VU.Vector a) ->+            UnboxedColumn ubm (v :: VU.Vector a) ->                 case testEquality (typeRep @a) (typeRep @Int) of-                    Just Refl ->-                        VU.imapM_-                            ( \i x -> do-                                !h <- VUM.unsafeRead mh i-                                VUM.unsafeWrite mh i (mixInt h x)-                            )-                            v+                    Just Refl -> hashUnboxed mh ubm mixInt v                     Nothing ->                         case testEquality (typeRep @a) (typeRep @Double) of-                            Just Refl ->-                                VU.imapM_-                                    ( \i d -> do-                                        !h <- VUM.unsafeRead mh i-                                        VUM.unsafeWrite mh i (mixDouble h d)-                                    )-                                    v+                            Just Refl -> hashUnboxed mh ubm mixDouble v                             Nothing ->                                 case sIntegral @a of                                     STrue ->-                                        VU.imapM_-                                            ( \i d -> do-                                                !h <- VUM.unsafeRead mh i-                                                VUM.unsafeWrite mh i (mixInt h (fromIntegral @a @Int d))-                                            )-                                            v+                                        hashUnboxed mh ubm (\h d -> mixInt h (fromIntegral @a @Int d)) v                                     SFalse ->                                         case sFloating @a of                                             STrue ->-                                                VU.imapM_-                                                    ( \i d -> do-                                                        !h <- VUM.unsafeRead mh i-                                                        VUM.unsafeWrite mh i (mixDouble h (realToFrac d :: Double))-                                                    )-                                                    v+                                                hashUnboxed mh ubm (\h d -> mixDouble h (realToFrac d :: Double)) v                                             SFalse ->-                                                VU.imapM_-                                                    ( \i d -> do-                                                        !h <- VUM.unsafeRead mh i-                                                        VUM.unsafeWrite mh i (mixShow h d)-                                                    )-                                                    v+                                                hashUnboxed mh ubm mixShow v             BoxedColumn bm (v :: V.Vector a) ->                 case testEquality (typeRep @a) (typeRep @T.Text) of                     Just Refl ->@@ -128,7 +102,7 @@                             ( \i t -> do                                 !h <- VUM.unsafeRead mh i                                 let h' = case bm of-                                        Just bm' | not (bitmapTestBit bm' i) -> mixInt h 0 -- null sentinel+                                        Just bm' | not (bitmapTestBit bm' i) -> mixInt h nullSalt                                         _ -> mixText h t                                 VUM.unsafeWrite mh i h'                             )@@ -138,7 +112,7 @@                             ( \i d -> do                                 !h <- VUM.unsafeRead mh i                                 let h' = case bm of-                                        Just bm' | not (bitmapTestBit bm' i) -> mixInt h 0 -- null sentinel+                                        Just bm' | not (bitmapTestBit bm' i) -> mixInt h nullSalt                                         _ -> mixShow h d                                 VUM.unsafeWrite mh i h'                             )@@ -159,6 +133,36 @@                 , i <- reverse is                 ]         return (VU.fromList ordered)++{- | Fold a value-mix over an unboxed column into the running hash vector,+respecting the null bitmap: a null slot mixes a fixed 'nullSalt' sentinel.+-}+hashUnboxed ::+    (VU.Unbox a) =>+    VUM.MVector s Int ->+    Maybe Bitmap ->+    (Int -> a -> Int) ->+    VU.Vector a ->+    ST s ()+hashUnboxed mh ubm mix v = case ubm of+    Nothing ->+        VU.imapM_+            ( \i x -> do+                !h <- VUM.unsafeRead mh i+                VUM.unsafeWrite mh i (mix h x)+            )+            v+    Just bm ->+        VU.imapM_+            ( \i x -> do+                !h <- VUM.unsafeRead mh i+                VUM.unsafeWrite+                    mh+                    i+                    (if bitmapTestBit bm i then mix h x else mixInt h nullSalt)+            )+            v+{-# INLINE hashUnboxed #-}  -- Inline accessors to avoid depending on Operations.Core 
src/DataFrame/Internal/Hash.hs view
@@ -1,14 +1,19 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+ {- | A poor-man's hash used by 'DataFrame.Internal.Grouping' to bucket rows without depending on the @hashable@ package. -The hash is FNV-1a-shaped: an accumulator is repeatedly @xor@ed with the-next chunk and multiplied by an FNV prime. It is intentionally small and-not cryptographically strong — it only needs to spread group-key tuples-well enough that 'Data.IntMap' bucketing produces sensible groups.+Each value is folded into an 'Int' accumulator with an FxHash-style step+(rotate, xor, multiply). It is intentionally small and not cryptographically+strong — it only needs to spread group-key tuples well enough that+'Data.IntMap' bucketing produces sensible groups. -} module DataFrame.Internal.Hash (     fnvOffset,+    nullSalt,     mixInt,     mixDouble,     mixBool,@@ -17,10 +22,17 @@     mixShow, ) where -import Data.Bits (xor)+import Data.Bits (rotateL, unsafeShiftL, unsafeShiftR, xor) import Data.Char (ord) import qualified Data.Text as T-import Data.Word (Word64)+#if MIN_VERSION_text(2,1,0)+import Data.Array.Byte (ByteArray (ByteArray))+#else+import Data.Text.Array (Array (ByteArray))+#endif+import Data.Text.Internal (Text (Text))+import GHC.Exts (Int (I#), indexWord8Array#, indexWord8ArrayAsWord64#)+import GHC.Word (Word64 (W64#), Word8 (W8#))  {- | FNV-1a 64-bit offset basis (used as the initial accumulator). The literal is unsigned and exceeds 'Int' range, so we round-trip through@@ -33,9 +45,26 @@ fnvPrime :: Int fnvPrime = 0x00000100000001b3 --- | Mix an 'Int' into the accumulator.+{- | Sentinel mixed in for a /null/ slot of a nullable column, so that a+@Nothing@ does not hash to the same value as a present @Just x@ that happens to+store the same underlying bits (notably @Just 0@). A fixed distinctive constant+(the 64-bit golden-ratio mix constant) keeps null hashing deterministic; a real+value equal to it collides only as rarely as any other hash collision.+-}+nullSalt :: Int+nullSalt = fromIntegral (0x9E3779B97F4A7C15 :: Word64)++{- | Mix an 'Int' into the accumulator.++An FxHash-style step (rotate the accumulator, xor the value, multiply by a large+odd constant). The rotate diffuses each value's bits across all positions before+the next is folded in, so small/adjacent integers — common as group keys — do+not produce the structured collisions that a plain @(acc `xor` x) * prime@ does+once several columns are combined. Grouping trusts hash equality, so this+robustness is what keeps distinct rows in distinct groups.+-} mixInt :: Int -> Int -> Int-mixInt acc x = (acc `xor` x) * fnvPrime+mixInt acc x = (rotateL acc 13 `xor` x) * fnvPrime {-# INLINE mixInt #-}  {- | Mix a 'Double' into the accumulator. Loses sub-millisecond precision@@ -53,9 +82,31 @@ mixChar acc = mixInt acc . ord {-# INLINE mixChar #-} --- | Mix a 'T.Text' value into the accumulator, byte by byte.+{- | Mix a 'T.Text' value into the accumulator over its raw UTF-8 bytes,+eight at a time. Reading a whole 'Word64' per step (rather than decoding and+mixing one codepoint at a time) cuts the multiply count ~8x on long keys while+staying collision-equivalent: UTF-8 is injective, so equal 'T.Text's mix to the+same value and distinct ones almost never collide. The trailing @len `mod` 8@+bytes are folded in individually.+-} mixText :: Int -> T.Text -> Int-mixText = T.foldl' (\a c -> mixInt a (ord c))+mixText !acc (Text (ByteArray ba) off len) = goBytes (goWords acc off) wordsEnd+  where+    !nWords = len `unsafeShiftR` 3+    !wordsEnd = off + (nWords `unsafeShiftL` 3)+    !end = off + len+    goWords !h !i+        | i >= wordsEnd = h+        | otherwise =+            let !(I# i#) = i+                !w = fromIntegral (W64# (indexWord8ArrayAsWord64# ba i#)) :: Int+             in goWords (mixInt h w) (i + 8)+    goBytes !h !i+        | i >= end = h+        | otherwise =+            let !(I# i#) = i+                !b = fromIntegral (W8# (indexWord8Array# ba i#)) :: Int+             in goBytes (mixInt h b) (i + 1) {-# INLINE mixText #-}  {- | Fallback for arbitrary 'Show'-able values. Slower but covers types
src/DataFrame/Internal/Interpreter.hs view
@@ -262,7 +262,38 @@     Column ->     Either DataFrameException Column     #-}+-- Bool-returning binary comparators (hot path for Expr Bool used in+-- DecisionTree splits)+{-# SPECIALIZE zipWithColumns ::+    (Double -> Double -> Bool) ->+    Column ->+    Column ->+    Either DataFrameException Column+    #-}+{-# SPECIALIZE zipWithColumns ::+    (Float -> Float -> Bool) ->+    Column ->+    Column ->+    Either DataFrameException Column+    #-}+{-# SPECIALIZE zipWithColumns ::+    (Int -> Int -> Bool) ->+    Column ->+    Column ->+    Either DataFrameException Column+    #-}+{-# SPECIALIZE zipWithColumns ::+    (Bool -> Bool -> Bool) ->+    Column ->+    Column ->+    Either DataFrameException Column+    #-} +-- Bool-mapping unary ops (e.g. 'not')+{-# SPECIALIZE mapColumn ::+    (Bool -> Bool) -> Column -> Either DataFrameException Column+    #-}+ ------------------------------------------------------------------------------- -- Value: the unified result type -------------------------------------------------------------------------------@@ -273,15 +304,15 @@ -} data Value a where     -- | A single value, not yet broadcast to any length.-    Scalar :: (Columnable a) => a -> Value a+    Scalar :: (Columnable a) => !a -> Value a     {- | A flat column (one element per row in the flat case, or one     element per group after aggregation).     -}-    Flat :: (Columnable a) => Column -> Value a+    Flat :: (Columnable a) => !Column -> Value a     {- | A grouped column: one 'Column' slice per group.  Only produced     when interpreting inside a 'GroupCtx'.     -}-    Group :: (Columnable a) => V.Vector Column -> Value a+    Group :: (Columnable a) => !(V.Vector Column) -> Value a  instance (Show a) => Show (Value a) where     show (Scalar v) = show v@@ -325,6 +356,7 @@ liftValue f (Scalar v) = Right (Scalar (f v)) liftValue f (Flat col) = Flat <$> mapColumn f col liftValue f (Group gs) = Group <$> V.mapM (mapColumn f) gs+{-# INLINEABLE liftValue #-}  {- | Apply a binary function to two 'Value's.  When one side is a 'Scalar' the operation degenerates to a 'liftValue' — this is how the@@ -351,6 +383,7 @@     Left $ AggregatedAndNonAggregatedException "non-aggregated" "aggregated" liftValue2 _ (Group _) (Group _) =     Left $ InternalException "Group count mismatch in binary operation"+{-# INLINEABLE liftValue2 #-}  -- | Branch on a boolean 'Value', selecting from two same-typed 'Value's. branchValue ::@@ -384,6 +417,7 @@         AggregatedAndNonAggregatedException             "if-then-else branches"             "mismatched shapes"+{-# INLINEABLE branchValue #-}  {- | Low-level column branch: given a boolean column and two same-typed columns, produce the element-wise selection.@@ -807,13 +841,13 @@             Group <$> V.mapM (promoteColumnWith onResult) gs -- Unary ------------------------------------------------------------------ -eval ctx expr@(Unary (op :: UnaryOp b a) inner) = addContext expr $ do+eval ctx expr@(Unary op (inner :: Expr b)) = addContext expr $ do     v <- eval @b ctx inner     liftValue (unaryFn op) v  -- Binary ----------------------------------------------------------------- -eval ctx expr@(Binary (op :: BinaryOp c b a) left right) =+eval ctx expr@(Binary op (left :: Expr c) (right :: Expr b)) =     addContext expr $ do         l <- eval @c ctx left         r <- eval @b ctx right
src/DataFrame/Internal/Row.hs view
@@ -17,7 +17,7 @@  import Control.Exception (throw) import Data.Function (on)-import Data.Maybe (fromMaybe)+import Data.Maybe (catMaybes, fromMaybe, isNothing, mapMaybe) import Data.Type.Equality (TestEquality (..)) import Data.Typeable (type (:~:) (..)) import DataFrame.Errors (DataFrameException (..))@@ -28,16 +28,23 @@  data Any where     Value :: (Columnable a) => a -> Any+    -- Saves us the extra indirection we get from making Value (Maybe a)+    -- and having to unpack it again to check for nulls.+    -- Instead, we just have Null as a separate constructor.+    Null :: Any  instance Eq Any where     (==) :: Any -> Any -> Bool     (Value a) == (Value b) = fromMaybe False $ do         Refl <- testEquality (typeOf a) (typeOf b)         return $ a == b+    Null == Null = True+    _ == _ = False  instance Show Any where     show :: Any -> String     show (Value a) = T.unpack (showValue a)+    show Null = "null"  showValue :: forall a. (Columnable a) => a -> T.Text showValue v = case testEquality (typeRep @a) (typeRep @T.Text) of@@ -50,12 +57,21 @@ toAny :: forall a. (Columnable a) => a -> Any toAny = Value --- | Unwraps a value from an \Any\ type.+-- | Unwraps a value from an \Any\ type. A 'Null' cell yields 'Nothing'. fromAny :: forall a. (Columnable a) => Any -> Maybe a+fromAny Null = Nothing fromAny (Value (v :: b)) = do     Refl <- testEquality (typeRep @a) (typeRep @b)     pure v +{- | Wrap a column cell into an 'Any', honouring the column's null bitmap: a slot+marked invalid becomes 'Null', any other slot becomes a 'Value'. Only needs+@Columnable a@ (the stored element type), not @Columnable (Maybe a)@.+-}+cellAny :: (Columnable a) => Maybe Bitmap -> Int -> a -> Any+cellAny Nothing _ x = Value x+cellAny (Just bm) i x = if bitmapTestBit bm i then Value x else Null+ type Row = V.Vector Any  (!?) :: [a] -> Int -> Maybe a@@ -63,18 +79,31 @@ (!?) (x : _) 0 = Just x (!?) (_x : xs) n = (!?) xs (n - 1) +{- | Reconstruct column @i@ from a list of rows. The element type is taken from+the first non-'Null' cell; cells of a different type are skipped. If any cell is+'Null' the result is a nullable column (built with 'fromMaybeVec', which needs+only @Columnable a@), so a round-trip through 'toRowList'/'fromRows' preserves+nulls.+-} mkColumnFromRow :: Int -> [[Any]] -> Column-mkColumnFromRow i rows = case rows of-    [] -> fromList ([] :: [T.Text])-    (row : _) -> case row !? i of-        Nothing -> fromList ([] :: [T.Text])-        Just (Value (v :: a)) -> fromList $ reverse $ L.foldl' addToList [v] (drop 1 rows)-          where-            addToList acc r = case r !? i of-                Nothing -> acc-                Just (Value (v' :: b)) -> case testEquality (typeRep @a) (typeRep @b) of-                    Nothing -> acc-                    Just Refl -> v' : acc+mkColumnFromRow i rows =+    let cells = mapMaybe (!? i) rows+     in case L.find isValue cells of+            Nothing -> fromList ([] :: [T.Text])+            Just (Value (_ :: a)) ->+                let collect Null = Just (Nothing :: Maybe a)+                    collect (Value (v' :: b)) =+                        case testEquality (typeRep @a) (typeRep @b) of+                            Just Refl -> Just (Just v')+                            Nothing -> Nothing+                    maybes = mapMaybe collect cells+                 in if any isNothing maybes+                        then fromMaybeVec (V.fromList maybes)+                        else fromList (catMaybes maybes)+            Just Null -> fromList ([] :: [T.Text]) -- unreachable: find isValue+  where+    isValue (Value _) = True+    isValue Null = False  {- | Converts the entire dataframe to a list of rows. @@ -146,8 +175,8 @@                     [name]                     "[INTERNAL] mkRowFromArgs"                     (M.keys $ columnIndices df)-        Just (BoxedColumn _ column) -> toAny (column V.! i)-        Just (UnboxedColumn _ column) -> toAny (column VU.! i)+        Just (BoxedColumn bm column) -> cellAny bm i (column V.! i)+        Just (UnboxedColumn bm column) -> cellAny bm i (column VU.! i)  -- This function will return the items in the order that is specified -- by the user. For example, if the dataframe consists of the columns@@ -165,11 +194,11 @@                 ++ "the other columns at index "                 ++ show i     get name = case getColumn name df of-        Just (BoxedColumn _ c) -> case c V.!? i of-            Just e -> toAny e+        Just (BoxedColumn bm c) -> case c V.!? i of+            Just e -> cellAny bm i e             Nothing -> throwError name-        Just (UnboxedColumn _ c) -> case c VU.!? i of-            Just e -> toAny e+        Just (UnboxedColumn bm c) -> case c VU.!? i of+            Just e -> cellAny bm i e             Nothing -> throwError name         Nothing ->             throw $ ColumnsNotFoundException [name] "mkRowRep" (M.keys $ columnIndices df)
+ src/DataFrame/Internal/Simplify.hs view
@@ -0,0 +1,422 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module DataFrame.Internal.Simplify (+    simplify,+    simplifyPredicatePair,++    -- * Path-condition entailment (for fitted-tree pruning)+    PredFact,+    factTrue,+    factFalse,+    entails,+) where++import Control.Monad (guard)+import Data.Maybe (fromMaybe)+import Data.Type.Equality (testEquality, (:~:) (Refl))+import Type.Reflection (eqTypeRep, typeRep, (:~~:) (HRefl), pattern App)++import DataFrame.Internal.Column (Columnable)+import DataFrame.Internal.Expression (+    BinaryOp,+    Expr (..),+    UnaryOp (unaryName),+    eqExpr,+    normalize,+ )+import DataFrame.Operators (+    NullAnd,+    NullEq,+    NullGeq,+    NullGt,+    NullLeq,+    NullLt,+    NullNeq,+    NullOr,+    (.==.),+ )++simplify :: forall a. (Columnable a) => Expr a -> Expr a+simplify e+    | isBoolish @a = fixpoint (10 :: Int) e+    | otherwise = e+  where+    fixpoint 0 x = x+    fixpoint n x = let x' = simplifyB x in if eqExpr x x' then x else fixpoint (n - 1) x'++isBoolish :: forall a. (Columnable a) => Bool+isBoolish =+    case ( testEquality (typeRep @a) (typeRep @Bool)+         , testEquality (typeRep @a) (typeRep @(Maybe Bool))+         ) of+        (Just Refl, _) -> True+        (_, Just Refl) -> True+        _ -> False++data Conn = ConnAnd | ConnOr++connOf :: forall op c b r. (BinaryOp op) => op c b r -> Maybe Conn+connOf _+    | Just HRefl <- eqTypeRep (typeRep @op) (typeRep @NullAnd) = Just ConnAnd+    | Just HRefl <- eqTypeRep (typeRep @op) (typeRep @NullOr) = Just ConnOr+    | otherwise = Nothing++simplifyB :: forall a. (Columnable a) => Expr a -> Expr a+simplifyB expr = case expr of+    Binary (op :: op c b a) l r+        | Just conn <- connOf op+        , Just Refl <- testEquality (typeRep @c) (typeRep @a)+        , Just Refl <- testEquality (typeRep @b) (typeRep @a) ->+            let l' = simplifyB l; r' = simplifyB r+             in fromMaybe (Binary op l' r') (combine conn l' r')+        | otherwise -> expr+    Unary (op :: op b a) inner+        | Just Refl <- testEquality (typeRep @a) (typeRep @Bool)+        , Just Refl <- testEquality (typeRep @b) (typeRep @Bool)+        , unaryName op == "not" ->+            simplifyNot op (simplifyB inner)+        | otherwise -> expr+    If c t f ->+        let c' = simplify c+            t' = simplifyB t+            f' = simplifyB f+         in case asBoolLit c' of+                Just True -> t'+                Just False -> f'+                Nothing+                    | eqExpr t' f' -> t'+                    | Just Refl <- testEquality (typeRep @a) (typeRep @Bool)+                    , asBoolLit t' == Just True+                    , asBoolLit f' == Just False ->+                        c'+                    | otherwise -> If c' t' f'+    _ -> expr++simplifyNot :: (UnaryOp op) => op Bool Bool -> Expr Bool -> Expr Bool+simplifyNot op inner = case asBoolLit inner of+    Just b -> Lit (not b)+    Nothing -> case inner of+        Unary (op2 :: op2 b2 Bool) inner2+            | unaryName op2 == "not"+            , Just Refl <- testEquality (typeRep @b2) (typeRep @Bool) ->+                inner2+        _ -> Unary op inner++combine :: (Columnable a) => Conn -> Expr a -> Expr a -> Maybe (Expr a)+combine ConnAnd = combineAnd+combine ConnOr = combineOr++asBoolLit :: forall a. (Columnable a) => Expr a -> Maybe Bool+asBoolLit (Lit v) =+    case testEquality (typeRep @a) (typeRep @Bool) of+        Just Refl -> Just v+        Nothing -> case testEquality (typeRep @a) (typeRep @(Maybe Bool)) of+            Just Refl -> v+            Nothing -> Nothing+asBoolLit _ = Nothing++{- | Polymorphic boolean literal: @Lit b@ for @Expr Bool@, @Lit (Just b)@ for+@Expr (Maybe Bool)@.+-}+litBoolish :: forall a. (Columnable a) => Bool -> Maybe (Expr a)+litBoolish v =+    case testEquality (typeRep @a) (typeRep @Bool) of+        Just Refl -> Just (Lit v)+        Nothing -> case testEquality (typeRep @a) (typeRep @(Maybe Bool)) of+            Just Refl -> Just (Lit (Just v))+            Nothing -> Nothing++combineAnd :: (Columnable a) => Expr a -> Expr a -> Maybe (Expr a)+combineAnd l r+    | eqExpr l r = Just l+    | asBoolLit l == Just False = litBoolish False+    | asBoolLit r == Just False = litBoolish False+    | asBoolLit l == Just True = Just r+    | asBoolLit r == Just True = Just l+    | absorbs ConnOr l r = Just l+    | absorbs ConnOr r l = Just r+    | otherwise = simplifyPredicatePair True l r++combineOr :: (Columnable a) => Expr a -> Expr a -> Maybe (Expr a)+combineOr l r+    | eqExpr l r = Just l+    | asBoolLit l == Just True = litBoolish True+    | asBoolLit r == Just True = litBoolish True+    | asBoolLit l == Just False = Just r+    | asBoolLit r == Just False = Just l+    | absorbs ConnAnd l r = Just l+    | absorbs ConnAnd r l = Just r+    | otherwise = simplifyPredicatePair False l r++absorbs :: (Columnable a) => Conn -> Expr a -> Expr a -> Bool+absorbs conn x (Binary (op :: op c b a) ya yb)+    | Just c' <- connOf op+    , sameConn conn c'+    , Just Refl <- testEquality (typeRep @c) (typeRep @a)+    , Just Refl <- testEquality (typeRep @b) (typeRep @a) =+        eqExpr x ya || eqExpr x yb+absorbs _ _ _ = False++sameConn :: Conn -> Conn -> Bool+sameConn ConnAnd ConnAnd = True+sameConn ConnOr ConnOr = True+sameConn _ _ = False++data Cmp = CLt | CLeq | CGt | CGeq | CEq | CNeq deriving (Eq)++data NullK = Total | FalseOnNull | UnknownOnNull deriving (Eq)++data Atom = Atom+    { aCmp :: Cmp+    , aThr :: !Double+    , aKey :: String+    , aNull :: NullK+    , aIntegral :: Bool+    }++cmpOf :: forall op c b r. (BinaryOp op) => op c b r -> Maybe Cmp+cmpOf _+    | Just HRefl <- eqTypeRep (typeRep @op) (typeRep @NullLt) = Just CLt+    | Just HRefl <- eqTypeRep (typeRep @op) (typeRep @NullLeq) = Just CLeq+    | Just HRefl <- eqTypeRep (typeRep @op) (typeRep @NullGt) = Just CGt+    | Just HRefl <- eqTypeRep (typeRep @op) (typeRep @NullGeq) = Just CGeq+    | Just HRefl <- eqTypeRep (typeRep @op) (typeRep @NullEq) = Just CEq+    | Just HRefl <- eqTypeRep (typeRep @op) (typeRep @NullNeq) = Just CNeq+    | otherwise = Nothing++isLower, isUpper :: Cmp -> Bool+isLower c = c == CGt || c == CGeq+isUpper c = c == CLt || c == CLeq++-- | True if @x@ is a @Maybe _@ type.+isMaybeTy :: forall x. (Columnable x) => Bool+isMaybeTy = case typeRep @x of+    App con _ -> case eqTypeRep con (typeRep @Maybe) of Just HRefl -> True; _ -> False+    _ -> False++litDouble :: forall b. (Columnable b) => Expr b -> Maybe Double+litDouble (Lit v) =+    case testEquality (typeRep @b) (typeRep @Double) of+        Just Refl -> Just v+        Nothing -> case testEquality (typeRep @b) (typeRep @Int) of+            Just Refl -> Just (fromIntegral v)+            Nothing -> case testEquality (typeRep @b) (typeRep @(Maybe Double)) of+                Just Refl -> v+                Nothing -> case testEquality (typeRep @b) (typeRep @(Maybe Int)) of+                    Just Refl -> fromIntegral <$> v+                    Nothing -> Nothing+litDouble _ = Nothing++{- | True for a column lifted from an integral type (never NaN): @toDouble (col …)@+or a column whose type is itself integral.+-}+integralColE :: forall c. (Columnable c) => Expr c -> Bool+integralColE (Unary op _) = unaryName op == "toDouble"+integralColE _ =+    or+        [ matches @Int+        , matches @(Maybe Int)+        ]+  where+    matches :: forall t. (Columnable t) => Bool+    matches = case testEquality (typeRep @c) (typeRep @t) of Just Refl -> True; _ -> False++atomOf :: forall a. (Columnable a) => Expr a -> Maybe Atom+atomOf (Unary fm (Binary (op :: op c b r) (colE :: Expr c) litE))+    | unaryName fm == "fromMaybe"+    , Just cmp <- cmpOf op+    , Just t <- litDouble litE =+        Just (Atom cmp t (show (normalize colE)) FalseOnNull (integralColE colE))+atomOf (Binary (op :: op c b a) (colE :: Expr c) litE)+    | Just cmp <- cmpOf op+    , Just t <- litDouble litE =+        let nk = if isMaybeTy @c then UnknownOnNull else Total+         in Just (Atom cmp t (show (normalize colE)) nk (integralColE colE))+atomOf _ = Nothing++simplifyPredicatePair ::+    forall a. (Columnable a) => Bool -> Expr a -> Expr a -> Maybe (Expr a)+simplifyPredicatePair isAnd a b = do+    atomA <- atomOf a+    atomB <- atomOf b+    guard (aKey atomA == aKey atomB)+    let nk = aNull atomA+        integral = aIntegral atomA+    if isAnd+        then andAtoms a atomA b atomB nk integral+        else orAtoms a atomA b atomB nk integral++-- | Contradiction folds to a literal False unless null-rows make it unknown.+litFalseGated :: (Columnable a) => NullK -> Maybe (Expr a)+litFalseGated UnknownOnNull = Nothing+litFalseGated _ = litBoolish False++{- | Tautology to literal True is sound only for total (never-null) atoms; the+exhaustive-cover form additionally needs a non-NaN (integral) column.+-}+litTrueTotal :: (Columnable a) => NullK -> Maybe (Expr a)+litTrueTotal Total = litBoolish True+litTrueTotal _ = Nothing++andAtoms ::+    (Columnable a) =>+    Expr a -> Atom -> Expr a -> Atom -> NullK -> Bool -> Maybe (Expr a)+andAtoms a atomA b atomB nk _ =+    let cA = aCmp atomA; tA = aThr atomA; cB = aCmp atomB; tB = aThr atomB+     in if+            | isLower cA, isLower cB, cA == cB -> Just (if tA >= tB then a else b)+            | isUpper cA, isUpper cB, cA == cB -> Just (if tA <= tB then a else b)+            | isLower cA, isUpper cB -> lu cA tA cB tB+            | isUpper cA, isLower cB -> lu cB tB cA tA+            | cA == CEq, cB == CEq -> if tA == tB then Just a else litFalseGated nk+            | cA == CEq, cB == CNeq -> if tA == tB then litFalseGated nk else Just a+            | cA == CNeq, cB == CEq -> if tA == tB then litFalseGated nk else Just b+            | cA == CEq -> if satisfies tA cB tB then Just a else litFalseGated nk+            | cB == CEq -> if satisfies tB cA tA then Just b else litFalseGated nk+            | cA == CNeq, cB == CNeq -> Nothing+            | cA == CNeq -> if outside tA cB tB then Just b else Nothing+            | cB == CNeq -> if outside tB cA tA then Just a else Nothing+            | otherwise -> Nothing+  where+    lu lc lo uc hi+        | lo > hi = litFalseGated nk+        | lo == hi, lc == CGeq, uc == CLeq = pointEq a lo+        | lo == hi = litFalseGated nk+        | otherwise = Nothing++orAtoms ::+    (Columnable a) =>+    Expr a -> Atom -> Expr a -> Atom -> NullK -> Bool -> Maybe (Expr a)+orAtoms a atomA b atomB nk integral =+    let cA = aCmp atomA; tA = aThr atomA; cB = aCmp atomB; tB = aThr atomB+     in if+            | isLower cA, isLower cB, cA == cB -> Just (if tA <= tB then a else b)+            | isUpper cA, isUpper cB, cA == cB -> Just (if tA >= tB then a else b)+            | isUpper cA+            , isLower cB+            , nk == Total+            , integral+            , covers cB tB cA tA ->+                litTrueTotal nk+            | isLower cA+            , isUpper cB+            , nk == Total+            , integral+            , covers cA tA cB tB ->+                litTrueTotal nk+            | cA == CNeq, cB == CNeq -> if tA == tB then Just a else litTrueTotal nk+            | cA == CEq, cB == CNeq -> if tA == tB then litTrueTotal nk else Just b+            | cA == CNeq, cB == CEq -> if tA == tB then litTrueTotal nk else Just a+            | cA == CEq, cB == CEq -> if tA == tB then Just a else Nothing+            | otherwise -> Nothing++{- | Build @col == t@ for the point-collapse rule; only strict @Expr Bool@ over a+@Double@ column (otherwise bail).+-}+pointEq :: forall a. (Columnable a) => Expr a -> Double -> Maybe (Expr a)+pointEq atom lo = case testEquality (typeRep @a) (typeRep @Bool) of+    Just Refl -> (\colE -> colE .==. Lit lo) <$> recoverColD atom+    Nothing -> Nothing++recoverColD :: Expr x -> Maybe (Expr Double)+recoverColD (Binary _ (colE :: Expr c) _) =+    case testEquality (typeRep @c) (typeRep @Double) of+        Just Refl -> Just colE+        _ -> Nothing+recoverColD (Unary _ inner) = recoverColD inner+recoverColD _ = Nothing++covers :: Cmp -> Double -> Cmp -> Double -> Bool+covers lowerCmp lo upperCmp hi =+    lo < hi || (lo == hi && (lowerCmp == CGeq || upperCmp == CLeq))++satisfies :: Double -> Cmp -> Double -> Bool+satisfies t CGt tb = t > tb+satisfies t CGeq tb = t >= tb+satisfies t CLt tb = t < tb+satisfies t CLeq tb = t <= tb+satisfies _ _ _ = False++outside :: Double -> Cmp -> Double -> Bool+outside t CGt tb = t <= tb+outside t CGeq tb = t < tb+outside t CLt tb = t >= tb+outside t CLeq tb = t > tb+outside _ _ _ = False++-- ---------------------------------------------------------------------------+-- Path-condition entailment for fitted-tree pruning.+-- ---------------------------------------------------------------------------++-- | A known same-column threshold fact accumulated along a tree path.+data PredFact = PredFact !String !Cmp !Double++-- | The fact a branch's true edge establishes (the condition holds).+factTrue :: Expr Bool -> Maybe PredFact+factTrue e = (\a -> PredFact (aKey a) (aCmp a) (aThr a)) <$> atomOf e++{- | The fact a branch's false edge establishes (the negated condition). Only+sound for non-NaN (integral) columns — a NaN row takes the false edge too,+so @¬(x>t)@ is not a clean @x<=t@ bound for floats.+-}+factFalse :: Expr Bool -> Maybe PredFact+factFalse e = do+    a <- atomOf e+    guard (aIntegral a && aNull a == Total)+    nc <- negCmp (aCmp a)+    pure (PredFact (aKey a) nc (aThr a))++negCmp :: Cmp -> Maybe Cmp+negCmp CLt = Just CGeq+negCmp CLeq = Just CGt+negCmp CGt = Just CLeq+negCmp CGeq = Just CLt+negCmp _ = Nothing++{- | @entails facts cond@: 'Just' 'True' when the path facts force @cond@ true,+'Just' 'False' when they force it false, 'Nothing' when undecided.+-}+entails :: [PredFact] -> Expr Bool -> Maybe Bool+entails facts cond = do+    a <- atomOf cond+    let decisions =+            [ d+            | PredFact fk fc ft <- facts+            , fk == aKey a+            , Just d <- [factImplies (fc, ft) (aCmp a, aThr a)]+            ]+    case decisions of+        (d : _) -> Just d+        [] -> Nothing++{- | Does the fact's solution set sit inside @cond@ ('Just' 'True'), disjoint+from it ('Just' 'False'), or neither ('Nothing')? Boundary strictness is+honoured: e.g. @x<=t@ does NOT entail @x<t@, and @x>=t ∧ x<=t@ is not empty.+-}+factImplies :: (Cmp, Double) -> (Cmp, Double) -> Maybe Bool+factImplies (fc, ft) (cc, tc)+    | isLower fc, isLower cc, subset = Just True+    | isUpper fc, isUpper cc, subset = Just True+    | isLower fc, isUpper cc, disjointAtEq = Just False+    | isUpper fc, isLower cc, disjointBelow = Just False+    | otherwise = Nothing+  where+    fIncl = fc == CGeq || fc == CLeq+    cIncl = cc == CGeq || cc == CLeq+    -- same-direction containment: strictly tighter, or equal threshold where the+    -- fact's boundary inclusivity is no stronger than the condition's.+    subset =+        (if isLower fc then ft > tc else ft < tc)+            || (ft == tc && (not fIncl || cIncl))+    -- lower fact ∩ upper cond empty: fact starts above cond's top, or they meet+    -- at a point that is not in both.+    disjointAtEq = ft > tc || (ft == tc && not (fIncl && cIncl))+    -- upper fact ∩ lower cond empty (mirror).+    disjointBelow = ft < tc || (ft == tc && not (fIncl && cIncl))
src/DataFrame/Operators.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}@@ -9,8 +10,8 @@ import qualified Data.Text as T import DataFrame.Internal.Column (Columnable) import DataFrame.Internal.Expression (+    BinUDF (MkBinaryOp),     BinaryOp (-        MkBinaryOp,         binaryCommutative,         binaryFn,         binaryName,@@ -20,7 +21,7 @@     Expr (Binary, Col, If, Lit, Unary),     NamedExpr,     UExpr (UExpr),-    UnaryOp (MkUnaryOp, unaryFn, unaryName, unarySymbol),+    UnUDF (MkUnaryOp),  ) import DataFrame.Internal.Nullable (     BaseType,@@ -72,7 +73,7 @@ liftDecorated ::     (Columnable a, Columnable b) =>     (a -> b) -> T.Text -> Maybe T.Text -> Expr a -> Expr b-liftDecorated f opName rep = Unary (MkUnaryOp{unaryFn = f, unaryName = opName, unarySymbol = rep})+liftDecorated f opName rep = Unary (MkUnaryOp f opName rep)  lift2Decorated ::     (Columnable c, Columnable b, Columnable a) =>@@ -85,16 +86,111 @@     Expr b ->     Expr a lift2Decorated f opName rep comm prec =-    Binary-        ( MkBinaryOp-            { binaryFn = f-            , binaryName = opName-            , binarySymbol = rep-            , binaryCommutative = comm-            , binaryPrecedence = prec-            }-        )+    Binary (MkBinaryOp f opName rep comm prec) +data NullEq a b c where+    NullEq ::+        ( NumericWidenOp (BaseType a) (BaseType b)+        , NullLift2Op a b Bool (NullCmpResult a b)+        , Eq (Promote (BaseType a) (BaseType b))+        ) =>+        NullEq a b (NullCmpResult a b)++data NullNeq a b c where+    NullNeq ::+        ( NumericWidenOp (BaseType a) (BaseType b)+        , NullLift2Op a b Bool (NullCmpResult a b)+        , Eq (Promote (BaseType a) (BaseType b))+        ) =>+        NullNeq a b (NullCmpResult a b)++data NullLt a b c where+    NullLt ::+        ( NumericWidenOp (BaseType a) (BaseType b)+        , NullLift2Op a b Bool (NullCmpResult a b)+        , Ord (Promote (BaseType a) (BaseType b))+        ) =>+        NullLt a b (NullCmpResult a b)++data NullGt a b c where+    NullGt ::+        ( NumericWidenOp (BaseType a) (BaseType b)+        , NullLift2Op a b Bool (NullCmpResult a b)+        , Ord (Promote (BaseType a) (BaseType b))+        ) =>+        NullGt a b (NullCmpResult a b)++data NullLeq a b c where+    NullLeq ::+        ( NumericWidenOp (BaseType a) (BaseType b)+        , NullLift2Op a b Bool (NullCmpResult a b)+        , Ord (Promote (BaseType a) (BaseType b))+        ) =>+        NullLeq a b (NullCmpResult a b)++data NullGeq a b c where+    NullGeq ::+        ( NumericWidenOp (BaseType a) (BaseType b)+        , NullLift2Op a b Bool (NullCmpResult a b)+        , Ord (Promote (BaseType a) (BaseType b))+        ) =>+        NullGeq a b (NullCmpResult a b)++data NullAnd a b c where+    NullAnd ::+        (NullableCmpOp a b (NullCmpResult a b), BaseType a ~ Bool) =>+        NullAnd a b (NullCmpResult a b)++data NullOr a b c where+    NullOr ::+        (NullableCmpOp a b (NullCmpResult a b), BaseType a ~ Bool) =>+        NullOr a b (NullCmpResult a b)++instance BinaryOp NullEq where+    binaryFn NullEq = applyNull2 (widenCmpOp (==))+    binaryName NullEq = "eq"+    binarySymbol NullEq = Just ".=="+    binaryCommutative NullEq = True+    binaryPrecedence NullEq = 4+instance BinaryOp NullNeq where+    binaryFn NullNeq = applyNull2 (widenCmpOp (/=))+    binaryName NullNeq = "neq"+    binarySymbol NullNeq = Just "./="+    binaryCommutative NullNeq = True+    binaryPrecedence NullNeq = 4+instance BinaryOp NullLt where+    binaryFn NullLt = applyNull2 (widenCmpOp (<))+    binaryName NullLt = "lt"+    binarySymbol NullLt = Just ".<"+    binaryPrecedence NullLt = 4+instance BinaryOp NullGt where+    binaryFn NullGt = applyNull2 (widenCmpOp (>))+    binaryName NullGt = "gt"+    binarySymbol NullGt = Just ".>"+    binaryPrecedence NullGt = 4+instance BinaryOp NullLeq where+    binaryFn NullLeq = applyNull2 (widenCmpOp (<=))+    binaryName NullLeq = "leq"+    binarySymbol NullLeq = Just ".<="+    binaryPrecedence NullLeq = 4+instance BinaryOp NullGeq where+    binaryFn NullGeq = applyNull2 (widenCmpOp (>=))+    binaryName NullGeq = "geq"+    binarySymbol NullGeq = Just ".>="+    binaryPrecedence NullGeq = 4+instance BinaryOp NullAnd where+    binaryFn NullAnd = nullCmpOp (&&)+    binaryName NullAnd = "nulland"+    binarySymbol NullAnd = Just ".&&"+    binaryCommutative NullAnd = True+    binaryPrecedence NullAnd = 3+instance BinaryOp NullOr where+    binaryFn NullOr = nullCmpOp (||)+    binaryName NullOr = "nullor"+    binarySymbol NullOr = Just ".||"+    binaryCommutative NullOr = True+    binaryPrecedence NullOr = 2+ (.==.) ::     (Columnable a, Eq a) =>     Expr a ->@@ -211,7 +307,7 @@     Expr a ->     Expr b ->     Expr (NullCmpResult a b)-(.==) = lift2Decorated (applyNull2 (widenCmpOp (==))) "eq" (Just ".==") True 4+(.==) = Binary NullEq  -- | Nullable-aware inequality. Widens numeric operands to their common type. (./=) ::@@ -222,7 +318,7 @@     Expr a ->     Expr b ->     Expr (NullCmpResult a b)-(./=) = lift2Decorated (applyNull2 (widenCmpOp (/=))) "neq" (Just "./=") True 4+(./=) = Binary NullNeq  -- | Nullable-aware less-than. Widens numeric operands to their common type. (.<) ::@@ -233,7 +329,7 @@     Expr a ->     Expr b ->     Expr (NullCmpResult a b)-(.<) = lift2Decorated (applyNull2 (widenCmpOp (<))) "lt" (Just ".<") False 4+(.<) = Binary NullLt  -- | Nullable-aware greater-than. Widens numeric operands to their common type. (.>) ::@@ -244,7 +340,7 @@     Expr a ->     Expr b ->     Expr (NullCmpResult a b)-(.>) = lift2Decorated (applyNull2 (widenCmpOp (>))) "gt" (Just ".>") False 4+(.>) = Binary NullGt  {- | Nullable-aware less-than-or-equal. Widens numeric operands to their common type, so @Expr Double .<= Expr Int@ typechecks.@@ -257,7 +353,7 @@     Expr a ->     Expr b ->     Expr (NullCmpResult a b)-(.<=) = lift2Decorated (applyNull2 (widenCmpOp (<=))) "leq" (Just ".<=") False 4+(.<=) = Binary NullLeq  -- | Nullable-aware greater-than-or-equal. Widens numeric operands to their common type. (.>=) ::@@ -268,7 +364,7 @@     Expr a ->     Expr b ->     Expr (NullCmpResult a b)-(.>=) = lift2Decorated (applyNull2 (widenCmpOp (>=))) "geq" (Just ".>=") False 4+(.>=) = Binary NullGeq  (.&&.) :: Expr Bool -> Expr Bool -> Expr Bool (.&&.) = lift2Decorated (&&) "and" (Just ".&&.") True 3@@ -282,7 +378,7 @@     Expr a ->     Expr b ->     Expr (NullCmpResult a b)-(.&&) = lift2Decorated (nullCmpOp (&&)) "nulland" (Just ".&&") True 3+(.&&) = Binary NullAnd  -- | Nullable-aware logical OR. Returns @Maybe Bool@ when either operand is nullable. (.||) ::@@ -290,7 +386,7 @@     Expr a ->     Expr b ->     Expr (NullCmpResult a b)-(.||) = lift2Decorated (nullCmpOp (||)) "nullor" (Just ".||") True 2+(.||) = Binary NullOr  (.^^) ::     ( Columnable (BaseType a)