diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ - + -> 2.0 * x + 0.9999999999999989 +> :17:7: error: [GHC-83865] +> • Couldn't match expected type: [Double] +> with actual type: (Data.Text.Internal.Text, D.Column) +> • In the expression: "x" =: [1, 2, 3, ....] :: [Double] +> In the first argument of ‘D.fromColumns’, namely +> ‘["x" =: [1, 2, ....] :: [Double], +> "y" =: [2 * x + 1 | x <- [1, ....]] :: [Double]]’ +> In the expression: +> D.fromColumns +> ["x" =: [1, 2, ....] :: [Double], +> "y" =: [2 * x + 1 | x <- [1, ....]] :: [Double]] +> +> :18:7: error: [GHC-83865] +> • Couldn't match expected type: [Double] +> with actual type: (Data.Text.Internal.Text, D.Column) +> • In the expression: +> "y" =: [2 * x + 1 | x <- [1, 2, ....]] :: [Double] +> In the first argument of ‘D.fromColumns’, namely +> ‘["x" =: [1, 2, ....] :: [Double], +> "y" =: [2 * x + 1 | x <- [1, ....]] :: [Double]]’ +> In the expression: +> D.fromColumns +> ["x" =: [1, 2, ....] :: [Double], +> "y" =: [2 * x + 1 | x <- [1, ....]] :: [Double]] +> +> :24:34: error: [GHC-88464] +> Variable not in scope: model ## Type-safe linear regression @@ -67,18 +94,25 @@ ``` > -> typed model: 2.0 * x + 0.9999999999999989 -> schema after: ["x","y","prediction"] +> :35:66: error: [GHC-88464] +> Variable not in scope: sales :: D.DataFrame +> Suggested fix: Perhaps use ‘salesT’ (line 35) +> +> :42:61: error: [GHC-88464] +> Variable not in scope: typedModel +> +> :43:47: error: [GHC-88464] +> Variable not in scope: scored :: T.TypedDataFrame cols1 ## Decision trees The tree compiles to nested `if/then/else` over your columns: ```haskell -flowers = D.fromNamedColumns - [ ("petal_length", D.fromList ([1.4, 1.3, 1.5, 1.4, 4.5, 4.7, 4.6, 4.4, 5.5, 5.8, 5.6, 5.7] :: [Double])) - , ("petal_width", D.fromList ([0.2, 0.2, 0.1, 0.3, 1.5, 1.4, 1.6, 1.3, 2.0, 2.1, 1.9, 2.2] :: [Double])) - , ("species", D.fromList ([0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2] :: [Double])) +flowers = D.fromColumns + [ "petal_length" =: [1.4, 1.3, 1.5, 1.4, 4.5, 4.7, 4.6, 4.4, 5.5, 5.8, 5.6, 5.7] :: [Double] + , "petal_width" =: [0.2, 0.2, 0.1, 0.3, 1.5, 1.4, 1.6, 1.3, 2.0, 2.1, 1.9, 2.2] :: [Double] + , "species" =: [0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2] :: [Double] ] tree = fit defaultTreeConfig (D.col @Double "species") flowers @@ -86,11 +120,51 @@ ``` > -> if petal_length .<=. 2.95 -> then 0.0 -> else if petal_length .<=. 5.1 -> then 1.0 -> else 2.0 +> :52:7: error: [GHC-83865] +> • Couldn't match expected type: [Double] +> with actual type: (Data.Text.Internal.Text, D.Column) +> • In the expression: +> "petal_length" =: [1.4, 1.3, 1.5, ....] :: [Double] +> In the first argument of ‘D.fromColumns’, namely +> ‘["petal_length" =: [1.4, 1.3, ....] :: [Double], +> "petal_width" =: [0.2, 0.2, ....] :: [Double], +> "species" =: [0, 0, ....] :: [Double]]’ +> In the expression: +> D.fromColumns +> ["petal_length" =: [1.4, 1.3, ....] :: [Double], +> "petal_width" =: [0.2, 0.2, ....] :: [Double], +> "species" =: [0, 0, ....] :: [Double]] +> +> :53:7: error: [GHC-83865] +> • Couldn't match expected type: [Double] +> with actual type: (Data.Text.Internal.Text, D.Column) +> • In the expression: +> "petal_width" =: [0.2, 0.2, 0.1, ....] :: [Double] +> In the first argument of ‘D.fromColumns’, namely +> ‘["petal_length" =: [1.4, 1.3, ....] :: [Double], +> "petal_width" =: [0.2, 0.2, ....] :: [Double], +> "species" =: [0, 0, ....] :: [Double]]’ +> In the expression: +> D.fromColumns +> ["petal_length" =: [1.4, 1.3, ....] :: [Double], +> "petal_width" =: [0.2, 0.2, ....] :: [Double], +> "species" =: [0, 0, ....] :: [Double]] +> +> :54:7: error: [GHC-83865] +> • Couldn't match expected type: [Double] +> with actual type: (Data.Text.Internal.Text, D.Column) +> • In the expression: "species" =: [0, 0, 0, ....] :: [Double] +> In the first argument of ‘D.fromColumns’, namely +> ‘["petal_length" =: [1.4, 1.3, ....] :: [Double], +> "petal_width" =: [0.2, 0.2, ....] :: [Double], +> "species" =: [0, 0, ....] :: [Double]]’ +> In the expression: +> D.fromColumns +> ["petal_length" =: [1.4, 1.3, ....] :: [Double], +> "petal_width" =: [0.2, 0.2, ....] :: [Double], +> "species" =: [0, 0, ....] :: [Double]] +> +> :60:34: error: [GHC-88464] Variable not in scope: tree ## Symbolic regression discovers a formula @@ -98,9 +172,9 @@ it as a dataframe `Expr` plus the accuracy/complexity Pareto front: ```haskell -curve = D.fromNamedColumns - [ ("x", D.fromList xs) - , ("y", D.fromList [x * x + x | x <- xs]) +curve = D.fromColumns + [ "x" =: xs + , "y" =: [x * x + x | x <- xs] ] where xs = [-3, -2, -1, 0, 1, 2, 3, 4, 5, 6] :: [Double] @@ -122,7 +196,12 @@ ``` > -> ["x","y","prediction"] +> :87:47: error: [GHC-88464] +> Variable not in scope: model +> Suggested fix: Perhaps use ‘T.mode’ (imported from DataFrame.Typed) +> +> :87:54: error: [GHC-88464] +> Variable not in scope: sales :: D.DataFrame ## A model and its preprocessing compose by substitution @@ -145,8 +224,19 @@ ``` > -> trained in scaled space: 3.4156502553198655 * x + 8.0 -> folded to raw columns: 3.4156502553198655 * (x - 3.5) / 1.707825127659933 + 8.0 +> :95:36: error: [GHC-88464] +> Variable not in scope: sales :: D.DataFrame +> +> :96:55: error: [GHC-88464] +> Variable not in scope: sales :: D.DataFrame +> +> :103:61: error: [GHC-88464] +> Variable not in scope: scaledModel +> Suggested fix: +> Perhaps use data constructor ‘ScalerModel’ (imported from DataFrame.Learn) +> +> :104:52: error: [GHC-88464] +> Variable not in scope: deployed :: D.Expr a1 The folded expression is a function of the raw `x` alone, so it scores the original frame with no preprocessing step at inference time. @@ -156,17 +246,21 @@ ``` > -> 3.6259732146947156e-16 +> :112:15: error: [GHC-88464] +> Variable not in scope: deployed :: D.Expr Double +> +> :112:44: error: [GHC-88464] +> Variable not in scope: sales :: D.DataFrame ## Splitting the data, and evaluation ```haskell import qualified DataFrame as D -realistic = D.fromNamedColumns - [ ("id", D.fromList [fromIntegral ((i * 7919) `mod` 97) | i <- [1 .. 40 :: Int]]) - , ("x", D.fromList xs) - , ("y", D.fromList [2 * x + 1 + noise i | (i, x) <- zip [0 :: Int ..] xs]) +realistic = D.fromColumns + [ "id" =: [fromIntegral ((i * 7919) `mod` 97) | i <- [1 .. 40 :: Int]] + , "x" =: xs + , "y" =: [2 * x + 1 + noise i | (i, x) <- zip [0 :: Int ..] xs] ] where xs = map fromIntegral [1 .. 40 :: Int] :: [Double] @@ -224,14 +318,13 @@ ``` > -> class precision recall f1 support -> 0.0 1.0 1.0 1.0 4 -> 1.0 1.0 1.0 1.0 4 -> 2.0 1.0 1.0 1.0 4 +> :170:59: error: [GHC-88464] +> Variable not in scope: flowers :: D.DataFrame > -> accuracy = 1.0 -> macro f1 = 1.0 -> weighted f1 = 1.0 +> :173:49: error: [GHC-88464] Variable not in scope: clf +> +> :173:80: error: [GHC-88464] +> Variable not in scope: flowers :: D.DataFrame ## Pipelines compose as a monoid @@ -249,7 +342,17 @@ ``` > -> ["petal_length","petal_width","species","pc1","pc2"] +> :182:36: error: [GHC-88464] +> Variable not in scope: flowers :: D.DataFrame +> +> :183:74: error: [GHC-88464] +> Variable not in scope: flowers :: D.DataFrame +> +> :188:31: error: [GHC-88464] +> Variable not in scope: pipeline :: Transform +> +> :188:40: error: [GHC-88464] +> Variable not in scope: flowers :: D.DataFrame ## Synthesize the feature you would have hand-engineered @@ -261,10 +364,10 @@ to exact — still a formula you can read: ```haskell -interactions = D.fromNamedColumns - [ ("a", D.fromList as) - , ("b", D.fromList bs) - , ("y", D.fromList (zipWith (*) as bs)) +interactions = D.fromColumns + [ "a" =: as + , "b" =: bs + , "y" =: zipWith (*) as bs ] where as = [-1, -1, 1, 1, -2, 2, -2, 2] :: [Double] diff --git a/dataframe-learn.cabal b/dataframe-learn.cabal --- a/dataframe-learn.cabal +++ b/dataframe-learn.cabal @@ -1,6 +1,6 @@ cabal-version: 3.4 name: dataframe-learn -version: 2.4.2.0 +version: 2.5.0.0 synopsis: Interpretable, expression-returning machine learning for the dataframe ecosystem. description: A small scikit-learn-style ML library where every model returns both an @@ -45,6 +45,7 @@ DataFrame.DecisionTree.Pool DataFrame.DecisionTree.Linear DataFrame.DecisionTree.Tao + DataFrame.DecisionTree.Histogram DataFrame.DecisionTree.Fit DataFrame.LinearSolver DataFrame.LinearSolver.Loss @@ -61,8 +62,8 @@ containers >= 0.6.7 && < 0.10, parallel >= 3.3 && < 4, random >= 1.2 && < 2, - dataframe-core >= 2.5 && < 2.6, - dataframe-operations >= 2.5 && < 2.6, + dataframe-core >= 2.6 && < 2.7, + dataframe-operations >= 2.6 && < 2.7, text >= 2.1 && < 3, vector >= 0.13 && < 0.15, vector-algorithms >= 0.9 && < 0.11 @@ -105,14 +106,15 @@ containers >= 0.6.7 && < 0.10, parallel >= 3.3 && < 4, random >= 1.2 && < 2, - dataframe-core >= 2.5 && < 2.6, - dataframe-core >= 2.5 && < 2.6, - dataframe-operations >= 2.5 && < 2.6, - dataframe-operations >= 2.5 && < 2.6, - dataframe-expr-serializer >= 1.2.1 && < 1.3, + dataframe-core >= 2.6 && < 2.7, + dataframe-core >= 2.6 && < 2.7, + dataframe-operations >= 2.6 && < 2.7, + dataframe-operations >= 2.6 && < 2.7, + dataframe-expr-serializer >= 1.3 && < 1.4, dataframe-learn:internal, text >= 2.1 && < 3, - vector >= 0.13 && < 0.15 + vector >= 0.13 && < 0.15, + vector-algorithms >= 0.9 && < 0.11 hs-source-dirs: src default-language: Haskell2010 @@ -125,6 +127,8 @@ main-is: Main.hs other-modules: DataFrameApi Cart + NullSplits + HistogramTrees DecisionTree TreePruning Worklist @@ -140,13 +144,13 @@ aeson >= 0.11.0.0 && < 3, bytestring >= 0.11 && < 0.14, containers >= 0.6.7 && < 0.10, - dataframe-core >= 2.5 && < 2.6, - dataframe-core >= 2.5 && < 2.6, + dataframe-core >= 2.6 && < 2.7, + dataframe-core >= 2.6 && < 2.7, dataframe-csv >= 2.3 && < 2.4, dataframe-learn, dataframe-learn:internal, - dataframe-operations >= 2.5 && < 2.6, - dataframe-operations >= 2.5 && < 2.6, + dataframe-operations >= 2.6 && < 2.7, + dataframe-operations >= 2.6 && < 2.7, HUnit >= 1.6 && < 1.8, QuickCheck >= 2 && < 3, random >= 1 && < 2, diff --git a/src-internal/DataFrame/DecisionTree/Cart.hs b/src-internal/DataFrame/DecisionTree/Cart.hs --- a/src-internal/DataFrame/DecisionTree/Cart.hs +++ b/src-internal/DataFrame/DecisionTree/Cart.hs @@ -4,19 +4,20 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -{- | sklearn-faithful CART initializer used to seed TAO. One-hot encodes -categoricals and splits on exact (unsmoothed) Gini over midpoint thresholds -(@<=@ routes left), matching @DecisionTreeClassifier(criterion='gini')@. --} module DataFrame.DecisionTree.Cart ( CartFeature (..), + NullSide (..), + cfPred, + splitMidpoint, CartNode (..), sortIndicesByValue, buildCartTree, cartFeatures, + cartFeaturesByColumn, cartTargetLabels, ) where +import qualified Data.List as L import DataFrame.DecisionTree.Types (Tree (..), TreeConfig (..)) import DataFrame.Errors (DataFrameException (..), TypeErrorContext (..)) import DataFrame.Expression.Operators @@ -35,7 +36,6 @@ import Control.Exception (throw) import Data.Either (fromRight) import Data.Function (on) -import Data.List (foldl') import qualified Data.Map.Strict as M import qualified Data.Set as Set import qualified Data.Text as T @@ -45,14 +45,29 @@ import qualified Data.Vector.Unboxed as VU import Type.Reflection (TypeRep, typeRep) -{- | A one-hot feature column: per-row Double values plus the sklearn LEFT -predicate (@x <= threshold@) over the ORIGINAL DataFrame. --} +-- | A one-hot feature column with its sklearn LEFT predicate. data CartFeature = CartFeature { cfValues :: !(VU.Vector Double) - , cfPred :: !(Double -> Expr Bool) + -- ^ One value per row. Null rows hold @+Infinity@, so they sort last. + , cfNulls :: !(Maybe (VU.Vector Bool)) + -- ^ Which rows are null; 'Nothing' if the training data has no nulls here. + , cfSplit :: !(Double -> NullSide -> Expr Bool) + -- ^ The split expression, sending null rows to the given side. } +data NullSide = NullsLeft | NullsRight + deriving (Eq, Show) + +-- | The split expression with null rows sent right. +cfPred :: CartFeature -> Double -> Expr Bool +cfPred f t = cfSplit f t NullsRight + +-- | The threshold between two adjacent sorted values, keeping nulls right. +splitMidpoint :: Double -> Double -> Double +splitMidpoint lo hi + | isInfinite hi = lo + | otherwise = (lo + hi) / 2 + -- | Pre-'Tree' CART node: a leaf class id, or a split on feature @j@. data CartNode = CLeaf !Int | CSplit !Int !Double !CartNode !CartNode @@ -66,9 +81,7 @@ , ctxMinLeaf :: !Int } -{- | Indices @0..n-1@ stably sorted by their value (ascending), ties keeping -ascending index. In-place unboxed merge sort — no boxed-list allocation. --} +-- | Indices 0..n-1 stably sorted by value, via in-place merge sort. sortIndicesByValue :: VU.Vector Double -> VU.Vector Int sortIndicesByValue vs = VU.create $ do @@ -95,10 +108,7 @@ (maxTreeDepth cfg) (max 1 (minLeafSize cfg)) -{- | Read the target column at the type the tree is being fitted at. Names the -column and both types on failure: a bare @fromIntegral@ defaults to 'Integer' -and lands here, and the old message said only that something went wrong. --} +-- | Read the target column at the fitted type, naming both types on failure. cartLabels :: forall a. (Columnable a) => DataFrame -> T.Text -> V.Vector a cartLabels df target = case interpret @a df (Col target) of Right (TColumn column) -> fromRight (throw err) (toVector @a column) @@ -170,9 +180,7 @@ rightSorted = V.map (VU.filter (\i -> vals VU.! i > thr)) sortedByFeat rec = buildCartNode ctx (depth + 1) -{- | Minimum weighted-child-Gini @(feature, threshold)@; the first feature wins -ties; 'Nothing' when no feature has a leaf-size-respecting threshold. --} +-- | Minimum weighted-child-Gini split; the first feature wins ties. bestSplit :: CartCtx -> V.Vector (VU.Vector Int) -> @@ -180,16 +188,14 @@ Int -> Maybe (Int, Double) bestSplit ctx sortedByFeat counts n = - fmap (\(_, j, t) -> (j, t)) (foldl' consider Nothing [0 .. ctxNFeats ctx - 1]) + fmap (\(_, j, t) -> (j, t)) (L.foldl' consider Nothing [0 .. ctxNFeats ctx - 1]) where total = VU.toList counts consider acc fj = case sweepFeature ctx total (sortedByFeat V.! fj) (ctxFeats ctx V.! fj) n of Just (g, thr) | maybe True (\(gB, _, _) -> g < gB) acc -> Just (g, fj, thr) _ -> acc -{- | Accumulator while sweeping a feature's sorted rows: best @(gini, thr)@ so -far, per-class left counts, rows moved left, and the previous value seen. --} +-- | Accumulator while sweeping a feature's sorted rows. data Sweep = Sweep { swBest :: !(Maybe (Double, Double)) , swLeft :: ![Int] @@ -206,7 +212,7 @@ Maybe (Double, Double) sweepFeature ctx total si feat n = swBest - ( foldl' + ( L.foldl' step (Sweep Nothing (replicate (ctxNClasses ctx) 0) 0 (0 / 0)) [0 .. VU.length si - 1] @@ -234,7 +240,7 @@ keepBetter (swBest s) (weightedGini total (swLeft s) (swMoved s) n) - ((swPrev s + v) / 2) + (splitMidpoint (swPrev s) v) | otherwise = swBest s keepBetter :: @@ -263,40 +269,102 @@ -- | One-hot features in @pd.get_dummies(drop_first=False)@ column order. cartFeatures :: T.Text -> DataFrame -> [CartFeature] -cartFeatures target df = concatMap (featuresOfColumn df) (filter (/= target) (columnNames df)) +cartFeatures target df = map snd (cartFeaturesByColumn target df) +-- | 'cartFeatures', each paired with the column it was built from. +cartFeaturesByColumn :: T.Text -> DataFrame -> [(T.Text, CartFeature)] +cartFeaturesByColumn target df = + [(c, f) | c <- filter (/= target) (columnNames df), f <- featuresOfColumn df c] + featuresOfColumn :: DataFrame -> T.Text -> [CartFeature] featuresOfColumn df c = case unsafeGetColumn c df of - UnboxedColumn _ (v :: VU.Vector b) -> numericFeature @b c v - BoxedColumn _ (v :: V.Vector b) -> oneHotFeatures @b (nRows df) c v + UnboxedColumn bm (v :: VU.Vector b) -> numericFeature @b c bm v + BoxedColumn bm (v :: V.Vector b) -> oneHotFeatures @b c bm v pt@(PackedText _ _) -> case materializePacked pt of - BoxedColumn _ (v :: V.Vector b) -> oneHotFeatures @b (nRows df) c v + BoxedColumn bm (v :: V.Vector b) -> oneHotFeatures @b c bm v _ -> [] mc@(MergedColumn _ _) -> case materializeMerged mc of - BoxedColumn _ (v :: V.Vector b) -> oneHotFeatures @b (nRows df) c v + BoxedColumn bm (v :: V.Vector b) -> oneHotFeatures @b c bm v _ -> [] +nullFlags :: Int -> Bitmap -> VU.Vector Bool +nullFlags n bm = VU.generate n (not . bitmapTestBit bm) + +-- | Nothing if no row is null, so null-free columns split the plain way. +trainingNulls :: VU.Vector Bool -> Maybe (VU.Vector Bool) +trainingNulls nulls + | VU.or nulls = Just nulls + | otherwise = Nothing + numericFeature :: - forall b. (Columnable b, VU.Unbox b) => T.Text -> VU.Vector b -> [CartFeature] -numericFeature c v = case testEquality (typeRep @b) (typeRep @Double) of - Just Refl -> [CartFeature v (\t -> F.col @Double c .<=. F.lit t)] + forall b. + (Columnable b, VU.Unbox b) => + T.Text -> Maybe Bitmap -> VU.Vector b -> [CartFeature] +numericFeature c Nothing v = case testEquality (typeRep @b) (typeRep @Double) of + Just Refl -> [CartFeature v Nothing (\t _ -> F.col @Double c .<=. F.lit t)] Nothing -> case sIntegral @b of STrue -> - [ CartFeature (VU.map fromIntegral v) (\t -> F.toDouble (F.col @b c) .<=. F.lit t) + [ CartFeature + (VU.map fromIntegral v) + Nothing + (\t _ -> F.toDouble (F.col @b c) .<=. F.lit t) ] SFalse -> [] +numericFeature c (Just bm) v = case nullableLeq @b c of + Just (toD, leq) -> + [ CartFeature + (VU.imap (\i x -> if nulls VU.! i then 1 / 0 else toD x) v) + (trainingNulls nulls) + (\t side -> F.fromMaybe (side == NullsLeft) (leq t)) + ] + Nothing -> [] + where + nulls = nullFlags (VU.length v) bm +nullableLeq :: + forall b. + (Columnable b) => + T.Text -> Maybe (b -> Double, Double -> Expr (Maybe Bool)) +nullableLeq c + | Just Refl <- testEquality (typeRep @b) (typeRep @Double) = + Just (id, \t -> F.col @(Maybe Double) c .<= F.lit t) + | Just Refl <- testEquality (typeRep @b) (typeRep @Int) = + Just (fromIntegral, \t -> F.col @(Maybe Int) c .<= F.lit t) + | otherwise = Nothing + oneHotFeatures :: - forall b. (Columnable b) => Int -> T.Text -> V.Vector b -> [CartFeature] -oneHotFeatures nAll c v = case testEquality (typeRep @b) (typeRep @T.Text) of - Just Refl -> [oneHot nAll c v cat | cat <- Set.toList (Set.fromList (V.toList v))] + forall b. + (Columnable b) => T.Text -> Maybe Bitmap -> V.Vector b -> [CartFeature] +oneHotFeatures c bm v = case testEquality (typeRep @b) (typeRep @T.Text) of + Just Refl -> [oneHot c nulls v cat | cat <- Set.toList (Set.fromList present)] Nothing -> [] + where + nulls = fmap (nullFlags (V.length v)) bm + present = [x | (i, x) <- zip [0 ..] (V.toList v), maybe True (not . (VU.! i)) nulls] -oneHot :: Int -> T.Text -> V.Vector T.Text -> T.Text -> CartFeature -oneHot nAll c v cat = +oneHot :: + T.Text -> Maybe (VU.Vector Bool) -> V.Vector T.Text -> T.Text -> CartFeature +oneHot c Nothing v cat = CartFeature - (VU.generate nAll (\i -> if v V.! i == cat then 1 else 0)) - (const (F.col @T.Text c ./=. F.lit cat)) + (VU.generate (V.length v) (\i -> if v V.! i == cat then 1 else 0)) + Nothing + (\_ _ -> F.col @T.Text c ./=. F.lit cat) +oneHot c (Just nulls) v cat = + CartFeature + (VU.generate (V.length v) value) + (trainingNulls nulls) + cond + where + value i + | nulls VU.! i = 1 / 0 + | v V.! i == cat = 1 + | otherwise = 0 + col' = F.col @(Maybe T.Text) c + -- Threshold 1 passes every non-null row, so that split is null vs non-null. + cond t side + | t < 1 = F.fromMaybe (side == NullsLeft) (col' ./= F.lit cat) + | side == NullsLeft = F.lit True + | otherwise = F.isJust col' -- | Target column as string labels (matches pandas @y.astype(str)@). cartTargetLabels :: T.Text -> DataFrame -> V.Vector T.Text diff --git a/src-internal/DataFrame/DecisionTree/Categorical.hs b/src-internal/DataFrame/DecisionTree/Categorical.hs --- a/src-internal/DataFrame/DecisionTree/Categorical.hs +++ b/src-internal/DataFrame/DecisionTree/Categorical.hs @@ -5,10 +5,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -{- | Categorical split candidates: Breiman prefixes for binary targets, -subset/singleton enumeration otherwise, and cross-column equality. Each -value-list becomes an OR-of-equalities condition. --} +-- | Categorical split candidates: Breiman prefixes, subsets and equality. module DataFrame.DecisionTree.Categorical ( TargetInfo (..), mkTargetInfo, @@ -37,7 +34,6 @@ ) import DataFrame.Expression.Operators import DataFrame.Internal.Column -import DataFrame.Internal.Column.Bitmap import DataFrame.Internal.DataFrame (DataFrame, columnNames, unsafeGetColumn) import DataFrame.Internal.Expression (Expr (..)) import DataFrame.Internal.Interpreter (interpret) @@ -58,18 +54,14 @@ validBoxedValues :: Bitmap -> V.Vector a -> V.Vector a validBoxedValues bm = V.ifilter (\i _ -> bitmapTestBit bm i) -{- | Target-column summary driving the categorical generator: binary vs -multi-class, the deterministic positive class, and the raw label vector. --} +-- | Target-column summary driving the categorical generator. data TargetInfo target = TargetInfo { tiIsBinary :: !Bool , tiPositiveClass :: !(Maybe target) , tiValues :: !(V.Vector target) } -{- | Compute 'TargetInfo' once per fit. The positive class for binary targets -is the lexicographically-first distinct value, for deterministic pools. --} +-- | Compute TargetInfo once per fit. mkTargetInfo :: forall target. (Columnable target, Ord target) => @@ -88,9 +80,7 @@ (p : _) | isBinary -> Just p _ -> Nothing -{- | Distinct values, capped: @Right vs@ (sorted) under the cap, else @Left@ -the count-so-far so the caller routes to the high-cardinality path. --} +-- | Distinct values up to a cap, else the count so far. distinctValuesUpTo :: (Ord a) => Int -> V.Vector a -> Either Int [a] distinctValuesUpTo cap values = go Set.empty 0 where @@ -100,9 +90,7 @@ | Set.size s > cap = Left (Set.size s) | otherwise = go (Set.insert (V.unsafeIndex values i) s) (i + 1) -{- | OR-of-equalities for a value-list, shared by the expression and -truth-vector discrete paths so they stay byte-identical. --} +-- | OR-of-equalities for a value-list, shared by both discrete paths. orEqs :: (a -> Expr Bool) -> [a] -> Expr Bool orEqs eqLit = foldr1 (.||.) . map eqLit @@ -130,9 +118,7 @@ breimanPrefixSplits pc values targetVals distinctVals eqLit = map (orEqs eqLit) (breimanPrefixLists pc values targetVals distinctVals) -{- | Breiman's binary-target split set: sort levels by Laplace-smoothed -positive rate, then take every contiguous non-trivial prefix. --} +-- | Breiman's binary-target split set: contiguous prefixes by positive rate. breimanPrefixLists :: (Ord a, Ord target) => target -> V.Vector a -> V.Vector target -> [a] -> [[a]] breimanPrefixLists pc values targetVals distinctVals = @@ -158,9 +144,7 @@ nonTrivialPrefixes :: [a] -> [[a]] nonTrivialPrefixes = drop 1 . init . inits -{- | Value-lists a categorical column contributes; shared by the expression and -truth-vector paths so both enumerate identical candidates in the same order. --} +-- | Value-lists a categorical column contributes, in a fixed order. catValueLists :: (Ord a, Ord target) => Bool -> Maybe target -> V.Vector target -> Int -> V.Vector a -> [[a]] @@ -186,17 +170,13 @@ ascDistinct :: (Ord a) => V.Vector a -> [a] ascDistinct = Set.toAscList . Set.fromList . V.toList -{- | Truth vector of @col ∈ values@ read directly from the column; equal to -interpreting @orEqs (== v) values@ because the values are distinct. --} +-- | Truth vector of col in values, read directly from the column. membershipVec :: (Ord a) => V.Vector a -> [a] -> VU.Vector Bool membershipVec colVals vs = let !s = Set.fromList vs in VU.generate (V.length colVals) (\i -> Set.member (colVals `V.unsafeIndex` i) s) -{- | Per-fit categorical generation context bundling the target summary and -the column-ordering registry. --} +-- | Per-fit categorical generation context. data CatCtx target = CatCtx { ccBinary :: !Bool , ccPos :: !(Maybe target) @@ -225,9 +205,7 @@ STrue -> True SFalse -> False -{- | All equality-based candidate splits from non-numeric columns: per-column -categorical conditions plus cross-column equality/order conditions. --} +-- | All equality-based candidate splits from non-numeric columns. discreteConditions :: forall target. (Columnable target, Ord target) => @@ -344,10 +322,7 @@ Just Refl -> True Nothing -> False -{- | 'discreteConditions' materialized with shared per-column reads: the -non-nullable categorical path builds truth vectors directly from one read -per column; nullable and cross-column fall back to interpret. --} +-- | discreteConditions materialized with shared per-column reads. discreteCondVecs :: forall target. (Columnable target, Ord target) => diff --git a/src-internal/DataFrame/DecisionTree/CondVec.hs b/src-internal/DataFrame/DecisionTree/CondVec.hs --- a/src-internal/DataFrame/DecisionTree/CondVec.hs +++ b/src-internal/DataFrame/DecisionTree/CondVec.hs @@ -3,10 +3,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -{- | Cached condition truth vectors and the per-fit cache keyed by structural -form. A condition's truth over a fixed DataFrame is invariant for a whole -fit, so it is materialized once and reused. --} +-- | Cached condition truth vectors and the per-fit cache keyed by form. module DataFrame.DecisionTree.CondVec ( CondVec (..), materializeCondVec, @@ -48,9 +45,7 @@ , cvVec :: !(VU.Vector Bool) } -{- | Interpret a condition once over the DataFrame; 'Nothing' on a -type/interpret failure so the candidate is silently dropped. --} +-- | Interpret a condition once over the DataFrame; Nothing on failure. materializeCondVec :: DataFrame -> Expr Bool -> Maybe CondVec materializeCondVec df cond = case interpret @Bool df cond of Left _ -> Nothing @@ -59,15 +54,10 @@ eitherToMaybe :: Either e a -> Maybe a eitherToMaybe = either (const Nothing) Just -{- | Full-DataFrame truth vectors keyed by structural form, read-only once -built. Seeded for free from the candidate pool plus the initial tree so the -predict/loss passes index a vector instead of re-interpreting per node. --} +-- | Truth vectors keyed by structural form, read-only once built. type CondCache = M.Map T.Text (VU.Vector Bool) -{- | Structural key matching the candidate-dedup key, so a tree branch whose -condition came from the pool hits the cache (equal keys ⟹ equal vector). --} +-- | Structural key matching the candidate-dedup key. condCacheKey :: Expr Bool -> T.Text condCacheKey = T.pack . show . normalize @@ -75,9 +65,7 @@ condCacheFromVecs :: [CondVec] -> CondCache condCacheFromVecs cvs = M.fromList [(condCacheKey (cvExpr cv), cvVec cv) | cv <- cvs] -{- | Add a tree's branch-condition vectors to a cache (one interpret per -distinct, not-yet-cached condition). --} +-- | Add a tree's branch-condition vectors to a cache. addTreeCondsToCache :: DataFrame -> Tree a -> CondCache -> CondCache addTreeCondsToCache df = go where @@ -92,15 +80,13 @@ where k = condCacheKey cond -{- | A condition's truth vector: a cache hit, else interpret over the -DataFrame. 'Nothing' mirrors the interpret-failure fallback (route left). --} +-- | A condition's truth vector: a cache hit, else interpret. lookupCondVec :: CondCache -> DataFrame -> Expr Bool -> Maybe (VU.Vector Bool) lookupCondVec cache df cond = case M.lookup (condCacheKey cond) cache of hit@(Just _) -> hit Nothing -> cvVec <$> materializeCondVec df cond --- | Partition row indices by a truth vector: @True@ → left, @False@ → right. +-- | Partition row indices by a truth vector: True goes left. partitionByVec :: VU.Vector Bool -> V.Vector Int -> (V.Vector Int, V.Vector Int) partitionByVec boolVals = V.partition (boolVals VU.!) @@ -110,9 +96,7 @@ where misrouted cp = (boolVals VU.! cpIndex cp) /= (cpCorrectDir cp == GoLeft) -{- | A same-column same-direction Double threshold comparison, with a rebuild -function to swap in a new threshold. --} +-- | A same-column same-direction Double threshold comparison. data ThreshCmp = ThreshCmp { tcCol :: !T.Text , tcName :: !T.Text @@ -132,9 +116,7 @@ directionalNames :: [T.Text] directionalNames = ["lt", "leq", "gt", "geq"] -{- | Tighter (AND) or looser (OR) of two same-direction thresholds: @<@/@<=@ -are left-half-spaces (AND = min), @>@/@>=@ are right-half-spaces (AND = max). --} +-- | Tighter (AND) or looser (OR) of two same-direction thresholds. chooseThreshold :: Bool -> T.Text -> Double -> Double -> Double chooseThreshold isAnd name t1 t2 | leftDir = if isAnd then min t1 t2 else max t1 t2 @@ -142,9 +124,7 @@ where leftDir = name == "lt" || name == "leq" -{- | Collapse two same-column same-direction strict-Double comparisons into one -comparison (the @True@ argument selects AND, @False@ OR); 'Nothing' otherwise. --} +-- | Collapse two same-direction Double comparisons into one, if possible. consolidateThreshold :: Bool -> Expr Bool -> Expr Bool -> Maybe (Expr Bool) consolidateThreshold isAnd ea eb = do a <- asDoubleThreshold ea @@ -153,9 +133,7 @@ then Just (tcRebuild a (chooseThreshold isAnd (tcName a) (tcThr a) (tcThr b))) else Nothing -{- | AND-combine two cached conditions: idempotence and threshold consolidation -first, else the generic @F.and@; the vector is always the elementwise AND. --} +-- | AND-combine two cached conditions, consolidating thresholds if possible. combineAndVec :: CondVec -> CondVec -> CondVec combineAndVec a b | eqExpr (cvExpr a) (cvExpr b) = a @@ -166,9 +144,7 @@ (F.and (cvExpr a) (cvExpr b)) (consolidateThreshold True (cvExpr a) (cvExpr b)) -{- | OR-combine two cached conditions (see 'combineAndVec'; AND/OR direction -differs in 'consolidateThreshold'). --} +-- | OR-combine two cached conditions (see combineAndVec). combineOrVec :: CondVec -> CondVec -> CondVec combineOrVec a b | eqExpr (cvExpr a) (cvExpr b) = a diff --git a/src-internal/DataFrame/DecisionTree/Fit.hs b/src-internal/DataFrame/DecisionTree/Fit.hs --- a/src-internal/DataFrame/DecisionTree/Fit.hs +++ b/src-internal/DataFrame/DecisionTree/Fit.hs @@ -4,10 +4,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -{- | Top-level fitting: assemble the candidate pool, seed from CART, run TAO, -and convert the result to an expression. Also the probability-tree variant -('fitProbTree') that annotates leaves with class distributions. --} +-- | Top-level fitting: candidate pool, CART seed, TAO, then an expression. module DataFrame.DecisionTree.Fit ( treeToExpr, fitDecisionTree, @@ -25,6 +22,7 @@ probExprs, ) where +import qualified Data.List as L import DataFrame.DecisionTree.Cart (buildCartTree) import DataFrame.DecisionTree.Categorical ( TargetInfo (..), @@ -50,7 +48,7 @@ import Control.Exception (throw) import Data.Function (on) -import Data.List (foldl', maximumBy, nub, sort) +import Data.List (maximumBy, nub, sort) import qualified Data.Map.Strict as M import Data.Maybe (fromMaybe) import qualified Data.Text as T @@ -130,7 +128,7 @@ Left e -> throw e Right (TColumn column) -> case toVector @a column of Left e -> throw e - Right vals -> foldl' (\acc x -> M.insertWith (+) x 1 acc) M.empty (V.toList vals) + Right vals -> L.foldl' (\acc x -> M.insertWith (+) x 1 acc) M.empty (V.toList vals) -- | The @p@-th percentile of an expression's values (@0@ on failure/empty). percentile :: Int -> Expr Double -> DataFrame -> Double @@ -167,9 +165,7 @@ indices total = fromIntegral (V.length indices) :: Double -{- | Re-label a fitted tree's leaves with class distributions, routing the -training data through the (unchanged) split conditions. --} +-- | Re-label a fitted tree's leaves with class distributions. buildProbTree :: forall a. (Columnable a, Ord a) => diff --git a/src-internal/DataFrame/DecisionTree/Histogram.hs b/src-internal/DataFrame/DecisionTree/Histogram.hs new file mode 100644 --- /dev/null +++ b/src-internal/DataFrame/DecisionTree/Histogram.hs @@ -0,0 +1,329 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE TupleSections #-} + +-- | Regression trees grown from per-bin histograms, for gradient boosting. +module DataFrame.DecisionTree.Histogram ( + Binned, + BinnedFeatures, + binFeatures, + TreeLimits (..), + fitBinnedTree, + fitBinnedTreeOn, +) where + +import Control.Monad.ST (runST) +import Control.Parallel (par, pseq) +import Data.Maybe (fromMaybe, maybeToList) +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU +import qualified Data.Vector.Unboxed.Mutable as VUM +import Data.Word (Word16) + +import DataFrame.DecisionTree.Cart ( + CartFeature (..), + NullSide (..), + sortIndicesByValue, + splitMidpoint, + ) +import DataFrame.DecisionTree.Types (Tree (..)) +import DataFrame.Internal.Expression (Expr) + +-- | A feature's bins: rows in bin @b@ satisfy @value <= upper ! b@. +data Binned = Binned + { bnFeature :: !CartFeature + , bnBins :: !(VU.Vector Word16) + -- ^ Bin per row; null rows hold 'bnNBins'. + , bnNBins :: !Int + , bnUpper :: !(VU.Vector Double) + } + +-- | Every feature's bins, also stored row by row for cache locality. +data BinnedFeatures = BinnedFeatures + { bfFeatures :: !(V.Vector Binned) + , bfRows :: !(VU.Vector Word16) + , bfOffsets :: !(VU.Vector Int) + -- ^ Where each feature's histogram starts in a node's histogram buffer. + , bfSlots :: !Int + } + +-- | Bin every feature into at most @maxBins@ bins (capped at 65535). +binFeatures :: Int -> V.Vector CartFeature -> BinnedFeatures +binFeatures maxBins features = BinnedFeatures binned rows offsets (VU.last sizes) + where + binned = V.map (binFeature (max 2 (min 65535 maxBins))) features + nf = V.length binned + n = if nf == 0 then 0 else VU.length (bnBins (V.head binned)) + sizes = + VU.prescanl' + (+) + 0 + (VU.fromList [4 * (bnNBins b + 1) | b <- V.toList binned] `VU.snoc` 0) + offsets = VU.take nf sizes + rows = VU.create $ do + m <- VUM.unsafeNew (n * nf) + V.iforM_ binned $ \j b -> + VU.iforM_ (bnBins b) $ \i bin -> VUM.unsafeWrite m (i * nf + j) bin + pure m + +binFeature :: Int -> CartFeature -> Binned +binFeature maxBins f = Binned f bins nb upper + where + vals = cfValues f + isNull i = maybe False (VU.! i) (cfNulls f) + sorted = + VU.map (vals VU.!) (VU.filter (not . isNull) (sortIndicesByValue vals)) + runs = runLengths sorted + distinct = map fst runs + edges + | length runs <= maxBins = + VU.fromList (zipWith splitMidpoint distinct (drop 1 distinct)) + | otherwise = VU.fromList (cutEdges maxBins (VU.length sorted) runs) + nb = VU.length edges + 1 + -- Top threshold is the largest value, so null vs non-null stays valid. + upper = VU.snoc edges (if VU.null sorted then 0 else VU.last sorted) + bins = VU.generate (VU.length vals) binOf + binOf i + | isNull i = fromIntegral nb + | otherwise = fromIntegral (lowerBound edges (vals VU.! i)) + +-- | Cut points giving bins of roughly equal row counts, never inside a run. +cutEdges :: Int -> Int -> [(Double, Int)] -> [Double] +cutEdges maxBins n = go 0 0 + where + perBin = fromIntegral n / fromIntegral maxBins :: Double + go :: Int -> Int -> [(Double, Int)] -> [Double] + go !nCuts !acc ((v, c) : rest@((v', _) : _)) + | nCuts >= maxBins - 1 = [] + | fromIntegral (acc + c) >= perBin = splitMidpoint v v' : go (nCuts + 1) 0 rest + | otherwise = go nCuts (acc + c) rest + go _ _ _ = [] + +runLengths :: VU.Vector Double -> [(Double, Int)] +runLengths v = go 0 + where + n = VU.length v + go i + | i >= n = [] + | otherwise = + let x = v VU.! i + j = until (\k -> k >= n || v VU.! k /= x) (+ 1) i + in (x, j - i) : go j + +-- | Number of edges below @x@: the bin @x@ falls in. +lowerBound :: VU.Vector Double -> Double -> Int +lowerBound edges x = go 0 (VU.length edges) + where + go lo hi + | lo >= hi = lo + | VU.unsafeIndex edges m < x = go (m + 1) hi + | otherwise = go lo m + where + m = (lo + hi) `div` 2 + +-- | The stopping rules of 'DataFrame.DecisionTree.Regression.RegTreeConfig'. +data TreeLimits = TreeLimits + { tlMaxDepth :: !Int + , tlMinSamplesSplit :: !Int + , tlMinLeafSize :: !Int + , tlMinImpurityDecrease :: !Double + , tlL2 :: !Double + -- ^ Added to every node's total weight, shrinking leaf values and gains. + , tlMinChildWeight :: !Double + -- ^ Smallest total weight a child may have. + } + +-- | Per-bin weight, weighted-y sums and row count, four slots per bin. +type Hist = VU.Vector Double + +-- | Every feature's histogram for a node, built in one pass over its rows. +buildHists :: + BinnedFeatures -> + VU.Vector Int -> + VU.Vector Double -> + VU.Vector Double -> + VU.Vector Int -> + V.Vector Hist +buildHists bf allowed w y idxs = V.imap slice (bfFeatures bf) + where + nf = V.length (bfFeatures bf) + na = VU.length allowed + slice j b = VU.slice (VU.unsafeIndex (bfOffsets bf) j) (4 * (bnNBins b + 1)) flat + flat = runST $ do + m <- VUM.replicate (bfSlots bf) 0 + VU.forM_ idxs $ \i -> do + let wi = VU.unsafeIndex w i + yi = VU.unsafeIndex y i + wy = wi * yi + wyy = wy * yi + row = i * nf + go !k + | k >= na = pure () + | otherwise = do + let j = VU.unsafeIndex allowed k + bin = fromIntegral (VU.unsafeIndex (bfRows bf) (row + j)) + s = VU.unsafeIndex (bfOffsets bf) j + 4 * bin + VUM.unsafeModify m (+ wi) s + VUM.unsafeModify m (+ wy) (s + 1) + VUM.unsafeModify m (+ wyy) (s + 2) + VUM.unsafeModify m (+ 1) (s + 3) + go (k + 1) + go 0 + VU.unsafeFreeze m + +data Node + = NLeaf !Double !(VU.Vector Int) + | NBranch !(Expr Bool) !Node !Node + +-- | Fit a weighted-SSE regression tree on binned features. +fitBinnedTree :: + TreeLimits -> + BinnedFeatures -> + VU.Vector Double -> + Maybe (VU.Vector Double) -> + (Tree Double, VU.Vector Double) +fitBinnedTree lim bf = fitBinnedTreeOn (VU.enumFromN 0 (V.length (bfFeatures bf))) lim bf + +-- | 'fitBinnedTree' splitting only on the features at the given indices. +fitBinnedTreeOn :: + VU.Vector Int -> + TreeLimits -> + BinnedFeatures -> + VU.Vector Double -> + Maybe (VU.Vector Double) -> + (Tree Double, VU.Vector Double) +fitBinnedTreeOn allowed lim bf y mw = (toTree root, inSample) + where + binned = bfFeatures bf + n = VU.length y + w = Data.Maybe.fromMaybe (VU.replicate n 1) mw + allIdx = VU.enumFromN 0 n + root = node 0 allIdx (hists allIdx) + inSample = VU.update (VU.replicate n 0) (VU.concat (leafRows root)) + leafRows (NLeaf v idxs) = [VU.map (,v) idxs] + leafRows (NBranch _ l r) = leafRows l ++ leafRows r + + hists = buildHists bf allowed w y + -- Every allowed feature's histogram covers all of a node's rows. + totalsOf hs = histTotals (hs V.! VU.head allowed) + + node depth idxs hs + | depth >= tlMaxDepth lim || VU.length idxs < tlMinSamplesSplit lim || V.null hs = + leaf + | otherwise = maybe leaf split (bestSplit lim binned allowed hs) + where + Totals tw tsy _ _ = totalsOf hs + leaf = NLeaf (if tw + tlL2 lim == 0 then 0 else tsy / (tw + tlL2 lim)) idxs + split (fj, b, nullLeft) = + forceNode l `par` (forceNode r `pseq` NBranch cond l r) + where + bn = binned V.! fj + goesLeft i = + let k = fromIntegral (VU.unsafeIndex (bnBins bn) i) + in if k == bnNBins bn then nullLeft else k <= b + lefts = VU.filter goesLeft idxs + rights = VU.filter (not . goesLeft) idxs + -- Histogram the smaller child; the larger is parent minus it. + smallIsLeft = VU.length lefts <= VU.length rights + smallH = hists (if smallIsLeft then lefts else rights) + bigH = V.zipWith (VU.zipWith (-)) hs smallH + (lh, rh) = if smallIsLeft then (smallH, bigH) else (bigH, smallH) + l = node (depth + 1) lefts lh + r = node (depth + 1) rights rh + side = if nullLeft then NullsLeft else NullsRight + cond = cfSplit (bnFeature bn) (bnUpper bn VU.! b) side + +data Totals = Totals !Double !Double !Double !Double + +histTotals :: Hist -> Totals +histTotals h = go 0 0 0 0 0 + where + slots = VU.length h `div` 4 + go !k !a !b !c !d + | k >= slots = Totals a b c d + | otherwise = + go + (k + 1) + (a + h VU.! (4 * k)) + (b + h VU.! (4 * k + 1)) + (c + h VU.! (4 * k + 2)) + (d + h VU.! (4 * k + 3)) + +-- | Best (feature, bin, nulls left) by SSE reduction. +bestSplit :: + TreeLimits -> + V.Vector Binned -> + VU.Vector Int -> + V.Vector Hist -> + Maybe (Int, Int, Bool) +bestSplit lim binned allowed hs + | null candidates = Nothing + | red > 0 && red >= tlMinImpurityDecrease lim = Just sp + | otherwise = Nothing + where + Totals totW totSY totSY2 totC = histTotals (hs V.! VU.head allowed) + nNode = round totC :: Int + sse = penalisedSse (tlL2 lim) + nodeSSE = sse totSY totSY2 totW + candidates = concat [featBest fj (hs V.! fj) | fj <- VU.toList allowed] + (red, sp) = maximumByFst candidates + featBest fj h = [(r, (fj, b, nl)) | (b, nl, r) <- maybeToList (scan 0 0 0 0 0 Nothing)] + where + nb = bnNBins (binned V.! fj) + nW = h VU.! (4 * nb) + nSY = h VU.! (4 * nb + 1) + nSY2 = h VU.! (4 * nb + 2) + nC = round (h VU.! (4 * nb + 3)) :: Int + hasNulls = nC > 0 + lastB = if hasNulls then nb - 1 else nb - 2 + score nl wl syl syl2 + | nl >= tlMinLeafSize lim + , nNode - nl >= tlMinLeafSize lim + , wl > 0 + , wr > 0 + , wl >= tlMinChildWeight lim + , wr >= tlMinChildWeight lim = + Just (nodeSSE - (sse syl syl2 wl + sse (totSY - syl) (totSY2 - syl2) wr)) + | otherwise = Nothing + where + wr = totW - wl + scan :: + Int -> + Double -> + Double -> + Double -> + Int -> + Maybe (Int, Bool, Double) -> + Maybe (Int, Bool, Double) + scan !b !wl !syl !syl2 !cl best + | b > lastB = best + | otherwise = scan (b + 1) wl' syl' syl2' cl' best' + where + wl' = wl + h VU.! (4 * b) + syl' = syl + h VU.! (4 * b + 1) + syl2' = syl2 + h VU.! (4 * b + 2) + cl' = cl + round (h VU.! (4 * b + 3)) + right = (,) False <$> score cl' wl' syl' syl2' + left + | hasNulls = + (,) True <$> score (cl' + nC) (wl' + nW) (syl' + nSY) (syl2' + nSY2) + | otherwise = Nothing + consider bst (dir, r) + | maybe True (\(_, _, rb) -> r > rb) bst = Just (b, dir, r) + | otherwise = bst + best' = foldl consider best (maybeToList right ++ maybeToList left) + +-- | Weighted SSE of a node, with l2 added to the weight. +penalisedSse :: Double -> Double -> Double -> Double -> Double +penalisedSse l2 sumY sumSq wt = sumSq - (if wt + l2 == 0 then 0 else sumY * sumY / (wt + l2)) + +maximumByFst :: (Ord a) => [(a, b)] -> (a, b) +maximumByFst = foldr1 (\x@(a, _) y@(b, _) -> if a >= b then x else y) + +toTree :: Node -> Tree Double +toTree (NLeaf v _) = Leaf v +toTree (NBranch c l r) = Branch c (toTree l) (toTree r) + +-- | Force a subtree so the sibling's spark has real work (cf. 'Regression'). +forceNode :: Node -> () +forceNode (NLeaf v _) = v `seq` () +forceNode (NBranch _ l r) = forceNode l `seq` forceNode r diff --git a/src-internal/DataFrame/DecisionTree/Linear.hs b/src-internal/DataFrame/DecisionTree/Linear.hs --- a/src-internal/DataFrame/DecisionTree/Linear.hs +++ b/src-internal/DataFrame/DecisionTree/Linear.hs @@ -1,10 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} -{- | Oblique split candidates: fit an L1-regularised logistic hyperplane to the -care points (class-balanced) and convert it to a boolean condition, rejecting -all-zero and degenerate (single-side) hyperplanes. --} +-- | Oblique split candidates from an L1-regularised logistic hyperplane. module DataFrame.DecisionTree.Linear ( bestLinearCandidate, fitLinearCandidate, @@ -21,6 +18,8 @@ Direction (..), TreeConfig (..), ) +import DataFrame.Expression.Operators ((.*.), (.+.), (.>.)) +import qualified DataFrame.Functions as F import DataFrame.Internal.Column (TypedColumn (..), toVector) import DataFrame.Internal.DataFrame (DataFrame) import DataFrame.Internal.Expression (Expr, getColumns) @@ -32,10 +31,7 @@ import qualified Data.Vector as V import qualified Data.Vector.Unboxed as VU -{- | Best oblique candidate, or 'Nothing' when the linear path is disabled or -there are too few care points to fit on. The target column is named so it can -be kept out of the feature set. --} +-- | Best oblique candidate, or Nothing when disabled or too few care points. bestLinearCandidate :: TreeConfig -> T.Text -> DataFrame -> [CarePoint] -> Maybe (Expr Bool) bestLinearCandidate cfg target df carePoints @@ -43,32 +39,53 @@ | length carePoints < minCarePointsForLinear cfg = Nothing | otherwise = fitLinearCandidate cfg target df carePoints -{- | Fit an L1 logistic regression to the care points and convert the resulting -hyperplane to a condition, or 'Nothing' when no numeric features exist or the -fitted model is all-zero or degenerate. --} +-- | Fit an L1 logistic regression to the care points, as a condition. fitLinearCandidate :: TreeConfig -> T.Text -> DataFrame -> [CarePoint] -> Maybe (Expr Bool) fitLinearCandidate cfg target df carePoints = case materializedFeatures target df carePoints of [] -> Nothing - mats -> linearFromFeatures cfg carePoints mats + feats -> linearFromFeatures cfg carePoints feats +-- | Each feature's materialised care values with the expression behind them. materializedFeatures :: - T.Text -> DataFrame -> [CarePoint] -> [(T.Text, VU.Vector Double)] + T.Text -> + DataFrame -> + [CarePoint] -> + [(Expr Double, (T.Text, VU.Vector Double))] materializedFeatures target df carePoints = - mapMaybe (materializeFeatureForCare df carePoints) (featureCols target df) + mapMaybe + ( \ne -> + (\m -> (doubleExprOf ne (snd m), m)) + <$> materializeFeatureForCare df carePoints ne + ) + (featureCols target df) +-- | The expression behind a feature; nullable ones take the care-point mean. +doubleExprOf :: NumExpr -> VU.Vector Double -> Expr Double +doubleExprOf (NDouble e) _ = e +doubleExprOf (NMaybeDouble e) vals = F.fromMaybe (VU.sum vals / fromIntegral (max 1 (VU.length vals))) e + featureCols :: T.Text -> DataFrame -> [NumExpr] featureCols target df = filter (notElem target . numExprCols) (numericCols df) linearFromFeatures :: - TreeConfig -> [CarePoint] -> [(T.Text, VU.Vector Double)] -> Maybe (Expr Bool) -linearFromFeatures cfg carePoints mats + TreeConfig -> + [CarePoint] -> + [(Expr Double, (T.Text, VU.Vector Double))] -> + Maybe (Expr Bool) +linearFromFeatures cfg carePoints feats | VU.all (== 0) weights = Nothing | degenerateHyperplane rows weights (LS.lmIntercept model) = Nothing - | otherwise = Just (LS.modelToExpr model) + | otherwise = Just hyperplane where + mats = map snd feats + hyperplane = + foldl + (\acc (w, e) -> acc .+. (F.lit w .*. e)) + (F.lit (LS.lmIntercept model)) + [(w, e) | (w, (e, _)) <- zip (VU.toList weights) feats, w /= 0] + .>. F.lit (0 :: Double) rows = careRowsFromFeatures (length carePoints) mats labels = careLabels carePoints model = @@ -82,9 +99,7 @@ solverConfigFor :: TreeConfig -> VU.Vector Double -> LS.SolverConfig solverConfigFor cfg labels = (linearSolverConfig cfg){LS.scSampleWeights = classBalancedWeights labels} -{- | Class-balanced sklearn-form weights @w_i = N / (2 · N_class)@ (mean 1), or -'Nothing' in the degenerate one-class case (uniform weighting). --} +-- | Class-balanced sklearn-form weights, or Nothing for one class. classBalancedWeights :: VU.Vector Double -> Maybe (VU.Vector Double) classBalancedWeights labels | nPos > 0 && nNeg > 0 = Just (VU.generate nCare weightAt) @@ -97,9 +112,7 @@ | VU.unsafeIndex labels i > 0 = fromIntegral nCare / (2 * fromIntegral nPos) | otherwise = fromIntegral nCare / (2 * fromIntegral nNeg) -{- | A hyperplane is degenerate when every care row scores on the same side of -zero (equivalent to an invalid split, caught upstream). --} +-- | A hyperplane is degenerate when every care row scores on one side. degenerateHyperplane :: V.Vector (VU.Vector Double) -> VU.Vector Double -> Double -> Bool degenerateHyperplane rows weights bias = @@ -111,9 +124,7 @@ nCare (\i -> VU.sum (VU.zipWith (*) weights (V.unsafeIndex rows i)) + bias) -{- | Per-care-point feature rows from materialized columns (each of length -@nCare@, so indexing is in range). --} +-- | Per-care-point feature rows from materialized columns. careRowsFromFeatures :: Int -> [(T.Text, VU.Vector Double)] -> V.Vector (VU.Vector Double) careRowsFromFeatures nCare mats = @@ -133,9 +144,7 @@ (c : _) -> c [] -> "" -{- | Replace missing values with the mean of present ones; 'Nothing' when -nothing is present so the caller can drop the feature. --} +-- | Replace missing values with the mean of present ones. imputeMean :: [Maybe Double] -> Maybe (VU.Vector Double) imputeMean careRaw = case catMaybes careRaw of [] -> Nothing @@ -154,9 +163,7 @@ Right (TColumn column) -> either (const Nothing) Just (toVector @(Maybe Double) column) _ -> Nothing -{- | Materialize a 'NumExpr' over the care rows; 'Nothing' on interpret failure -or (nullable) when no care point has a present value, else mean-imputed. --} +-- | Materialize a NumExpr over the care rows, mean-imputing nullable values. materializeFeatureForCare :: DataFrame -> [CarePoint] -> NumExpr -> Maybe (T.Text, VU.Vector Double) materializeFeatureForCare df carePoints (NDouble expr) = do diff --git a/src-internal/DataFrame/DecisionTree/Numeric.hs b/src-internal/DataFrame/DecisionTree/Numeric.hs --- a/src-internal/DataFrame/DecisionTree/Numeric.hs +++ b/src-internal/DataFrame/DecisionTree/Numeric.hs @@ -5,12 +5,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -{- | Numeric split candidates: per-column Double expressions, arithmetic -expansion, and threshold conditions. Nullable columns also contribute an -@isNothing@ candidate, so missingness is splittable directly rather than -only via the null-routing of value splits. 'numericCondVecs' materializes -the pool with one interpret per distinct expression. --} +-- | Numeric split candidates: expressions, arithmetic expansion, thresholds. module DataFrame.DecisionTree.Numeric ( NumExpr (..), numExprCols, @@ -133,9 +128,7 @@ (F.fromMaybe False) [e .<= F.lit t, e .>= F.lit t, e .< F.lit t, e .> F.lit t] -{- | Percentile thresholds for a value list: sort once, index each percentile. -Shared by 'generateNumericConds' and 'numericCondVecs' for identical results. --} +-- | Percentile thresholds for a value list: sort once, index each percentile. percentilesOf :: [Int] -> [Double] -> [Double] percentilesOf ps valsList | n == 0 = [] @@ -155,10 +148,7 @@ Right (TColumn column) -> either (const Nothing) Just (toVector @(Maybe Double) column) _ -> Nothing -{- | Materialize the numeric pool with one interpret per distinct expression, -deriving each threshold/operator truth vector by direct comparison. -Byte-identical to materializing 'numericConditions' one at a time. --} +-- | Materialize the numeric pool with one interpret per distinct expression. numericCondVecs :: TreeConfig -> DataFrame -> DataFrame -> [CondVec] numericCondVecs cfg dfGen df = concatMap forExpr (numericExprsWithTerms (synthConfig cfg) dfGen) @@ -199,10 +189,7 @@ where gen p = VU.generate n (\i -> maybe False p (mvals V.! i)) -{- | Arithmetic candidate expansion, generated already-deduped: each round -combines @frontier × base@ and admits only normalized-novel candidates. -Produces @base@ plus @maxExprDepth-1@ combination rounds. --} +-- | Arithmetic candidate expansion, generated already-deduped. numericExprsWithTerms :: SynthConfig -> DataFrame -> [NumExpr] numericExprsWithTerms cfg df | not (enableArithOps cfg) = base diff --git a/src-internal/DataFrame/DecisionTree/Pool.hs b/src-internal/DataFrame/DecisionTree/Pool.hs --- a/src-internal/DataFrame/DecisionTree/Pool.hs +++ b/src-internal/DataFrame/DecisionTree/Pool.hs @@ -1,10 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} -{- | Candidate-pool scoring and boolean expansion: penalized scoring, diverse -top-K selection, AND/OR saturation, and structural/truth-vector dedup. The -per-node scoring scans run in parallel chunks. --} +-- | Candidate-pool scoring and boolean expansion with structural dedup. module DataFrame.DecisionTree.Pool ( evalWithPenaltyVec, primaryColExpr, @@ -50,18 +47,14 @@ import qualified Data.Text as T import qualified Data.Vector.Unboxed as VU -{- | Penalized score of a candidate: care-point errors plus a complexity -penalty, tie-broken by expression size. --} +-- | Penalized score of a candidate: errors plus a complexity penalty. evalWithPenaltyVec :: TreeConfig -> [CarePoint] -> CondVec -> (Int, Int) evalWithPenaltyVec cfg carePoints cv = (countErrorsByVec (cvVec cv) carePoints + penalty, sz) where sz = eSize (cvExpr cv) penalty = floor (complexityPenalty (synthConfig cfg) * fromIntegral sz) -{- | First referenced column of a condition (a sentinel for literal-only ones), -used by 'takeDiverse' to enforce per-column diversity. --} +-- | First referenced column of a condition, used for per-column diversity. primaryColExpr :: Expr Bool -> T.Text primaryColExpr e = case getColumns e of [] -> "" @@ -70,9 +63,7 @@ primaryColCV :: CondVec -> T.Text primaryColCV = primaryColExpr . cvExpr -{- | Keep the first @k@ of an already-sorted list, admitting at most @quota@ per -primary column (@Nothing@ disables the per-column cap). --} +-- | Keep the first k of a sorted list, at most quota per primary column. takeDiverse :: Int -> Maybe Int -> (a -> T.Text) -> [a] -> [a] takeDiverse k Nothing _ = take k takeDiverse k (Just quota) primary = go M.empty 0 @@ -85,15 +76,11 @@ where !col = primary x -{- | Chunk size for the parallel per-node candidate scans; tuned by an -N -sweep, not correctness-affecting. --} +-- | Chunk size for the parallel per-node candidate scans. candidateParChunk :: Int candidateParChunk = 64 -{- | Decorate candidates with their penalty in parallel chunks, forcing only -the @(Int, Int)@ key so the order (hence later sorts/minima) is preserved. --} +-- | Decorate candidates with their penalty in parallel, preserving order. decorate :: (CondVec -> (Int, Int)) -> [CondVec] -> [((Int, Int), CondVec)] decorate penaltyCV xs = zip (map penaltyCV xs `using` parListChunk candidateParChunk rdeepseq) xs @@ -123,9 +110,7 @@ [] -> Nothing xs -> Just (snd (minimumBy (compare `on` fst) (decorate penaltyCV xs))) -{- | AND/OR expansion of cached conditions to depth @maxDepth@ (each -combination is a single vector op, not an interpret). --} +-- | AND/OR expansion of cached conditions to a given depth. boolExprsVec :: [CondVec] -> [CondVec] -> Int -> Int -> [CondVec] boolExprsVec baseExprs prevExprs depth maxDepth | depth == 0 = @@ -138,9 +123,7 @@ data DedupMode = Structural | TruthVector deriving (Eq, Show) -{- | Saturate the pool with AND/OR combinations, deduplicating structurally -(byte-identical, first occurrence kept) or by truth vector (opt-in). --} +-- | Saturate the pool with AND/OR combinations, deduplicating as configured. saturateCandidates :: DedupMode -> Int -> [CondVec] -> [CondVec] saturateCandidates Structural maxDepth base = base' ++ go 1 base' seen0 where @@ -159,9 +142,7 @@ let (reps', admitted) = admitVecs reps (roundProducts frontier base) in go (depth + 1) admitted reps' -{- | One combination round: @frontier × base@ via AND then OR, skipping -self-pairs (mirrors 'boolExprsVec' for byte-identical structural output). --} +-- | One combination round: frontier by base via AND then OR, skipping pairs. roundProducts :: [CondVec] -> [CondVec] -> [CondVec] roundProducts frontier base = [ c @@ -183,9 +164,7 @@ structuralKey :: CondVec -> String structuralKey = show . normalize . cvExpr -{- | Admit candidates by distinct truth vector, keeping the smallest-expression -representative per vector. --} +-- | Admit candidates by distinct truth vector, keeping the smallest expression. admitVecs :: M.Map (VU.Vector Bool) CondVec -> [CondVec] -> diff --git a/src-internal/DataFrame/DecisionTree/Predict.hs b/src-internal/DataFrame/DecisionTree/Predict.hs --- a/src-internal/DataFrame/DecisionTree/Predict.hs +++ b/src-internal/DataFrame/DecisionTree/Predict.hs @@ -3,10 +3,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -{- | Prediction, care-point identification, node validity, and tree loss. The -batched, cache-aware variants resolve each branch condition's truth vector -once per call instead of once per row. --} +-- | Prediction, care-point identification, node validity, and tree loss. module DataFrame.DecisionTree.Predict ( predictWithTree, predictManyWithTree, @@ -49,9 +46,7 @@ import qualified Data.Vector.Mutable as VM import qualified Data.Vector.Unboxed as VU -{- | A condition's truth vector over the DataFrame, or 'Nothing' on a -type/interpret failure (callers default such rows to the left child). --} +-- | A condition's truth vector over the DataFrame, or Nothing on failure. branchBool :: DataFrame -> Expr Bool -> Maybe (VU.Vector Bool) branchBool df cond = case interpret @Bool df cond of Right (TColumn column) -> either (const Nothing) Just (toVector @Bool @VU.Vector column) @@ -64,7 +59,7 @@ Right (TColumn column) -> either (const Nothing) Just (toVector @a column) _ -> Nothing --- | Predict the label for a single row by walking a fixed tree (@True@ → left). +-- | Predict the label for a single row by walking a fixed tree. predictWithTree :: forall a. (Columnable a) => T.Text -> DataFrame -> Int -> Tree a -> a predictWithTree _ _ _ (Leaf v) = v @@ -80,9 +75,7 @@ forall a. (Columnable a) => Tree a -> DataFrame -> V.Vector Int -> V.Vector a predictManyWithTree = predictManyWithTreeCached @a M.empty -{- | 'predictManyWithTree' resolving each branch condition through a 'CondCache'. -Each condition is read at most once per call rather than once per row. --} +-- | predictManyWithTree resolving each branch through a CondCache. predictManyWithTreeCached :: forall a. (Columnable a) => CondCache -> Tree a -> DataFrame -> V.Vector Int -> V.Vector a @@ -111,9 +104,7 @@ T.Text -> DataFrame -> V.Vector Int -> Tree a -> Tree a -> [CarePoint] identifyCarePoints = identifyCarePointsCached @a M.empty -{- | Rows the parent must route to a specific child for the (fixed) subtrees to -classify correctly; a 'CondCache' avoids re-interpreting subtree conditions. --} +-- | Rows the parent must route to a specific child for subtrees to classify. identifyCarePointsCached :: forall a. (Columnable a) => @@ -151,9 +142,7 @@ Expr Bool -> DataFrame -> V.Vector Int -> (V.Vector Int, V.Vector Int) partitionIndices = partitionIndicesCached M.empty -{- | 'partitionIndices' resolving the condition through a 'CondCache'; a miss -routes every index left (matching the uncached fallback). --} +-- | partitionIndices resolving the condition through a CondCache. partitionIndicesCached :: CondCache -> Expr Bool -> diff --git a/src-internal/DataFrame/DecisionTree/Prune.hs b/src-internal/DataFrame/DecisionTree/Prune.hs --- a/src-internal/DataFrame/DecisionTree/Prune.hs +++ b/src-internal/DataFrame/DecisionTree/Prune.hs @@ -2,10 +2,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} -{- | Post-convergence simplification of a fitted tree and its expression form: -drop branches forced by path-condition entailment, collapse identical -siblings, and fold redundant nested conditionals. --} +-- | Post-convergence simplification of a fitted tree and its expression. module DataFrame.DecisionTree.Prune ( pruneDead, treeEq, @@ -22,10 +19,7 @@ factTrue, ) -{- | Drop branches whose test is forced by the path conditions reaching them, -and collapse @Branch c t t@ to @t@. Sound for the decidable threshold subset; -other tests are left untouched. --} +-- | Drop branches whose test is forced by the path conditions reaching them. pruneDead :: forall a. (Columnable a) => Tree a -> Tree a pruneDead = go [] where @@ -54,9 +48,7 @@ treeEq (Branch c1 l1 r1) (Branch c2 l2 r2) = eqExpr c1 c2 && treeEq l1 l2 && treeEq r1 r2 treeEq _ _ = False -{- | Recursively fold @If@ expressions whose branches coincide or nest the same -condition; leave other expressions structurally unchanged. --} +-- | Fold If expressions whose branches coincide or nest the same condition. pruneExpr :: forall a. (Columnable a) => Expr a -> Expr a pruneExpr (If cond t0 f0) = collapseIf cond (pruneExpr t0) (pruneExpr f0) pruneExpr (Unary op e) = Unary op (pruneExpr e) diff --git a/src-internal/DataFrame/DecisionTree/Tao.hs b/src-internal/DataFrame/DecisionTree/Tao.hs --- a/src-internal/DataFrame/DecisionTree/Tao.hs +++ b/src-internal/DataFrame/DecisionTree/Tao.hs @@ -3,10 +3,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -{- | Tree Alternating Optimization: hold the tree fixed and re-optimize one node -at a time, bottom-up, minimizing care-point misroutes. Sibling subtrees at a -depth level are independent and optimized in parallel. --} +-- | Tree Alternating Optimization: re-optimize one node at a time, bottom-up. module DataFrame.DecisionTree.Tao ( taoOptimize, taoOptimizeCV, @@ -16,6 +13,7 @@ findBestSplitTAO, ) where +import qualified Data.List as L import DataFrame.DecisionTree.CondVec import DataFrame.DecisionTree.Linear (bestLinearCandidate) import DataFrame.DecisionTree.Pool ( @@ -33,15 +31,13 @@ import Control.Parallel (par, pseq) import Control.Parallel.Strategies (parListChunk, rdeepseq, using) import Data.Function (on) -import Data.List (foldl', minimumBy) +import Data.List (minimumBy) import Data.Maybe (catMaybes, mapMaybe) import qualified Data.Text as T import qualified Data.Vector as V import qualified Data.Vector.Unboxed as VU -{- | The constant per-fit context threaded through the node-optimization -recursion (the cache is rebuilt each iteration). --} +-- | The constant per-fit context threaded through node optimization. data TaoEnv = TaoEnv { teCache :: !CondCache , teCfg :: !TreeConfig @@ -64,9 +60,7 @@ taoOptimize cfg target conds df = taoOptimizeCV @a cfg target (mapMaybe (materializeCondVec df) conds) df -{- | TAO outer loop over pre-evaluated candidates: iterate until the iteration -budget or convergence tolerance is reached, then prune dead branches. --} +-- | TAO outer loop over pre-evaluated candidates, then prune dead branches. taoOptimizeCV :: forall a. (Columnable a, Ord a) => @@ -120,7 +114,7 @@ Tree a -> Tree a taoIterationCV cache cfg target condVecs df rootIndices tree = - foldl' + L.foldl' (optimizeDepthLevel env rootIndices) tree [treeDepth tree, treeDepth tree - 1 .. 0] @@ -142,9 +136,7 @@ Leaf v -> Leaf v Branch cond left right -> optimizeChildren @a env indices cond left right currentDepth targetDepth -{- | Optimize the two subtrees over their disjoint index sets, scoring the left -in parallel with the right (the cache is read-only, so this is pure). --} +-- | Optimize the two subtrees over their disjoint index sets in parallel. optimizeChildren :: forall a. (Columnable a, Ord a) => @@ -156,16 +148,12 @@ left' = optimizeAtDepth @a env indicesL left (currentDepth + 1) targetDepth right' = optimizeAtDepth @a env indicesR right (currentDepth + 1) targetDepth -{- | Force a subtree's optimization work to WHNF so the parallel scheduler has -something substantial to evaluate; pure and value-preserving. --} +-- | Force a subtree's optimization work to WHNF for the parallel scheduler. forceTreeWork :: Tree a -> () forceTreeWork (Leaf v) = v `seq` () forceTreeWork (Branch c l r) = c `seq` forceTreeWork l `seq` forceTreeWork r -{- | Re-optimize one node: pick its best split, or collapse to a leaf when the -node is empty or the chosen split underflows 'minLeafSize'. --} +-- | Re-optimize one node: pick its best split, or collapse to a leaf. optimizeNode :: forall a. (Columnable a, Ord a) => TaoEnv -> V.Vector Int -> Tree a -> Tree a optimizeNode env indices tree @@ -188,9 +176,7 @@ (l, r) = partitionIndicesCached (teCache env) newCond (teDf env) indices underflows = V.length l < minLeafSize (teCfg env) || V.length r < minLeafSize (teCfg env) -{- | The lowest-penalty replacement condition for a node, falling back to the -current condition when no valid candidate beats it. --} +-- | The lowest-penalty replacement condition for a node. findBestSplitTAO :: forall a. (Columnable a) => @@ -227,9 +213,7 @@ bestOfPool _ currentCond [] = currentCond bestOfPool penaltyCV _ pool = cvExpr (minimumBy (compare `on` penaltyCV) pool) -{- | Validity-filtered candidates the node could split on: both children must -keep at least 'minLeafSize'. Scored in parallel chunks, order preserved. --} +-- | Candidates valid for a node: both children keep the minimum leaf size. filterValidCandidates :: TreeConfig -> V.Vector Int -> [CondVec] -> [CondVec] filterValidCandidates cfg indices condVecs = map snd (filter fst (zip validity condVecs)) where @@ -247,9 +231,7 @@ (0 :: Int) indices -{- | The candidate pool to minimize over: the current condition, the best -discrete candidate, and the linear candidate, each kept only if valid. --} +-- | The candidate pool to minimize over, each kept only if valid. candidatePool :: TaoEnv -> V.Vector Int -> diff --git a/src-internal/DataFrame/DecisionTree/Types.hs b/src-internal/DataFrame/DecisionTree/Types.hs --- a/src-internal/DataFrame/DecisionTree/Types.hs +++ b/src-internal/DataFrame/DecisionTree/Types.hs @@ -5,9 +5,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -{- | Shared types, configuration and ordering machinery for the decision-tree -learner. Imported by every other @DataFrame.DecisionTree.*@ module. --} +-- | Shared types, configuration and ordering machinery for the tree learner. module DataFrame.DecisionTree.Types ( Tree (..), treeDepth, @@ -39,9 +37,7 @@ import System.IO.Unsafe (unsafePerformIO) import Type.Reflection (SomeTypeRep (..), typeRep) -{- | A fitted tree: a leaf value, or an internal node testing a boolean -expression with @True@ routing left. --} +-- | A fitted tree: a leaf value, or a boolean test with True routing left. data Tree a = Leaf !a | Branch !(Expr Bool) !(Tree a) !(Tree a) @@ -51,9 +47,7 @@ treeDepth (Leaf _) = 0 treeDepth (Branch _ l r) = 1 + max (treeDepth l) (treeDepth r) -{- | A row the parent node must route to a specific child for the subtrees to -classify it correctly (the TAO objective is the count of misroutes). --} +-- | A row the parent must route to a specific child (TAO counts misroutes). data CarePoint = CarePoint { cpIndex :: !Int , cpCorrectDir :: !Direction @@ -124,9 +118,7 @@ , pureReplacementLinear = False } -{- | Which column types support ordering for splits. Register a type with -'orderable' and combine with @<>@. --} +-- | Which column types support ordering for splits. newtype ColumnOrdering = ColumnOrdering (M.Map SomeTypeRep OrdDict) instance Semigroup ColumnOrdering where @@ -168,9 +160,7 @@ data OrdDict where OrdDict :: (Columnable a, Ord a) => Proxy a -> OrdDict -{- | Run @k@ with the @Ord a@ instance recovered from the ordering registry, -or 'Nothing' when @a@ is not registered. --} +-- | Run a continuation with the Ord instance from the registry, if present. withOrdFrom :: forall a r. (Columnable a) => ColumnOrdering -> ((Ord a) => r) -> Maybe r withOrdFrom (ColumnOrdering m) k = case M.lookup (SomeTypeRep (typeRep @a)) m of diff --git a/src-internal/DataFrame/Featurize/Internal.hs b/src-internal/DataFrame/Featurize/Internal.hs --- a/src-internal/DataFrame/Featurize/Internal.hs +++ b/src-internal/DataFrame/Featurize/Internal.hs @@ -3,10 +3,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -{- | Shared internal helpers used across the model fitters: turning a 'DataFrame' -plus a target/feature 'Expr' into the numeric matrices the algorithms consume, -plus common expression builders (affine score, arg-max/arg-min over scores). --} +-- | Shared helpers turning a DataFrame into the matrices the fitters consume. module DataFrame.Featurize.Internal ( -- * Supervised extraction featureNames, @@ -59,19 +56,13 @@ featureNames (Col target) df = filter (/= target) (columnNames df) featureNames _ df = columnNames df -{- | The named columns as a row-major @n×d@ matrix, paired with the names. Every -column must already be stored as non-null 'Double'; a nullable ('Maybe Double') -or non-'Double' column is a fit-time error rather than a silent coercion. --} +-- | The named columns as a row-major matrix, paired with the names. numericMatrix :: [T.Text] -> DataFrame -> (V.Vector T.Text, Matrix) numericMatrix names df = (V.fromList names, transposeM colMajor) where colMajor = V.fromList (map (`requireDoubleColumn` df) names) -{- | Read a feature\/target column strictly as a non-null 'Double' vector. A -nullable ('Maybe Double') column, or a column of any other type, is a fit-time -error naming the column and pointing at the fix. --} +-- | Read a column strictly as a non-null Double vector. requireDoubleColumn :: T.Text -> DataFrame -> VU.Vector Double requireDoubleColumn name df = case getColumn name df of Nothing -> @@ -131,9 +122,7 @@ TypeErrorContext Double () ) -{- | The target column as a non-null 'Double' vector. A nullable or non-'Double' -target is a fit-time error, not a coercion. --} +-- | The target column as a non-null Double vector. targetDoubles :: Expr Double -> DataFrame -> VU.Vector Double targetDoubles (Col name) df = requireDoubleColumn name df targetDoubles expr df = case columnAsUnboxedVector expr df of @@ -146,10 +135,7 @@ Right v -> v Left e -> throw e -{- | The extracted feature columns of an unsupervised fit, in the shapes the -algorithms need: names, column-major vectors, the row-major matrix, and the -@(n, d)@ dimensions. --} +-- | The extracted feature columns of an unsupervised fit, in several shapes. data Features = Features { ftNames :: ![T.Text] , ftCols :: ![VU.Vector Double] @@ -182,9 +168,7 @@ Right v -> v Left err -> throw err -{- | An affine score @b + Σ wⱼ·colⱼ@ over named columns, dropping zero weights -(the shared core of linear/logistic/SVM margins). --} +-- | An affine score over named columns, dropping zero weights. affineExpr :: Double -> [(Double, T.Text)] -> Expr Double affineExpr b terms = foldr @@ -192,9 +176,7 @@ (F.lit b) [F.lit w .*. (Col n :: Expr Double) | (w, n) <- terms, w /= 0] -{- | The class whose score is greatest, as a nested-@If@ expression; ties go to -the earlier class. --} +-- | The class whose score is greatest, as a nested If; ties go earlier. argMaxExpr :: (Columnable a) => [(a, Expr Double)] -> Expr a argMaxExpr = argExtreme (.>=.) diff --git a/src-internal/DataFrame/LinearAlgebra.hs b/src-internal/DataFrame/LinearAlgebra.hs --- a/src-internal/DataFrame/LinearAlgebra.hs +++ b/src-internal/DataFrame/LinearAlgebra.hs @@ -1,9 +1,6 @@ {-# LANGUAGE BangPatterns #-} -{- | Dependency-free dense linear algebra over row-major matrices, shared by the -models in @dataframe-learn@. Solvers live in "DataFrame.LinearAlgebra.Solve" -and eigenproblems in "DataFrame.LinearAlgebra.Eigen". --} +-- | Dependency-free dense linear algebra over row-major matrices. module DataFrame.LinearAlgebra ( Matrix, dot, @@ -23,9 +20,7 @@ import qualified Data.Vector as V import qualified Data.Vector.Unboxed as VU -{- | Row-major dense matrix: an outer boxed vector of equal-length rows. An -@n×d@ matrix has @n@ rows of length @d@. --} +-- | Row-major dense matrix: an outer boxed vector of equal-length rows. type Matrix = V.Vector (VU.Vector Double) -- | Inner product of two equal-length vectors. @@ -43,11 +38,11 @@ scaleV a = VU.map (* a) {-# INLINE scaleV #-} --- | @matVec A v@ for @A@ of shape @n×d@ and @v@ of length @d@; result length @n@. +-- | Matrix-vector product A v. matVec :: Matrix -> VU.Vector Double -> VU.Vector Double matVec a v = VU.convert (V.map (`dot` v) a) --- | @tMatVec A v = Aᵀ v@ for @A@ of shape @n×d@, @v@ of length @n@; result length @d@. +-- | Transposed matrix-vector product. tMatVec :: Matrix -> VU.Vector Double -> VU.Vector Double tMatVec a v | V.null a = VU.empty @@ -105,9 +100,7 @@ (-1, 1 / 0) centers -{- | Indices @j@ (excluding @i@) within squared radius @eps²@ of row @i@, by -brute force; @O(n d)@ per query. --} +-- | Indices (excluding i) within squared radius eps squared of row i. epsNeighbors :: Double -> Matrix -> Int -> VU.Vector Int epsNeighbors eps rows i = VU.fromList diff --git a/src-internal/DataFrame/LinearAlgebra/Eigen.hs b/src-internal/DataFrame/LinearAlgebra/Eigen.hs --- a/src-internal/DataFrame/LinearAlgebra/Eigen.hs +++ b/src-internal/DataFrame/LinearAlgebra/Eigen.hs @@ -1,9 +1,6 @@ {-# LANGUAGE BangPatterns #-} -{- | Symmetric eigenproblems in pure Haskell: cyclic Jacobi for full -decomposition (PCA covariance, @m×m@ kernels) and power iteration for the -dominant eigenpair (FISTA step sizes). Deterministic, sign-canonicalised output. --} +-- | Symmetric eigenproblems in pure Haskell: Jacobi and power iteration. module DataFrame.LinearAlgebra.Eigen ( jacobiEigenSym, powerIterTop, @@ -18,10 +15,7 @@ import qualified Data.Vector.Unboxed.Mutable as VUM import DataFrame.LinearAlgebra (Matrix, dot, matVec, scaleV) -{- | Cyclic Jacobi eigendecomposition of a symmetric matrix. Eigenvalues are -returned in descending order paired with eigenvectors as rows, each -sign-canonicalised (largest-magnitude component positive) for unique output. --} +-- | Cyclic Jacobi eigendecomposition of a symmetric matrix. jacobiEigenSym :: Matrix -> (VU.Vector Double, Matrix) jacobiEigenSym a0 | V.null a0 = (VU.empty, V.empty) @@ -102,9 +96,7 @@ let idx = VU.maxIndex (VU.map abs vec) in if vec VU.! idx < 0 then VU.map negate vec else vec -{- | Dominant eigenvalue and eigenvector of a symmetric PSD matrix via power -iteration with a deterministic all-ones start. --} +-- | Dominant eigenpair of a symmetric PSD matrix via power iteration. powerIterTop :: Int -> Matrix -> (Double, VU.Vector Double) powerIterTop iters a | V.null a = (0, VU.empty) diff --git a/src-internal/DataFrame/LinearAlgebra/Solve.hs b/src-internal/DataFrame/LinearAlgebra/Solve.hs --- a/src-internal/DataFrame/LinearAlgebra/Solve.hs +++ b/src-internal/DataFrame/LinearAlgebra/Solve.hs @@ -1,9 +1,6 @@ {-# LANGUAGE BangPatterns #-} -{- | Householder QR (for ordinary least squares) and Cholesky factorisation (for -ridge normal equations and Gaussian log-densities). Pure, deterministic, no -LAPACK; sound at the @d@ ≤ low-hundreds scales this library targets. --} +-- | Householder QR and Cholesky factorisation, pure and deterministic. module DataFrame.LinearAlgebra.Solve ( qrLeastSquares, cholesky, @@ -20,10 +17,7 @@ import qualified Data.Vector.Unboxed.Mutable as VUM import DataFrame.LinearAlgebra (Matrix) -{- | Solve @min ‖A x − b‖₂@ for an @n×d@ matrix @A@ (@n ≥ d@) via Householder QR. -@Left cols@ reports rank deficiency (near-zero @R@ diagonal) with the offending -column indices; @Right x@ is the least-squares solution. --} +-- | Least squares via Householder QR, or the rank-deficient column indices. qrLeastSquares :: Matrix -> VU.Vector Double -> Either [Int] (VU.Vector Double) qrLeastSquares a b | V.null a = Right VU.empty @@ -127,9 +121,7 @@ xj <- VUM.read x j sumAbove i (j + 1) (acc + rij * xj) -{- | Cholesky factor @L@ (lower-triangular, @A = L Lᵀ@) of a symmetric -positive-definite matrix, or 'Nothing' if a non-positive pivot is hit. --} +-- | Cholesky factor of a symmetric positive-definite matrix, if one exists. cholesky :: Matrix -> Maybe Matrix cholesky a | V.null a = Just V.empty @@ -200,9 +192,7 @@ xj <- VUM.read x j sumKnown x i (j + 1) (acc + ((l V.! j) VU.! i) * xj) -{- | Solve the SPD system @A x = b@ via Cholesky; 'Nothing' when @A@ is not -positive-definite. --} +-- | Solve an SPD system via Cholesky; Nothing when not positive-definite. choleskySolve :: Matrix -> VU.Vector Double -> Maybe (VU.Vector Double) choleskySolve a b = do l <- cholesky a diff --git a/src-internal/DataFrame/LinearSolver.hs b/src-internal/DataFrame/LinearSolver.hs --- a/src-internal/DataFrame/LinearSolver.hs +++ b/src-internal/DataFrame/LinearSolver.hs @@ -1,10 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} -{- | Proximal-gradient (FISTA) solver for L1/L2-regularized generalized linear -models. 'fitL1Logistic' is the binary logistic split solver; 'fitProx' -generalizes it to any 'SmoothLoss'. Features are standardized internally. --} +-- | Proximal-gradient (FISTA) solver for L1/L2-regularized linear models. module DataFrame.LinearSolver ( -- * Model LinearModel (..), @@ -45,10 +42,7 @@ import qualified Data.Vector.Unboxed as VU import qualified Data.Vector.Unboxed.Mutable as VUM -{- | A fitted linear classifier: predicts the positive class when -@sum (weights .* features) + intercept > 0@. Weights of exactly @0@ mark -features dropped by the L1 penalty (filtered out by 'modelToExpr'). --} +-- | A fitted linear classifier; zero weights mark features dropped by L1. data LinearModel = LinearModel { lmWeights :: !(VU.Vector Double) , lmIntercept :: !Double @@ -61,19 +55,13 @@ { scL1Lambda :: !Double -- ^ Strength of the L1 penalty on weights (intercept is not regularized). , scL2Lambda :: !Double - {- ^ Strength of the L2 penalty @(λ₂/2)·|w|²@ (Elastic Net; Zou & Hastie - 2005). Combined with @scL1Lambda@ this is the elastic-net objective; - @0@ reduces the solver to pure L1. - -} + -- ^ Strength of the L2 penalty (elastic net); 0 reduces to pure L1. , scMaxIter :: !Int -- ^ Maximum number of FISTA iterations. , scTol :: !Double -- ^ Convergence tolerance on the weight delta (L-inf norm). , scSampleWeights :: !(Maybe (VU.Vector Double)) - {- ^ Optional per-row sample weights, length @n@ (@Nothing@ is uniform). - Weights should have mean 1 (i.e. @Σ w_i = N@) so the Lipschitz bound stays - valid; see 'fitLinearCandidate' for the class-balanced construction. - -} + -- ^ Optional per-row sample weights with mean 1 (Nothing is uniform). } deriving (Eq, Show) @@ -87,10 +75,7 @@ , scSampleWeights = Nothing } -{- | Fit L1-regularized binary logistic regression by FISTA. Rows are feature -vectors of equal length; labels are in @{\-1,+1}@. Features are standardized -internally and weights de-standardized, so the model applies to raw values. --} +-- | Fit L1-regularized binary logistic regression by FISTA. fitL1Logistic :: SolverConfig -> V.Vector (VU.Vector Double) -> @@ -100,10 +85,7 @@ {-# INLINEABLE fitL1Logistic #-} fitL1Logistic = runFista logisticLoss (specNormLipschitz logisticLoss) -{- | Fit any 'SmoothLoss' with the elastic-net proximal-gradient engine. The -Lipschitz constant uses the spectral norm of the standardized Gram matrix -(power iteration), tight for squared and squared-hinge losses. --} +-- | Fit any SmoothLoss with the elastic-net proximal-gradient engine. fitProx :: SmoothLoss -> SolverConfig -> @@ -113,10 +95,7 @@ LinearModel fitProx loss = runFista loss (specNormLipschitz loss) -{- | FISTA smooth-part Lipschitz bound: the loss curvature bound times the -spectral norm of the standardized Gram (+1 for the intercept), via power -iteration. Tight for every smooth loss. --} +-- | FISTA smooth-part Lipschitz bound from the standardized Gram spectral norm. specNormLipschitz :: SmoothLoss -> Matrix -> Int -> Double specNormLipschitz loss xKept _ = let n = V.length xKept @@ -124,10 +103,7 @@ (specNorm, _) = powerIterTop 50 gramN in slCurvBound loss * (specNorm + 1) -{- | Shared FISTA scaffolding: standardize, drop near-constant columns, run the -inner loop, de-standardize. @lipschitzOf@ returns the smooth-part Lipschitz -bound from the kept-feature matrix; the L2 contribution @λ₂@ is added here. --} +-- | Shared FISTA scaffolding: standardize, drop constants, loop, unscale. runFista :: SmoothLoss -> (Matrix -> Int -> Double) -> @@ -170,9 +146,7 @@ !d = V.length featureNames zeroModel = LinearModel (VU.replicate d 0) 0 featureNames -{- | Indices of columns whose variance clears the near-constant threshold. -Columns below it are dropped before fitting; their weight ends up @0@. --} +-- | Indices of columns whose variance clears the near-constant threshold. keptIndices :: VU.Vector Double -> VU.Vector Int keptIndices variances = VU.fromList @@ -181,15 +155,11 @@ , VU.unsafeIndex variances j >= 1.0e-12 ] -{- | Gather the entries of @v@ at @idxs@, preserving order. unsafeIndex is -safe: every index in @idxs@ is in range by construction. --} +-- | Gather the entries of a vector at the given indices, preserving order. gatherBy :: VU.Vector Int -> VU.Vector Double -> VU.Vector Double gatherBy idxs v = VU.map (VU.unsafeIndex v) idxs -{- | Standardize one row to the kept columns only (subtract column mean, divide -by column std). unsafeIndex is safe: rows share the column layout. --} +-- | Standardize one row to the kept columns only. standardizeRowKept :: VU.Vector Int -> VU.Vector Double -> @@ -201,19 +171,14 @@ standardizeAt j = (VU.unsafeIndex row j - VU.unsafeIndex means j) / VU.unsafeIndex stds j -{- | Scatter kept-column weights back into a full-width vector, with @0@ for -the dropped (near-constant) columns. --} +-- | Scatter kept-column weights into a full-width vector, zero elsewhere. expandWeights :: Int -> VU.Vector Int -> VU.Vector Double -> VU.Vector Double expandWeights d keep wKept = VU.create $ do mv <- VUM.replicate d 0 VU.iforM_ keep $ \k j -> VUM.unsafeWrite mv j (VU.unsafeIndex wKept k) pure mv -{- | Convert a fitted model to an 'Expr Bool' over its feature columns, -dropping zero-weight features. With no non-zero weights it returns the -constant @Lit (intercept > 0)@. --} +-- | Convert a fitted model to a Bool expression, dropping zero-weight features. modelToExpr :: LinearModel -> Expr Bool modelToExpr m = case nonZero of @@ -229,10 +194,7 @@ term w n = F.lit w .*. (Col n :: Expr Double) score rest first = foldl (\acc (w, n) -> acc .+. term w n) first rest .+. F.lit b -{- | Per-column @(means, stds, variances)@ of a feature matrix. Cheaper than -'standardize' when only the statistics are needed. unsafeIndex within is -safe: all rows share width @d@. --} +-- | Per-column means, stds and variances of a feature matrix. columnStats :: V.Vector (VU.Vector Double) -> (VU.Vector Double, VU.Vector Double, VU.Vector Double) @@ -278,10 +240,7 @@ | j >= VUM.length mv = pure () | otherwise = VUM.unsafeModify mv (* factor) j >> go (j + 1) -{- | Standardize each column to zero mean and unit variance, also returning -@(means, stds, variances)@. Near-constant columns get std @1@; callers use -the raw variances to detect and drop them (see 'fitL1Logistic'). --} +-- | Standardize columns to zero mean and unit variance, with their statistics. standardize :: V.Vector (VU.Vector Double) -> ( V.Vector (VU.Vector Double) @@ -299,25 +258,18 @@ (VU.unsafeIndex row j - VU.unsafeIndex means j) / VU.unsafeIndex stds j in (V.map standardizeRow x, means, stds, variances) -{- | Proximal operator for the L1 norm: shrink @v@ toward zero by @lambda@, -clamping at zero. --} +-- | Proximal operator for the L1 norm: shrink toward zero, clamping at zero. softThreshold :: Double -> Double -> Double softThreshold lambda v | v > lambda = v - lambda | v < -lambda = v + lambda | otherwise = 0 -{- | Dot product of two unboxed vectors. Caller must ensure equal length; -lengths are not checked. --} +-- | Dot product of two unboxed vectors; lengths are not checked. dotProduct :: VU.Vector Double -> VU.Vector Double -> Double dotProduct u v = VU.sum (VU.zipWith (*) u v) -{- | Gradient of the average loss at @(w, b)@, returning @(gradW, gradB)@. -When @sampleWeights@ is @Just ws@ each row is scaled by @ws[i]@; with mean-1 -weights the @1/N@ normalisation is preserved exactly. --} +-- | Gradient of the average loss, optionally scaled by per-row sample weights. lossGradient :: SmoothLoss -> Maybe (VU.Vector Double) -> @@ -333,9 +285,7 @@ !gradW = accumulateGradW (VU.length w) features coeffs !gradB = VU.sum coeffs -{- | Per-row loss coefficient @c_i = ℓ'(y_i, z_i) / N@ at margin -@z_i = w·x_i + b@, optionally scaled by @ws[i]@. --} +-- | Per-row loss coefficient at the current margin, optionally weighted. rowCoeffs :: SmoothLoss -> Maybe (VU.Vector Double) -> @@ -355,9 +305,7 @@ Nothing -> base Just ws -> base * VU.unsafeIndex ws i -{- | Accumulate the weight gradient in one pass over every (row, feature) -pair, scattering into a length-@d@ mutable vector. --} +-- | Accumulate the weight gradient in one pass over every row and feature. accumulateGradW :: Int -> V.Vector (VU.Vector Double) -> VU.Vector Double -> VU.Vector Double accumulateGradW d features coeffs = runST $ do @@ -367,10 +315,7 @@ in VU.iforM_ row $ \j v -> VUM.unsafeModify mv (+ c * v) j VU.unsafeFreeze mv -{- | Inner FISTA loop over standardized features, returning the final @(w, b)@ -(the caller de-standardizes). @lambda1@/@lambda2@ are the L1/L2 strengths and -@lp@ the smooth-part Lipschitz constant driving the elastic-net prox step. --} +-- | Inner FISTA loop over standardized features, returning the final weights. fistaLoop :: SmoothLoss -> Double -> @@ -400,10 +345,7 @@ !delta = if VU.null xW then 0 else deltaInf xWPrev xW (!yWNew, !yBNew, !tNew) = fistaMomentum t xWPrev xBPrev xW xB -{- | One fused FISTA prox step: gradient step plus the Elastic-Net proximal -operator @softThreshold(z, λ₁/lp) / (1 + λ₂/lp)@ (soft-threshold then ridge -shrinkage). The intercept is unregularised. --} +-- | One fused FISTA prox step: gradient step plus the elastic-net prox. fistaProxStep :: SmoothLoss -> Maybe (VU.Vector Double) -> @@ -425,9 +367,7 @@ !bNew = yB - gB * stepInv in (wNew, bNew) -{- | Nesterov momentum extrapolation: new look-ahead point @(yW, yB)@ and the -updated step size @t@. --} +-- | Nesterov momentum extrapolation: new look-ahead point and step size. fistaMomentum :: Double -> VU.Vector Double -> @@ -442,9 +382,7 @@ !yB = xB + mom * (xB - xBPrev) in (yW, yB, tNew) -{- | L-inf norm of the weight delta. unsafeIndex is safe: both vectors share -the same length by construction. --} +-- | L-inf norm of the weight delta. {-# INLINE deltaInf #-} deltaInf :: VU.Vector Double -> VU.Vector Double -> Double deltaInf xWPrev = VU.ifoldl' (\acc i x -> max acc (abs (x - VU.unsafeIndex xWPrev i))) 0 diff --git a/src-internal/DataFrame/LinearSolver/Loss.hs b/src-internal/DataFrame/LinearSolver/Loss.hs --- a/src-internal/DataFrame/LinearSolver/Loss.hs +++ b/src-internal/DataFrame/LinearSolver/Loss.hs @@ -1,9 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -{- | Smooth losses for the proximal-gradient engine. Each carries its -derivative @∂ℓ/∂z@ at @z = w·x + b@ and a global bound on the curvature -@∂²ℓ/∂z²@ (used for the FISTA step size). --} +-- | Smooth losses for the proximal-gradient engine. module DataFrame.LinearSolver.Loss ( SmoothLoss (..), sigmoid, @@ -14,9 +11,7 @@ import qualified Data.Text as T -{- | A convex, @C¹@ per-sample loss @ℓ(y, z)@. 'slGradZ' is @∂ℓ/∂z@; -'slCurvBound' bounds @∂²ℓ/∂z²@ over all @(y, z)@. --} +-- | A convex per-sample loss with its gradient and a curvature bound. data SmoothLoss = SmoothLoss { slName :: !T.Text , slGradZ :: Double -> Double -> Double diff --git a/src-internal/DataFrame/Random.hs b/src-internal/DataFrame/Random.hs --- a/src-internal/DataFrame/Random.hs +++ b/src-internal/DataFrame/Random.hs @@ -1,9 +1,6 @@ {-# LANGUAGE CPP #-} -{- | Deterministic, platform-independent random sampling for the stochastic -fitters. Built on @random@'s SplitMix 'StdGen'; the distributions here are our -own so a seeded fit is bit-reproducible across platforms. --} +-- | Deterministic, platform-independent random sampling for the fitters. module DataFrame.Random ( Gen, mkGen, @@ -52,9 +49,7 @@ d = fromIntegral (w `shiftR` 11) * (1 / 9007199254740992) in (d, g') -{- | Uniform 'Int' in the inclusive range @[lo, hi]@ by rejection sampling -(unbiased). Returns @lo@ when @hi <= lo@. --} +-- | Uniform Int in an inclusive range by rejection sampling (unbiased). nextIntR :: (Int, Int) -> Gen -> (Int, Gen) nextIntR (lo, hi) g | hi <= lo = (lo, g) @@ -68,9 +63,7 @@ then (lo + fromIntegral (w `mod` range), gg') else loop gg' -{- | A pair of independent standard normals via Box-Muller, consuming exactly two -uniforms so stream offsets stay data-independent. --} +-- | A pair of independent standard normals via Box-Muller. gaussianPair :: Gen -> ((Double, Double), Gen) gaussianPair g = let (u1, g1) = nextDouble g @@ -90,9 +83,7 @@ let ((z0, z1), g') = gaussianPair g in go (k - 2) g' (z1 : z0 : acc) -{- | A uniformly random permutation of @[0 .. n-1]@ (Fisher-Yates), threading the -generator purely. --} +-- | A uniformly random permutation of 0 .. n-1 (Fisher-Yates). shuffleInts :: Int -> Gen -> (VU.Vector Int, Gen) shuffleInts n g0 | n <= 1 = (VU.enumFromN 0 (max 0 n), g0) @@ -110,9 +101,7 @@ let (j, g') = nextIntR (0, i) g in genSwaps (i - 1) g' ((i, j) : acc) -{- | @sampleIndices k n@ draws @k@ distinct indices from @[0 .. n-1]@ (the first -@k@ of a full shuffle); returns all @n@ when @k >= n@. --} +-- | Draw k distinct indices from 0 .. n-1; returns all n when k >= n. sampleIndices :: Int -> Int -> Gen -> (VU.Vector Int, Gen) sampleIndices k n g = let (perm, g') = shuffleInts n g diff --git a/src-internal/DataFrame/SymbolicRegression/Expr.hs b/src-internal/DataFrame/SymbolicRegression/Expr.hs --- a/src-internal/DataFrame/SymbolicRegression/Expr.hs +++ b/src-internal/DataFrame/SymbolicRegression/Expr.hs @@ -1,9 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} -{- | The symbolic-regression expression tree: a small first-order ADT with -vectorized evaluation and a total translation to a dataframe 'Expr Double'. -Division, log, and sqrt are protected so evaluation never produces @NaN@. --} +-- | The symbolic-regression expression tree with protected, total operators. module DataFrame.SymbolicRegression.Expr ( SRExpr (..), BinOp (..), @@ -45,9 +42,7 @@ allUnOps :: [UnOp] allUnOps = [minBound .. maxBound] -{- | Evaluate over a feature matrix given column-major (@feats ! j@ is feature -@j@ across all rows). Protected operators keep results finite. --} +-- | Evaluate over a column-major feature matrix with protected operators. evalSR :: V.Vector (VU.Vector Double) -> Int -> SRExpr -> VU.Vector Double evalSR feats n = go where diff --git a/src-internal/DataFrame/SymbolicRegression/GP.hs b/src-internal/DataFrame/SymbolicRegression/GP.hs --- a/src-internal/DataFrame/SymbolicRegression/GP.hs +++ b/src-internal/DataFrame/SymbolicRegression/GP.hs @@ -1,13 +1,11 @@ -{- | A compact generational genetic-programming search over 'SRExpr': ramped -initialization, tournament selection, subtree crossover/mutation, elitism, and a -complexity-keyed Pareto archive. Deterministic given the seed. --} +-- | A compact generational genetic-programming search over SRExpr. module DataFrame.SymbolicRegression.GP ( GPParams (..), runGP, ) where -import Data.List (foldl', minimumBy, sortBy) +import Data.List (minimumBy, sortBy) +import qualified Data.List as L import qualified Data.Map.Strict as M import Data.Ord (comparing) import qualified Data.Vector as V @@ -45,7 +43,7 @@ runGP p g0 = let (pop0, g1) = initPop p g0 scored0 = map (scoreOf p) pop0 - arch0 = foldl' (archiveInsert p) M.empty scored0 + arch0 = L.foldl' (archiveInsert p) M.empty scored0 (_, finalArch, gN, _) = iterate' 0 scored0 arch0 g1 best = bestOfArchive finalArch @@ -59,7 +57,7 @@ | gen >= gpGenerations p = (pop, arch, gen, g) | otherwise = let (pop', g') = nextGen p pop g - arch' = foldl' (archiveInsert p) arch pop' + arch' = L.foldl' (archiveInsert p) arch pop' in iterate' (gen + 1) pop' arch' g' fst3 (a, _, _) = a snd3 (_, b, _) = b diff --git a/src-internal/DataFrame/SymbolicRegression/Optimize.hs b/src-internal/DataFrame/SymbolicRegression/Optimize.hs --- a/src-internal/DataFrame/SymbolicRegression/Optimize.hs +++ b/src-internal/DataFrame/SymbolicRegression/Optimize.hs @@ -1,9 +1,6 @@ {-# LANGUAGE BangPatterns #-} -{- | Constant optimization for symbolic-regression candidates: finite-difference -gradient descent with backtracking line search on the embedded constants. Pure -and dependency-free; effective at the one-to-few constants a tree carries. --} +-- | Constant optimization for symbolic-regression candidates. module DataFrame.SymbolicRegression.Optimize ( optimizeConstants, meanSquaredError, diff --git a/src-internal/DataFrame/SymbolicRegression/Simplify.hs b/src-internal/DataFrame/SymbolicRegression/Simplify.hs --- a/src-internal/DataFrame/SymbolicRegression/Simplify.hs +++ b/src-internal/DataFrame/SymbolicRegression/Simplify.hs @@ -1,7 +1,4 @@ -{- | A fuel-bounded, deterministic algebraic simplifier — the dependency-light -stand-in for equality saturation. Used as a canonical dedup key for the Pareto -archive and to tidy reported expressions; total and evaluation-preserving. --} +-- | A fuel-bounded, deterministic algebraic simplifier. module DataFrame.SymbolicRegression.Simplify ( simplify, ) where diff --git a/src/DataFrame/Boosting.hs b/src/DataFrame/Boosting.hs --- a/src/DataFrame/Boosting.hs +++ b/src/DataFrame/Boosting.hs @@ -1,6 +1,4 @@ -{- | Tree ensembles: gradient boosting (the recommended default) and AdaBoost -(SAMME). Re-exports the focused submodules. --} +-- | Tree ensembles: gradient boosting and AdaBoost (SAMME). module DataFrame.Boosting ( module DataFrame.Boosting.GBM, module DataFrame.Boosting.AdaBoost, diff --git a/src/DataFrame/Boosting/AdaBoost.hs b/src/DataFrame/Boosting/AdaBoost.hs --- a/src/DataFrame/Boosting/AdaBoost.hs +++ b/src/DataFrame/Boosting/AdaBoost.hs @@ -8,11 +8,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -{- | AdaBoost (SAMME) over short, sample-weighted classification trees. The -weighted-Gini stump fitter here is self-contained (it reuses the CART feature -encoding but not the unweighted CART recursion), so the existing decision-tree -path is untouched. 'predict' is the arg-max of weighted votes. --} +-- | AdaBoost (SAMME) over short, sample-weighted classification trees. module DataFrame.Boosting.AdaBoost ( module DataFrame.Model, AdaBoostConfig (..), @@ -31,7 +27,9 @@ import DataFrame.DecisionTree.Cart ( CartFeature (..), cartFeatures, + cfPred, sortIndicesByValue, + splitMidpoint, ) import DataFrame.DecisionTree.Fit (treeToExpr) import DataFrame.DecisionTree.Types (Tree (..)) @@ -188,7 +186,7 @@ valid = vCur /= vNext && wl > 0 && wr > 0 best' = if valid && maybe True (\(_, s) -> score < s) best - then Just ((vCur + vNext) / 2, score) + then Just (splitMidpoint vCur vNext, score) else best in go0 (k + 1) leftW' best' @@ -202,9 +200,7 @@ minimum3 :: (Ord a) => [(a, b, c)] -> (a, b, c) minimum3 = foldr1 (\x@(a, _, _) y@(b, _, _) -> if a <= b then x else y) -{- | Compile to an arg-max-of-weighted-votes expression over the class set: -@argmax_c Σ_m αₘ·[stumpₘ = c]@. --} +-- | Compile to an arg-max-of-weighted-votes expression over the class set. adaBoostExpr :: (Columnable a, Ord a) => AdaBoostModel a -> Expr a adaBoostExpr m = argMaxExpr (zip classes scores) where diff --git a/src/DataFrame/Boosting/GBM.hs b/src/DataFrame/Boosting/GBM.hs --- a/src/DataFrame/Boosting/GBM.hs +++ b/src/DataFrame/Boosting/GBM.hs @@ -3,15 +3,9 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -{- | Gradient boosting of regression trees (Friedman). Trees are fitted to the -negative gradient of the loss each round and accumulated with a shrinkage -factor; squared error gives regression, logistic deviance gives binary -classification. 'predict' is the additive score; 'gbProbaExpr' / -'gbDecisionExpr' give the classification probability / decision. --} +-- | Gradient boosting of regression trees on per-feature histograms. module DataFrame.Boosting.GBM ( module DataFrame.Model, GBLoss (..), @@ -24,25 +18,28 @@ ) where import Control.Exception (throw) -import Data.Either (fromRight) import qualified Data.Map.Strict as M import qualified Data.Text as T import qualified Data.Vector as V import qualified Data.Vector.Unboxed as VU import DataFrame.Errors (DataFrameException (..)) -import DataFrame.DecisionTree.Cart (cartFeatures) +import Data.Maybe (fromMaybe) +import DataFrame.DecisionTree.Cart (cartFeaturesByColumn) import DataFrame.DecisionTree.Fit (treeToExpr) -import DataFrame.DecisionTree.Regression (RegTreeConfig (..), fitRegTreeOn) +import DataFrame.DecisionTree.Histogram ( + TreeLimits (..), + binFeatures, + fitBinnedTreeOn, + ) import DataFrame.DecisionTree.Types (Tree) import DataFrame.Expression.Operators ((.*.), (.+.), (.>.)) import DataFrame.Featurize.Internal (targetDoubles) import qualified DataFrame.Functions as F -import DataFrame.Internal.Column (TypedColumn (..), toVector) import DataFrame.Internal.DataFrame (DataFrame) import DataFrame.Internal.Expression (Expr (..), getColumns) -import DataFrame.Internal.Interpreter (interpret) import DataFrame.Model +import System.Random (StdGen, mkStdGen, randoms) -- | The boosting loss. data GBLoss = SquaredError | LogisticDeviance @@ -53,9 +50,23 @@ , gbNEstimators :: !Int , gbLearningRate :: !Double , gbMaxDepth :: !Int + , gbMaxBins :: !Int + -- ^ Bins per feature for split finding. , gbSeed :: !Int + , gbL2 :: !Double + -- ^ L2 penalty on leaf values (XGBoost's @lambda@). + , gbMinChildWeight :: !Double + -- ^ Smallest Hessian sum a leaf may have (XGBoost's @min_child_weight@). + , gbFeatureGroups :: ![[T.Text]] + -- ^ Column groups: tree m splits only on group m mod the group count. + , gbBaseScore :: !(Maybe (Expr Double)) + -- ^ Per-row scores to boost from instead of a constant. + , gbSubsample :: !Double + -- ^ Fraction of rows each tree is fitted on (1 = all). + , gbColsample :: !Double + -- ^ Fraction of allowed features each tree may split on (1 = all). } - deriving (Eq, Show) + deriving (Show) defaultGBConfig :: GBConfig defaultGBConfig = @@ -64,13 +75,17 @@ , gbNEstimators = 100 , gbLearningRate = 0.1 , gbMaxDepth = 3 + , gbMaxBins = 1024 , gbSeed = 0 + , gbL2 = 0 + , gbMinChildWeight = 0 + , gbFeatureGroups = [] + , gbBaseScore = Nothing + , gbSubsample = 1 + , gbColsample = 1 } -{- | A fitted gradient-boosting model. 'gbInit' is the constant initial score -(mean, or log-odds for classification); 'gbTrees' are the staged regression -trees. --} +-- | A fitted gradient-boosting model: initial score plus staged trees. data GBModel = GBModel { gbInit :: !Double , gbTrees :: !(V.Vector (Tree Double)) @@ -78,6 +93,7 @@ , gbModelLoss :: !GBLoss , gbTrainScore :: !(VU.Vector Double) , gbFeatureUsage :: !(M.Map T.Text Int) + , gbBase :: !(Maybe (Expr Double)) } deriving (Show) @@ -89,7 +105,7 @@ type Prediction GBModel = Expr Double predict = gbExpr --- | Fit a gradient-boosting ensemble predicting @target@ from the other columns. +-- | Fit a gradient-boosting ensemble predicting the target column. fitGBM :: GBConfig -> Expr Double -> DataFrame -> GBModel fitGBM cfg target@(Col name) df = GBModel @@ -99,33 +115,70 @@ (gbLoss cfg) (VU.fromList (reverse scores)) usage + (gbBaseScore cfg) where - feats = V.fromList (cartFeatures name df) + byColumn = cartFeaturesByColumn name df + binned = binFeatures (gbMaxBins cfg) (V.fromList (map snd byColumn)) + allFeatures = VU.enumFromN 0 (length byColumn) + groupFeatures = + [ VU.fromList [j | (j, (c, _)) <- zip [0 ..] byColumn, c `elem` g] + | g <- gbFeatureGroups cfg + ] + featuresFor m = + let allowed = case groupFeatures of + [] -> allFeatures + gs -> gs !! (m `mod` length gs) + in if gbColsample cfg >= 1 + then allowed + else + keepFraction + (gbColsample cfg) + (mkStdGen (7919 * gbSeed cfg + 2 * m + 1)) + allowed + rowMask m + | gbSubsample cfg >= 1 = Nothing + | otherwise = + Just + ( VU.fromList + ( take + n + ( map + (\u -> if u < gbSubsample cfg then 1 else 0) + (randoms (mkStdGen (7919 * gbSeed cfg + 2 * m)) :: [Double]) + ) + ) + ) y = targetDoubles target df n = VU.length y lr = gbLearningRate cfg - rtCfg = - RegTreeConfig - { rtMaxDepth = gbMaxDepth cfg - , rtMinSamplesSplit = 2 - , rtMinLeafSize = 1 - , rtMinImpurityDecrease = 0.0 + limits = + TreeLimits + { tlMaxDepth = gbMaxDepth cfg + , tlMinSamplesSplit = 2 + , tlMinLeafSize = 1 + , tlMinImpurityDecrease = 0.0 + , tlL2 = gbL2 cfg + , tlMinChildWeight = gbMinChildWeight cfg } - f0 = case gbLoss cfg of - SquaredError -> VU.sum y / fromIntegral (max 1 n) - LogisticDeviance -> + baseScores = fmap (`targetDoubles` df) (gbBaseScore cfg) + f0 = case (baseScores, gbLoss cfg) of + (Just _, _) -> 0 + (Nothing, SquaredError) -> VU.sum y / fromIntegral (max 1 n) + (Nothing, LogisticDeviance) -> let p = clamp01 (VU.sum y / fromIntegral (max 1 n)) in log (p / (1 - p)) - (trees, scores, usage) = boost 0 (VU.replicate n f0) [] [] M.empty + (trees, scores, usage) = boost 0 (fromMaybe (VU.replicate n f0) baseScores) [] [] M.empty boost !m fScores ts ss usageAcc | m >= gbNEstimators cfg = (ts, ss, usageAcc) | otherwise = - let (target', weights) = newtonStep (gbLoss cfg) y fScores - tree = fitRegTreeOn rtCfg feats target' weights - pred = predictTree df tree + let (target', weights0) = newtonStep (gbLoss cfg) y fScores + weights = case rowMask m of + Nothing -> weights0 + Just mask -> Just (VU.zipWith (*) mask (fromMaybe (VU.replicate n 1) weights0)) + (tree, pred) = fitBinnedTreeOn (featuresFor m) limits binned target' weights fScores' = VU.zipWith (\f p -> f + lr * p) fScores pred - score = lossValue (gbLoss cfg) y fScores' - usage' = foldr (\c -> M.insertWith (+) c 1) usageAcc (treeColumns tree) + !score = lossValue (gbLoss cfg) y fScores' + !usage' = foldr (\c -> M.insertWith (+) c 1) usageAcc (treeColumns tree) in boost (m + 1) fScores' (tree : ts) (score : ss) usage' fitGBM _ expr _ = throw (NonColumnReferenceException ("fitGBM: " <> T.pack (show expr))) @@ -174,11 +227,6 @@ clamp01 :: Double -> Double clamp01 p = max 1e-12 (min (1 - 1e-12) p) -predictTree :: DataFrame -> Tree Double -> VU.Vector Double -predictTree df t = case interpret @Double df (treeToExpr t) of - Right (TColumn c) -> fromRight VU.empty (toVector @Double @VU.Vector c) - Left e -> throw e - treeColumns :: Tree Double -> [T.Text] treeColumns = getColumns . treeToExpr @@ -194,8 +242,9 @@ stageExpr :: Int -> GBModel -> Expr Double stageExpr k m = - foldr ((.+.) . scaled) (F.lit (gbInit m)) (take k (V.toList (gbTrees m))) + foldr ((.+.) . scaled) start (take k (V.toList (gbTrees m))) where + start = maybe (F.lit (gbInit m)) (\b -> b .+. F.lit (gbInit m)) (gbBase m) scaled t = F.lit (gbRate m) .*. treeToExpr t -- | Probability expression for classification: @sigmoid(score)@. @@ -205,3 +254,11 @@ -- | Decision expression for classification: positive class when score > 0. gbDecisionExpr :: GBModel -> Expr Bool gbDecisionExpr m = gbExpr m .>. F.lit 0 + +-- | A uniformly chosen subset of the given size fraction, in order. +keepFraction :: Double -> StdGen -> VU.Vector Int -> VU.Vector Int +keepFraction frac g xs = + let k = max 1 (round (frac * fromIntegral (VU.length xs))) + keyed = zip (take (VU.length xs) (randoms g :: [Double])) (VU.toList xs) + chosen = map snd (take k (M.toAscList (M.fromList keyed))) + in VU.fromList (M.keys (M.fromList [(x, ()) | x <- chosen])) diff --git a/src/DataFrame/DBSCAN.hs b/src/DataFrame/DBSCAN.hs --- a/src/DataFrame/DBSCAN.hs +++ b/src/DataFrame/DBSCAN.hs @@ -5,12 +5,7 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -{- | Density-based clustering (DBSCAN). Brute-force @O(n²)@ region queries, no -spatial index — suitable for the in-memory scales this library targets. DBSCAN -is transductive: it has a 'Fit' instance but deliberately no 'Predict' instance -(there is no honest single prediction expression). 'dbscanSurrogateExpr' fits an -interpretable decision-tree surrogate on the cluster labels instead. --} +-- | Density-based clustering (DBSCAN) with brute-force region queries. module DataFrame.DBSCAN ( module DataFrame.Model, DBSCANConfig (..), @@ -34,7 +29,7 @@ ) import qualified DataFrame.Functions as F import qualified DataFrame.Internal.Column as DI -import DataFrame.Internal.DataFrame (DataFrame, fromNamedColumns) +import DataFrame.Internal.DataFrame (DataFrame, fromColumns) import DataFrame.Internal.Expression (Expr) import DataFrame.LinearAlgebra (epsNeighbors) import DataFrame.Model @@ -48,9 +43,7 @@ defaultDBSCANConfig :: DBSCANConfig defaultDBSCANConfig = DBSCANConfig{dbEps = 0.5, dbMinSamples = 5} -{- | A fitted DBSCAN labelling. 'dbLabels' uses @-1@ for noise (sklearn's -@labels_@); 'dbCoreSampleIndices' are the core points. --} +-- | A fitted DBSCAN labelling, with -1 marking noise. data DBSCANModel = DBSCANModel { dbLabels :: !(VU.Vector Int) , dbCoreSampleIndices :: !(VU.Vector Int) @@ -106,9 +99,7 @@ seedLoop 0 0 VU.freeze lab -{- | Fit a decision-tree surrogate on the DBSCAN labels so new rows can be -assigned an (approximate) cluster. Noise (@-1@) is its own class. --} +-- | Fit a decision-tree surrogate on the DBSCAN labels. dbscanSurrogateExpr :: TreeConfig -> [Expr Double] -> DBSCANModel -> DataFrame -> Expr Int dbscanSurrogateExpr cfg features model df = @@ -117,6 +108,6 @@ clusterCol = "__cluster__" cols = map (\e -> (columnExprName e, materializeColumn df e)) features augmented = - fromNamedColumns $ - [(n, DI.fromList (VU.toList v)) | (n, v) <- cols] - ++ [(clusterCol, DI.fromList (VU.toList (dbLabels model)))] + fromColumns $ + [(n, DI.fromUnboxedVector v) | (n, v) <- cols] + ++ [(clusterCol, DI.fromUnboxedVector (dbLabels model))] diff --git a/src/DataFrame/DecisionTree.hs b/src/DataFrame/DecisionTree.hs --- a/src/DataFrame/DecisionTree.hs +++ b/src/DataFrame/DecisionTree.hs @@ -1,13 +1,8 @@ -{- | Interpretable decision trees on DataFrames (CART refined by TAO). The -curated public surface: classifier/regressor configs, fitted-model records, -and their 'Fit'\/'Predict' instances. --} +-- | Interpretable decision trees on DataFrames (CART refined by TAO). module DataFrame.DecisionTree ( -- * Estimators - {- | Fitted-model records with their @Fit@\/@Predict@ instances and the - estimator classes (via "DataFrame.Model"). - -} + -- | Fitted-model records with their Fit and Predict instances. module DataFrame.DecisionTree.Model, -- * Classifier configuration diff --git a/src/DataFrame/DecisionTree/Model.hs b/src/DataFrame/DecisionTree/Model.hs --- a/src/DataFrame/DecisionTree/Model.hs +++ b/src/DataFrame/DecisionTree/Model.hs @@ -5,13 +5,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -{- | sklearn-style standalone tree estimators returning inspectable records -(depth, leaf count, per-feature split usage). 'fit' trains a classifier (from a -'TreeConfig') or a regressor (from a 'RegTreeConfig'); 'predict' is the compiled -tree expression, and the record exposes the raw 'Tree' too. The bare -'DataFrame.DecisionTree.Fit.fitDecisionTree' remains for callers that only want -the classifier @Expr@. --} +-- | Standalone tree estimators returning inspectable fitted records. module DataFrame.DecisionTree.Model ( module DataFrame.Model, DecisionTreeClassifier (..), @@ -27,7 +21,11 @@ import DataFrame.DecisionTree.Cart (cartFeatures) import DataFrame.DecisionTree.Fit (fitDecisionTree, treeToExpr) -import DataFrame.DecisionTree.Regression (RegTreeConfig, fitRegTreeOn) +import DataFrame.DecisionTree.Regression ( + RegFit (..), + RegTreeConfig, + fitRegTree, + ) import DataFrame.DecisionTree.Types (Tree (..), TreeConfig) import DataFrame.Featurize.Internal (targetDoubles) import DataFrame.Internal.Column (Columnable) @@ -80,11 +78,13 @@ where t = case target of Col name -> - fitRegTreeOn - cfg - (V.fromList (cartFeatures name df)) - (targetDoubles target df) - Nothing + rfTree + ( fitRegTree + cfg + (V.fromList (cartFeatures name df)) + (targetDoubles target df) + Nothing + ) _ -> throw ( NonColumnReferenceException diff --git a/src/DataFrame/DecisionTree/Regression.hs b/src/DataFrame/DecisionTree/Regression.hs --- a/src/DataFrame/DecisionTree/Regression.hs +++ b/src/DataFrame/DecisionTree/Regression.hs @@ -1,15 +1,14 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} -{- | Variance-reduction (weighted-SSE) regression trees over the CART feature -machinery; leaves predict the weighted mean of their rows. 'fitRegTreeOn' lets -gradient boosting refit on residuals without re-extracting features. --} +-- | Variance-reduction (weighted-SSE) regression trees. module DataFrame.DecisionTree.Regression ( RegTreeConfig (..), defaultRegTreeConfig, + RegFit (..), -- | Implementation verb used by the fit\/predict instances and boosting. - fitRegTreeOn, + fitRegTree, ) where import Control.Parallel (par, pseq) @@ -17,8 +16,14 @@ import qualified Data.Vector as V import qualified Data.Vector.Unboxed as VU -import DataFrame.DecisionTree.Cart (CartFeature (..), sortIndicesByValue) +import DataFrame.DecisionTree.Cart ( + CartFeature (..), + NullSide (..), + sortIndicesByValue, + splitMidpoint, + ) import DataFrame.DecisionTree.Types (Tree (..)) +import DataFrame.Internal.Expression (Expr) -- | Stopping criteria for the regression tree. data RegTreeConfig = RegTreeConfig @@ -38,35 +43,50 @@ , rtMinImpurityDecrease = 0.0 } -{- | Fit on pre-extracted features, a target vector, and optional per-row -weights (length @n@). Used by gradient boosting on residual targets. --} -fitRegTreeOn :: +data RegFit = RegFit + { rfTree :: !(Tree Double) + , rfFitted :: !(VU.Vector Double) + } + +-- | Fit on pre-extracted features, a target vector and optional weights. +fitRegTree :: RegTreeConfig -> V.Vector CartFeature -> VU.Vector Double -> Maybe (VU.Vector Double) -> - Tree Double -fitRegTreeOn cfg feats y mw = buildNode 0 (VU.enumFromN 0 n) featSorted + RegFit +fitRegTree cfg feats y mw = RegFit (toTree root) inSample where + root = buildNode 0 (VU.enumFromN 0 n) featSorted + inSample = VU.update (VU.replicate n 0) (VU.concat (leafRows root)) + leafRows (FLeaf v idxs) = [VU.map (,v) idxs] + leafRows (FBranch _ l r) = leafRows l ++ leafRows r n = VU.length y weightAt i = maybe 1 (VU.! i) mw - featSorted = V.map (sortIndicesByValue . cfValues) feats + -- For each feature, row indices sorted by value, with null rows left out. + featSorted = V.map presentSorted feats + presentSorted f = case cfNulls f of + Nothing -> sortIndicesByValue (cfValues f) + Just nulls -> VU.filter (not . (nulls VU.!)) (sortIndicesByValue (cfValues f)) buildNode depth idxs sortedByFeat | depth >= rtMaxDepth cfg || VU.length idxs < rtMinSamplesSplit cfg = leaf | otherwise = maybe leaf (splitNode depth idxs sortedByFeat) (bestSplit idxs sortedByFeat) where - leaf = Leaf (weightedMean idxs) + leaf = FLeaf (weightedMean idxs) idxs - splitNode depth idxs sortedByFeat (fj, thr) - | VU.null lefts || VU.null rights = Leaf (weightedMean idxs) + splitNode depth idxs sortedByFeat (fj, thr, side) + | VU.null lefts || VU.null rights = FLeaf (weightedMean idxs) idxs | otherwise = - forceTree l `par` (forceTree r `pseq` Branch (cfPred (feats V.! fj) thr) l r) + forceTree l `par` + (forceTree r `pseq` FBranch (cfSplit feat thr side) l r) where - vals = cfValues (feats V.! fj) - goesLeft i = vals VU.! i <= thr + feat = feats V.! fj + vals = cfValues feat + goesLeft i = case cfNulls feat of + Just nulls | nulls VU.! i -> side == NullsLeft + _ -> vals VU.! i <= thr lefts = VU.filter goesLeft idxs rights = VU.filter (not . goesLeft) idxs l = buildNode (depth + 1) lefts (V.map (VU.filter goesLeft) sortedByFeat) @@ -80,41 +100,64 @@ bestSplit idxs sortedByFeat | null candidates = Nothing - | red > 0 && red >= rtMinImpurityDecrease cfg = Just (fj, thr) + | red > 0 && red >= rtMinImpurityDecrease cfg = Just split | otherwise = Nothing where + nNode = VU.length idxs (totW, totSY, totSY2) = moments idxs nodeSSE = sse totSY totSY2 totW candidates = - [ (red', fj', thr') - | fj' <- [0 .. V.length feats - 1] - , (thr', red') <- - bestThreshold fj' (sortedByFeat V.! fj') totW totSY totSY2 nodeSSE - ] - (red, fj, thr) = maximumByFst candidates + concat + [ bestThreshold fj (sortedByFeat V.! fj) nNode totW totSY totSY2 nodeSSE + | fj <- [0 .. V.length feats - 1] + ] + (red, split) = maximumByFst candidates - bestThreshold fj sorted totW totSY totSY2 nodeSSE = maybeToList (go 0 0 0 0 Nothing) + -- Best (threshold, null side) for feature @fj@ at this node. + bestThreshold fj sorted nNode totW totSY totSY2 nodeSSE = + [(r, (fj, thr, dir)) | (thr, dir, r) <- maybeToList (go 0 0 0 0 Nothing)] where vals = cfValues (feats V.! fj) m = VU.length sorted + nNull = nNode - m + (pW, pSY, pSY2) = moments sorted + (nW, nSY, nSY2) = (totW - pW, totSY - pSY, totSY2 - pSY2) + hasNulls = nNull > 0 + -- Last split to try; without nulls the final row splits nothing. + lastK = if hasNulls then m - 1 else m - 2 + score nl wl syl syl2 = + let wr = totW - wl + ok = + nl >= rtMinLeafSize cfg && nNode - nl >= rtMinLeafSize cfg && wl > 0 && wr > 0 + in if ok + then Just (nodeSSE - (sse syl syl2 wl + sse (totSY - syl) (totSY2 - syl2) wr)) + else Nothing go !k !wl !syl !syl2 best - | k >= m - 1 = best + | k > lastK || k >= m = best | otherwise = go (k + 1) wl' syl' syl2' best' where i = sorted VU.! k - next = sorted VU.! (k + 1) wi = weightAt i yi = y VU.! i wl' = wl + wi syl' = syl + wi * yi syl2' = syl2 + wi * yi * yi - wr = totW - wl' - leafSizesOk = k + 1 >= rtMinLeafSize cfg && m - (k + 1) >= rtMinLeafSize cfg - splittable = vals VU.! i /= vals VU.! next && leafSizesOk && wl' > 0 && wr > 0 - reduction = nodeSSE - (sse syl' syl2' wl' + sse (totSY - syl') (totSY2 - syl2') wr) + boundary + | k + 1 < m = vals VU.! i /= vals VU.! (sorted VU.! (k + 1)) + | otherwise = True + thr + | k + 1 < m = splitMidpoint (vals VU.! i) (vals VU.! (sorted VU.! (k + 1))) + | otherwise = vals VU.! i + right = (,) NullsRight <$> score (k + 1) wl' syl' syl2' + left + | hasNulls = + (,) NullsLeft <$> score (k + 1 + nNull) (wl' + nW) (syl' + nSY) (syl2' + nSY2) + | otherwise = Nothing + consider b (dir, r) + | maybe True (\(_, _, rb) -> r > rb) b = Just (thr, dir, r) + | otherwise = b best' - | splittable && maybe True ((reduction >) . snd) best = - Just ((vals VU.! i + vals VU.! next) / 2, reduction) + | boundary = foldl consider best (maybeToList right ++ maybeToList left) | otherwise = best moments = VU.foldl' step (0, 0, 0) @@ -126,16 +169,22 @@ safeDiv :: Double -> Double -> Double safeDiv a b = if b == 0 then 0 else a / b --- | Weighted SSE of a node from its Σy, Σy², and total weight: @Σy² − (Σy)²/w@. +-- | Weighted SSE of a node from its sums and total weight. sse :: Double -> Double -> Double -> Double sse sumY sumSq w = sumSq - safeDiv (sumY * sumY) w -{- | Force a subtree to WHNF throughout so the spark scoring the sibling has -substantial work to evaluate; pure and value-preserving (cf. 'Tao'). --} -forceTree :: Tree Double -> () -forceTree (Leaf v) = v `seq` () -forceTree (Branch _ l r) = forceTree l `seq` forceTree r +data FitNode + = FLeaf !Double !(VU.Vector Int) + | FBranch !(Expr Bool) !FitNode !FitNode -maximumByFst :: (Ord a) => [(a, b, c)] -> (a, b, c) -maximumByFst = foldr1 (\x@(a, _, _) y@(b, _, _) -> if a >= b then x else y) +toTree :: FitNode -> Tree Double +toTree (FLeaf v _) = Leaf v +toTree (FBranch c l r) = Branch c (toTree l) (toTree r) + +-- | Force a subtree to WHNF throughout; pure and value-preserving. +forceTree :: FitNode -> () +forceTree (FLeaf v _) = v `seq` () +forceTree (FBranch _ l r) = forceTree l `seq` forceTree r + +maximumByFst :: (Ord a) => [(a, b)] -> (a, b) +maximumByFst = foldr1 (\x@(a, _) y@(b, _) -> if a >= b then x else y) diff --git a/src/DataFrame/GMM.hs b/src/DataFrame/GMM.hs --- a/src/DataFrame/GMM.hs +++ b/src/DataFrame/GMM.hs @@ -5,12 +5,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} -{- | Gaussian mixture models fitted by EM. Full covariance by default (with a -diagonal option and an automatic fall-back when a covariance is not positive -definite), log-space responsibilities, and Cholesky-based densities for -stability. 'predict' is the hard (arg-max) component assignment; per-component -log-densities are available via 'gmmLogDensityExprs'. --} +-- | Gaussian mixture models fitted by EM, full or diagonal covariance. module DataFrame.GMM ( module DataFrame.Model, CovType (..), @@ -63,7 +58,7 @@ , gmmSeed = 0 } --- | A fitted mixture. 'gmmCovariances' are the per-component covariance matrices. +-- | A fitted mixture with per-component covariance matrices. data GMMModel = GMMModel { gmmWeights :: !(VU.Vector Double) , gmmMeans :: !(V.Vector (VU.Vector Double)) diff --git a/src/DataFrame/KMeans.hs b/src/DataFrame/KMeans.hs --- a/src/DataFrame/KMeans.hs +++ b/src/DataFrame/KMeans.hs @@ -4,11 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} -{- | k-means clustering (Lloyd's algorithm with k-means++ seeding and multiple -restarts). 'fit' trains a 'KMeansModel' (inspectable centres); 'predict' is the -arg-min cluster assignment. Per-cluster distance features are available via -'kmeansDistanceExprs' / 'kmeansTransform'. --} +-- | k-means clustering (Lloyd with k-means++ seeding and restarts). module DataFrame.KMeans ( module DataFrame.Model, KMeansConfig (..), @@ -29,7 +25,7 @@ import DataFrame.Featurize.Internal (Features (..), argMinExpr, extractFeatures) import qualified DataFrame.Functions as F import DataFrame.Internal.DataFrame (DataFrame) -import DataFrame.Internal.Expression (Expr (..), UExpr (..)) +import DataFrame.Internal.Expression (Expr (..), SomeExpr (..)) import DataFrame.LinearAlgebra (Matrix, nearestCenter, sqDist) import DataFrame.Model import DataFrame.Random (Gen, mkGen, nextDouble, nextIntR, splitGen) @@ -82,9 +78,7 @@ genSeeds :: Gen -> [Gen] genSeeds g = let (g1, g2) = splitGen g in g1 : genSeeds g2 -{- | One k-means run: k-means++ seeding then Lloyd iterations. Returns -@(centers, labels, inertia, nIter)@. --} +-- | One k-means run: k-means++ seeding then Lloyd iterations. lloyd :: KMeansConfig -> Int -> @@ -158,4 +152,4 @@ -- | The per-cluster distance features as a composable fitted 'Transform'. kmeansTransform :: KMeansModel -> Transform -kmeansTransform m = Transform [(n, UExpr e) | (n, e) <- kmeansDistanceExprs m] +kmeansTransform m = Transform [(n, SomeExpr e) | (n, e) <- kmeansDistanceExprs m] diff --git a/src/DataFrame/Learn.hs b/src/DataFrame/Learn.hs --- a/src/DataFrame/Learn.hs +++ b/src/DataFrame/Learn.hs @@ -1,13 +1,4 @@ -{- | The one import an application needs for the @dataframe-learn@ estimators: -the @fit@\/@predict@ verbs, every model config and fitted-model record, and all -their 'Fit'\/'Predict' instances. - -@ -import DataFrame.Learn -... -fit defaultRegTreeConfig target df -@ --} +-- | The one import an application needs for the dataframe-learn estimators. module DataFrame.Learn ( module DataFrame.Model, module DataFrame.LinearModel, diff --git a/src/DataFrame/LinearModel.hs b/src/DataFrame/LinearModel.hs --- a/src/DataFrame/LinearModel.hs +++ b/src/DataFrame/LinearModel.hs @@ -1,12 +1,8 @@ -{- | Linear models for the dataframe ecosystem: regression (OLS, ridge, lasso, -elastic net) and one-vs-rest logistic classification. Re-exports the focused -submodules. --} +-- | Linear regression (OLS, ridge, lasso, elastic net) and logistic models. module DataFrame.LinearModel ( module DataFrame.LinearModel.Regression, module DataFrame.LinearModel.Logistic, - -- Re-exported from the internal solver so the public configs' and records' - -- @SolverConfig@\/@LinearModel@ fields stay usable. + -- Re-exported so the configs' @SolverConfig@\/@LinearModel@ fields work. SolverConfig (..), defaultSolverConfig, LinearModel (..), diff --git a/src/DataFrame/LinearModel/Logistic.hs b/src/DataFrame/LinearModel/Logistic.hs --- a/src/DataFrame/LinearModel/Logistic.hs +++ b/src/DataFrame/LinearModel/Logistic.hs @@ -4,11 +4,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -{- | Logistic regression: binary and one-vs-rest multiclass over the FISTA -solver. 'fit' trains a 'LogisticModel'; 'predict' is the arg-max class decision. -Per-class margins and (normalized) probabilities stay available as named -auxiliary expressions. --} +-- | Logistic regression: binary and one-vs-rest multiclass via FISTA. module DataFrame.LinearModel.Logistic ( module DataFrame.Model, LogisticConfig (..), @@ -50,9 +46,7 @@ defaultLogisticConfig :: LogisticConfig defaultLogisticConfig = LogisticConfig defaultSolverConfig -{- | A fitted (one-vs-rest) logistic model: parallel vectors of class labels and -their binary sub-models. 'lgModels' carries sklearn's per-class @coef_@. --} +-- | A fitted one-vs-rest logistic model of class labels and sub-models. data LogisticModel a = LogisticModel { lgClasses :: !(V.Vector a) , lgModels :: !(V.Vector LinearModel) @@ -67,7 +61,7 @@ type Prediction (LogisticModel a) = Expr a predict m = argMaxExpr (labelledMargins m) --- | Fit one-vs-rest logistic regression; the target column supplies the classes. +-- | Fit one-vs-rest logistic regression; the target supplies the classes. fitLogistic :: (Columnable a, Ord a) => LogisticConfig -> Expr a -> DataFrame -> LogisticModel a @@ -83,22 +77,17 @@ let labels = VU.generate (V.length ys) (\i -> if ys V.! i == c then 1 else -1) in fitL1Logistic cfg mat labels nameVec - -- Binary one-vs-rest fits two sign-mirrored models; solve once and negate. - -- Multiclass fits the per-class binary problems in parallel. + -- Binary fits two sign-mirrored models; solve once and negate. models = case classes of [c0, _c1] -> let m0 = fitOne c0 in [m0, negateModel m0] _ -> map fitOne classes `using` parList forceModel -{- | Sign-flip a fitted binary model (the other one-vs-rest class in a 2-class -problem is its exact mirror). --} +-- | Sign-flip a fitted binary model. negateModel :: LinearModel -> LinearModel negateModel m = m{lmWeights = VU.map negate (lmWeights m), lmIntercept = negate (lmIntercept m)} -{- | Force a fitted model's solver work by evaluating its (unboxed, strict) -weight vector, so 'parList' actually runs the per-class fits in parallel. --} +-- | Force a fitted model's weight vector so per-class fits run in parallel. forceModel :: Strategy LinearModel forceModel m = lmWeights m `seq` rseq m diff --git a/src/DataFrame/LinearModel/Regression.hs b/src/DataFrame/LinearModel/Regression.hs --- a/src/DataFrame/LinearModel/Regression.hs +++ b/src/DataFrame/LinearModel/Regression.hs @@ -3,10 +3,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} -{- | Linear regression with the standard penalties: OLS (QR), ridge (Cholesky), -and lasso\/elastic net (FISTA). 'fit' produces a 'LinearRegressor'; 'predict' -compiles it to an @Expr Double@ over the raw feature columns. --} +-- | Linear regression: OLS, ridge and lasso/elastic net. module DataFrame.LinearModel.Regression ( module DataFrame.Model, Penalty (..), @@ -37,7 +34,7 @@ import DataFrame.LinearSolver.Loss (squaredLoss) import DataFrame.Model --- | Regularization choice. @alpha@ is the penalty strength; @l1Ratio@ mixes L1/L2. +-- | Regularization choice: penalty strength and L1/L2 mix. data Penalty = OLS | Ridge !Double @@ -45,7 +42,7 @@ | ElasticNet !Double !Double deriving (Eq, Show) --- | Hyperparameters for linear regression: the penalty and the FISTA solver config. +-- | Hyperparameters for linear regression: penalty and solver config. data LinearConfig = LinearConfig { lcPenalty :: !Penalty , lcSolver :: !SolverConfig @@ -55,9 +52,7 @@ defaultLinearConfig :: LinearConfig defaultLinearConfig = LinearConfig{lcPenalty = OLS, lcSolver = defaultSolverConfig} -{- | A fitted linear regressor. @regCoef@ and @regIntercept@ are sklearn's -@coef_@ / @intercept_@ in raw feature space. --} +-- | A fitted linear regressor with coefficients in raw feature space. data LinearRegressor = LinearRegressor { regCoef :: !(VU.Vector Double) , regIntercept :: !Double @@ -103,9 +98,7 @@ where augmented = V.map (VU.cons 1) mat -{- | Ridge via Cholesky on @(XcᵀXc + αI) w = Xcᵀ yc@ over centred data; the -intercept is recovered from the column/target means. --} +-- | Ridge via Cholesky over centred data, intercept from the means. ridgeSolve :: Double -> Matrix -> VU.Vector Double -> (VU.Vector Double, Double) ridgeSolve alpha mat y = case choleskySolve a rhs of diff --git a/src/DataFrame/Metrics.hs b/src/DataFrame/Metrics.hs --- a/src/DataFrame/Metrics.hs +++ b/src/DataFrame/Metrics.hs @@ -1,14 +1,9 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -{- | Evaluation metrics for fitted models. The everyday entry point is -'evaluate', which applies a model's prediction expression and a truth column to -a frame and folds a metric — no manual @interpret@/extract plumbing. Metrics are -plain functions (@type Metric = Vector -> Vector -> Double@), so you pass @mse@ -or @accuracy@ directly. Classification metrics handle multiclass via 'Average'; -'classificationReport' / 'regressionReport' bundle the common numbers with a -scikit-learn-style 'Show'. --} +-- | Evaluation metrics for fitted models. module DataFrame.Metrics ( -- * Metric type + evaluation Metric, @@ -40,11 +35,13 @@ import Control.Exception (throw) import Data.Either (fromRight) -import Data.List (nub, sort, sortBy) +import Data.List (nub, sort) import Data.Ord (comparing) import qualified Data.Text as T +import qualified Data.Vector.Algorithms.Intro as VA import qualified Data.Vector.Unboxed as VU +import DataFrame.Errors (DataFrameException (..)) import DataFrame.Internal.Column (TypedColumn (..), toVector) import DataFrame.Internal.DataFrame (DataFrame) import DataFrame.Internal.Expression (Expr) @@ -54,11 +51,7 @@ -- | A metric maps predictions and ground truth to a scalar score. type Metric = VU.Vector Double -> VU.Vector Double -> Double -{- | Evaluate a model's prediction expression against a truth column on a frame. - -> evaluate rmse (linearExpr model) (F.col @Double "target") df -> evaluate accuracy (logisticDecisionExpr model) (F.col @Double "label") df --} +-- | Evaluate a model's prediction expression against a truth column. evaluate :: Metric -> Expr Double -> Expr Double -> DataFrame -> Double evaluate metric predExpr truthExpr df = metric (columnOf df predExpr) (columnOf df truthExpr) @@ -73,15 +66,18 @@ Right (TColumn c) -> fromRight VU.empty (toVector @Double @VU.Vector c) Left err -> throw err -n2 :: VU.Vector Double -> Double -n2 = fromIntegral . VU.length +-- | Number of compared pairs, the shorter of the two vectors' lengths. +nCompared :: VU.Vector Double -> VU.Vector Double -> Double +nCompared preds truth = fromIntegral (min (VU.length preds) (VU.length truth)) -- | Mean squared error. mse :: Metric mse preds truth - | VU.null truth = 0 + | n == 0 = throw (EmptyDataSetException "mse") | otherwise = - VU.sum (VU.zipWith (\p t -> (p - t) ^ (2 :: Int)) preds truth) / n2 truth + VU.sum (VU.zipWith (\p t -> (p - t) ^ (2 :: Int)) preds truth) / n + where + n = nCompared preds truth -- | Root mean squared error. rmse :: Metric @@ -90,30 +86,37 @@ -- | Mean absolute error. mae :: Metric mae preds truth - | VU.null truth = 0 - | otherwise = VU.sum (VU.zipWith (\p t -> abs (p - t)) preds truth) / n2 truth + | n == 0 = throw (EmptyDataSetException "mae") + | otherwise = VU.sum (VU.zipWith (\p t -> abs (p - t)) preds truth) / n + where + n = nCompared preds truth -- | Coefficient of determination @R²@. r2 :: Metric r2 preds truth - | VU.null truth || ssTot == 0 = 0 + | n == 0 = throw (EmptyDataSetException "r2") + | ssTot == 0 = 0 | otherwise = 1 - ssRes / ssTot where - mean = VU.sum truth / n2 truth - ssRes = VU.sum (VU.zipWith (\p t -> (t - p) ^ (2 :: Int)) preds truth) - ssTot = VU.sum (VU.map (\t -> (t - mean) ^ (2 :: Int)) truth) + n = nCompared preds truth + truth' = VU.take (min (VU.length preds) (VU.length truth)) truth + mean = VU.sum truth' / n + ssRes = VU.sum (VU.zipWith (\p t -> (t - p) ^ (2 :: Int)) preds truth') + ssTot = VU.sum (VU.map (\t -> (t - mean) ^ (2 :: Int)) truth') -- | Fraction of exact matches. accuracy :: Metric accuracy preds truth - | VU.null truth = 0 + | n == 0 = throw (EmptyDataSetException "accuracy") | otherwise = - fromIntegral (VU.length (VU.filter id (VU.zipWith (==) preds truth))) / n2 truth + fromIntegral (VU.length (VU.filter id (VU.zipWith (==) preds truth))) / n + where + n = nCompared preds truth -- | Binary log loss; probabilities clamped away from @0@/@1@. logLoss :: Metric logLoss probs truth - | VU.null truth = 0 + | n == 0 = throw (EmptyDataSetException "logLoss") | otherwise = negate ( VU.sum @@ -123,8 +126,9 @@ truth ) ) - / n2 truth + / n where + n = nCompared probs truth clampP p = max 1e-15 (min (1 - 1e-15) p) -- | Averaging strategy for multiclass precision/recall/F1. @@ -207,32 +211,22 @@ f1 :: Average -> VU.Vector Double -> VU.Vector Double -> Double f1 = averaged f1Of -{- | Binary ROC-AUC (Mann–Whitney). @scores@ are predicted probabilities, @truth@ -is @0@/@1@. --} +-- | Binary ROC-AUC (Mann-Whitney), tied scores sharing their average rank. rocAuc :: VU.Vector Double -> VU.Vector Double -> Double rocAuc scores truth | nPos == 0 || nNeg == 0 = 0.5 | otherwise = (rankSum - nPos * (nPos + 1) / 2) / (nPos * nNeg) where - ranked = rankAverages (VU.toList scores) - pairs = zip (VU.toList truth) ranked - rankSum = sum [r | (y, r) <- pairs, y == 1] - nPos = fromIntegral (length (filter (== 1) (VU.toList truth))) - nNeg = fromIntegral (VU.length truth) - nPos - --- | Average ranks (ties share the mean rank), returned in input order. -rankAverages :: [Double] -> [Double] -rankAverages xs = - let indexed = zip [0 :: Int ..] xs - sorted = sortBy (comparing snd) indexed - ranked = assignRanks 1 sorted - in map snd (sortBy (comparing fst) ranked) - where - assignRanks _ [] = [] - assignRanks start grp = - let v = snd (head grp) - (tied, rest) = span ((== v) . snd) grp - k = length tied - avgRank = fromIntegral (sum [start .. start + k - 1]) / fromIntegral k - in [(i, avgRank) | (i, _) <- tied] ++ assignRanks (start + k) rest + n = VU.length scores + sorted = VU.modify (VA.sortBy (comparing fst)) (VU.zip scores truth) + nPos = fromIntegral (VU.length (VU.filter (== 1) truth)) + nNeg = fromIntegral n - nPos + rankSum = go 0 0 + go !start !acc + | start >= n = acc + | otherwise = + let v = fst (VU.unsafeIndex sorted start) + end = maybe n (+ start) (VU.findIndex ((/= v) . fst) (VU.drop start sorted)) + rank = fromIntegral (start + 1 + end) / 2 + positives = VU.length (VU.filter ((== 1) . snd) (VU.slice start (end - start) sorted)) + in go end (acc + rank * fromIntegral positives) diff --git a/src/DataFrame/Metrics/Report.hs b/src/DataFrame/Metrics/Report.hs --- a/src/DataFrame/Metrics/Report.hs +++ b/src/DataFrame/Metrics/Report.hs @@ -1,8 +1,4 @@ -{- | Bundled, pretty-printing evaluation summaries: a labelled confusion matrix -and scikit-learn-style regression / classification reports. The @*Expr@ variants -take a model's prediction expression and a truth column directly, so a full -report is a one-liner after fitting. --} +-- | Pretty-printing evaluation summaries: confusion matrix and reports. module DataFrame.Metrics.Report ( ConfusionMatrix (..), confusionMatrix, @@ -37,7 +33,7 @@ rmse, ) --- | A labelled confusion matrix: class order plus row-major @actual×predicted@. +-- | A labelled confusion matrix: class order plus row-major counts. data ConfusionMatrix = ConfusionMatrix { cmClasses :: ![Double] , cmCounts :: ![[Int]] @@ -115,9 +111,7 @@ } deriving (Eq, Show) -{- | A scikit-learn-style classification report: per-class stats plus accuracy -and macro/weighted F1. --} +-- | A scikit-learn-style classification report. data ClassificationReport = ClassificationReport { crPerClass :: ![(Double, ClassStats)] , crAccuracy :: !Double diff --git a/src/DataFrame/Model.hs b/src/DataFrame/Model.hs --- a/src/DataFrame/Model.hs +++ b/src/DataFrame/Model.hs @@ -8,33 +8,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -{- | The two verbs every model speaks. Instead of a per-model @fitX@ / @xExpr@ -zoo, every estimator is an instance of these classes: - - * 'fit' trains a model from a hyperparameter config, an @input@ (the supervised - target @Expr a@ or the unsupervised feature list @[Expr Double]@), and a frame. - * 'predict' compiles the model's canonical prediction to an @Expr@ over the raw - columns (regressors give @Expr Double@, classifiers @Expr a@, clusterers - @Expr Int@). Models with no honest out-of-sample prediction (e.g. DBSCAN) simply - have no instance — @predict@ on them is a compile error, not a fake. - -Every prediction lands in the /same/ expression type, so a fitted model composes -with 'DataFrame.Operations.Transformations.derive', the 'DataFrame.Transform' -monoid, and 'DataFrame.Transform.compileThrough' with no per-model glue. - -Auxiliary outputs (class probabilities, per-cluster distances, component -loadings, the @*Transform@ pipeline pieces) keep their own descriptive -functions — they are not the one canonical prediction, so they are not forced -through 'predict'. - -'fit' is a single, frame-polymorphic verb: it accepts an untyped 'DataFrame' or a -phantom-typed 'DataFrame.Typed.Types.TypedDataFrame', via 'ToDataFrame'. When a -model declares a schema requirement (via 'FrameReq'), that requirement is checked -at /compile time/ for a typed frame and is a no-op for an untyped one. Linear -regression, for instance, requires an all-'Double' frame ('AllDoubleFrame'), so -@fit@ on a typed frame with a non-'Double' column is a compile error; on an -untyped frame the same mistake surfaces as a fit-time error. --} +-- | The two verbs every model speaks: fit and predict. module DataFrame.Model ( Fit (..), ToDataFrame (..), @@ -59,64 +33,33 @@ import GHC.TypeLits (Symbol) -{- | A model trained on a typed frame, carrying the schema @cols@ as a phantom so -its 'predict' yields a typed 'TExpr'. Use 'fittedModel' to recover the bare model -record (coefficients, etc.). --} +-- | A model trained on a typed frame, carrying the schema as a phantom. newtype Fitted (cols :: [(Symbol, Type)]) model = Fitted {fittedModel :: model} -{- | The type 'fit' returns for a given frame source: the bare @model@ for an -untyped 'DataFrame', or a schema-tagged 'Fitted' for a 'TypedDataFrame'. Training -on an untyped frame is therefore unchanged. --} +-- | The type fit returns: the bare model, or a schema-tagged Fitted. type family FitResult (f :: Type) (model :: Type) :: Type where FitResult DataFrame model = model FitResult (TypedDataFrame cols) model = Fitted cols model -{- | The frame a given training @input@ is fit against: an untyped target/feature -input pairs with a plain 'DataFrame'; a typed input ('TExpr' / @['TExpr']@) pairs -with a 'TypedDataFrame' over the /same/ schema. So the target expression and the -frame are forced to share their columns at compile time. --} +-- | The frame a training input is fit against, sharing its schema if typed. type family FrameFor (input :: Type) :: Type where FrameFor (Expr a) = DataFrame FrameFor (TExpr cols a) = TypedDataFrame cols FrameFor [Expr Double] = DataFrame FrameFor [TExpr cols Double] = TypedDataFrame cols -{- | The schema requirement a model places on its training frame. 'AnyFrame' -imposes nothing (the default); 'AllDoubleFrame' demands every column be 'Double'. --} +-- | The schema requirement a model places on its training frame. data FrameKind = AnyFrame | AllDoubleFrame -{- | Turn a model's 'FrameKind' requirement into a constraint on the actual frame -type. Untyped 'DataFrame's are never constrained (they are runtime-checked); a -typed frame must satisfy the requirement at compile time. --} +-- | Turn a model's FrameKind requirement into a constraint on the frame. type family CheckFrame (req :: FrameKind) (f :: Type) :: Constraint where CheckFrame _ DataFrame = () CheckFrame 'AnyFrame _ = () CheckFrame 'AllDoubleFrame (TypedDataFrame cols) = AllDouble cols -{- | Train a model. @cfg@ is the hyperparameter config; @input@ is the supervised -target @Expr a@ or the unsupervised feature list @[Expr Double]@; the frame is -any 'ToDataFrame' source (an untyped 'DataFrame' or a 'TypedDataFrame'). The -config and input together determine the model, so no annotation is needed (a -classifier's label type comes from its @Expr a@ target). - -A model overrides 'FrameReq' to demand a schema shape (e.g. 'AllDoubleFrame'), -which 'fit' enforces at compile time on a typed frame; the default is 'AnyFrame'. - -The frame is determined by the @input@ (via 'FrameFor'): an untyped target pairs -with a 'DataFrame' and yields the bare model; a typed target ('TExpr' over @cols@) -pairs with a @TypedDataFrame cols@ and yields a @Fitted cols model@, so 'predict' -gives a typed 'TExpr'. A non-'Double' typed column is then a compile error. --} +-- | Train a model from a config, an input and a frame. class Fit cfg input where - {- | The model this config + input trains, computed as a type family so it is - visible in the instance head (and so the typed-lift instances below can - forward it) without needing a result annotation at the call site. - -} + -- | The model this config and input train. type ModelOf cfg input :: Type type FrameReq cfg input :: FrameKind @@ -128,9 +71,7 @@ FrameFor input -> FitResult (FrameFor input) (ModelOf cfg input) -{- | Lift any model fittable on an untyped target @Expr a@ to a typed target -@TExpr cols a@ over a @TypedDataFrame cols@, returning a schema-tagged 'Fitted'. --} +-- | Lift a model fittable on an untyped target to a typed target. instance (Fit cfg (Expr a)) => Fit cfg (TExpr cols a) where type ModelOf cfg (TExpr cols a) = ModelOf cfg (Expr a) type FrameReq cfg (TExpr cols a) = FrameReq cfg (Expr a) @@ -142,10 +83,7 @@ type FrameReq cfg [TExpr cols Double] = FrameReq cfg [Expr Double] fit cfg feats tdf = Fitted (fit cfg (map unTExpr feats) (thaw tdf)) -{- | Compile a fitted model's canonical prediction to an expression over the raw -columns. The 'Prediction' type tracks the model: a bare model gives @Expr r@; a -'Fitted' model (trained on a typed frame) gives @TExpr cols r@. --} +-- | Compile a fitted model's prediction to an expression over raw columns. class Predict model where type Prediction model :: Type predict :: model -> Prediction model diff --git a/src/DataFrame/ModelSelection.hs b/src/DataFrame/ModelSelection.hs --- a/src/DataFrame/ModelSelection.hs +++ b/src/DataFrame/ModelSelection.hs @@ -1,29 +1,26 @@ -{- | Cross-validation and grid search for hyperparameter tuning. The model -fitters have heterogeneous types, so these helpers are parameterized by a -user-supplied @train -> test -> score@ closure; the search maximizes the mean -cross-validated score (use a negated error metric to minimize). Splitting reuses -the deterministic 'kFolds' from @dataframe-operations@. --} +-- | Cross-validation and grid search for hyperparameter tuning. module DataFrame.ModelSelection ( crossValScore, crossValidate, + stratifiedFoldIds, + outOfFold, GridSearchResult (..), gridSearch, ) where -import Data.List (maximumBy) +import Data.List (maximumBy, sortOn) import Data.Ord (comparing) -import System.Random (mkStdGen) +import qualified Data.Set as S +import qualified Data.Vector.Unboxed as VU +import System.Random (mkStdGen, randoms) import DataFrame.Internal.DataFrame (DataFrame) import DataFrame.Internal.Expression (Expr) import DataFrame.Metrics (Metric, evaluate) import DataFrame.Operations.Merge () -import DataFrame.Operations.Subset (kFolds) +import DataFrame.Operations.Subset (kFolds, rowsAtIndices) -{- | Per-fold scores from k-fold cross-validation. @scoreFn train test@ fits on -the training rows and returns a score on the held-out fold. --} +-- | Per-fold scores from k-fold cross-validation. crossValScore :: Int -> Int -> (DataFrame -> DataFrame -> Double) -> DataFrame -> [Double] crossValScore folds seed scoreFn df = @@ -36,15 +33,7 @@ others i = [f | (j, f) <- zip [0 ..] fs, j /= i] combine = foldr1 (<>) -{- | scikit-learn @cross_val_score@: fit a model on each training fold and score -its prediction expression against a truth column on the held-out fold. - -@fitPredict train@ fits on the training frame and returns the prediction -expression; @truth@ is the target column. Returns the per-fold metric values. - -> crossValidate 5 0 rmse (F.col @Double "target") -> (\tr -> predict (fit defaultLinearConfig (F.col @Double "target") tr)) df --} +-- | Fit on each training fold and score predictions on the held-out fold. crossValidate :: Int -> Int -> @@ -58,6 +47,35 @@ where score train = evaluate metric (fitPredict train) truth +-- | A class-balanced fold number in [0, k) for every row. +stratifiedFoldIds :: Int -> Int -> VU.Vector Double -> VU.Vector Int +stratifiedFoldIds k seed labels = VU.update (VU.replicate n 0) (VU.fromList assigned) + where + n = VU.length labels + shuffled = map snd (sortOn fst (zip (randoms (mkStdGen seed) :: [Double]) [0 .. n - 1])) + assigned = + concat + [ zip [i | i <- shuffled, labels VU.! i == c] (cycle [0 .. k - 1]) + | c <- S.toList (S.fromList (VU.toList labels)) + ] + +-- | Out-of-fold scores: each row is scored by a model not trained on it. +outOfFold :: + VU.Vector Int -> + (DataFrame -> DataFrame -> VU.Vector Double) -> + DataFrame -> + VU.Vector Double +outOfFold folds fitScore df = + VU.update + (VU.replicate (VU.length folds) 0) + (VU.concat (map score [0 .. k - 1])) + where + k = if VU.null folds then 0 else VU.maximum folds + 1 + score f = + let test = VU.findIndices (== f) folds + train = VU.findIndices (/= f) folds + in VU.zip test (fitScore (rowsAtIndices train df) (rowsAtIndices test df)) + -- | The outcome of a grid search: the best config, its score, and all results. data GridSearchResult c = GridSearchResult { gsBest :: !c @@ -66,9 +84,7 @@ } deriving (Show) -{- | Search configurations by mean cross-validated score, returning the -maximizer. @scoreFn cfg train test@ fits @cfg@ on @train@ and scores on @test@. --} +-- | Search configurations by mean cross-validated score, returning the best. gridSearch :: Int -> Int -> diff --git a/src/DataFrame/PCA.hs b/src/DataFrame/PCA.hs --- a/src/DataFrame/PCA.hs +++ b/src/DataFrame/PCA.hs @@ -4,11 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} -{- | Principal component analysis via the symmetric Jacobi eigensolver on the -covariance of the (optionally standardized) feature columns. 'fit' trains a -'PCAModel' (components + explained variance); the projection is exposed as -'pcaExprs' / 'pcaTransform' (PCA is a transformer, so it has no 'Predict'). --} +-- | Principal component analysis via a Jacobi eigensolver on the covariance. module DataFrame.PCA ( module DataFrame.Model, NComponents (..), @@ -27,7 +23,7 @@ import DataFrame.Featurize.Internal (Features (..), extractFeatures) import qualified DataFrame.Functions as F import DataFrame.Internal.DataFrame (DataFrame) -import DataFrame.Internal.Expression (Expr (..), UExpr (..)) +import DataFrame.Internal.Expression (Expr (..), SomeExpr (..)) import DataFrame.LinearAlgebra (gram) import DataFrame.LinearAlgebra.Eigen (jacobiEigenSym) import DataFrame.Model @@ -46,10 +42,7 @@ defaultPCAConfig :: PCAConfig defaultPCAConfig = PCAConfig{pcaNComponents = NComp 2, pcaStandardize = False} -{- | A fitted PCA. 'pcaComponents' are sklearn's @components_@ (row @i@ is the -@i@-th loading vector); 'pcaScale' is @Just@ the per-column std when -standardizing. --} +-- | A fitted PCA with components and explained variance. data PCAModel = PCAModel { pcaComponents :: !(V.Vector (VU.Vector Double)) , pcaExplainedVariance :: !(VU.Vector Double) @@ -118,7 +111,7 @@ -- | The PCA projection as a composable fitted 'Transform'. pcaTransform :: PCAModel -> Transform -pcaTransform m = Transform [(n, UExpr e) | (n, e) <- pcaExprs m] +pcaTransform m = Transform [(n, SomeExpr e) | (n, e) <- pcaExprs m] resolveK :: NComponents -> Int -> VU.Vector Double -> Int resolveK (NComp k) d _ = max 1 (min k d) diff --git a/src/DataFrame/PCA/Kernel.hs b/src/DataFrame/PCA/Kernel.hs --- a/src/DataFrame/PCA/Kernel.hs +++ b/src/DataFrame/PCA/Kernel.hs @@ -3,11 +3,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} -{- | Kernel PCA with an RBF kernel, solved on a set of landmark points (Nyström). -Exact kernel PCA when the landmark count covers every row, a principled -approximation otherwise. 'fit' trains the model; the projection is exposed as -'kernelPCAExprs' / 'kernelPcaTransform' (a transformer, so no 'Predict'). --} +-- | Kernel PCA with an RBF kernel, solved on Nystrom landmark points. module DataFrame.PCA.Kernel ( module DataFrame.Model, KernelPCAConfig (..), @@ -25,7 +21,7 @@ import DataFrame.Featurize.Internal (Features (..), extractFeatures) import qualified DataFrame.Functions as F import DataFrame.Internal.DataFrame (DataFrame) -import DataFrame.Internal.Expression (Expr (..), UExpr (..)) +import DataFrame.Internal.Expression (Expr (..), SomeExpr (..)) import DataFrame.LinearAlgebra (sqDist) import DataFrame.LinearAlgebra.Eigen (jacobiEigenSym) import DataFrame.Model @@ -49,9 +45,7 @@ , kpcaSeed = 0 } -{- | A fitted kernel PCA. Each component is @Σ_l βₗ·K(x, landmarkₗ) + cᵢ@ with an -RBF kernel of bandwidth 'kpcaGammaUsed'. --} +-- | A fitted kernel PCA using an RBF kernel on landmark points. data KernelPCAModel = KernelPCAModel { kpcaLandmarks :: !(V.Vector (VU.Vector Double)) , kpcaBetas :: !(V.Vector (VU.Vector Double)) @@ -136,4 +130,4 @@ -- | The kernel-PCA projection as a composable fitted 'Transform'. kernelPcaTransform :: KernelPCAModel -> Transform -kernelPcaTransform m = Transform [(n, UExpr e) | (n, e) <- kernelPCAExprs m] +kernelPcaTransform m = Transform [(n, SomeExpr e) | (n, e) <- kernelPCAExprs m] diff --git a/src/DataFrame/SVM.hs b/src/DataFrame/SVM.hs --- a/src/DataFrame/SVM.hs +++ b/src/DataFrame/SVM.hs @@ -4,10 +4,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -{- | Linear support vector classification: L2-regularized squared hinge via -FISTA (sklearn's LinearSVC default). 'fit' trains a one-vs-rest 'LinearSVCModel'; -'predict' is the arg-max class margin (no @predict_proba@, as in sklearn). --} +-- | Linear support vector classification via FISTA (squared hinge, L2). module DataFrame.SVM ( module DataFrame.Model, LinearSVCModel (..), @@ -37,7 +34,7 @@ import DataFrame.LinearSolver.Loss (sqHingeLoss) import DataFrame.Model --- | Hyper-parameters. @svcC@ is the inverse regularization strength (sklearn @C@). +-- | Hyper-parameters; svcC is the inverse regularization strength. data SVCConfig = SVCConfig { svcC :: !Double , svcMaxIter :: !Int diff --git a/src/DataFrame/SVM/RFF.hs b/src/DataFrame/SVM/RFF.hs --- a/src/DataFrame/SVM/RFF.hs +++ b/src/DataFrame/SVM/RFF.hs @@ -6,11 +6,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -{- | Approximate RBF-kernel SVM via Random Fourier Features (Rahimi & Recht): map -each row through @z(x) = √(2/D)·cos(W x + b)@ with @W ~ N(0, 2γI)@ (seeded), then -fit a linear SVC in the random-feature space. 'predict' compiles to a closed -@Σ_r β_r·cos(…)@ expression of size @O(D·d)@, independent of the row count. --} +-- | Approximate RBF-kernel SVM via Random Fourier Features. module DataFrame.SVM.RFF ( module DataFrame.Model, RFFConfig (..), @@ -58,9 +54,7 @@ , rffSeed = 0 } -{- | A fitted RFF SVM (binary). 'rffW' / 'rffB' are the random projection; -'rffCoef' / 'rffIntercept' the linear SVC in feature space. --} +-- | A fitted binary RFF SVM: random projection plus a linear SVC. data RFFSVMModel a = RFFSVMModel { rffW :: !(V.Vector (VU.Vector Double)) , rffB :: !(VU.Vector Double) diff --git a/src/DataFrame/Segmented.hs b/src/DataFrame/Segmented.hs --- a/src/DataFrame/Segmented.hs +++ b/src/DataFrame/Segmented.hs @@ -9,10 +9,7 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -{- | Fit a separate base model per categorical value-combination, routing each -row to its segment at predict time; unseen or too-small segments fall back to a -global fit. Optional partial pooling (linear base) shrinks small segments. --} +-- | Fit a separate base model per categorical value-combination. module DataFrame.Segmented ( module DataFrame.Model, Segmented (..), @@ -25,7 +22,8 @@ ) where import Control.Exception (throw) -import Data.List (foldl', (\\)) +import Data.List ((\\)) +import qualified Data.List as L import qualified Data.Map.Strict as M import Data.Maybe (isJust) import qualified Data.Set as Set @@ -59,10 +57,7 @@ import DataFrame.Operations.Subset (exclude, rowsAtIndices) import DataFrame.SymbolicRegression (SRConfig) -{- | A base estimator @cfg@ wrapped to fit one model per categorical -value-combination. @segOn@ picks the columns ('Nothing' = auto-detect), -@segMinRows@ the smallest own-model segment, @segPool@ the pooling strength @λ@. --} +-- | A base estimator wrapped to fit one model per categorical combination. data Segmented cfg = Segmented { segBase :: !cfg , segOn :: !(Maybe [T.Text]) @@ -72,11 +67,11 @@ } deriving (Eq, Show) --- | Wrap a base config with the defaults: auto-detect, cap 32, min 30 rows, no pooling. +-- | Wrap a base config with default segmentation settings. segmented :: cfg -> Segmented cfg segmented base = Segmented base Nothing 32 30 0 --- | Segment only on the named columns (each must be Text), overriding auto-detect. +-- | Segment only on the named Text columns, overriding auto-detect. segmentOn :: Segmented cfg -> [T.Text] -> Segmented cfg segmentOn s cols = s{segOn = Just cols} @@ -92,10 +87,7 @@ } deriving (Show) -{- | A fitted segmented model: the columns segmented on, the per-segment models -(ascending key order), the observed combinations that fell back (key + row -count), the global fallback model, and the compiled routing expression. --} +-- | A fitted segmented model with per-segment, fallback and routing parts. data SegmentedModel a model = SegmentedModel { smCatCols :: ![T.Text] , smSegments :: ![Segment model] @@ -105,10 +97,7 @@ } deriving (Show) -{- | How a base estimator fits its per-segment models under pooling strength @λ@. -The default fits each segment independently and rejects @λ > 0@; the linear -instance overrides it with closed-form shrinkage. Every base model needs an instance. --} +-- | How a base estimator fits per-segment models under pooling strength. class (Fit cfg (Expr a)) => SegmentFit cfg a where -- | Fit the qualifying segments (each a numeric-only frame, in order). fitSegments :: cfg -> Double -> Expr a -> [DataFrame] -> [ModelOf cfg (Expr a)] @@ -185,14 +174,11 @@ expr = buildExpr catCols segments globalM in SegmentedModel catCols segments fellBack globalM expr --- | 'span' over a predicate that need not hold contiguously (a filter partition). +-- | 'span' over a predicate that need not hold contiguously. span' :: (b -> Bool) -> [b] -> ([b], [b]) span' p xs = (filter p xs, filter (not . p) xs) -{- | Compile the routing: a right-folded @If@ ladder of @key == value@ conjuncts, -ending in the fallback model's prediction. Keys are disjoint, so order is -immaterial. --} +-- | Compile the routing: a right-folded If ladder ending in the fallback. buildExpr :: (Columnable a, Predict model, Prediction model ~ Expr a) => [T.Text] -> @@ -210,10 +196,7 @@ keyCond catCols vals = foldr1 (.&&.) [(Col c :: Expr T.Text) .==. Lit v | (c, v) <- zip catCols vals] -{- | The Text feature columns to segment on, chosen from the frame's Text features -@textCols@. An explicit list is validated to be all-Text; auto-detect keeps Text -columns with at most @maxCard@ distinct values. --} +-- | The Text feature columns to segment on, explicit or auto-detected. resolveCatCols :: DataFrame -> Maybe T.Text -> [T.Text] -> Maybe [T.Text] -> Int -> [T.Text] resolveCatCols df mTarget textCols mcols maxCard = case mcols of @@ -235,10 +218,7 @@ distinctCount df c = Set.size (Set.fromList (V.toList (columnToTextVec (unsafeGetColumn c df)))) -{- | Reject feature columns that are neither Text (dropped\/segmented) nor -non-null 'Double', naming each with its fix — clearer than the base fitter's -raw type mismatch. --} +-- | Reject feature columns that are neither Text nor non-null Double. guardNumeric :: DataFrame -> [T.Text] -> Expr a -> () guardNumeric df textCols target = case problems of @@ -271,9 +251,7 @@ _ -> False _ -> False -{- | Group row indices by their composite categorical key, dropping rows whose key -has a null in any segmented column (served by the fallback). Ascending key order. --} +-- | Group row indices by composite categorical key, dropping null keys. groupByKey :: DataFrame -> [T.Text] -> [([T.Text], VU.Vector Int)] groupByKey df catCols = map (\(k, is) -> (k, VU.fromList (reverse is))) (M.toAscList grouped) @@ -285,15 +263,12 @@ validRow i = all (maybe True (`bitmapTestBit` i)) bitmaps keyOf i = [tv V.! i | tv <- textVecs] grouped = - foldl' + L.foldl' (\m i -> if validRow i then M.insertWith (++) (keyOf i) [i] m else m) M.empty [0 .. n - 1] -{- | Linear segments with exact closed-form pooling. @λ = 0@ is independent OLS; -@λ > 0@ shrinks each segment's coefficients toward the @n_g@-weighted mean of the -per-segment fits. --} +-- | Linear segments with exact closed-form pooling. instance SegmentFit LinearConfig Double where fitSegments cfg lam target dfs | lam == 0 = map (fit cfg target) dfs diff --git a/src/DataFrame/SymbolicRegression.hs b/src/DataFrame/SymbolicRegression.hs --- a/src/DataFrame/SymbolicRegression.hs +++ b/src/DataFrame/SymbolicRegression.hs @@ -3,11 +3,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} -{- | Symbolic regression by genetic programming (modelled on the -@symbolic-regression@ library, ported dependency-light: no e-graphs, no NLOPT). -'predict' is the best discovered @Expr Double@; the search also returns the -accuracy-vs-complexity Pareto front. Deterministic given the seed. --} +-- | Symbolic regression by genetic programming, returning a Pareto front. module DataFrame.SymbolicRegression ( module DataFrame.Model, UnOp (..), @@ -63,9 +59,7 @@ , srUnaryOps = allUnOps } -{- | A fitted symbolic regressor. 'srBest' is the lowest-error expression; -'srPareto' is the @(complexity, mse, expr)@ frontier. --} +-- | A fitted symbolic regressor: best expression plus Pareto frontier. data SRModel = SRModel { srBest :: !(Expr Double) , srBestMSE :: !Double diff --git a/src/DataFrame/Synthesis.hs b/src/DataFrame/Synthesis.hs --- a/src/DataFrame/Synthesis.hs +++ b/src/DataFrame/Synthesis.hs @@ -5,38 +5,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} -{- | Feature synthesis by bottom-up enumerative search with observational -equivalence — the canonical enumerative method from Solar-Lezama's -/Introduction to Program Synthesis/. - -Given a frame and a numeric target column, it searches for a small, interpretable -arithmetic expression over the other columns whose values track the target. - -The engine: - - * enumerates programs by increasing AST size (so the first representative of any - behaviour is the smallest — interpretability for free); - * evaluates each candidate /incrementally/ by combining the cached result - vectors of its subprograms (one vector op), never re-interpreting the whole - tree; - * keeps exactly one program per /observational-equivalence/ class — candidates - producing the same column (up to a float tolerance) are interchangeable, so - duplicates are dropped rather than re-explored; - * breaks commutative symmetry (never both @a+b@ and @b+a@) and uses protected - operators (@sqrt|x|@, @log(|x|+1)@) plus a denominator guard so domain errors - never arise; - * caps each size layer by fit score when it grows large (a cost-guided - tractability bound over /distinct/ behaviours, not a lossy beam over raw - syntax). - -'fit' returns the best 'SynthesizedFeature'; 'predict' is its expression. -'synthesizeFeatures' returns the whole ranked, deduplicated feature bank — useful -as automated feature engineering feeding a downstream model. - -Deferred (documented next steps, not yet implemented): skeleton enumeration with -closed-form least-squares coefficient fitting, hard-row counterexample sampling -for very large frames, and piecewise (condition-abduction) features. --} +-- | Feature synthesis by bottom-up enumerative search over expressions. module DataFrame.Synthesis ( module DataFrame.Model, LossFunction (..), @@ -72,7 +41,7 @@ import DataFrame.Model import DataFrame.Operations.Core (columnAsDoubleVector) --- | How a candidate's output column is scored against the target (higher is better). +-- | How a candidate's output column is scored against the target. data LossFunction = -- | Pearson @r²@: scale-invariant, the default for derived features. PearsonCorrelation @@ -106,9 +75,7 @@ , synMaxAllocBytes = 8 * 1024 * 1024 * 1024 } -{- | A synthesized feature. 'sfExpr' is the best-scoring expression and 'sfFeatures' -is the ranked, observationally-distinct bank (expression and its score). --} +-- | A synthesized feature: the best expression and a ranked bank. data SynthesizedFeature = SynthesizedFeature { sfExpr :: !(Expr Double) , sfScore :: !Double @@ -156,7 +123,7 @@ ((e, s) : _) -> (e, s) [] -> (Lit 0, negate (1 / 0)) --- | Size-1 programs: numeric feature columns and a pool of constants, OE-deduped. +-- | Size-1 programs: numeric feature columns and a pool of constants. mkLeaves :: DataFrame -> [T.Text] -> Int -> [Prog] mkLeaves df feats n = fst (dedupProgs M.empty candidates) where @@ -167,9 +134,7 @@ ] ++ [Prog (Lit v) 1 (VU.replicate n v) | v <- constantPool df feats] -{- | Domain-informed constants: per-column quartiles, variance, and std, plus a few -small integers. (Duplicates collapse under observational equivalence.) --} +-- | Domain-informed constants: column quartiles, variance, std, small ints. constantPool :: DataFrame -> [T.Text] -> [Double] constantPool df feats = [0, 1, 2, -1] @@ -244,7 +209,7 @@ , (F.max, max) ] --- | Ordered operand pairs whose sizes sum to @size-1@ (for non-commutative ops). +-- | Ordered operand pairs whose sizes sum to size-1. orderedPairs :: Int -> [Prog] -> [(Prog, Prog)] orderedPairs size bank = [ (a, b) @@ -272,9 +237,7 @@ where atSize s = filter ((== s) . progSize) bank -{- | Keep the valid, observationally-novel candidates of a layer, then cap by fit -score (cost-guided). Returns the kept programs and the updated OE-class set. --} +-- | Keep valid, observationally-novel candidates of a layer, capped by score. absorb :: SynthesisConfig -> Output -> Seen -> [Prog] -> ([Prog], Seen) absorb cfg tgt seen0 cands = (capLayer cfg tgt fresh, seen') @@ -306,8 +269,7 @@ where budget = synMaxAllocBytes cfg bytesPerProg = 8 * max 1 n - -- 4 commutative ops over unordered pairs plus sub and div over ordered - -- pairs, all quadratic in the bank; unaries and powers are lower order. + -- Quadratic in the bank: 4 commutative ops plus ordered sub and div. binaryOpCount = 4 :: Int -- Layer k pairs the capped bank with itself over the binary operators. candidatesAt k @@ -324,7 +286,7 @@ ] ) --- | When a layer has more distinct programs than the cap, keep the best-scoring. +-- | When a layer exceeds the cap, keep the best-scoring programs. capLayer :: SynthesisConfig -> Output -> [Prog] -> [Prog] capLayer cfg tgt progs | length progs <= synBankCap cfg = progs @@ -342,15 +304,11 @@ MeanSquaredError -> negate <$> meanSquaredError tgt out where bins = max 10 (ceiling (sqrt (fromIntegral (VU.length tgt) :: Double))) - -- Belt-and-suspenders: drop any non-finite score so it cannot win the ranking. + -- Drop non-finite scores so they cannot win the ranking. finite (Just s) | isNaN s || isInfinite s = Nothing finite ms = ms -{- | Pearson @r²@ via the numerically stable centered two-pass formula. Returns -'Nothing' when the feature (or target) is constant, and is bounded by -Cauchy–Schwarz to @[0,1]@ — unlike the one-pass @n·Σxy − Σx·Σy@ form, which -cancels catastrophically for low-variance features and can report @r² > 1@. --} +-- | Pearson r-squared via the stable centered two-pass formula. pearsonR2 :: Output -> Output -> Maybe Double pearsonR2 ys xs | n < 2 = Nothing @@ -369,18 +327,11 @@ valid :: Output -> Bool valid o = not (VU.null o) && VU.all (\x -> not (isNaN x || isInfinite x)) o -{- | Quantize an output to nine significant digits, so float noise (@x*2@ vs -@x+x@) collapses while genuinely distinct features stay apart. --} +-- | Quantize an output to nine significant digits to absorb float noise. quantize :: Output -> Output quantize = VU.map (\x -> if x == 0 then 0 else signum x * roundSig 9 (abs x)) -{- | The observational-equivalence class set: a map from a 64-bit FNV-1a -fingerprint of the quantized output to the (usually one) quantized outputs with -that fingerprint. Bucketing on the fingerprint keeps membership cheap, and -verifying exact equality within the bucket makes a hash collision harmless — two -genuinely different columns that happen to collide are kept apart, not merged. --} +-- | The observational-equivalence class set, bucketed by output fingerprint. type Seen = M.Map Int [Output] -- | FNV-1a fingerprint of an already-quantized output's bit patterns. @@ -404,9 +355,7 @@ scale = 10 ** fromIntegral (n - 1 - magnitude) in fromIntegral (round (x * scale) :: Integer) / scale -{- | Keep the first valid program of each observational-equivalence class, -preserving order; returns the kept programs and the grown class set. --} +-- | Keep the first valid program of each observational-equivalence class. dedupProgs :: Seen -> [Prog] -> ([Prog], Seen) dedupProgs = go [] where diff --git a/src/DataFrame/Transform.hs b/src/DataFrame/Transform.hs --- a/src/DataFrame/Transform.hs +++ b/src/DataFrame/Transform.hs @@ -2,15 +2,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -{- | Fitted column transforms as a composable monoid. A 'Transform' is a list of -named output expressions; @s <> t@ means \"apply @s@, then @t@\", fusing @t@'s -references to @s@'s outputs by simultaneous substitution. 'applyTransform' runs -one against a frame; 'compileThrough' folds a transform into a model's -prediction expression so the result is a single expression over the raw inputs. - -Every right-hand side must be row-wise (no aggregation/window), and within one -transform each expression reads the original frame. --} +-- | Fitted column transforms as a composable monoid. module DataFrame.Transform ( Transform (..), applyTransform, @@ -33,7 +25,7 @@ import DataFrame.Internal.Expression ( Expr (..), NamedExpr, - UExpr (..), + SomeExpr (..), substituteColumns, ) import DataFrame.Operations.Core (columnAsDoubleVector) @@ -46,8 +38,8 @@ Transform s <> Transform t = Transform (s ++ map (subst (M.fromList s)) t) where - subst :: M.Map T.Text UExpr -> NamedExpr -> NamedExpr - subst m (nm, UExpr e) = (nm, UExpr (substituteColumns m e)) + subst :: M.Map T.Text SomeExpr -> NamedExpr -> NamedExpr + subst m (nm, SomeExpr e) = (nm, SomeExpr (substituteColumns m e)) instance Monoid Transform where mempty = Transform [] @@ -56,9 +48,7 @@ applyTransform :: Transform -> DataFrame -> DataFrame applyTransform (Transform os) = deriveMany os -{- | Fold a preprocessing transform into a model's prediction expression, -yielding one expression over the transform's input columns. --} +-- | Fold a preprocessing transform into a model's prediction expression. compileThrough :: (Columnable a) => Transform -> Expr a -> Expr a compileThrough (Transform os) = substituteColumns (M.fromList os) @@ -94,7 +84,7 @@ scalerTransform :: ScalerModel -> Transform scalerTransform m = Transform - [ (n, UExpr ((F.col @Double n .-. F.lit mu) ./. F.lit sigma)) + [ (n, SomeExpr ((F.col @Double n .-. F.lit mu) ./. F.lit sigma)) | (n, mu, sigma) <- zip3 (V.toList (smColumns m)) diff --git a/src/DataFrame/Transform/Serialize.hs b/src/DataFrame/Transform/Serialize.hs --- a/src/DataFrame/Transform/Serialize.hs +++ b/src/DataFrame/Transform/Serialize.hs @@ -1,13 +1,4 @@ -{- | Persist and reload a fitted 'Transform'. - -A 'Transform' is just an ordered list of named output expressions, so it -serializes through the same JSON wire format as any pipeline (see -"DataFrame.Expr.Serialize"). Save a fitted preprocessing/feature transform in one -process and reload it in another with 'applyTransform' to run inference: - -> Right t <- loadTransformFromFile "scaler.json" -> let scored = applyTransform t newData --} +-- | Persist and reload a fitted Transform. module DataFrame.Transform.Serialize ( encodeTransform, decodeTransform, diff --git a/tests-internal/Cart.hs b/tests-internal/Cart.hs --- a/tests-internal/Cart.hs +++ b/tests-internal/Cart.hs @@ -1,10 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} -{- | Agreement tests: 'buildCartTree' must predict identically to sklearn's -@DecisionTreeClassifier(random_state=0, max_depth=4)@ on shared folds (golden -fixtures from @bench/export_cart_fixtures.py@); missing fixtures SKIP. --} +-- | Agreement tests: buildCartTree must predict identically to sklearn. module Cart (tests) where import Control.Exception (SomeException, try) @@ -35,8 +32,7 @@ instance FromJSON Fixture where parseJSON = withObject "fixture" $ \o -> Fixture <$> o .: "test_index" <*> o .: "test_pred" --- sklearn cart_d4 params: max_depth 4, min_samples_leaf 1 (min_samples_split --- is fixed at 2 inside buildCartTree). +-- sklearn cart_d4 params: max_depth 4, min_samples_leaf 1. cartCfg :: TreeConfig cartCfg = defaultTreeConfig{maxTreeDepth = 4, minLeafSize = 1} @@ -57,9 +53,7 @@ Left _ -> Left "missing" Right raw -> eitherDecode raw --- wine is tie-free so sklearn is deterministic (exact match); bcw/adult have --- equal-gain ties sklearn breaks via a seeded feature permutation, so we only --- report the match fraction rather than chase its RNG. +-- wine is tie-free (exact match); bcw/adult report the match fraction. runCase :: String -> Int -> IO () runCase name i = do efx <- readJson ("tests/fixtures/cart/" ++ name ++ "_fold" ++ show i ++ ".json") diff --git a/tests-internal/DataFrameApi.hs b/tests-internal/DataFrameApi.hs --- a/tests-internal/DataFrameApi.hs +++ b/tests-internal/DataFrameApi.hs @@ -1,10 +1,7 @@ -{- | The umbrella subset these internal tests use. The suite cannot depend on -the meta @dataframe@ package (that would be a package-level cycle), so the -names the tests reach for are re-exported under one alias here. --} +-- | The umbrella subset these internal tests use, re-exported under one alias. module DataFrameApi ( DataFrame, - fromNamedColumns, + fromColumns, fromUnnamedColumns, dimensions, nRows, @@ -15,7 +12,7 @@ readCsv, ) where -import DataFrame.Core (DataFrame, fromNamedColumns) +import DataFrame.Core (DataFrame, fromColumns) import DataFrame.IO.CSV (readCsv) import DataFrame.Operations.Core (dimensions, fromUnnamedColumns, nRows, rename) import DataFrame.Operations.Subset (exclude, randomSplit) diff --git a/tests-internal/DecisionTree.hs b/tests-internal/DecisionTree.hs --- a/tests-internal/DecisionTree.hs +++ b/tests-internal/DecisionTree.hs @@ -25,6 +25,7 @@ probExprs, probsFromIndices, ) +import DataFrame.DecisionTree.Linear (fitLinearCandidate) import DataFrame.DecisionTree.Numeric ( NumExpr (NMaybeDouble), generateNumericConds, @@ -46,7 +47,6 @@ import DataFrame.Expression.Operators import qualified DataFrame.Functions as F import qualified DataFrame.Internal.Column as DI -import qualified DataFrame.Internal.Column.Bitmap as DI import DataFrame.Internal.Data.PackedText (mkPackedContiguous) import DataFrame.Internal.Expression (Expr (..), eqExpr, getColumns) import DataFrame.Internal.Interpreter (interpret) @@ -66,13 +66,7 @@ import Data.Word (Word8) import Test.HUnit ------------------------------------------------------------------------- --- Shared fixtures ------------------------------------------------------------------------- - -{- | Build a 'TargetInfo' or fail loudly; the test fixtures always satisfy -'mkTargetInfo', so a 'Nothing' here is a broken test, not a runtime case. --} +-- | Build a TargetInfo or fail loudly; fixtures always satisfy mkTargetInfo. requireTargetInfo :: T.Text -> D.DataFrame -> TargetInfo T.Text requireTargetInfo target df = case mkTargetInfo @T.Text target df of Just ti -> ti @@ -81,7 +75,7 @@ -- 4 rows: label = ["A","B","A","C"], x = [1.0,2.0,3.0,4.0] fixtureDF :: D.DataFrame fixtureDF = - D.fromNamedColumns + D.fromColumns [ ("label", DI.fromList (["A", "B", "A", "C"] :: [T.Text])) , ("x", DI.fromList ([1.0, 2.0, 3.0, 4.0] :: [Double])) ] @@ -104,10 +98,6 @@ carePoints3 = identifyCarePoints @T.Text "label" fixtureDF allIndices leftTree rightTree ------------------------------------------------------------------------- --- Unit tests: identifyCarePoints ------------------------------------------------------------------------- - carePointsBothWrong :: Test carePointsBothWrong = TestCase $ @@ -149,7 +139,7 @@ carePointsBothCorrect :: Test carePointsBothCorrect = TestCase $ do let df2 = - D.fromNamedColumns + D.fromColumns [ ("label", DI.fromList (["A", "A"] :: [T.Text])) , ("x", DI.fromList ([1.0, 2.0] :: [Double])) ] @@ -162,14 +152,10 @@ (Leaf "A") assertEqual "no care points when both subtrees agree" 0 (length cps) ------------------------------------------------------------------------- --- Unit tests: majorityValueFromIndices ------------------------------------------------------------------------- - majorityVoteTest :: Test majorityVoteTest = TestCase $ do let df = - D.fromNamedColumns + D.fromColumns [ ("label", DI.fromList (["cat", "dog", "cat", "cat"] :: [T.Text])) , ("x", DI.fromList ([1.0, 2.0, 3.0, 4.0] :: [Double])) ] @@ -181,21 +167,17 @@ majorityVoteSubset :: Test majorityVoteSubset = TestCase $ do let df = - D.fromNamedColumns + D.fromColumns [ ("label", DI.fromList (["cat", "dog", "cat", "cat"] :: [T.Text])) , ("x", DI.fromList ([1.0, 2.0, 3.0, 4.0] :: [Double])) ] result = majorityValueFromIndices @T.Text "label" df (V.fromList [0, 1, 3]) assertEqual "majority from subset [0,1,3] is cat" "cat" result ------------------------------------------------------------------------- --- Unit tests: computeTreeLoss ------------------------------------------------------------------------- - computeLossZero :: Test computeLossZero = TestCase $ do let df = - D.fromNamedColumns + D.fromColumns [ ("label", DI.fromList (["A", "A", "B", "B"] :: [T.Text])) , ("x", DI.fromList ([1.0, 2.0, 3.0, 4.0] :: [Double])) ] @@ -206,7 +188,7 @@ computeLossHalf :: Test computeLossHalf = TestCase $ do let df = - D.fromNamedColumns + D.fromColumns [ ("label", DI.fromList (["A", "A", "B", "B"] :: [T.Text])) , ("x", DI.fromList ([1.0, 2.0, 3.0, 4.0] :: [Double])) ] @@ -214,10 +196,6 @@ loss = computeTreeLoss @T.Text "label" df (V.fromList [0, 1, 2, 3]) constTree assertEqual "constant leaf misclassifies half of balanced data" 0.5 loss ------------------------------------------------------------------------- --- Unit tests: partitionIndices ------------------------------------------------------------------------- - partitionDisjoint :: Test partitionDisjoint = TestCase $ do let (lft, rgt) = partitionIndices splitCond fixtureDF allIndices @@ -235,10 +213,6 @@ [0, 1, 2, 3] combined ------------------------------------------------------------------------- --- Unit tests: countCarePointErrors ------------------------------------------------------------------------- - countErrorsAllCorrect :: Test countErrorsAllCorrect = TestCase $ do let cps = [CarePoint 0 GoLeft, CarePoint 1 GoRight] @@ -253,10 +227,6 @@ errs = countCarePointErrors cond fixtureDF cps assertEqual "reversed condition misroutes all care points" 2 errs ------------------------------------------------------------------------- --- Unit tests: predictWithTree ------------------------------------------------------------------------- - predictLeaf :: Test predictLeaf = TestCase $ @@ -277,16 +247,12 @@ "B" (predictWithTree @T.Text "label" fixtureDF 3 stump) ------------------------------------------------------------------------- --- Integration tests ------------------------------------------------------------------------- - -- 20-row, linearly separable: x in [1..10] -> "pos", x in [11..20] -> "neg" sepDF :: D.DataFrame sepDF = let xs = map fromIntegral [1 .. 20 :: Int] :: [Double] labels = map (\x -> if x <= 10.0 then "pos" else "neg") xs :: [T.Text] - in D.fromNamedColumns + in D.fromColumns [ ("label", DI.fromList labels) , ("x", DI.fromList xs) ] @@ -343,7 +309,7 @@ taoConvergesPureLabels :: Test taoConvergesPureLabels = TestCase $ do let df = - D.fromNamedColumns + D.fromColumns [ ("label", DI.fromList (replicate 10 ("A" :: T.Text))) , ("x", DI.fromList ([1.0 .. 10.0] :: [Double])) ] @@ -373,7 +339,7 @@ gridBaseDF :: D.DataFrame gridBaseDF = - D.fromNamedColumns + D.fromColumns [ ("x", DI.fromList (map fst gridPairs)) , ("y", DI.fromList (map snd gridPairs)) ] @@ -497,11 +463,10 @@ 0.0 finalLoss --- Cleanly separable nullable column (no actual nulls): Just 1..6 -> "pos", --- Just 7..12 -> "neg". Exercises the nullable numeric path. +-- Separable nullable column, no actual nulls: Just 1..6 pos, Just 7..12 neg. nullableSepDF :: D.DataFrame nullableSepDF = - D.fromNamedColumns + D.fromColumns [ ("label", DI.fromList (replicate 6 "pos" ++ replicate 6 "neg" :: [T.Text])) , ( "x" @@ -517,7 +482,7 @@ -- DF with genuine nulls interspersed. nullsMixedDF :: D.DataFrame nullsMixedDF = - D.fromNamedColumns + D.fromColumns [ ("label", DI.fromList (["pos", "pos", "pos", "neg", "neg", "neg"] :: [T.Text])) , ( "x" @@ -538,11 +503,11 @@ "numericCols finds NMaybeDouble for DI.fromVector (Maybe Double)" hasMD --- numericCols picks up DI.fromVector (Maybe Int) as NMaybeDouble (via whenPresent). +-- numericCols picks up DI.fromVector (Maybe Int) as NMaybeDouble. numericColsNullableIntTest :: Test numericColsNullableIntTest = TestCase $ do let df = - D.fromNamedColumns + D.fromColumns [ ("label", DI.fromList (["pos", "neg"] :: [T.Text])) , ( "n" @@ -552,7 +517,7 @@ hasMD = any (\case NMaybeDouble _ -> True; _ -> False) (numericCols df) assertBool "numericCols finds NMaybeDouble for DI.fromVector (Maybe Int)" hasMD --- generateNumericConds is non-empty for a DF with an DI.fromVector (Maybe Double). +-- generateNumericConds is non-empty for a nullable (Maybe Double) column. numericCondsNullableNonEmptyTest :: Test numericCondsNullableNonEmptyTest = TestCase $ @@ -560,11 +525,11 @@ "generateNumericConds non-empty for DI.fromVector (Maybe Double)" (not (null (generateNumericConds defaultTreeConfig nullableSepDF))) --- Null values evaluate to False for threshold conditions (null rows route right). +-- Null values fail threshold conditions, so null rows route right. nullValueRoutesFalseTest :: Test nullValueRoutesFalseTest = TestCase $ do let df = - D.fromNamedColumns + D.fromColumns [ ("label", DI.fromList (["A", "B"] :: [T.Text])) , ( "x" @@ -577,7 +542,7 @@ assertBool "null row (idx 0) routes to right (false) partition" (0 `V.elem` rgt) assertBool "Just 5.0 <= 6.0 routes to left (true) partition" (1 `V.elem` lft) --- Nullable feature (no actual nulls) achieves zero loss on cleanly separable data. +-- Nullable feature with no actual nulls reaches zero loss on separable data. nullableFitZeroLossTest :: Test nullableFitZeroLossTest = TestCase $ do let cfg = defaultTreeConfig{taoIterations = 5, expressionPairs = 4, minLeafSize = 1} @@ -603,12 +568,11 @@ "loss is in [0,1] with null values present" (loss >= 0.0 && loss <= 1.0) --- numericExprsWithTerms produces cross-column combinations when one col is --- DI.fromVector (Maybe Double) and another is a plain UnboxedColumn Double. +-- numericExprsWithTerms crosses a Maybe Double column with a plain Double one. numericExprsWithTermsMixedTest :: Test numericExprsWithTermsMixedTest = TestCase $ do let df = - D.fromNamedColumns + D.fromColumns [ ( "x" , DI.fromVector @@ -629,9 +593,12 @@ missingnessCondsTest = TestCase $ do let conds = missingnessConditions (D.exclude ["label"] nullsMixedDF) assertEqual "one nullable column -> one missingness cond" 1 (length conds) - assertBool - "cond is isNothing x" - (eqExpr (head conds) (F.isNothing (F.col @(Maybe Double) "x"))) + case conds of + [c] -> + assertBool + "cond is isNothing x" + (eqExpr c (F.isNothing (F.col @(Maybe Double) "x"))) + _ -> assertFailure "expected exactly one condition" assertBool "no missingness conds for a non-nullable DataFrame" (null (missingnessConditions fixtureDF)) @@ -662,7 +629,7 @@ observedOnlyThresholdsTest :: Test observedOnlyThresholdsTest = TestCase $ do let df = - D.fromNamedColumns + D.fromColumns [ ( "x" , DI.fromVector @@ -694,22 +661,23 @@ zipWithM_ (A.unsafeWrite m) [0 ..] ws pure m --- G5: nullable PackedText columns (what CSV ingest emits for nullable text) --- get a missingness candidate; non-nullable PackedText does not. +-- G5: nullable PackedText columns get a missingness candidate; others do not. packedMissingnessTest :: Test packedMissingnessTest = TestCase $ do let df = - D.fromNamedColumns + D.fromColumns [("s", packedFromTexts (Just [1, 3]) ["yes", "", "no", ""])] isMissingS = F.isNothing (F.col @(Maybe T.Text) "s") conds = missingnessConditions df assertEqual "one missingness cond for nullable PackedText" 1 (length conds) - assertBool "cond is isNothing s" (eqExpr (head conds) isMissingS) + case conds of + [c] -> assertBool "cond is isNothing s" (eqExpr c isMissingS) + _ -> assertFailure "expected exactly one condition" assertBool "no missingness cond for non-nullable PackedText" ( null ( missingnessConditions - (D.fromNamedColumns [("t", packedFromTexts Nothing ["a", "b"])]) + (D.fromColumns [("t", packedFromTexts Nothing ["a", "b"])]) ) ) case filter (eqExpr isMissingS . cvExpr) (numericCondVecs defaultTreeConfig df df) of @@ -723,7 +691,7 @@ probsFromIndicesBasic :: Test probsFromIndicesBasic = TestCase $ do let df = - D.fromNamedColumns + D.fromColumns [ ("label", DI.fromList (["A", "A", "B"] :: [T.Text])) , ("x", DI.fromList ([1.0, 2.0, 3.0] :: [Double])) ] @@ -735,7 +703,7 @@ probsFromIndicesSubset :: Test probsFromIndicesSubset = TestCase $ do let df = - D.fromNamedColumns + D.fromColumns [ ("label", DI.fromList (["A", "A", "B", "B"] :: [T.Text])) , ("x", DI.fromList ([1.0, 2.0, 3.0, 4.0] :: [Double])) ] @@ -752,7 +720,7 @@ buildProbTreeLeaf :: Test buildProbTreeLeaf = TestCase $ do let df = - D.fromNamedColumns + D.fromColumns [ ("label", DI.fromList (["A", "A", "A"] :: [T.Text])) , ("x", DI.fromList ([1.0, 2.0, 3.0] :: [Double])) ] @@ -950,7 +918,7 @@ | i <- [0 .. n - 1] ] df = - D.fromNamedColumns + D.fromColumns [ ("label", DI.fromList labels) , ("a", DI.fromList avals) , ("b", DI.fromList bs) @@ -985,7 +953,7 @@ bs = [fromIntegral (i `mod` 3) :: Double | i <- [0 .. n - 1]] targets = [if even i then 1.0 else 0.0 :: Double | i <- [0 .. n - 1]] df = - D.fromNamedColumns + D.fromColumns [ ("target", DI.fromList targets) , ("a", DI.fromList as) , ("b", DI.fromList bs) @@ -1018,8 +986,7 @@ r2 = fitDecisionTree @T.Text cfg (Col "label") sepDF assertBool "fitDecisionTree is deterministic on the same input" (eqExpr r1 r2) --- D1: One care point — solver must not crash; integration should fall back --- gracefully (via minCarePointsForLinear) and rely on the discrete path. +-- D1: One care point; the solver must not crash and should fall back. taoLinearTinyCareSet :: Test taoLinearTinyCareSet = TestCase $ do let cfg = @@ -1173,7 +1140,7 @@ -- A small synthetic DataFrame to materialize CondVecs against. threshFixtureDF :: D.DataFrame threshFixtureDF = - D.fromNamedColumns + D.fromColumns [ ("x", DI.fromList ([0.0, 1.0, 2.0, 3.0, 4.0, 5.0] :: [Double])) , ("y", DI.fromList ([5.0, 4.0, 3.0, 2.0, 1.0, 0.0] :: [Double])) ] @@ -1334,8 +1301,7 @@ (F.and (cvExpr a) (cvExpr b)) (cvExpr r) --- Semantic-preservation spot check: the consolidated cvVec matches the --- elementwise AND/OR of the inputs at every row of a synthetic DataFrame. +-- The consolidated cvVec equals the elementwise AND/OR of the inputs. threshSemanticPreservation :: Test threshSemanticPreservation = TestCase $ do let a = materializeOrFail (F.col @Double "x" .>. F.lit (1.0 :: Double)) @@ -1353,13 +1319,34 @@ expectedOr (cvVec rOr) ------------------------------------------------------------------------- --- Test list ------------------------------------------------------------------------- +-- Regression: oblique candidates on Int features were silently dropped. +obliqueOnIntColumns :: Test +obliqueOnIntColumns = TestCase $ do + let as = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 2, 4, 6, 8, 1, 3, 5, 7, 9] :: [Int] + bs = [9, 7, 5, 3, 1, 8, 6, 4, 2, 0, 1, 3, 5, 7, 9, 0, 2, 4, 6, 8] :: [Int] + labels = [if a + b > 9 then "yes" else "no" | (a, b) <- zip as bs] :: [T.Text] + df = + D.fromColumns + [("a", DI.fromList as), ("b", DI.fromList bs), ("label", DI.fromList labels)] + cps = + [ CarePoint i (if l == "yes" then GoRight else GoLeft) + | (i, l) <- zip [0 ..] labels + ] + case fitLinearCandidate defaultTreeConfig "label" df cps of + Nothing -> assertFailure "no oblique candidate on Int features" + Just cond -> case interpret @Bool df cond of + Left err -> assertFailure ("oblique condition does not evaluate: " ++ show err) + Right (DI.TColumn col) -> case DI.toVector @Bool @V.Vector col of + Left err -> assertFailure (show err) + Right v -> do + let sides = V.toList (v :: V.Vector Bool) + assertBool "both sides non-empty" (or sides && not (and sides)) + assertBool "uses both features" (length (getColumns cond) == 2) tests :: [Test] tests = - [ TestLabel "carePointsBothWrong" carePointsBothWrong + [ TestLabel "obliqueOnIntColumns" obliqueOnIntColumns + , TestLabel "carePointsBothWrong" carePointsBothWrong , TestLabel "carePointsLeftCorrect" carePointsLeftCorrect , TestLabel "carePointsRightCorrect" carePointsRightCorrect , TestLabel "carePointsMixed" carePointsMixed diff --git a/tests-internal/HistogramTrees.hs b/tests-internal/HistogramTrees.hs new file mode 100644 --- /dev/null +++ b/tests-internal/HistogramTrees.hs @@ -0,0 +1,124 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + +-- | Histogram trees: compiled routing must match fitting, and exact trees. +module HistogramTrees (tests) where + +import Data.Either (fromRight) +import qualified Data.Text as T +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU +import Test.HUnit + +import DataFrame.DecisionTree.Cart (cartFeatures) +import DataFrame.DecisionTree.Fit (treeToExpr) +import DataFrame.DecisionTree.Histogram ( + TreeLimits (..), + binFeatures, + fitBinnedTree, + ) +import DataFrame.DecisionTree.Regression ( + RegFit (..), + RegTreeConfig (..), + defaultRegTreeConfig, + fitRegTree, + ) +import DataFrame.DecisionTree.Types (Tree) +import qualified DataFrame.Internal.Column as DI +import DataFrame.Internal.Interpreter (interpret) +import qualified DataFrameApi as D + +tests :: [Test] +tests = + [ TestLabel + "histogram tree: in-sample == interpreted (mixed nullable frame)" + inSampleMatchesInterpret + , TestLabel + "histogram tree: in-sample == interpreted (more values than bins)" + coarseBinsMatchInterpret + , TestLabel "histogram tree: same partition as the exact tree" matchesExactTree + ] + +limits :: Int -> TreeLimits +limits depth = TreeLimits depth 2 1 0 0 0 + +fitBinned :: + Int -> Int -> D.DataFrame -> VU.Vector Double -> (Tree Double, VU.Vector Double) +fitBinned bins depth df y = + fitBinnedTree + (limits depth) + (binFeatures bins (V.fromList (cartFeatures "y" df))) + y + Nothing + +interpreted :: D.DataFrame -> Tree Double -> VU.Vector Double +interpreted df t = case interpret @Double df (treeToExpr t) of + Right (DI.TColumn c) -> fromRight VU.empty (DI.toVector @Double @VU.Vector c) + Left e -> error (show e) + +maybeCol :: (DI.Columnable a) => [Maybe a] -> DI.Column +maybeCol = DI.fromVector . V.fromList + +-- Nullable Double, Int and Text columns plus a plain one, as in NullSplits. +mixedFrame :: Int -> ([Double], D.DataFrame) +mixedFrame n = (y, D.fromColumns (("y", DI.fromList y) : cols)) + where + rows = [0 .. n - 1] + md = + [ if i `mod` 7 == 0 + then Nothing + else Just (fromIntegral ((i * 37) `mod` 23) :: Double) + | i <- rows + ] + mi = + [if i `mod` 5 == 2 then Nothing else Just ((i * 11) `mod` 9 :: Int) | i <- rows] + mt = + [ if i `mod` 6 == 4 + then Nothing + else Just (["a", "b", "c"] !! (i `mod` 3) :: T.Text) + | i <- rows + ] + z = [fromIntegral ((i * 13) `mod` 17) :: Double | i <- rows] + y = [fromIntegral ((i * 29) `mod` 31) / 7 :: Double | i <- rows] + cols = + [ ("md", maybeCol md) + , ("mi", maybeCol mi) + , ("mt", maybeCol mt) + , ("z", DI.fromList z) + ] + +inSampleMatchesInterpret :: Test +inSampleMatchesInterpret = TestCase $ do + let (y, df) = mixedFrame 60 + (t, inSample) = fitBinned 1024 6 df (VU.fromList y) + assertEqual + "in-sample predictions equal the interpreted tree" + (interpreted df t) + inSample + +-- 23 distinct md values squeezed into 4 bins must still route consistently. +coarseBinsMatchInterpret :: Test +coarseBinsMatchInterpret = TestCase $ do + let (y, df) = mixedFrame 200 + (t, inSample) = fitBinned 4 5 df (VU.fromList y) + assertEqual + "in-sample predictions equal the interpreted tree" + (interpreted df t) + inSample + +matchesExactTree :: Test +matchesExactTree = TestCase $ do + let (y, df) = mixedFrame 120 + yv = VU.fromList y + (_, binned) = fitBinned 1024 4 df yv + exact = + rfFitted + ( fitRegTree + defaultRegTreeConfig{rtMaxDepth = 4} + (V.fromList (cartFeatures "y" df)) + yv + Nothing + ) + gap = VU.maximum (VU.zipWith (\a b -> abs (a - b)) binned exact) + assertBool ("same leaves up to rounding, max gap " ++ show gap) (gap < 1e-9) diff --git a/tests-internal/Learn/EdgeCases.hs b/tests-internal/Learn/EdgeCases.hs --- a/tests-internal/Learn/EdgeCases.hs +++ b/tests-internal/Learn/EdgeCases.hs @@ -2,10 +2,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -{- | Edge-case / degeneracy tests (category 7) and numerical-stability tests -(category 8) for @dataframe-learn@. Each asserts the mathematically correct -result or a specific documented degenerate behaviour — never "it ran". --} +-- | Edge-case and numerical-stability tests for dataframe-learn. module Learn.EdgeCases (tests) where import qualified Data.Map.Strict as M @@ -28,12 +25,10 @@ import DataFrame.LinearSolver (sigmoid) import DataFrame.PCA -import DataFrame.Internal.Statistics (correlation', variance') +import DataFrame.Internal.Statistics (correlation', meanSquaredError, variance') import Test.HUnit --- Helpers (mirrors Learn.Models) -------------------------------------------- - interpD :: D.DataFrame -> Expr Double -> [Double] interpD df e = case interpret @Double df e of Right (TColumn c) -> either (const []) VU.toList (toVector @Double @VU.Vector c) @@ -53,13 +48,7 @@ finite :: Double -> Bool finite x = not (isNaN x) && not (isInfinite x) --- =========================================================================== --- Category 8: numerical stability --- =========================================================================== - -{- logSumExp on a large-positive cluster: log(e^1000+e^1001+e^1002) = - 1002 + log(e^-2+e^-1+1) ≈ 1002.40760596. A naive log.sum.map exp - overflows to +Inf here. -} +-- logSumExp on a large positive cluster must not overflow to +Inf. testLogSumExpLargePositive :: Test testLogSumExpLargePositive = TestCase $ do let lse = logSumExp (VU.fromList [1000, 1001, 1002]) @@ -70,9 +59,7 @@ (close 1e-9 lse expected) assertBool "lse literal ~ 1002.40760596" (close 1e-7 lse 1002.4076059644443) -{- logSumExp on a large-negative cluster: log(e^-1000+e^-1001+e^-1002) = - -1000 + log(1+e^-1+e^-2) ≈ -999.59239403. A naive impl underflows every - term to 0 -> log 0 = -Inf. -} +-- logSumExp on a large negative cluster must not underflow to -Inf. testLogSumExpLargeNegative :: Test testLogSumExpLargeNegative = TestCase $ do let lse = logSumExp (VU.fromList [-1000, -1001, -1002]) @@ -83,14 +70,12 @@ (close 1e-9 lse expected) assertBool "lse literal ~ -999.59239403" (close 1e-7 lse (-999.5923940355557)) -{- logSumExp of a single element is that element exactly (m + log 1). -} +-- logSumExp of a single element is that element exactly. testLogSumExpSingleton :: Test testLogSumExpSingleton = TestCase $ do assertBool "lse [42] == 42" (close 0 (logSumExp (VU.fromList [42])) 42) -{- sigmoid at extreme arguments must stay in [0,1] and not NaN/Inf: - sigmoid(1000) ≈ 1, sigmoid(-1000) ≈ 0. The stable branch avoids the - overflow a naive 1/(1+exp(-z)) hits. -} +-- sigmoid at extreme arguments stays in [0,1] and finite. testSigmoidExtreme :: Test testSigmoidExtreme = TestCase $ do let sp = sigmoid 1000 @@ -106,9 +91,7 @@ "sigmoid antisymmetric at 3" (close 1e-12 (sigmoid (-3)) (1 - sigmoid 3)) -{- Variance of large-but-low-variance data [1e8+1,+2,+3]: true sample variance - is 1.0. A naive sum-of-squares formula loses all precision (catastrophic - cancellation); Welford keeps it ~1. -} +-- Variance of large low-variance data is 1.0, not lost to cancellation. testVarianceCatastrophicCancellation :: Test testVarianceCatastrophicCancellation = TestCase $ do let xs = VU.fromList [1e8 + 1, 1e8 + 2, 1e8 + 3] :: VU.Vector Double @@ -117,15 +100,13 @@ assertBool "variance is positive" (v > 0) assertBool "variance of shifted {1,2,3} == 1.0" (close 1e-6 v 1.0) -{- Variance of an identical column is exactly 0 (not a tiny negative from - cancellation). -} +-- Variance of an identical column is exactly 0. testVarianceConstant :: Test testVarianceConstant = TestCase $ do let v = variance' (VU.replicate 100 (7.0 :: Double)) assertEqual "variance of constant column is 0" 0 v -{- Variance of fewer than two samples is defined to be 0 (computeVariance guard), - not NaN from a /0. -} +-- Variance of fewer than two samples is 0, not NaN. testVarianceSingleton :: Test testVarianceSingleton = TestCase $ do assertEqual @@ -133,8 +114,7 @@ 0 (variance' (VU.fromList [3.5 :: Double])) -{- Correlation of a perfectly linear pair is exactly +1 (and -1 reversed), - computed stably. y = 2x+1 over a spread of x. -} +-- Correlation of a perfectly linear pair is exactly +1 (and -1 reversed). testCorrelationPerfect :: Test testCorrelationPerfect = TestCase $ do let xs = VU.fromList [1, 2, 3, 4, 5] :: VU.Vector Double @@ -147,9 +127,7 @@ Just r -> assertBool "corr(x, -2x+1) == -1" (close 1e-9 r (-1)) Nothing -> assertFailure "expected a correlation" -{- Degeneracy: correlation against a constant column. The denominator is 0, so - the library returns Just NaN — this pins the actual (non-throwing) behaviour; - a future Nothing/0 would flag the contract change. -} +-- Correlation against a constant column is Just NaN; pins current behaviour. testCorrelationConstantColumnIsNaN :: Test testCorrelationConstantColumnIsNaN = TestCase $ do let xs = VU.fromList [1, 2, 3, 4, 5] :: VU.Vector Double @@ -161,7 +139,7 @@ (isNaN r) Nothing -> assertFailure "correlation' returned Nothing (contract changed)" -{- correlation' on n<2 returns Nothing (guarded), not a NaN. -} +-- correlation' on n<2 returns Nothing, not NaN. testCorrelationTooFew :: Test testCorrelationTooFew = TestCase $ do assertEqual @@ -169,24 +147,38 @@ Nothing (correlation' (VU.fromList [1]) (VU.fromList [2])) --- =========================================================================== --- Category 8: stability inside the model expr layer --- =========================================================================== +-- meanSquaredError refuses length mismatches and empty inputs. +testMeanSquaredErrorGuards :: Test +testMeanSquaredErrorGuards = TestCase $ do + assertEqual + "mse of mismatched lengths is Nothing" + Nothing + (meanSquaredError (VU.fromList [0, 0, 0, 0]) (VU.fromList [2, 2])) + assertEqual + "mse with the longer prediction does not index out of bounds" + Nothing + (meanSquaredError (VU.fromList [1]) (VU.fromList [1, 2, 3])) + assertEqual + "mse of empty inputs is Nothing" + Nothing + (meanSquaredError VU.empty VU.empty) + assertEqual + "mse of equal-length inputs is the plain mean" + (Just 4.0) + (meanSquaredError (VU.fromList [0, 0]) (VU.fromList [2, 2])) -{- Logistic probability expressions at extreme feature values (|x| ~ 1e6) must - remain finite and in [0,1]; a non-stable 1/(1+exp(-margin)) would overflow. - Also checks both one-vs-rest class probabilities are present. -} +-- Logistic probabilities at extreme features stay finite and in [0,1]. testLogisticProbsExtremeFeatures :: Test testLogisticProbsExtremeFeatures = TestCase $ do let trainDf = - D.fromNamedColumns + D.fromColumns [ ("x", DI.fromList ([-3, -2, -1, -0.5, 0.5, 1, 2, 3] :: [Double])) , ("label", DI.fromList ([0, 0, 0, 0, 1, 1, 1, 1] :: [Int])) ] m = fit defaultLogisticConfig (F.col @Int "label") trainDf probs = logisticProbExprs m extremeDf = - D.fromNamedColumns + D.fromColumns [("x", DI.fromList ([-1e6, -1, 0, 1, 1e6] :: [Double]))] assertEqual "two one-vs-rest probability exprs" 2 (M.size probs) let allProbVals = @@ -196,17 +188,11 @@ "all logistic probabilities in [0,1]" (all (\p -> p >= 0 && p <= 1) allProbVals) --- =========================================================================== --- Category 7: edge cases / degeneracy on models --- =========================================================================== - -{- One-row OLS (x=2, y=7): under-determined, so olsSolve falls back to - ridge(1e-8). The fit must interpolate the single point (predict 7 at x=2) - and never be NaN/Inf. -} +-- One-row OLS falls back to ridge and interpolates the point, never NaN. testOLSOneRow :: Test testOLSOneRow = TestCase $ do let df = - D.fromNamedColumns + D.fromColumns [ ("x", DI.fromList ([2] :: [Double])) , ("y", DI.fromList ([7] :: [Double])) ] @@ -217,13 +203,11 @@ "OLS fits the single training point" (case preds of [p] -> close 1e-3 p 7; _ -> False) -{- All-identical labels in logistic regression: every row is class 1. There is - exactly one class, so predict must return that class for every row (no - division-by-zero, no crash, no spurious second class). -} +-- Logistic regression with a single class predicts that class everywhere. testLogisticSingleClass :: Test testLogisticSingleClass = TestCase $ do let df = - D.fromNamedColumns + D.fromColumns [ ("x", DI.fromList ([-2, -1, 0, 1, 2] :: [Double])) , ("label", DI.fromList ([1, 1, 1, 1, 1] :: [Int])) ] @@ -234,13 +218,11 @@ [1, 1, 1, 1, 1] preds -{- Perfectly separable logistic data plus a constant (zero-variance) feature: - the constant column is dropped, the informative one still separates, and - prediction recovers the labels exactly. -} +-- A constant feature is dropped; the informative one still separates. testLogisticConstantFeatureIgnored :: Test testLogisticConstantFeatureIgnored = TestCase $ do let df = - D.fromNamedColumns + D.fromColumns [ ("x", DI.fromList ([-3, -2, -1, -0.5, 0.5, 1, 2, 3] :: [Double])) , ("const", DI.fromList (replicate 8 (5.0 :: Double))) , ("label", DI.fromList ([0, 0, 0, 0, 1, 1, 1, 1] :: [Int])) @@ -252,14 +234,12 @@ [0, 0, 0, 0, 1, 1, 1, 1] preds -{- Linear regression with an irrelevant constant feature: the constant column is - near-constant (variance 0) and must get a zero weight, while the informative - coefficient is recovered. y = 3x + 4 exactly. -} +-- A constant feature gets zero weight; y = 3x + 4 is recovered exactly. testLinearConstantFeatureZeroWeight :: Test testLinearConstantFeatureZeroWeight = TestCase $ do let xs = [1, 2, 3, 4, 5, 6] :: [Double] df = - D.fromNamedColumns + D.fromColumns [ ("x", DI.fromList xs) , ("const", DI.fromList (replicate 6 (5.0 :: Double))) , ("y", DI.fromList [3 * x + 4 | x <- xs]) @@ -277,13 +257,11 @@ "regression with constant feature still fits y=3x+4" (and (zipWith (close 1e-4) preds truth)) -{- k-means with k > n: the library clamps k = min k (max 1 n), so 3 rows with - kmK=10 must yield exactly 3 centres, in-range labels, and finite centres — - not a crash or degenerate centres. -} +-- k-means with k > n clamps k, giving finite centres and in-range labels. testKMeansKGreaterThanN :: Test testKMeansKGreaterThanN = TestCase $ do let df = - D.fromNamedColumns + D.fromColumns [ ("a", DI.fromList ([0, 5, 10] :: [Double])) , ("b", DI.fromList ([0, 5, 10] :: [Double])) ] @@ -297,13 +275,11 @@ (all (VU.all finite) (V.toList (kmCenters m))) assertBool "k=n clustering has ~zero inertia" (close 1e-9 (kmInertia m) 0) -{- k-means on an all-identical feature set: any clustering has inertia 0 and - centres equal that point, staying finite (no NaN from an empty cluster or a - zero distance sum in k-means++ sampling). -} +-- k-means on identical points has inertia 0 and finite centres. testKMeansAllIdentical :: Test testKMeansAllIdentical = TestCase $ do let df = - D.fromNamedColumns + D.fromColumns [ ("a", DI.fromList (replicate 6 (4.0 :: Double))) , ("b", DI.fromList (replicate 6 (4.0 :: Double))) ] @@ -316,13 +292,11 @@ let assigns = interpI df (predict m) assertBool "assignments in [0,1]" (all (\l -> l >= 0 && l < 2) assigns) -{- GMM with k > n: clamped like k-means (k = min k (max 1 n)). Two rows, gmmK=5 - must yield 2 components, finite weights summing to ~1, and a finite log - likelihood -- not a crash or NaN. -} +-- GMM with k > n clamps k; weights sum to ~1 and the likelihood is finite. testGMMKGreaterThanN :: Test testGMMKGreaterThanN = TestCase $ do let df = - D.fromNamedColumns + D.fromColumns [ ("a", DI.fromList ([0, 10] :: [Double])) , ("b", DI.fromList ([0, 10] :: [Double])) ] @@ -333,13 +307,11 @@ assertBool "GMM weights sum to ~1" (close 1e-6 (VU.sum (gmmWeights m)) 1) assertBool "GMM log-likelihood finite" (finite (gmmLogLikelihood m)) -{- PCA on one informative axis plus a constant column: the constant's explained - ratio must be ~0 while ratios sum to ~1 and stay finite. Catches a - divide-by-zero in ratio normalisation when an eigenvalue is 0. -} +-- PCA with a constant column: its explained ratio is ~0 and all are finite. testPCAConstantColumn :: Test testPCAConstantColumn = TestCase $ do let df = - D.fromNamedColumns + D.fromColumns [ ("x", DI.fromList ([-2, -1, 0, 1, 2] :: [Double])) , ("const", DI.fromList (replicate 5 (3.0 :: Double))) ] @@ -360,13 +332,11 @@ "pca exprs finite on constant column" (all (all finite . interpD df) es) -{- PCA on extreme-scale features (1e8-shifted), no standardisation: components - must stay unit-length and finite — catches cancellation in the covariance / - eigendecomposition at large magnitudes. -} +-- PCA on extreme-scale features keeps components unit-length and finite. testPCAExtremeScale :: Test testPCAExtremeScale = TestCase $ do let df = - D.fromNamedColumns + D.fromColumns [ ("x", DI.fromList ([1e8 + 1, 1e8 + 2, 1e8 + 3, 1e8 + 4] :: [Double])) , ("y", DI.fromList ([1e8 + 1, 1e8 + 2, 1e8 + 3, 1e8 + 4] :: [Double])) ] @@ -383,12 +353,7 @@ "explained ratio finite at 1e8 scale" (VU.all finite (pcaExplainedVarianceRatio m)) --- =========================================================================== --- Category 7/8: linear-algebra degeneracy --- =========================================================================== - -{- choleskySolve on a non-positive-definite (zero) matrix returns Nothing rather - than crashing or producing NaNs. A 2x2 all-zero matrix has a zero pivot. -} +-- choleskySolve on a non-positive-definite matrix returns Nothing. testCholeskyNonPD :: Test testCholeskyNonPD = TestCase $ do assertEqual @@ -396,17 +361,14 @@ Nothing (choleskySolve (mat [[0, 0], [0, 0]]) (VU.fromList [1, 1])) -{- Jacobi eigendecomposition of a 1x1 matrix (one-column degenerate case): - eigenvalue is the single entry, eigenvector is [1] (sign-canonicalised). -} +-- Jacobi on a 1x1 matrix: eigenvalue is the entry, eigenvector is [1]. testJacobi1x1 :: Test testJacobi1x1 = TestCase $ do let (ev, vecs) = jacobiEigenSym (mat [[5]]) assertBool "1x1 eigenvalue is the entry" (close 1e-12 (ev VU.! 0) 5) assertBool "1x1 eigenvector is [1]" (close 1e-12 ((vecs V.! 0) VU.! 0) 1) -{- Jacobi on an identity matrix: both eigenvalues are exactly 1 and the result is - finite (the rotation angle code must not divide by zero when off-diagonals are - already 0). -} +-- Jacobi on an identity matrix gives eigenvalues exactly 1, all finite. testJacobiIdentity :: Test testJacobiIdentity = TestCase $ do let (ev, vecs) = jacobiEigenSym (mat [[1, 0], [0, 1]]) @@ -425,6 +387,7 @@ , testCorrelationPerfect , testCorrelationConstantColumnIsNaN , testCorrelationTooFew + , testMeanSquaredErrorGuards , testLogisticProbsExtremeFeatures , testOLSOneRow , testLogisticSingleClass diff --git a/tests-internal/Learn/NumericalRigor.hs b/tests-internal/Learn/NumericalRigor.hs --- a/tests-internal/Learn/NumericalRigor.hs +++ b/tests-internal/Learn/NumericalRigor.hs @@ -2,10 +2,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -{- | Numerical-rigor suite: gradient checks (cat 4), reproducibility of the -stochastic models (cat 16), and statistical properties of the RNG and splitters -(cat 5). Every test is constructed to FAIL on a real bug. --} +-- | Numerical-rigor suite: gradient checks, reproducibility, RNG properties. module Learn.NumericalRigor (tests) where import qualified DataFrame.Functions as F @@ -28,12 +25,6 @@ import System.Random (mkStdGen) import Test.HUnit --- --------------------------------------------------------------------------- --- Independent reference loss VALUE functions. The library exposes only the --- gradient 'slGradZ'; these reconstruct the scalar value so the finite --- difference is computed independently of the analytic gradient. --- --------------------------------------------------------------------------- - -- | @½ (z - y)²@ (squaredLoss). squaredValue :: Double -> Double -> Double squaredValue y z = 0.5 * (z - y) * (z - y) @@ -55,10 +46,7 @@ (Double -> Double -> Double) -> Double -> Double -> Double -> Double centralDiff f eps y z = (f y (z + eps) - f y (z - eps)) / (2 * eps) -{- | Gradient-check one 'SmoothLoss' against its reference value fn over a grid -of @(y, z)@ points. Fails if the analytic gradient differs from the finite -difference anywhere beyond @tol@. --} +-- | Gradient-check one SmoothLoss against its reference over a grid of points. gradCheck :: String -> SmoothLoss -> @@ -95,14 +83,11 @@ testLogisticGradient :: Test testLogisticGradient = gradCheck "logistic" logisticLoss logisticValue 1e-5 --- | The squared-hinge gradient @-2y·max(0,1-yz)@ checked against (max 0 (1-yz))². +-- | The squared-hinge gradient checked against its closed form. testSqHingeGradient :: Test testSqHingeGradient = gradCheck "squared_hinge" sqHingeLoss sqHingeValue 1e-5 -{- | Sign sanity that a self-referential check can't pass: where the loss rises -in @z@ the gradient must be positive (and vice versa). Catches a flipped-sign -gradient even with the right magnitude. --} +-- | Sign sanity: where the loss rises in z the gradient must be positive. testGradientSigns :: Test testGradientSigns = TestCase $ do assertBool @@ -124,12 +109,6 @@ "sqHinge satisfied margin: grad==0" (slGradZ sqHingeLoss 1.0 5.0 == 0) --- --------------------------------------------------------------------------- --- Statistical / distributional tests (cat 5). Tolerances are CI-derived from --- the sample size (N = 100k → 6σ band ~ 5e-3). A broken sampler — constant or --- biased — falls well outside. --- --------------------------------------------------------------------------- - -- | Draw @n@ uniforms threading the generator; returns the sample list. drawUniforms :: Int -> Gen -> [Double] drawUniforms n g0 = go n g0 [] @@ -145,10 +124,7 @@ let m = mean xs in sum [(x - m) * (x - m) | x <- xs] / fromIntegral (length xs) -{- | @nextDouble@ is ~uniform on [0,1): mean ≈ 0.5 and variance ≈ 1/12, each -within a 6σ CI for 100k samples, AND every draw is in [0,1). A constant or -out-of-range sampler fails; a biased one (mean drifts) fails. --} +-- | nextDouble is roughly uniform on [0,1): mean, variance and range checks. testUniformDistribution :: Test testUniformDistribution = TestCase $ do let n = 100000 :: Int @@ -165,10 +141,7 @@ (abs (v - 1 / 12) <= 0.01) assertBool "uniform actually varies" (maximum xs - minimum xs > 0.9) -{- | Box-Muller @gaussianVector@ produces standard normals: sample mean ≈ 0 and -variance ≈ 1 over 100k draws (6σ band ~ 2e-2). Catches a Box-Muller bug that -shifts the mean or scales the variance. --} +-- | Box-Muller gaussianVector yields standard normals: mean near 0, variance 1. testGaussianMoments :: Test testGaussianMoments = TestCase $ do let n = 100000 :: Int @@ -192,15 +165,12 @@ ("gaussian |x|>2 frequency ~0.0455, got " ++ show tail2) (abs (tail2 - 0.0455) <= 0.01) -{- | @randomSplit frac@ over many seeds: the realized train fraction matches -@frac@ within a binomial CI, and train+test always sums to the input row count -(cat 2 invariant). A split that loses/dupes rows, or ignores @frac@, fails. --} +-- | randomSplit train fraction matches frac and train plus test sums to input. testSplitProportions :: Test testSplitProportions = TestCase $ do let nRows = 4000 frac = 0.7 :: Double - df = D.fromNamedColumns [("x", DI.fromList [1 .. nRows :: Int])] + df = D.fromColumns [("x", DI.fromList [1 .. nRows :: Int])] seeds = [1 .. 25] :: [Int] seFrac = sqrt (frac * (1 - frac) / fromIntegral nRows) mapM_ @@ -225,16 +195,13 @@ ) seeds -{- | k-means inertia on a clean, well-separated blob is stable across seeds and -never beats the true within-cluster sum of squares of the generating partition. -A broken inertia would report values below the optimum or wildly seed-dependent. --} +-- | k-means inertia is seed-stable and never beats the generating partition. testKMeansInertiaStable :: Test testKMeansInertiaStable = TestCase $ do let as = [0, 0.1, -0.1, 0.05, -0.05, 10, 10.1, 9.9, 10.05, 9.95] :: [Double] bs = [0, -0.1, 0.1, 0.05, -0.05, 10, 9.9, 10.1, 9.95, 10.05] :: [Double] - df = D.fromNamedColumns [("a", DI.fromList as), ("b", DI.fromList bs)] + df = D.fromColumns [("a", DI.fromList as), ("b", DI.fromList bs)] fitSeed s = kmInertia $ fit @@ -269,15 +236,9 @@ ) (worst - best <= 1e-6 + 1e-3 * optimum) --- --------------------------------------------------------------------------- --- Reproducibility tests (cat 16). Each compares two fits with the same seed --- (determinism) and asserts a different seed CAN change the model, so a --- constant-returning stub wouldn't pass. --- --------------------------------------------------------------------------- - blobsDF :: D.DataFrame blobsDF = - D.fromNamedColumns + D.fromColumns [ ( "a" , DI.fromList ([0, 0.2, -0.1, 0.1, 8, 8.1, 7.9, 8.2, 0.05, 8.05] :: [Double]) @@ -291,15 +252,12 @@ -- | Many-cluster frame so k-means++ seeding genuinely depends on the seed. spreadDF :: D.DataFrame spreadDF = - D.fromNamedColumns + D.fromColumns [ ("a", DI.fromList ([0, 1, 2, 10, 11, 12, 20, 21, 22, 30, 31, 32] :: [Double])) , ("b", DI.fromList ([0, 1, 0, 10, 11, 10, 0, 1, 0, 10, 11, 10] :: [Double])) ] -{- | k-means: same seed → identical KMeansModel (Eq derived); a different seed -on a multi-blob frame CAN yield different centers (the seed actually drives -k-means++ init). Single-init so the seed is not washed out by nInit restarts. --} +-- | k-means: same seed gives an identical model; a different seed can differ. testKMeansReproducible :: Test testKMeansReproducible = TestCase $ do let cfg s = defaultKMeansConfig{kmK = 4, kmNInit = 1, kmMaxIter = 1, kmSeed = s} @@ -312,9 +270,7 @@ anyDiffer = any (\s -> centersFor s /= base) [2, 3, 5, 7, 11, 13] assertBool "k-means: a different seed changes the model" anyDiffer -{- | GMM: same seed → identical GMMModel (Eq derived); a different seed CAN move -the fitted means (seed drives the responsibility init via sampleIndices). --} +-- | GMM: same seed gives an identical model; a different seed can move means. testGMMReproducible :: Test testGMMReproducible = TestCase $ do let cfg s = defaultGMMConfig{gmmK = 2, gmmMaxIter = 1, gmmSeed = s} @@ -327,14 +283,11 @@ anyDiffer = any (\s -> meansFor s /= base) [2, 3, 4, 5, 6, 7, 8] assertBool "GMM: a different seed changes the means" anyDiffer -{- | RFF-SVM: same seed → identical random projection AND identical fitted SVC -coefficients; a different seed changes the random Fourier features. The model -type only derives Show, so compare representative numeric fields directly. --} +-- | RFF-SVM: same seed gives identical projection and SVC coefficients. testRFFReproducible :: Test testRFFReproducible = TestCase $ do let clsDF = - D.fromNamedColumns + D.fromColumns [ ("x", DI.fromList ([-3, -2, -1, -0.5, 0.5, 1, 2, 3] :: [Double])) , ("label", DI.fromList ([0, 0, 0, 0, 1, 1, 1, 1] :: [Int])) ] @@ -350,17 +303,9 @@ anyDiffer = any (\s -> projFor s /= base) [1, 2, 3, 6, 7, 8] assertBool "RFF: a different seed changes the projection" anyDiffer --- --------------------------------------------------------------------------- --- randomSplit determinism + row-count invariant (cat 16 + 2). --- --------------------------------------------------------------------------- - -{- | @randomSplit@ with the same seed is bit-identical (compared via the -prettyPrinted frames), preserves total rows, and a different seed CAN change the -partition. --} testSplitReproducible :: Test testSplitReproducible = TestCase $ do - let df = D.fromNamedColumns [("x", DI.fromList [1 .. 200 :: Int])] + let df = D.fromColumns [("x", DI.fromList [1 .. 200 :: Int])] (tr1, te1) = D.randomSplit (mkStdGen 42) 0.6 df (tr2, te2) = D.randomSplit (mkStdGen 42) 0.6 df assertBool "randomSplit same seed: same train" (tr1 == tr2) @@ -374,11 +319,6 @@ anyDiffer = any (\s -> trainFor s /= base) [1, 2, 3, 7, 99] assertBool "randomSplit: a different seed changes the partition" anyDiffer --- --------------------------------------------------------------------------- --- A self-consistency sanity for the helpers above so a broken reference value --- fn cannot make the gradient checks vacuous: the reference squared value must --- actually be ½(z-y)² at a known point. --- --------------------------------------------------------------------------- testReferenceValueSanity :: Test testReferenceValueSanity = TestCase $ do assertBool diff --git a/tests-internal/Learn/Numerics.hs b/tests-internal/Learn/Numerics.hs --- a/tests-internal/Learn/Numerics.hs +++ b/tests-internal/Learn/Numerics.hs @@ -4,7 +4,6 @@ import qualified Data.Vector as V import qualified Data.Vector.Unboxed as VU -import DataFrame.Model (fit, predict) import Test.HUnit import DataFrame.LinearAlgebra diff --git a/tests-internal/Learn/Symbolic.hs b/tests-internal/Learn/Symbolic.hs --- a/tests-internal/Learn/Symbolic.hs +++ b/tests-internal/Learn/Symbolic.hs @@ -35,7 +35,7 @@ testSRRecovers = TestCase $ do let xs = [-3, -2, -1, 0, 1, 2, 3, 4, 5, 6] :: [Double] df = - D.fromNamedColumns + D.fromColumns [ ("x", DI.fromList xs) , ("y", DI.fromList [x * x + x | x <- xs]) ] @@ -59,7 +59,7 @@ testSRDeterminism = TestCase $ do let xs = [1 .. 8] :: [Double] df = - D.fromNamedColumns + D.fromColumns [ ("x", DI.fromList xs) , ("y", DI.fromList (map (\x -> 2 * x + 1) xs)) ] @@ -93,7 +93,7 @@ testKernelPCA :: Test testKernelPCA = TestCase $ do let df = - D.fromNamedColumns + D.fromColumns [ ("a", DI.fromList ([0, 0.2, -0.1, 0.1, 8, 8.1, 7.9, 8.2] :: [Double])) , ("b", DI.fromList ([0, -0.1, 0.2, 0.0, 5, 5.2, 4.9, 5.1] :: [Double])) ] @@ -116,7 +116,7 @@ testRFFSVM :: Test testRFFSVM = TestCase $ do let df = - D.fromNamedColumns + D.fromColumns [ ("x", DI.fromList ([-3, -2, -1, -0.5, 0.5, 1, 2, 3] :: [Double])) , ("label", DI.fromList ([0, 0, 0, 0, 1, 1, 1, 1] :: [Int])) ] diff --git a/tests-internal/LinearSolver.hs b/tests-internal/LinearSolver.hs --- a/tests-internal/LinearSolver.hs +++ b/tests-internal/LinearSolver.hs @@ -17,7 +17,7 @@ import System.Random (mkStdGen, randomR) import Test.HUnit --- Generate n points with d features, each value uniform in [-1, 1], from a seed. +-- Generate n points of d features, each uniform in [-1, 1], from a seed. syntheticPoints :: Int -> Int -> Int -> V.Vector (VU.Vector Double) syntheticPoints seed n d = let (rows, _) = foldr step ([], mkStdGen seed) [1 .. n] @@ -65,8 +65,7 @@ predictStandardized w b x = if dotProduct w x + b > 0 then 1 else -1 --- Average binary logistic loss at (w, b); the branch on @margin@ keeps --- @log(1 + exp(-margin))@ numerically stable. +-- Average binary logistic loss at (w, b), computed stably via @margin@. logisticLoss :: V.Vector (VU.Vector Double) -> VU.Vector Double -> @@ -363,7 +362,7 @@ } expr = modelToExpr model df = - D.fromNamedColumns + D.fromColumns [ ("x", DI.fromList ([0.0, 1.0, 2.0] :: [Double])) , ("y", DI.fromList ([0.0, 0.0, 5.0] :: [Double])) ] @@ -505,8 +504,7 @@ badB = isNaN (lmIntercept m1) || isInfinite (lmIntercept m1) assertBool "no NaN/Inf after one iteration" (not (badW || badB)) --- Generate two correlated features f0, f1 with correlation ρ, plus --- noise features f2..f7. Truth is sign(f0 + f1). +-- Features f0, f1 correlated by ρ plus noise f2..f7; truth is sign(f0 + f1). correlatedPairData :: Int -> Double -> (V.Vector (VU.Vector Double), VU.Vector Double) correlatedPairData seed rho = diff --git a/tests-internal/Main.hs b/tests-internal/Main.hs --- a/tests-internal/Main.hs +++ b/tests-internal/Main.hs @@ -9,11 +9,13 @@ import qualified Cart import qualified DecisionTree +import qualified HistogramTrees import qualified Learn.EdgeCases import qualified Learn.NumericalRigor import qualified Learn.Numerics import qualified Learn.Symbolic import qualified LinearSolver +import qualified NullSplits import qualified Properties.Simplify import qualified TreePruning import qualified Worklist @@ -23,7 +25,9 @@ TestList $ Cart.tests ++ DecisionTree.tests + ++ HistogramTrees.tests ++ LinearSolver.tests + ++ NullSplits.tests ++ TreePruning.tests ++ Worklist.tests ++ Learn.Numerics.tests diff --git a/tests-internal/NullSplits.hs b/tests-internal/NullSplits.hs new file mode 100644 --- /dev/null +++ b/tests-internal/NullSplits.hs @@ -0,0 +1,155 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + +-- | Tree learners on nullable columns route null rows as fitting did. +module NullSplits (tests) where + +import Data.Either (fromRight) +import qualified Data.Text as T +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU +import Test.HUnit + +import DataFrame.Boosting.AdaBoost (AdaBoostConfig (..), defaultAdaBoostConfig) +import DataFrame.DecisionTree.Cart (buildCartTree, cartFeatures) +import DataFrame.DecisionTree.Fit (treeToExpr) +import DataFrame.DecisionTree.Regression ( + RegFit (..), + RegTreeConfig (..), + defaultRegTreeConfig, + fitRegTree, + ) +import DataFrame.DecisionTree.Types (Tree, TreeConfig (..), defaultTreeConfig) +import qualified DataFrame.Internal.Column as DI +import DataFrame.Internal.Expression (Expr (..)) +import DataFrame.Internal.Interpreter (interpret) +import DataFrame.Model (Fit (..), Predict (..)) +import qualified DataFrameApi as D + +tests :: [Test] +tests = + [ TestLabel + "null splits: in-sample == interpreted (mixed nullable frame)" + inSampleMatchesInterpret + , TestLabel "null splits: nulls join the side they fit" learnedDirection + , TestLabel "null splits: null-indicator split" nullIndicator + , TestLabel "null splits: unseen nulls still route" unseenNullsRoute + , TestLabel "null splits: CART null indicator" cartNullIndicator + , TestLabel "null splits: AdaBoost null indicator" adaBoostNullIndicator + ] + +fitAll :: + Int -> D.DataFrame -> VU.Vector Double -> (Tree Double, VU.Vector Double) +fitAll depth df y = (rfTree fitted, rfFitted fitted) + where + fitted = + fitRegTree + defaultRegTreeConfig{rtMaxDepth = depth} + (V.fromList (cartFeatures "y" df)) + y + Nothing + +interpreted :: D.DataFrame -> Tree Double -> VU.Vector Double +interpreted df = interpretedExpr df . treeToExpr + +interpretedExpr :: D.DataFrame -> Expr Double -> VU.Vector Double +interpretedExpr df e = case interpret @Double df e of + Right (DI.TColumn c) -> fromRight VU.empty (DI.toVector @Double @VU.Vector c) + Left e -> error (show e) + +withTarget :: [Double] -> [(T.Text, DI.Column)] -> D.DataFrame +withTarget y cols = D.fromColumns (("y", DI.fromList y) : cols) + +maybeCol :: (DI.Columnable a) => [Maybe a] -> DI.Column +maybeCol = DI.fromVector . V.fromList + +inSampleMatchesInterpret :: Test +inSampleMatchesInterpret = TestCase $ do + let n = 60 :: Int + rows = [0 .. n - 1] + md = + [ if i `mod` 7 == 0 + then Nothing + else Just (fromIntegral ((i * 37) `mod` 23) :: Double) + | i <- rows + ] + mi = + [if i `mod` 5 == 2 then Nothing else Just ((i * 11) `mod` 9 :: Int) | i <- rows] + mt = + [ if i `mod` 6 == 4 + then Nothing + else Just (["a", "b", "c"] !! (i `mod` 3) :: T.Text) + | i <- rows + ] + z = [fromIntegral ((i * 13) `mod` 17) :: Double | i <- rows] + y = [fromIntegral ((i * 29) `mod` 31) / 7 :: Double | i <- rows] + df = + withTarget + y + [ ("md", maybeCol md) + , ("mi", maybeCol mi) + , ("mt", maybeCol mt) + , ("z", DI.fromList z) + ] + (t, inSample) = fitAll 6 df (VU.fromList y) + assertEqual + "in-sample predictions equal the interpreted tree" + (interpreted df t) + inSample + +-- Nulls share the low x values' target, so an exact split sends nulls left. +learnedDirection :: Test +learnedDirection = TestCase $ do + let y = [0, 0, 0, 1, 1, 1, 0, 0] + x = map Just [1, 2, 3, 4, 5, 6] ++ [Nothing, Nothing] :: [Maybe Double] + df = withTarget y [("x", maybeCol x)] + (t, inSample) = fitAll 1 df (VU.fromList y) + assertEqual "fits exactly" (VU.fromList y) inSample + assertEqual "interpreted agrees" (VU.fromList y) (interpreted df t) + +nullIndicator :: Test +nullIndicator = TestCase $ do + let y = [0, 0, 0, 1, 1] + x = [Just 1, Just 2, Just 3, Nothing, Nothing] :: [Maybe Int] + df = withTarget y [("x", maybeCol x)] + (t, inSample) = fitAll 1 df (VU.fromList y) + assertEqual "fits exactly" (VU.fromList y) inSample + assertEqual "interpreted agrees" (VU.fromList y) (interpreted df t) + +unseenNullsRoute :: Test +unseenNullsRoute = TestCase $ do + let y = [0, 0, 0, 1, 1, 1] + x = map Just [1, 2, 3, 4, 5, 6] :: [Maybe Int] + (t, inSample) = fitAll 1 (withTarget y [("x", maybeCol x)]) (VU.fromList y) + testDf = withTarget y [("x", maybeCol (take 4 x ++ [Nothing, Nothing]))] + scored = interpreted testDf t + assertEqual "fits exactly" (VU.fromList y) inSample + assertEqual "present rows unchanged" (VU.take 4 inSample) (VU.take 4 scored) + assertBool + "null rows land in a leaf" + (VU.all (`elem` [0, 1]) (VU.drop 4 scored)) + +-- The target depends only on whether x is null. +indicatorFrame :: ([Double], D.DataFrame) +indicatorFrame = (y, withTarget y [("x", maybeCol x)]) + where + y = [0, 0, 0, 1, 1] + x = [Just 1, Just 2, Just 3, Nothing, Nothing] :: [Maybe Int] + +cartNullIndicator :: Test +cartNullIndicator = TestCase $ do + let (y, df) = indicatorFrame + t = + buildCartTree @Double + defaultTreeConfig{maxTreeDepth = 1, minLeafSize = 1} + "y" + df + assertEqual "fits exactly" (VU.fromList y) (interpreted df t) + +adaBoostNullIndicator :: Test +adaBoostNullIndicator = TestCase $ do + let (y, df) = indicatorFrame + cfg = defaultAdaBoostConfig{abNEstimators = 1, abMaxDepth = 1} + model = fit cfg (Col @Double "y") df + assertEqual "fits exactly" (VU.fromList y) (interpretedExpr df (predict model)) diff --git a/tests-internal/Properties/Simplify.hs b/tests-internal/Properties/Simplify.hs --- a/tests-internal/Properties/Simplify.hs +++ b/tests-internal/Properties/Simplify.hs @@ -2,10 +2,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -{- | Property tests for the simplifier and tree-pruning pass: @simplify@ -preserves denotation (over Bool and Maybe Bool, incl. NaN\/null\/boundary rows) -and is idempotent; @pruneDead@ preserves the function the tree computes. --} +-- | Property tests for the simplifier and tree-pruning pass. module Properties.Simplify (tests) where import DataFrame.DecisionTree.Predict (predictWithTree) @@ -28,7 +25,7 @@ -- A fixture spanning the interesting rows: exact thresholds, gaps, NaN, null. fixtureDF :: D.DataFrame fixtureDF = - D.fromNamedColumns + D.fromColumns [ ( "x" , DI.fromList ([10, 20, 25, 30, 35, 40, 50, 0 / 0, -(1 / 0), 1 / 0] :: [Double]) diff --git a/tests-internal/TreePruning.hs b/tests-internal/TreePruning.hs --- a/tests-internal/TreePruning.hs +++ b/tests-internal/TreePruning.hs @@ -1,9 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} -{- | Specification for the fitted-tree pruning pass ('pruneDead'): path-condition -entailment, the false-edge NaN gate, and same-branch collapse. --} +-- | Specification for the fitted-tree pruning pass (pruneDead). module TreePruning (tests) where import DataFrame.DecisionTree.Prune (pruneDead) diff --git a/tests-internal/Worklist.hs b/tests-internal/Worklist.hs --- a/tests-internal/Worklist.hs +++ b/tests-internal/Worklist.hs @@ -1,10 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} -{- | TDD spec for the saturation worklist 'saturateCandidates' replacing the -lazy generate-all 'boolExprsVec', which is kept as the behaviour-preservation -oracle. --} +-- | Spec for the saturateCandidates worklist against the boolExprsVec oracle. module Worklist (tests, props) where import DataFrame.DecisionTree.CondVec ( @@ -38,12 +35,10 @@ import Test.HUnit import Test.QuickCheck --- Fixture: x = 0..5, y = 5..0 (anti-correlated), z scrambled (independent of both). --- Note x>2 and y<3 share the truth vector [F,F,F,T,T,T], so the truth-vector mode --- must collapse them; z gives a third column for non-consolidating cross-column combos. +-- Fixture: x = 0..5, y = 5..0, z scrambled; x>2 and y<3 share a truth vector. fixtureDF :: D.DataFrame fixtureDF = - D.fromNamedColumns + D.fromColumns [ ("x", DI.fromList ([0, 1, 2, 3, 4, 5] :: [Double])) , ("y", DI.fromList ([5, 4, 3, 2, 1, 0] :: [Double])) , ("z", DI.fromList ([2, 5, 1, 4, 0, 3] :: [Double])) @@ -63,8 +58,7 @@ zGt n = mat (F.col @Double "z" .>. F.lit n) zLt n = mat (F.col @Double "z" .<. F.lit n) --- Same truth vector as 'xGt 2' ([F,F,F,T,T,T]) but eSize 4 vs 3 — a non-degenerate --- truth-vector collision for the min-eSize representative rule. +-- Same truth vector as 'xGt 2' but eSize 4 vs 3: a non-degenerate collision. notLe2 :: CondVec notLe2 = mat (F.not (F.col @Double "x" .<=. F.lit 2)) @@ -80,15 +74,14 @@ truthSet :: [CondVec] -> Set.Set [Bool] truthSet = Set.fromList . map (VU.toList . cvVec) --- Mirrors 'evalWithPenaltyVec' (DecisionTree.hs): score = (#care-point errors, eSize), --- depending only on the cached vector + size, so distinct same-vector same-size atoms tie. +-- Mirrors 'evalWithPenaltyVec': score = (#care-point errors, eSize). penBy :: [Bool] -> CondVec -> (Int, Int) penBy lbls cv = ( length (filter id (zipWith (/=) lbls (VU.toList (cvVec cv)))) , eSize (cvExpr cv) ) --- The candidate 'bestDiscreteCandidate' would select: the first 'minimumBy penalty' winner. +-- The candidate 'bestDiscreteCandidate' would select (first minimumBy winner). argminKey :: [Bool] -> [CondVec] -> String argminKey lbls = keyOf . minimumBy (compare `on` penBy lbls) @@ -99,16 +92,14 @@ base3 :: [CondVec] base3 = [xGt 2, xGt 4, yGt 2] --- x>2 and y<3 share the truth vector [F,F,F,T,T,T], so truth-vector mode collapses --- this 3-atom base to 2 distinct vectors while structural mode keeps all three. +-- x>2 and y<3 share a truth vector, so truth-vector mode collapses this base. collBase :: [CondVec] collBase = [xGt 2, yLt 3, yGt 2] --- Wider fixture (3 independent-ish columns, 10 rows) yielding many distinct truth --- vectors — broader coverage for the truth-vector floor / dedup than the 6-row x/y fixture. +-- Wider fixture (3 columns, 10 rows) with many distinct truth vectors. wideDF :: D.DataFrame wideDF = - D.fromNamedColumns + D.fromColumns [ ("a", DI.fromList ([0, 1, 2, 3, 4, 5, 6, 7, 8, 9] :: [Double])) , ("b", DI.fromList ([9, 7, 5, 3, 1, 8, 6, 4, 2, 0] :: [Double])) , ("c", DI.fromList ([1, 1, 2, 2, 3, 3, 4, 4, 5, 5] :: [Double])) @@ -127,10 +118,6 @@ , matW (F.col @Double "c" .>=. F.lit 3) ] ------------------------------------------------------------------------- --- HUnit cases ------------------------------------------------------------------------- - tests :: [Test] tests = [ TestLabel "structural: same distinct set as oracle" . TestCase $ @@ -330,10 +317,6 @@ (map keyOf (saturateCandidates TruthVector 1 fiber)) ] ------------------------------------------------------------------------- --- QuickCheck properties (over generated base pools and depths) ------------------------------------------------------------------------- - genAtom :: Gen CondVec genAtom = elements @@ -342,7 +325,7 @@ genBase :: Gen [CondVec] genBase = choose (2, 5) >>= \k -> vectorOf k genAtom --- Random label vector of the fixture's length (6 rows), for selection-preservation. +-- Random label vector of the fixture's length (6 rows). genLabels :: Gen [Bool] genLabels = vectorOf 6 (elements [False, True]) @@ -361,7 +344,6 @@ truthSet (saturateCandidates TruthVector d base) === truthSet (ref d base) -- The candidate set depends only on the base as a set, not its input order. --- (Output order tracks input order — the byte-identity contract; see selection tests.) prop_orderInvariant :: Property prop_orderInvariant = forAllBlind genBase $ \base -> @@ -371,8 +353,6 @@ keySet (saturateCandidates Structural d base) === keySet (saturateCandidates Structural d base') --- The candidate the consumer's 'minimumBy penaltyCV' selects is byte-identical to the oracle's, --- for any label vector (d >= 2 so combinations exist). This is the model-preservation contract. prop_selectionPreserved :: Property prop_selectionPreserved = forAllBlind genBase $ \base -> @@ -381,10 +361,6 @@ counterexample (show (map keyOf base, lbls, d)) $ argminKey lbls (saturateCandidates Structural d base) === argminKey lbls (ref d base) - --- The full output (order included) is byte-identical to the deduped oracle, at every depth. --- Subsumes selection-preservation for ANY (cvVec,eSize)-penalty, and stresses the --- frontier:=admitted optimisation past the depth where it could first diverge. prop_orderMatchesOracle :: Property prop_orderMatchesOracle = forAllBlind genBase $ \base -> @@ -393,8 +369,7 @@ map keyOf (saturateCandidates Structural d base) === map keyOf (nubBy ((==) `on` keyOf) (ref d base)) --- The structural key faithfully represents the 'eqExpr' quotient on the candidate domain --- (atoms and their AND/OR products): show.normalize merges exactly what eqExpr merges. +-- The structural key represents the 'eqExpr' quotient on atoms and products. genCand :: Gen CondVec genCand = oneof