dataframe 2.3.0.0 → 3.0.0.0
raw patch · 38 files changed
+1438/−5373 lines, 38 filesdep +dataframe-expr-serializerdep ~HUnitdep ~bytestringdep ~containersbinary-added
Dependencies added: dataframe-expr-serializer
Dependency ranges changed: HUnit, bytestring, containers, dataframe, dataframe-core, dataframe-csv, dataframe-csv-th, dataframe-json, dataframe-lazy, dataframe-learn, dataframe-operations, dataframe-parquet, dataframe-parquet-th, dataframe-parsing, dataframe-th, dataframe-viz, temporary, vector
Files
- CHANGELOG.md +13/−0
- app/LazyBenchmark.hs +7/−37
- app/Synthesis.hs +4/−3
- dataframe.cabal +100/−91
- ffi/DataFrame/IR.hs +2/−5
- ffi/DataFrame/IR/ExprJson.hs +0/−701
- src/DataFrame.hs +42/−229
- src/DataFrame/Typed.hs +109/−1
- src/DataFrame/Typed/TH.hs +6/−0
- tests/Cart.hs +0/−112
- tests/DecisionTree.hs +0/−1384
- tests/IO/CsvGolden.hs +6/−10
- tests/IR/ExprJsonRoundtrip.hs +209/−0
- tests/Internal/Markdown.hs +4/−3
- tests/LazyParity.hs +7/−13
- tests/LazyParquet.hs +2/−2
- tests/Learn/EdgeCases.hs +0/−481
- tests/Learn/Ensembles.hs +11/−7
- tests/Learn/MetricsTests.hs +0/−5
- tests/Learn/Models.hs +83/−2
- tests/Learn/NumericalRigor.hs +0/−438
- tests/Learn/Numerics.hs +0/−99
- tests/Learn/Segmented.hs +316/−0
- tests/Learn/SklearnParity.hs +3/−5
- tests/Learn/Symbolic.hs +0/−134
- tests/Learn/TypedModel.hs +113/−0
- tests/LinearSolver.hs +0/−828
- tests/Main.hs +13/−25
- tests/Operations/Apply.hs +16/−0
- tests/Operations/Record.hs +6/−5
- tests/Parquet.hs +26/−1
- tests/PrettyPrint.hs +70/−0
- tests/Properties/Simplify.hs +0/−172
- tests/TreePruning.hs +0/−114
- tests/Typed/IOReaders.hs +65/−0
- tests/Typed/Parity.hs +205/−0
- tests/Worklist.hs +0/−466
- tests/data/timestamp_nanos.parquet binary
CHANGELOG.md view
@@ -1,5 +1,18 @@ # Revision history for dataframe +## 3.0.0.0++A breaking release that removes internal functions from the public API.++### Highlights+* Internalish modules now have public APIs/contracts. `DataFrame.Core`, `DataFrame.Schema`, and `DataFrame.Learn`.+* `import DataFrame` now surfaces `Columnable`, `Columnable'`, `eSize`, `NamedExpr`,+ `SchemaType(..)`, and the `Semigroup`/`Monoid DataFrame` instances directly.++### Breaking changes+* Internal modules are no longer on the public surface.+* Subpackage major bumps.+ ## 2.3.0.0 ### Breaking changes
app/LazyBenchmark.hs view
@@ -2,21 +2,14 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} -{- | End-to-end smoke test and benchmark for the Lazy streaming API.+{- | End-to-end smoke test and benchmark for the Lazy streaming API:+ generate a CSV then run five Lazy queries over it. Usage:- cabal run lazy-bench [-- [OPTIONS]]-- Options:- --rows N Number of rows to generate (default: 1_000_000_000)- --file PATH Output CSV path (default: /tmp/lazy_1b.csv)- --skip-gen Skip generation if the file already exists-- The executable generates a CSV file (streaming, constant memory) then- runs five Lazy queries over it, printing timing and result summaries.-- For heap/GC stats run with:- cabal run lazy-bench -- +RTS -s -RTS+ cabal run lazy-bench [-- [OPTIONS]] (+RTS -s -RTS for heap stats)+ --rows N rows to generate (default 1_000_000_000)+ --file PATH output CSV path (default /tmp/lazy_1b.csv)+ --skip-gen reuse the file if it already exists -} module Main where @@ -26,9 +19,9 @@ import qualified Data.Text as T import Data.Time (UTCTime, diffUTCTime, getCurrentTime) import qualified DataFrame as D-import DataFrame.Internal.Schema (Schema (..), schemaType) import qualified DataFrame.Lazy as L import DataFrame.Operators+import DataFrame.Schema (Schema (..), schemaType) import System.Directory (doesFileExist, getFileSize) import System.Environment (getArgs) import System.Exit (exitFailure)@@ -185,9 +178,6 @@ n = optRows opts pathT = T.pack path - -- ------------------------------------------------------------------------ -- Phase 1: Generate- -- ----------------------------------------------------------------------- putStrLn "=== Lazy API 1B-row benchmark ===" putStrLn $ " rows : " ++ commas n putStrLn $ " file : " ++ path@@ -205,12 +195,8 @@ sz <- getFileSize path putStrLn $ " file size: " ++ showBytes sz - -- ------------------------------------------------------------------------ -- Phase 2: Lazy queries- -- ----------------------------------------------------------------------- putStrLn "\nPhase 2: Lazy queries" - -- Schema for the generated CSV: id (Int), x (Double), y (Double), category (Text) let schema = Schema $ M.fromList@@ -220,25 +206,17 @@ , ("category", schemaType @T.Text) ] - -- Q1: Preview — limit 20, no filter.- -- Demonstrates that the executor reads only the first batch. runQuery "Q1 — preview first 20 rows (no filter)" $ L.runDataFrame $ L.take 20 $ L.scanCsv schema pathT - -- Q2: Filter + limit.- -- x > 0.999 ≈ 0.1% of rows. With a 512K-row batch the executor finds- -- ~512 matches in the first batch and stops — reads only one batch. runQuery "Q2 — filter (x > 0.999), limit 20" $ L.runDataFrame $ L.take 20 $ L.filter (col @Double "x" .> lit (0.999 :: Double)) $ L.scanCsv schema pathT - -- Q3: Filter + derive + select + limit.- -- Shows projection pushdown: only id/x/y/category are read, z is derived.- -- Predicate pushdown moves the filter into the scan batch loop. runQuery "Q3 — filter (x > 0.999), derive z = x*y, select [id,z], limit 20" $ L.runDataFrame $ L.take 20 $@@ -247,10 +225,6 @@ L.filter (col @Double "x" .> lit (0.999 :: Double)) $ L.scanCsv schema pathT - -- Q4: Filter fusion demo.- -- Two consecutive filters are fused into one AND predicate by the optimizer.- -- Result: rows where x > 0.5 AND y > 0.5 (≈ 25% of total).- -- We limit to keep result size manageable. runQuery "Q4 — filter fusion: (x > 0.5) . (y > 0.5), limit 20" $ L.runDataFrame $ L.take 20 $@@ -258,10 +232,6 @@ L.filter (col @Double "x" .> lit (0.5 :: Double)) $ L.scanCsv schema pathT - -- Q5: Full scan, heavy filter, count results.- -- x > 0.999 across the whole file ≈ 0.1% × N rows.- -- For 1B rows that is ~1M results — materialised into one DataFrame.- -- This query exercises streaming across all batches. runQuery ( "Q5 — full scan, filter (x > 0.999), count (~" ++ approx (n `div` 1000)
app/Synthesis.hs view
@@ -47,8 +47,8 @@ D.randomSplit (mkStdGen 4232) 0.7 (DT.thaw (clean train)) testDf = DT.thaw (clean test) - model =- fitDecisionTree+ fitted =+ fit ( defaultTreeConfig { maxTreeDepth = 5 , minSamplesSplit = 5@@ -68,8 +68,9 @@ ) (F.fromMaybe 0 (F.col @(Maybe Int) "Survived")) (trainDf |> D.exclude ["PassengerId"])+ model = predict fitted - print model+ print fitted putStrLn "Training accuracy: " print $ computeAccuracy (trainDf |> D.derive (F.name prediction) model)
dataframe.cabal view
@@ -1,6 +1,6 @@-cabal-version: 3.0+cabal-version: 3.4 name: dataframe-version: 2.3.0.0+version: 3.0.0.0 synopsis: A fast, safe, and intuitive DataFrame library. description: A fast, safe, and intuitive DataFrame library for exploratory data analysis.@@ -54,7 +54,7 @@ default: False manual: True description: Exclude the Parquet reader/writer (@dataframe-parquet@- plus pinch, zstd, snappy, streamly). Enable with+ plus pinch, zstd, snappy). Enable with @-f +no-parquet@. (Reading Parquet from HuggingFace lives in the separate @dataframe-huggingface@ package, which is not a dependency of this meta-package.)@@ -82,20 +82,8 @@ DataFrame.Display.Web.Plot, DataFrame.Display.Web.Chart, DataFrame.Display.Web.Chart.Typed,- DataFrame.Internal.Types,- DataFrame.Internal.Expression,- DataFrame.Internal.Grouping,- DataFrame.Internal.Interpreter,- DataFrame.Internal.Nullable,- DataFrame.Internal.Parsing,- DataFrame.Internal.Column,- DataFrame.Internal.Binary,- DataFrame.Internal.Statistics,- DataFrame.Display.Terminal.PrettyPrint,- DataFrame.Display.Terminal.Colours,- DataFrame.Internal.DataFrame,- DataFrame.Internal.Row,- DataFrame.Internal.Schema,+ DataFrame.Core,+ DataFrame.Schema, DataFrame.Errors, DataFrame.Operations.Core, DataFrame.Operations.Join,@@ -111,7 +99,24 @@ DataFrame.Display.Terminal.Plot, DataFrame.Monad, DataFrame.DecisionTree,+ DataFrame.Model,+ DataFrame.ModelSelection,+ DataFrame.LinearModel,+ DataFrame.LinearModel.Regression,+ DataFrame.LinearModel.Logistic,+ DataFrame.Segmented,+ DataFrame.SVM,+ DataFrame.KMeans,+ DataFrame.PCA,+ DataFrame.DBSCAN,+ DataFrame.GMM,+ DataFrame.Boosting,+ DataFrame.Boosting.GBM,+ DataFrame.Boosting.AdaBoost,+ DataFrame.Metrics, DataFrame.IO.JSON,+ DataFrame.Expr.Serialize,+ DataFrame.IR.ExprJson, DataFrame.Typed.Types, DataFrame.Typed.Schema, DataFrame.Typed.Freeze,@@ -123,16 +128,18 @@ DataFrame.Typed.Record, DataFrame.Typed.Generic build-depends: base >= 4 && <5,- dataframe-core ^>= 1.1,- dataframe-json ^>= 1.0,- dataframe-operations >= 1.1.1 && < 1.2,- dataframe-parsing ^>= 1.0.2,- dataframe-viz ^>= 1.0.3,- dataframe-learn ^>= 1.1+ dataframe-core >= 2.0 && < 2.1,+ dataframe-json >= 1.1 && < 1.2,+ dataframe-expr-serializer >= 1.1 && < 1.2,+ dataframe-operations >= 2.0 && < 2.1,+ dataframe-parsing >= 2.0 && < 2.1,+ dataframe-viz >= 1.1 && < 1.2,+ dataframe-learn >= 2.0 && < 2.1 if !flag(no-csv)- reexported-modules: DataFrame.IO.CSV- build-depends: dataframe-csv ^>= 1.0.2+ reexported-modules: DataFrame.IO.CSV,+ DataFrame.Typed.IO.CSV+ build-depends: dataframe-csv >= 2.0 && < 2.1 cpp-options: -DWITH_CSV if !flag(no-parquet)@@ -148,8 +155,9 @@ DataFrame.IO.Parquet.Utils, DataFrame.IO.Parquet.Seeking, DataFrame.IO.Parquet.Time,- DataFrame.IO.Utils.RandomAccess- build-depends: dataframe-parquet ^>= 1.1+ DataFrame.IO.Utils.RandomAccess,+ DataFrame.Typed.IO.Parquet+ build-depends: dataframe-parquet >= 1.2 && < 1.3 cpp-options: -DWITH_PARQUET -- The lazy executor calls both CSV and Parquet readers directly, so@@ -158,27 +166,22 @@ reexported-modules: DataFrame.Lazy, DataFrame.Lazy.IO.Binary, DataFrame.Lazy.IO.CSV,- DataFrame.Lazy.Internal.DataFrame,- DataFrame.Lazy.Internal.LogicalPlan,- DataFrame.Lazy.Internal.PhysicalPlan,- DataFrame.Lazy.Internal.Optimizer,- DataFrame.Lazy.Internal.Executor, DataFrame.Typed.Lazy- build-depends: dataframe-lazy ^>= 1.1+ build-depends: dataframe-lazy >= 2.0 && < 2.1 cpp-options: -DWITH_LAZY if !flag(no-th)- build-depends: dataframe-th ^>= 1.0.1.1+ build-depends: dataframe-th >= 2.0 && < 2.1 cpp-options: -DWITH_TH exposed-modules: DataFrame.TH, DataFrame.Typed.TH if !flag(no-th) && !flag(no-csv)- build-depends: dataframe-csv-th ^>= 1.0+ build-depends: dataframe-csv-th >= 1.1 && < 1.2 cpp-options: -DWITH_CSV_TH if !flag(no-th) && !flag(no-parquet)- build-depends: dataframe-parquet-th ^>= 1.0+ build-depends: dataframe-parquet-th >= 1.1 && < 1.2 cpp-options: -DWITH_PARQUET_TH hs-source-dirs: src@@ -190,25 +193,29 @@ hs-source-dirs: ffi exposed-modules: DataFrame.IO.Arrow DataFrame.IR- DataFrame.IR.ExprJson+ -- The expr/pipeline JSON codec now lives in its own lightweight package;+ -- re-export it so the Python FFI and Haskell consumers keep importing+ -- @DataFrame.IR.ExprJson@ unchanged.+ reexported-modules: DataFrame.IR.ExprJson -- The Arrow bridge IR loads CSV + Parquet readers, so it requires -- both backends. If either flag is off, skip building it. if flag(no-csv) || flag(no-parquet) buildable: False build-depends: base >= 4 && < 5,- dataframe-core ^>= 1.1,- dataframe-csv ^>= 1.0.2,- dataframe-json ^>= 1.0,- dataframe-lazy ^>= 1.1,- dataframe-operations >= 1.1.1 && < 1.2,- dataframe-parquet ^>= 1.1,- dataframe-parsing ^>= 1.0.2,+ dataframe-core:internal >= 2.0 && < 2.1,+ dataframe-expr-serializer >= 1.1 && < 1.2,+ dataframe-csv >= 2.0 && < 2.1,+ dataframe-json >= 1.1 && < 1.2,+ dataframe-lazy >= 2.0 && < 2.1,+ dataframe-operations >= 2.0 && < 2.1,+ dataframe-parquet >= 1.2 && < 1.3,+ dataframe-parsing >= 2.0 && < 2.1, text >= 2.1 && < 3, aeson >= 0.11 && < 3,- bytestring >= 0.11 && < 0.13,- containers >= 0.6.7 && < 0.9,- vector ^>= 0.13+ bytestring >= 0.11 && < 0.14,+ containers >= 0.6.7 && < 0.10,+ vector >= 0.13 && < 0.15 include-dirs: cbits default-language: Haskell2010 @@ -216,11 +223,11 @@ import: warnings main-is: Benchmark.hs build-depends: base >= 4 && < 5,- dataframe >= 1 && < 3,- dataframe-operations >= 1.1.1 && < 1.2,+ dataframe >= 3.0 && < 3.1,+ dataframe-operations >= 2.0 && < 2.1, random >= 1 && < 2, time >= 1.12 && < 2,- vector ^>= 0.13,+ vector >= 0.13 && < 0.15, hs-source-dirs: app default-language: Haskell2010 ghc-options: -rtsopts -threaded -with-rtsopts=-N@@ -229,10 +236,10 @@ import: warnings main-is: Synthesis.hs build-depends: base >= 4 && < 5,- dataframe >= 1 && < 3,- dataframe-core ^>= 1.1,- dataframe-learn ^>= 1.1,- dataframe-operations >= 1.1.1 && < 1.2,+ dataframe >= 3.0 && < 3.1,+ dataframe-core >= 2.0 && < 2.1,+ dataframe-learn >= 2.0 && < 2.1,+ dataframe-operations >= 2.0 && < 2.1, random >= 1 && < 2, text >= 2.1 && < 3 hs-source-dirs: app@@ -261,12 +268,12 @@ if flag(no-csv) || flag(no-parquet) buildable: False build-depends: base >= 4 && < 5,- bytestring >= 0.11 && < 0.13,- containers >= 0.6.7 && < 0.9,- dataframe >= 1 && < 3,- dataframe-core ^>= 1.1,- dataframe-lazy ^>= 1.1,- dataframe-parsing ^>= 1.0.2,+ bytestring >= 0.11 && < 0.14,+ containers >= 0.6.7 && < 0.10,+ dataframe >= 3.0 && < 3.1,+ dataframe-core >= 2.0 && < 2.1,+ dataframe-lazy >= 2.0 && < 2.1,+ dataframe-parsing >= 2.0 && < 2.1, directory >= 1.3.0.0 && < 2, random >= 1 && < 2, text >= 2.1 && < 3,@@ -284,7 +291,9 @@ criterion >= 1 && < 2, deepseq >= 1.4 && < 2, process >= 1.6 && < 2,- dataframe >= 1 && < 3,+ dataframe >= 3.0 && < 3.1,+ dataframe-core:internal >= 2.0 && < 2.1,+ dataframe-operations >= 2.0 && < 2.1, random >= 1 && < 2, default-language: Haskell2010 ghc-options:@@ -304,8 +313,6 @@ if flag(no-csv) || flag(no-parquet) || flag(no-th) buildable: False other-modules: Assertions,- Cart,- DecisionTree, Functions, GenDataFrame, Internal.ColumnBuilder,@@ -314,21 +321,20 @@ Internal.PackedText, Internal.Parsing, PackedTextMigration,- Learn.Numerics,+ PrettyPrint, Learn.Denotation, Learn.Models,+ Learn.TypedModel,+ Learn.Segmented, Learn.Ensembles,- Learn.Symbolic, Learn.SklearnParity, Learn.Synthesis, Learn.MetricsTests, Learn.Metamorphic,- Learn.EdgeCases,- Learn.NumericalRigor, IO.CSV, IO.CsvGolden, IO.JSON,- LinearSolver,+ IR.ExprJsonRoundtrip, Operations.Aggregations, Operations.Apply, Operations.Core,@@ -363,33 +369,36 @@ Plotting, Properties, Properties.Categorical,- Properties.Simplify, Simplify,- TreePruning,- Worklist,+ Typed.Parity,+ Typed.IOReaders, Monad build-depends: base >= 4 && < 5, aeson >= 0.11.0.0 && < 3,- bytestring >= 0.11 && < 0.13,- dataframe >= 1 && < 3,- dataframe-core ^>= 1.1,- dataframe-csv ^>= 1.0.2,- dataframe-json ^>= 1.0,- dataframe-lazy ^>= 1.1,- dataframe-learn ^>= 1.1,- dataframe-operations >= 1.1.1 && < 1.2,- dataframe-parquet ^>= 1.1,- dataframe-parsing ^>= 1.0.2,- HUnit ^>= 1.6,+ bytestring >= 0.11 && < 0.14,+ dataframe >= 3.0 && < 3.1,+ dataframe-core >= 2.0 && < 2.1,+ dataframe-core:internal >= 2.0 && < 2.1,+ dataframe-csv >= 2.0 && < 2.1,+ dataframe-expr-serializer >= 1.1 && < 1.2,+ dataframe-json >= 1.1 && < 1.2,+ dataframe-lazy >= 2.0 && < 2.1,+ dataframe-learn >= 2.0 && < 2.1,+ dataframe-operations >= 2.0 && < 2.1,+ dataframe-operations:internal >= 2.0 && < 2.1,+ dataframe-parquet >= 1.2 && < 1.3,+ dataframe-parsing >= 2.0 && < 2.1,+ dataframe-parsing:internal >= 2.0 && < 2.1,+ HUnit >= 1.6 && < 1.8, QuickCheck >= 2 && < 3, random-shuffle >= 0.0.4 && < 1, random >= 1 && < 2, text >= 2.1 && < 3, time >= 1.12 && < 2,- vector ^>= 0.13,- temporary >= 1.3 && < 1.4,+ vector >= 0.13 && < 0.15,+ temporary >= 1.3 && < 1.5, directory >= 1.3 && < 1.4,- containers >= 0.6.7 && < 0.9+ containers >= 0.6.7 && < 0.10 hs-source-dirs: tests default-language: Haskell2010 @@ -403,12 +412,12 @@ buildable: False other-modules: Internal.PackedText build-depends: base >= 4 && < 5,- bytestring >= 0.11 && < 0.13,- dataframe >= 1 && < 3,- dataframe-core ^>= 1.1,- dataframe-operations >= 1.1.1 && < 1.2,- HUnit ^>= 1.6,+ bytestring >= 0.11 && < 0.14,+ dataframe >= 3.0 && < 3.1,+ dataframe-core:internal >= 2.0 && < 2.1,+ dataframe-operations >= 2.0 && < 2.1,+ HUnit >= 1.6 && < 1.8, text >= 2.1 && < 3,- vector ^>= 0.13+ vector >= 0.13 && < 0.15 hs-source-dirs: tests default-language: Haskell2010
ffi/DataFrame/IR.hs view
@@ -49,7 +49,6 @@ import DataFrame.Internal.Column (Column (..), Columnable) import DataFrame.Internal.DataFrame (DataFrame, unsafeGetColumn) import DataFrame.Internal.Expression (Expr (..), NamedExpr)-import DataFrame.Internal.Schema (Schema, makeSchema, schemaType) import qualified DataFrame.Lazy as Lazy import DataFrame.Operations.Aggregation (aggregate, distinct, groupBy) import DataFrame.Operations.Core (insertVector, renameMany)@@ -60,6 +59,7 @@ import qualified DataFrame.Operations.Subset as Subset import DataFrame.Operations.Transformations (derive) import DataFrame.Operators ((.=))+import DataFrame.Schema (Schema, makeSchema, schemaType) -- --------------------------------------------------------------------------- -- IR types@@ -225,8 +225,7 @@ let r = Stats.correlation a b df valueCol = case r of Just d -> V.singleton d- Nothing -> V.singleton (0 / 0 :: Double) -- NaN when correlation is undefined- -- Return a single-row frame: { first, second, correlation }+ Nothing -> V.singleton (0 / 0 :: Double) return $ insertVector "first" (V.singleton a) $ insertVector "second" (V.singleton b) $@@ -239,8 +238,6 @@ executePlan reader (WriteCsv path node) = do df <- executePlan reader node writeCsv path df- -- Return the same frame so callers that pipe through .collect() get the- -- written data back too. Callers that don't care can discard. return df executePlan reader (ScanCsv path schemaPairs) = do schema <- buildSchema schemaPairs
− ffi/DataFrame/IR/ExprJson.hs
@@ -1,701 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE ExplicitNamespaces #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}--{- | JSON wire format for 'Expr' values.-- The Python bindings build expression trees as JSON; this module decodes them- back into 'Expr' GADTs (typed) and encodes them in the reverse direction- (used for shipping fitted decision trees back to Python).-- Encoded shape:-- > { "node": "col" , "out_type": "double", "name": "x" }- > { "node": "lit" , "out_type": "int" , "value": 42 }- > { "node": "unary" , "out_type": "double", "op": "toDouble"- > , "arg_type": "int" , "arg": <expr> }- > { "node": "binary", "out_type": "bool" , "op": "leq"- > , "arg_type": "double", "lhs": <expr>, "rhs": <expr> }- > { "node": "if" , "out_type": "text" , "cond": <expr>- > , "then": <expr>, "else": <expr> }-- Operator names follow 'binaryName' / 'unaryName' from- "DataFrame.Internal.Expression". Nullable variants ("nulladd", "nullor", …)- are accepted on decode and treated as their non-null equivalents — Python- data crosses the FFI boundary as non-null Arrow buffers, so this is lossless- for the supported workflow.--}-module DataFrame.IR.ExprJson (- SomeExpr (..),- encodeExpr,- encodeExprToBytes,- decodeExprAny,- decodeExprAt,- parseSomeExpr,- typeTagOf,- withTypeTag,- withOrdTypeTag,- withNumTypeTag,- withFracTypeTag,- withRealTypeTag,-) where--import Data.Aeson (object, (.:), (.=))-import qualified Data.Aeson as Aeson-import qualified Data.Aeson.Types as Aeson-import qualified Data.ByteString as BS-import qualified Data.ByteString.Lazy as BL-import Data.Int (Int16, Int32, Int64, Int8)-import Data.Proxy (Proxy (..))-import qualified Data.Text as T-import Data.Type.Equality (TestEquality (testEquality), type (:~:) (Refl))-import Data.Word (Word16, Word32, Word64, Word8)-import Type.Reflection (TypeRep, Typeable, typeRep)--import qualified DataFrame.Functions as F-import DataFrame.Internal.Column (Columnable)-import DataFrame.Internal.Expression (- AggStrategy (..),- BinaryOp (binaryName),- Expr (..),- UnaryOp (unaryName),- )-import qualified DataFrame.Internal.Expression as F-import DataFrame.Operators (- ifThenElse,- (.&&.),- (./=.),- (.<.),- (.<=.),- (.==.),- (.>.),- (.>=.),- (.||.),- )--{- | Existential wrapper around a typed expression decoded from JSON.-TODO: mchavinda - Maybe consolidate with UExpr from the main package.--}-data SomeExpr where- SomeExpr :: (Columnable a) => TypeRep a -> Expr a -> SomeExpr---- | Map a Haskell type to its wire-format tag string.-typeTagOf :: forall a. (Typeable a) => Maybe T.Text-typeTagOf- | Just _ <- testEquality (typeRep @a) (typeRep @Int) = Just "int"- | Just _ <- testEquality (typeRep @a) (typeRep @Int8) = Just "int8"- | Just _ <- testEquality (typeRep @a) (typeRep @Int16) = Just "int16"- | Just _ <- testEquality (typeRep @a) (typeRep @Int32) = Just "int32"- | Just _ <- testEquality (typeRep @a) (typeRep @Int64) = Just "int64"- | Just _ <- testEquality (typeRep @a) (typeRep @Word) = Just "word"- | Just _ <- testEquality (typeRep @a) (typeRep @Word8) = Just "word8"- | Just _ <- testEquality (typeRep @a) (typeRep @Word16) = Just "word16"- | Just _ <- testEquality (typeRep @a) (typeRep @Word32) = Just "word32"- | Just _ <- testEquality (typeRep @a) (typeRep @Word64) = Just "word64"- | Just _ <- testEquality (typeRep @a) (typeRep @Integer) = Just "integer"- | Just _ <- testEquality (typeRep @a) (typeRep @Double) = Just "double"- | Just _ <- testEquality (typeRep @a) (typeRep @Float) = Just "float"- | Just _ <- testEquality (typeRep @a) (typeRep @Bool) = Just "bool"- | Just _ <- testEquality (typeRep @a) (typeRep @Char) = Just "char"- | Just _ <- testEquality (typeRep @a) (typeRep @T.Text) = Just "text"- | Just _ <- testEquality (typeRep @a) (typeRep @String) = Just "string"- | otherwise = Nothing---- | Dispatch on a type tag with a 'Columnable' continuation.-withTypeTag ::- T.Text ->- (forall a. (Columnable a) => Proxy a -> Aeson.Parser r) ->- Aeson.Parser r-withTypeTag t k = case t of- "int" -> k (Proxy @Int)- "int8" -> k (Proxy @Int8)- "int16" -> k (Proxy @Int16)- "int32" -> k (Proxy @Int32)- "int64" -> k (Proxy @Int64)- "word" -> k (Proxy @Word)- "word8" -> k (Proxy @Word8)- "word16" -> k (Proxy @Word16)- "word32" -> k (Proxy @Word32)- "word64" -> k (Proxy @Word64)- "integer" -> k (Proxy @Integer)- "double" -> k (Proxy @Double)- "float" -> k (Proxy @Float)- "bool" -> k (Proxy @Bool)- "char" -> k (Proxy @Char)- "text" -> k (Proxy @T.Text)- "string" -> k (Proxy @String)- _ -> fail $ "DataFrame.IR.ExprJson: unknown type tag: " <> T.unpack t---- | Subset that supports 'Ord' (for comparison ops).-withOrdTypeTag ::- T.Text ->- (forall a. (Columnable a, Ord a) => Proxy a -> Aeson.Parser r) ->- Aeson.Parser r-withOrdTypeTag t k = case t of- "int" -> k (Proxy @Int)- "int8" -> k (Proxy @Int8)- "int16" -> k (Proxy @Int16)- "int32" -> k (Proxy @Int32)- "int64" -> k (Proxy @Int64)- "word" -> k (Proxy @Word)- "word8" -> k (Proxy @Word8)- "word16" -> k (Proxy @Word16)- "word32" -> k (Proxy @Word32)- "word64" -> k (Proxy @Word64)- "integer" -> k (Proxy @Integer)- "double" -> k (Proxy @Double)- "float" -> k (Proxy @Float)- "bool" -> k (Proxy @Bool)- "char" -> k (Proxy @Char)- "text" -> k (Proxy @T.Text)- "string" -> k (Proxy @String)- _ ->- fail $ "DataFrame.IR.ExprJson: type does not support ordering: " <> T.unpack t---- | Subset that supports 'Num' (arithmetic).-withNumTypeTag ::- T.Text ->- (forall a. (Columnable a, Num a) => Proxy a -> Aeson.Parser r) ->- Aeson.Parser r-withNumTypeTag t k = case t of- "int" -> k (Proxy @Int)- "int8" -> k (Proxy @Int8)- "int16" -> k (Proxy @Int16)- "int32" -> k (Proxy @Int32)- "int64" -> k (Proxy @Int64)- "word" -> k (Proxy @Word)- "word8" -> k (Proxy @Word8)- "word16" -> k (Proxy @Word16)- "word32" -> k (Proxy @Word32)- "word64" -> k (Proxy @Word64)- "integer" -> k (Proxy @Integer)- "double" -> k (Proxy @Double)- "float" -> k (Proxy @Float)- _ ->- fail $ "DataFrame.IR.ExprJson: type does not support arithmetic: " <> T.unpack t---- | Subset that supports 'Fractional' (division).-withFracTypeTag ::- T.Text ->- (forall a. (Columnable a, Fractional a) => Proxy a -> Aeson.Parser r) ->- Aeson.Parser r-withFracTypeTag t k = case t of- "double" -> k (Proxy @Double)- "float" -> k (Proxy @Float)- _ ->- fail $- "DataFrame.IR.ExprJson: type does not support fractional division: "- <> T.unpack t---- | Subset that supports 'Real' (used by toDouble source types).-withRealTypeTag ::- T.Text ->- (forall a. (Columnable a, Real a) => Proxy a -> Aeson.Parser r) ->- Aeson.Parser r-withRealTypeTag t k = case t of- "int" -> k (Proxy @Int)- "int8" -> k (Proxy @Int8)- "int16" -> k (Proxy @Int16)- "int32" -> k (Proxy @Int32)- "int64" -> k (Proxy @Int64)- "word" -> k (Proxy @Word)- "word8" -> k (Proxy @Word8)- "word16" -> k (Proxy @Word16)- "word32" -> k (Proxy @Word32)- "word64" -> k (Proxy @Word64)- "integer" -> k (Proxy @Integer)- "double" -> k (Proxy @Double)- "float" -> k (Proxy @Float)- _ ->- fail $- "DataFrame.IR.ExprJson: type does not support Real (toDouble source): "- <> T.unpack t---- | Subset that supports 'Floating'.-withFloatingTypeTag ::- T.Text ->- (forall a. (Columnable a, Floating a) => Proxy a -> Aeson.Parser r) ->- Aeson.Parser r-withFloatingTypeTag t k = case t of- "double" -> k (Proxy @Double)- "float" -> k (Proxy @Float)- _ ->- fail $ "DataFrame.IR.ExprJson: type does not support Floating: " <> T.unpack t--{- | Encode an 'Expr' to a JSON value. Returns 'Left' on unsupported-constructors (Agg, Over, CastWith, CastExprWith) or unsupported operator-names (binaryUdf, unaryUdf, …).--}-encodeExpr :: forall a. (Columnable a) => Expr a -> Either String Aeson.Value-encodeExpr expr = case expr of- Col name -> do- outTag <- requireTypeTag @a- Right $- object- [ "node" .= ("col" :: T.Text)- , "out_type" .= outTag- , "name" .= name- ]- Lit v -> do- outTag <- requireTypeTag @a- litVal <- encodeLit @a v- Right $- object- [ "node" .= ("lit" :: T.Text)- , "out_type" .= outTag- , "value" .= litVal- ]- Unary op (arg :: Expr b) -> do- outTag <- requireTypeTag @a- argTag <- requireTypeTag @b- opTag <- recognizeUnary (unaryName op)- argEnc <- encodeExpr arg- Right $- object- [ "node" .= ("unary" :: T.Text)- , "out_type" .= outTag- , "op" .= opTag- , "arg_type" .= argTag- , "arg" .= argEnc- ]- Binary op (lhs :: Expr c) (rhs :: Expr b) -> do- outTag <- requireTypeTag @a- argTag <- requireTypeTag @c- opTag <- recognizeBinary (binaryName op)- lEnc <- encodeExpr lhs- rEnc <- encodeExpr rhs- Right $- object- [ "node" .= ("binary" :: T.Text)- , "out_type" .= outTag- , "op" .= opTag- , "arg_type" .= argTag- , "lhs" .= lEnc- , "rhs" .= rEnc- ]- If cond th el -> do- outTag <- requireTypeTag @a- cEnc <- encodeExpr cond- tEnc <- encodeExpr th- eEnc <- encodeExpr el- Right $- object- [ "node" .= ("if" :: T.Text)- , "out_type" .= outTag- , "cond" .= cEnc- , "then" .= tEnc- , "else" .= eEnc- ]- CastWith{} ->- Left- "DataFrame.IR.ExprJson.encodeExpr: CastWith is not supported in the wire format"- CastExprWith{} ->- Left- "DataFrame.IR.ExprJson.encodeExpr: CastExprWith is not supported in the wire format"- Agg (strat :: F.AggStrategy a b) (inner :: F.Expr b) -> do- outTag <- requireTypeTag @a- argTag <- requireTypeTag @b- innerEnc <- encodeExpr inner- Right $- object- [ "node" .= ("agg" :: T.Text)- , "out_type" .= outTag- , "agg" .= aggStrategyName strat- , "arg_type" .= argTag- , "arg" .= innerEnc- ]- Over names inner -> do- outTag <- requireTypeTag @a- innerEnc <- encodeExpr inner- Right $- object- [ "node" .= ("over" :: T.Text)- , "out_type" .= outTag- , "partition_by" .= names- , "arg" .= innerEnc- ]- where- requireTypeTag :: forall x. (Typeable x) => Either String T.Text- requireTypeTag = case typeTagOf @x of- Just t -> Right t- Nothing ->- Left $- "DataFrame.IR.ExprJson.encodeExpr: unsupported type: " <> show (typeRep @x)---- | Wire-format name for an aggregation strategy.-aggStrategyName :: AggStrategy a b -> T.Text-aggStrategyName (CollectAgg n _) = n-aggStrategyName (FoldAgg n _ _) = n-aggStrategyName (MergeAgg n _ _ _ _) = n---- | Encode an 'Expr' to a strict 'BS.ByteString' of JSON.-encodeExprToBytes ::- forall a. (Columnable a) => Expr a -> Either String BS.ByteString-encodeExprToBytes e = BL.toStrict . Aeson.encode <$> encodeExpr e--encodeLit :: forall a. (Columnable a) => a -> Either String Aeson.Value-encodeLit v- | Just Refl <- testEquality (typeRep @a) (typeRep @Int) =- Right $ Aeson.toJSON (v :: Int)- | Just Refl <- testEquality (typeRep @a) (typeRep @Int8) =- Right $ Aeson.toJSON (v :: Int8)- | Just Refl <- testEquality (typeRep @a) (typeRep @Int16) =- Right $ Aeson.toJSON (v :: Int16)- | Just Refl <- testEquality (typeRep @a) (typeRep @Int32) =- Right $ Aeson.toJSON (v :: Int32)- | Just Refl <- testEquality (typeRep @a) (typeRep @Int64) =- Right $ Aeson.toJSON (v :: Int64)- | Just Refl <- testEquality (typeRep @a) (typeRep @Word) =- Right $ Aeson.toJSON (v :: Word)- | Just Refl <- testEquality (typeRep @a) (typeRep @Word8) =- Right $ Aeson.toJSON (v :: Word8)- | Just Refl <- testEquality (typeRep @a) (typeRep @Word16) =- Right $ Aeson.toJSON (v :: Word16)- | Just Refl <- testEquality (typeRep @a) (typeRep @Word32) =- Right $ Aeson.toJSON (v :: Word32)- | Just Refl <- testEquality (typeRep @a) (typeRep @Word64) =- Right $ Aeson.toJSON (v :: Word64)- | Just Refl <- testEquality (typeRep @a) (typeRep @Integer) =- Right $ Aeson.toJSON (v :: Integer)- | Just Refl <- testEquality (typeRep @a) (typeRep @Double) =- Right $ Aeson.toJSON (v :: Double)- | Just Refl <- testEquality (typeRep @a) (typeRep @Float) =- Right $ Aeson.toJSON (v :: Float)- | Just Refl <- testEquality (typeRep @a) (typeRep @Bool) =- Right $ Aeson.toJSON (v :: Bool)- | Just Refl <- testEquality (typeRep @a) (typeRep @T.Text) =- Right $ Aeson.toJSON (v :: T.Text)- | Just Refl <- testEquality (typeRep @a) (typeRep @Char) =- Right $ Aeson.toJSON [v :: Char]- | Just Refl <- testEquality (typeRep @a) (typeRep @String) =- Right $ Aeson.toJSON (v :: String)- | otherwise =- Left $- "DataFrame.IR.ExprJson.encodeLit: unsupported type: " <> show (typeRep @a)---- | Map a 'binaryName' string to a wire-format op name. Errors on opaque UDF names.-recognizeBinary :: T.Text -> Either String T.Text-recognizeBinary n = case n of- "add" -> Right "add"- "sub" -> Right "sub"- "mult" -> Right "mult"- "divide" -> Right "divide"- "eq" -> Right "eq"- "neq" -> Right "neq"- "lt" -> Right "lt"- "leq" -> Right "leq"- "gt" -> Right "gt"- "geq" -> Right "geq"- "and" -> Right "and"- "or" -> Right "or"- -- Nullable-aware aliases (lossless on non-null inputs)- "nulladd" -> Right "add"- "nullsub" -> Right "sub"- "nullmul" -> Right "mult"- "nulldiv" -> Right "divide"- "nulland" -> Right "and"- "nullor" -> Right "or"- "exponentiate" -> Right "exponentiate"- "logBase" -> Right "logBase"- "div" -> Right "div"- "mod" -> Right "mod"- "pow" -> Right "pow"- other ->- Left $- "DataFrame.IR.ExprJson: unsupported binary op (cannot serialize): "- <> T.unpack other---- | Map a 'unaryName' string to a wire-format op name. Errors on opaque UDF names.-recognizeUnary :: T.Text -> Either String T.Text-recognizeUnary n = case n of- "not" -> Right "not"- "negate" -> Right "negate"- "abs" -> Right "abs"- "signum" -> Right "signum"- "exp" -> Right "exp"- "sqrt" -> Right "sqrt"- "log" -> Right "log"- "sin" -> Right "sin"- "cos" -> Right "cos"- "tan" -> Right "tan"- "asin" -> Right "asin"- "acos" -> Right "acos"- "atan" -> Right "atan"- "sinh" -> Right "sinh"- "cosh" -> Right "cosh"- "asinh" -> Right "asinh"- "acosh" -> Right "acosh"- "atanh" -> Right "atanh"- "toDouble" -> Right "toDouble"- other ->- Left $- "DataFrame.IR.ExprJson: unsupported unary op (cannot serialize): "- <> T.unpack other--{- | Decode a JSON value into a 'SomeExpr'. The output type comes from the-@out_type@ field on the root node.--}-decodeExprAny :: Aeson.Value -> Either String SomeExpr-decodeExprAny = Aeson.parseEither parseSomeExpr---- | Decode a JSON value, asserting the result type matches @a@.-decodeExprAt ::- forall a. (Columnable a) => Aeson.Value -> Either String (Expr a)-decodeExprAt v = do- SomeExpr trep expr <- decodeExprAny v- case testEquality trep (typeRep @a) of- Just Refl -> Right expr- Nothing ->- Left $- "DataFrame.IR.ExprJson.decodeExprAt: expected "- <> show (typeRep @a)- <> " but got "- <> show trep---- | The Aeson.Parser entry point — useful when composing with bigger parsers.-parseSomeExpr :: Aeson.Value -> Aeson.Parser SomeExpr-parseSomeExpr = Aeson.withObject "Expr" $ \o -> do- node <- o .: "node" :: Aeson.Parser T.Text- outType <- o .: "out_type" :: Aeson.Parser T.Text- case node of- "col" -> do- name <- o .: "name" :: Aeson.Parser T.Text- withTypeTag outType $ \(_ :: Proxy a) ->- return $ SomeExpr (typeRep @a) (Col @a name)- "lit" -> do- rawVal <- o .: "value"- withTypeTag outType $ \(_ :: Proxy a) -> do- litVal <- decodeLit @a rawVal- return $ SomeExpr (typeRep @a) (Lit @a litVal)- "if" -> do- rawCond <- o .: "cond"- rawThen <- o .: "then"- rawElse <- o .: "else"- cond <- parseExprAt @Bool rawCond- withTypeTag outType $ \(_ :: Proxy a) -> do- thenE <- parseExprAt @a rawThen- elseE <- parseExprAt @a rawElse- return $ SomeExpr (typeRep @a) (ifThenElse cond thenE elseE)- "unary" -> do- op <- o .: "op" :: Aeson.Parser T.Text- argType <- o .: "arg_type" :: Aeson.Parser T.Text- rawArg <- o .: "arg"- parseUnary op outType argType rawArg- "binary" -> do- op <- o .: "op" :: Aeson.Parser T.Text- argType <- o .: "arg_type" :: Aeson.Parser T.Text- rawLhs <- o .: "lhs"- rawRhs <- o .: "rhs"- parseBinary op outType argType rawLhs rawRhs- other -> fail $ "DataFrame.IR.ExprJson: unknown node kind: " <> T.unpack other--parseExprAt :: forall a. (Columnable a) => Aeson.Value -> Aeson.Parser (Expr a)-parseExprAt v = do- SomeExpr trep expr <- parseSomeExpr v- case testEquality trep (typeRep @a) of- Just Refl -> return expr- Nothing ->- fail $- "DataFrame.IR.ExprJson: expected "- <> show (typeRep @a)- <> " but got "- <> show trep--decodeLit :: forall a. (Columnable a) => Aeson.Value -> Aeson.Parser a-decodeLit v- | Just Refl <- testEquality (typeRep @a) (typeRep @Int) = parseAs @Int v- | Just Refl <- testEquality (typeRep @a) (typeRep @Int8) = parseAs @Int8 v- | Just Refl <- testEquality (typeRep @a) (typeRep @Int16) = parseAs @Int16 v- | Just Refl <- testEquality (typeRep @a) (typeRep @Int32) = parseAs @Int32 v- | Just Refl <- testEquality (typeRep @a) (typeRep @Int64) = parseAs @Int64 v- | Just Refl <- testEquality (typeRep @a) (typeRep @Word) = parseAs @Word v- | Just Refl <- testEquality (typeRep @a) (typeRep @Word8) = parseAs @Word8 v- | Just Refl <- testEquality (typeRep @a) (typeRep @Word16) = parseAs @Word16 v- | Just Refl <- testEquality (typeRep @a) (typeRep @Word32) = parseAs @Word32 v- | Just Refl <- testEquality (typeRep @a) (typeRep @Word64) = parseAs @Word64 v- | Just Refl <- testEquality (typeRep @a) (typeRep @Integer) = parseAs @Integer v- | Just Refl <- testEquality (typeRep @a) (typeRep @Double) = parseAs @Double v- | Just Refl <- testEquality (typeRep @a) (typeRep @Float) = parseAs @Float v- | Just Refl <- testEquality (typeRep @a) (typeRep @Bool) = parseAs @Bool v- | Just Refl <- testEquality (typeRep @a) (typeRep @T.Text) = parseAs @T.Text v- | Just Refl <- testEquality (typeRep @a) (typeRep @Char) = parseChar v- | Just Refl <- testEquality (typeRep @a) (typeRep @String) = parseAs @String v- | otherwise =- fail $- "DataFrame.IR.ExprJson.decodeLit: unsupported type: " <> show (typeRep @a)--parseAs :: forall b. (Aeson.FromJSON b) => Aeson.Value -> Aeson.Parser b-parseAs = Aeson.parseJSON--parseChar :: Aeson.Value -> Aeson.Parser Char-parseChar v = do- s <- Aeson.parseJSON v :: Aeson.Parser T.Text- case T.unpack s of- [c] -> return c- _ ->- fail $- "DataFrame.IR.ExprJson: expected single-character string, got: " <> show s--requireTag :: T.Text -> T.Text -> Aeson.Parser ()-requireTag actual expected- | actual == expected = return ()- | otherwise =- fail $- "DataFrame.IR.ExprJson: type mismatch — expected "- <> T.unpack expected- <> " but got "- <> T.unpack actual--requireSame :: T.Text -> T.Text -> Aeson.Parser ()-requireSame a b- | a == b = return ()- | otherwise =- fail $- "DataFrame.IR.ExprJson: type mismatch — "- <> T.unpack a- <> " vs "- <> T.unpack b--parseUnary ::- T.Text -> T.Text -> T.Text -> Aeson.Value -> Aeson.Parser SomeExpr-parseUnary op outType argType rawArg = case op of- "not" -> do- requireTag outType "bool"- requireTag argType "bool"- arg <- parseExprAt @Bool rawArg- return $ SomeExpr (typeRep @Bool) (F.not arg)- "negate" -> withNumTypeTag outType $ \(_ :: Proxy a) -> do- requireSame outType argType- arg <- parseExprAt @a rawArg- return $ SomeExpr (typeRep @a) (negate arg)- "abs" -> withNumTypeTag outType $ \(_ :: Proxy a) -> do- requireSame outType argType- arg <- parseExprAt @a rawArg- return $ SomeExpr (typeRep @a) (abs arg)- "signum" -> withNumTypeTag outType $ \(_ :: Proxy a) -> do- requireSame outType argType- arg <- parseExprAt @a rawArg- return $ SomeExpr (typeRep @a) (signum arg)- "toDouble" -> do- requireTag outType "double"- withRealTypeTag argType $ \(_ :: Proxy a) -> do- arg <- parseExprAt @a rawArg- return $ SomeExpr (typeRep @Double) (F.toDouble arg)- "exp" -> floatingUnary outType argType rawArg exp- "sqrt" -> floatingUnary outType argType rawArg sqrt- "log" -> floatingUnary outType argType rawArg log- "sin" -> floatingUnary outType argType rawArg sin- "cos" -> floatingUnary outType argType rawArg cos- "tan" -> floatingUnary outType argType rawArg tan- "asin" -> floatingUnary outType argType rawArg asin- "acos" -> floatingUnary outType argType rawArg acos- "atan" -> floatingUnary outType argType rawArg atan- "sinh" -> floatingUnary outType argType rawArg sinh- "cosh" -> floatingUnary outType argType rawArg cosh- "asinh" -> floatingUnary outType argType rawArg asinh- "acosh" -> floatingUnary outType argType rawArg acosh- "atanh" -> floatingUnary outType argType rawArg atanh- other -> fail $ "DataFrame.IR.ExprJson: unsupported unary op: " <> T.unpack other--floatingUnary ::- T.Text ->- T.Text ->- Aeson.Value ->- (forall x. (Columnable x, Floating x) => Expr x -> Expr x) ->- Aeson.Parser SomeExpr-floatingUnary outType argType rawArg f = withFloatingTypeTag outType $ \(_ :: Proxy a) -> do- requireSame outType argType- arg <- parseExprAt @a rawArg- return $ SomeExpr (typeRep @a) (f arg)--parseBinary ::- T.Text ->- T.Text ->- T.Text ->- Aeson.Value ->- Aeson.Value ->- Aeson.Parser SomeExpr-parseBinary op outType argType rawLhs rawRhs = case op of- "eq" -> do- requireTag outType "bool"- withTypeTag argType $ \(_ :: Proxy a) -> do- l <- parseExprAt @a rawLhs- r <- parseExprAt @a rawRhs- return $ SomeExpr (typeRep @Bool) (l .==. r)- "neq" -> do- requireTag outType "bool"- withTypeTag argType $ \(_ :: Proxy a) -> do- l <- parseExprAt @a rawLhs- r <- parseExprAt @a rawRhs- return $ SomeExpr (typeRep @Bool) (l ./=. r)- "lt" -> do- requireTag outType "bool"- withOrdTypeTag argType $ \(_ :: Proxy a) -> do- l <- parseExprAt @a rawLhs- r <- parseExprAt @a rawRhs- return $ SomeExpr (typeRep @Bool) (l .<. r)- "leq" -> do- requireTag outType "bool"- withOrdTypeTag argType $ \(_ :: Proxy a) -> do- l <- parseExprAt @a rawLhs- r <- parseExprAt @a rawRhs- return $ SomeExpr (typeRep @Bool) (l .<=. r)- "gt" -> do- requireTag outType "bool"- withOrdTypeTag argType $ \(_ :: Proxy a) -> do- l <- parseExprAt @a rawLhs- r <- parseExprAt @a rawRhs- return $ SomeExpr (typeRep @Bool) (l .>. r)- "geq" -> do- requireTag outType "bool"- withOrdTypeTag argType $ \(_ :: Proxy a) -> do- l <- parseExprAt @a rawLhs- r <- parseExprAt @a rawRhs- return $ SomeExpr (typeRep @Bool) (l .>=. r)- "and" -> do- requireTag outType "bool"- l <- parseExprAt @Bool rawLhs- r <- parseExprAt @Bool rawRhs- return $ SomeExpr (typeRep @Bool) (l .&&. r)- "or" -> do- requireTag outType "bool"- l <- parseExprAt @Bool rawLhs- r <- parseExprAt @Bool rawRhs- return $ SomeExpr (typeRep @Bool) (l .||. r)- "add" -> withNumTypeTag outType $ \(_ :: Proxy a) -> do- requireSame outType argType- l <- parseExprAt @a rawLhs- r <- parseExprAt @a rawRhs- return $ SomeExpr (typeRep @a) (l + r)- "sub" -> withNumTypeTag outType $ \(_ :: Proxy a) -> do- requireSame outType argType- l <- parseExprAt @a rawLhs- r <- parseExprAt @a rawRhs- return $ SomeExpr (typeRep @a) (l - r)- "mult" -> withNumTypeTag outType $ \(_ :: Proxy a) -> do- requireSame outType argType- l <- parseExprAt @a rawLhs- r <- parseExprAt @a rawRhs- return $ SomeExpr (typeRep @a) (l * r)- "divide" -> withFracTypeTag outType $ \(_ :: Proxy a) -> do- requireSame outType argType- l <- parseExprAt @a rawLhs- r <- parseExprAt @a rawRhs- return $ SomeExpr (typeRep @a) (l / r)- "exponentiate" -> withFloatingTypeTag outType $ \(_ :: Proxy a) -> do- requireSame outType argType- l <- parseExprAt @a rawLhs- r <- parseExprAt @a rawRhs- return $ SomeExpr (typeRep @a) (l ** r)- "nulladd" -> parseBinary "add" outType argType rawLhs rawRhs- "nullsub" -> parseBinary "sub" outType argType rawLhs rawRhs- "nullmul" -> parseBinary "mult" outType argType rawLhs rawRhs- "nulldiv" -> parseBinary "divide" outType argType rawLhs rawRhs- "nulland" -> parseBinary "and" outType argType rawLhs rawRhs- "nullor" -> parseBinary "or" outType argType rawLhs rawRhs- other -> fail $ "DataFrame.IR.ExprJson: unsupported binary op: " <> T.unpack other
src/DataFrame.hs view
@@ -8,201 +8,13 @@ Stability : experimental Portability : POSIX -Batteries-included entry point for the DataFrame library.--This module re-exports the most commonly used pieces of the @dataframe@ library so you-can get productive fast in GHCi, IHaskell, or scripts.--__Naming convention__--* Use the @D.@ (\"DataFrame\") prefix for core table operations.-* Use the @F.@ (\"Functions\") prefix for the expression DSL (columns, math, aggregations).--Example session:--We provide a script that imports the core functionality and defines helpful-macros for writing safe code.--@-\$ cabal update-\$ cabal install dataframe-\$ dataframe-Configuring library for fake-package-0...-Warning: No exposed modules-GHCi, version 9.6.7: https:\/\/www.haskell.org\/ghc\/ :? for help-Loaded GHCi configuration from \/tmp\/cabal-repl.-242816\/setcwd.ghci-========================================- 📦Dataframe-========================================--✨ Modules were automatically imported.--💡 Use prefix 'D' for core functionality.- ● E.g. D.readCsv \"\/path\/to\/file\"-💡 Use prefix 'F' for expression functions.- ● E.g. F.sum (F.col \@Int \"value\")--✅ Ready.-Loaded GHCi configuration from ./dataframe.ghci-ghci>-@--= Quick start-Load a CSV, select a few columns, filter, derive a column, then group + aggregate:--@--- 1) Load data-ghci> df0 <- D.readCsv "data/housing.csv"-ghci> D.describeColumns df0--------------------------------------------------------------------------------------------------------------- Column Name | # Non-null Values | # Null Values | # Partially parsed | # Unique Values | Type---------------------|-------------------|---------------|--------------------|-----------------|-------------- Text | Int | Int | Int | Int | Text---------------------|-------------------|---------------|--------------------|-----------------|-------------- ocean_proximity | 20640 | 0 | 0 | 5 | Text- median_house_value | 20640 | 0 | 0 | 3842 | Double- median_income | 20640 | 0 | 0 | 12928 | Double- households | 20640 | 0 | 0 | 1815 | Double- population | 20640 | 0 | 0 | 3888 | Double- total_bedrooms | 20640 | 0 | 0 | 1924 | Maybe Double- total_rooms | 20640 | 0 | 0 | 5926 | Double- housing_median_age | 20640 | 0 | 0 | 52 | Double- latitude | 20640 | 0 | 0 | 862 | Double- longitude | 20640 | 0 | 0 | 844 | Double---- 2) Project & filter-ghci> :declareColumns df-ghci> df1 = D.filterWhere (ocean_proximity .== \"ISLAND\") df0 D.|> D.select [F.name median_house_value, F.name median_income, F.name ocean_proximity]---- 3) Add a derived column using the expression DSL--- (col types are explicit via TypeApplications)-ghci> df2 = D.derive "rooms_per_household" (total_rooms / households) df0---- 4) Group + aggregate-ghci> import DataFrame.Operators-ghci> let grouped = D.groupBy ["ocean_proximity"] df0-ghci> let summary =- D.aggregate- [ F.maximum median_house_value \`as\` "max_house_value"]- grouped-ghci> D.take 5 summary------------------------------------ ocean_proximity | max_house_value------------------|----------------- Text | Double------------------|----------------- <1H OCEAN | 500001.0- INLAND | 500001.0- ISLAND | 450000.0- NEAR BAY | 500001.0- NEAR OCEAN | 500001.0-@--== Simple operations (cheat sheet)-Most users only need a handful of verbs:--__I/O__-- * @D.readCsv :: FilePath -> IO DataFrame@- * @D.readTsv :: FilePath -> IO DataFrame@- * @D.writeCsv :: FilePath -> DataFrame -> IO ()@- * @D.readParquet :: FilePath -> IO DataFrame@- * @D.readParquetWithOpts :: ParquetReadOptions -> FilePath -> IO DataFrame@- * @D.readParquetFiles :: FilePath -> IO DataFrame@- * @D.readParquetFilesWithOpts :: ParquetReadOptions -> FilePath -> IO DataFrame@--__Exploration__-- * @D.take :: Int -> DataFrame -> DataFrame@- * @D.takeLast :: Int -> DataFrame -> DataFrame@- * @D.describeColumns :: DataFrame -> DataFrame@- * @D.summarize :: DataFrame -> DataFrame@--__Row ops__-- * @D.filter :: Expr a -> (a -> Bool) -> DataFrame -> DataFrame@- * @D.filterWhere :: Expr Bool -> DataFrame -> DataFrame@- * @D.sortBy :: SortOrder -> [Text] -> DataFrame -> DataFrame@--__Column ops__-- * @D.select :: [Text] -> DataFrame -> DataFrame@- * @D.exclude :: [Text] -> DataFrame -> DataFrame@- * @D.rename :: [(Text,Text)] -> DataFrame -> DataFrame@- * @D.derive :: Text -> D.Expr a -> DataFrame -> DataFrame@--__Group & aggregate__-- * @D.groupBy :: [Text] -> DataFrame -> GroupedDataFrame@- * @D.aggregate :: [NamedExpr] -> GroupedDataFrame -> DataFrame@--__Joins__-- * @D.innerJoin \/ D.leftJoin \/ D.rightJoin \/ D.fullOuterJoin@--== Expression DSL (F.*) at a glance-Columns (typed):--@-F.col \@Text "ocean_proximity"-F.col \@Double "total_rooms"-F.lit \@Double 1.0-@--Math & comparisons (overloaded by type):--@-(+), (-), (*), (/), abs, log, exp, round-(F.eq), (F.gt), (F.geq), (F.lt), (F.leq)-(.==), (.>), (.>=), (.<), (.<=)-@--Aggregations (for D.'aggregate'):--@-F.count \@a (F.col \@a "c")-F.sum \@Double (F.col \@Double "x")-F.mean \@Double (F.col \@Double "x")-F.min \@t (F.col \@t "x")-F.max \@t (F.col \@t "x")-@--== REPL power-tool: ':declareColumns'--Use @:declareColumns <df>@ in GHCi/IHaskell to turn each column of a bound 'DataFrame'-into a local binding with the same (mangled if needed) name and the column's concrete-vector type. This is great for quick ad-hoc analysis, plotting, or hand-rolled checks.--@--- Suppose df has columns: "passengers" :: Int, "fare" :: Double, "payment" :: Text-ghci> :set -XTemplateHaskell-ghci> :declareColumns df---- Now you have in scope:-ghci> :type passengers-passengers :: Expr Int--ghci> :type fare-fare :: Expr Double--ghci> :type payment-payment :: Expr Text---- You can use them directly:-ghci> D.derive "fare_with_tip" (fare * 1.2)-@--Notes:--* Name mangling: spaces and non-identifier characters are replaced (e.g. @"trip id"@ -> @trip_id@).-* Optional/nullable columns are exposed as @Expr (Maybe a)@.+Batteries-included entry point for @dataframe@: re-exports the most commonly+used pieces for GHCi and scripts. Use the @D.@ prefix for core table operations+and @F.@ for the expression DSL. -} module DataFrame ( -- * Core data structures- module Dataframe,- module Column,- module Row,- module Expression,+ module CoreTypes, -- * Operator symbols. module Operators,@@ -266,11 +78,10 @@ ) where --- DecisionTree defines its own `percentile`/`percentiles` helpers; the--- public versions surfaced through the meta module are the ones from--- Operations.Statistics / DataFrame.Synthesis. Hide the duplicates to--- avoid ambiguous-export errors.-import DataFrame.DecisionTree as DecisionTree hiding (percentile, percentiles)+-- DecisionTree's own `percentile`/`percentiles` are hidden here; the public+-- versions come from Operations.Statistics / DataFrame.Synthesis, avoiding+-- ambiguous-export errors.+import DataFrame.DecisionTree as DecisionTree import DataFrame.Display as Display ( DisplayOptions (..), defaultDisplayOptions,@@ -299,6 +110,9 @@ readJSON, readJSONEither, )+-- Marks the dataframe-expr-serializer dependency as used (the codec modules are+-- surfaced to consumers via this library's @reexported-modules@).+import DataFrame.Expr.Serialize () #ifdef WITH_PARQUET import DataFrame.IO.Parquet as Parquet ( ParquetReadOptions (..),@@ -309,56 +123,58 @@ readParquetWithOpts, ) #endif-import DataFrame.Internal.Column as Column (+import DataFrame.Core as CoreTypes (+ Any, Column,- fromList,- fromUnboxedVector,- fromVector,- hasElemType,- hasMissing,- isNumeric,- mkRandom,- toList,- toVector,- )-import DataFrame.Internal.DataFrame as Dataframe (+ Columnable,+ Columnable', DataFrame,+ Expr, GroupedDataFrame,+ NamedExpr,+ Row, TruncateConfig (..), columnNames, defaultTruncateConfig,+ eSize, empty,+ fromAny,+ fromList, fromNamedColumns,+ fromUnboxedVector,+ fromVector,+ hasElemType,+ hasMissing, insertColumn,+ isNumeric,+ mkRandom, null,+ prettyPrint,+ prettyPrintWidth,+ rowValue,+ toAny, toCsv, toCsv',+ toList, toMarkdown, toMarkdown',- toSeparated,- )-import DataFrame.Internal.Expression as Expression (Expr, prettyPrint)-import DataFrame.Internal.Row as Row (- Any,- Row,- fromAny,- rowValue,- toAny, toRowList, toRowVector,+ toSeparated,+ toVector, )-import DataFrame.Internal.Schema as Schema (+import DataFrame.Schema as Schema (+ SchemaType (..), makeSchema, schemaType, ) #ifdef WITH_TH-import DataFrame.Internal.Schema.TH as SchemaTH (deriveSchema)+import DataFrame.Typed.TH.Records as SchemaTH (deriveSchemaFromType, deriveSchemaValues) #endif #ifdef WITH_LAZY--- Re-export the lazy query engine's entry points. Only types and source--- constructors are surfaced; the operator surface (filter/select/derive/...)--- collides with the eager API already re-exported above, so users wanting--- full lazy access should `import qualified DataFrame.Lazy as L`.+-- Re-export only the lazy engine's types and source constructors; its+-- operator surface (filter/select/derive/...) collides with the eager API,+-- so users wanting full lazy access `import qualified DataFrame.Lazy as L`. import DataFrame.Lazy as Lazy ( LazyDataFrame, fromDataFrame,@@ -375,11 +191,7 @@ distinct, groupBy, )-import DataFrame.Operations.Core as Core hiding (- ColumnInfo (..),- nulls,- renameSafe,- )+import DataFrame.Operations.Core as Core import DataFrame.Operations.Join as Join ( JoinType (..), fullOuterJoin,@@ -442,6 +254,7 @@ sample, select, selectBy,+ selectRows, stratifiedSample, stratifiedSplit, take,
src/DataFrame/Typed.hs view
@@ -104,6 +104,7 @@ -- * Aggregation expression combinators DataFrame.Typed.Expr.sum, mean,+ median, count, countAll, DataFrame.Typed.Expr.minimum,@@ -111,6 +112,42 @@ collect, over, + -- * Expression combinators (full DataFrame.Functions parity)+ DataFrame.Typed.Expr.div,+ DataFrame.Typed.Expr.mod,+ mode,+ sumMaybe,+ DataFrame.Typed.Expr.meanMaybe,+ DataFrame.Typed.Expr.variance,+ DataFrame.Typed.Expr.medianMaybe,+ DataFrame.Typed.Expr.percentile,+ stddev,+ stddevMaybe,+ zScore,+ pow,+ relu,+ DataFrame.Typed.Expr.min,+ DataFrame.Typed.Expr.max,+ reduce,+ toMaybe,+ fromMaybe,+ isJust,+ isNothing,+ fromJust,+ whenPresent,+ whenBothPresent,+ recode,+ recodeWithCondition,+ recodeWithDefault,+ firstOrNothing,+ lastOrNothing,+ splitOn,+ match,+ matchAll,+ parseDate,+ daysBetween,+ bind,+ -- * Cast / coercion expressions castExpr, castExprWithDefault,@@ -132,6 +169,13 @@ -- * Typed column access columnAsVector, columnAsList,+ columnAsIntVector,+ columnAsDoubleVector,+ columnAsFloatVector,+ columnAsUnboxedVector,+ toDoubleMatrix,+ toFloatMatrix,+ toIntMatrix, -- * Schema-preserving operations filterWhere,@@ -140,6 +184,7 @@ filterAllJust, filterJust, filterNothing,+ filterAllNothing, sortBy, take, takeLast,@@ -192,6 +237,29 @@ aggregate, aggregateUntyped, + -- * Column transformations+ applyColumn,+ applyMany,+ applyWhere,+ applyAtIndex,+ safeApply,+ deriveWithExpr,+ insertWithDefault,+ insertVectorWithDefault,+ insertUnboxedVector,+ (|||),++ -- * Sampling and splitting+ randomSplit,+ kFolds,+ selectRows,+ stratifiedSample,+ stratifiedSplit,++ -- * Frequencies+ valueCounts,+ valueProportions,+ #ifdef WITH_TH -- * Template Haskell deriveSchema,@@ -199,6 +267,9 @@ deriveSchemaFromCsvFile, deriveSchemaFromCsvFileWith, #endif+#ifdef WITH_PARQUET_TH+ deriveSchemaFromParquetFile,+#endif deriveSchemaFromType, deriveSchemaFromTypeWith, SchemaOptions (..),@@ -227,6 +298,7 @@ RenameManyInSchema, RemoveColumn, Impute,+ SetColumnType, Append, Reverse, StripAllMaybe,@@ -239,6 +311,10 @@ AssertAbsent, AssertAllPresent, AssertPresent,+ AssertDisjoint,+ AssertRealColumn,+ AllColumnsReal,+ IsRealType, -- * Constraints KnownSchema (..),@@ -247,13 +323,42 @@ import Prelude hiding (drop, filter, take) -import DataFrame.Typed.Access (columnAsList, columnAsVector)+import DataFrame.Typed.Access (+ columnAsDoubleVector,+ columnAsFloatVector,+ columnAsIntVector,+ columnAsList,+ columnAsUnboxedVector,+ columnAsVector,+ toDoubleMatrix,+ toFloatMatrix,+ toIntMatrix,+ ) import DataFrame.Typed.Aggregate ( aggregate, aggregateUntyped, as, groupBy, )+import DataFrame.Typed.Apply (+ applyAtIndex,+ applyColumn,+ applyMany,+ applyWhere,+ deriveWithExpr,+ insertUnboxedVector,+ insertVectorWithDefault,+ insertWithDefault,+ safeApply,+ (|||),+ )+import DataFrame.Typed.Sampling (+ kFolds,+ randomSplit,+ selectRows,+ stratifiedSample,+ stratifiedSplit,+ ) import DataFrame.Typed.Expr import DataFrame.Typed.Freeze (freeze, freezeWithError, thaw, unsafeFreeze) import DataFrame.Typed.Generic (@@ -279,6 +384,9 @@ #ifdef WITH_CSV_TH deriveSchemaFromCsvFile, deriveSchemaFromCsvFileWith,+#endif+#ifdef WITH_PARQUET_TH+ deriveSchemaFromParquetFile, #endif deriveSchemaFromType, deriveSchemaFromTypeWith,
src/DataFrame/Typed/TH.hs view
@@ -19,9 +19,15 @@ #ifdef WITH_CSV_TH module DataFrame.Typed.TH.CSV, #endif+#ifdef WITH_PARQUET_TH+ module DataFrame.Typed.TH.Parquet,+#endif ) where import DataFrame.Typed.TH.Records #ifdef WITH_CSV_TH import DataFrame.Typed.TH.CSV+#endif+#ifdef WITH_PARQUET_TH+import DataFrame.Typed.TH.Parquet #endif
− tests/Cart.hs
@@ -1,112 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-}--{- | Agreement tests: the Haskell 'buildCartTree' must predict identically to-sklearn @DecisionTreeClassifier(random_state=0, max_depth=4)@ on the shared-folds. The oracle is golden fixtures (per-row test predictions) generated by-@bench/export_cart_fixtures.py@ in a sklearn env. wine/bcw (continuous) assert-exact equality; adult (one-hot, RNG-tie-prone) only reports a match fraction.--Tests SKIP (pass with a notice) when a fixture is absent, so the suite stays-green until the fixtures are generated.--}-module Cart (tests) where--import Control.Exception (SomeException, try)-import Data.Aeson (FromJSON (..), eitherDecode, withObject, (.:))-import qualified Data.ByteString.Lazy as BL-import qualified Data.Text as T-import qualified Data.Vector as V-import Test.HUnit--import qualified DataFrame as D-import DataFrame.DecisionTree (- TreeConfig (..),- buildCartTree,- defaultTreeConfig,- predictManyWithTree,- )-import qualified DataFrame.Operations.Subset as DSub--data Fold = Fold ![Int] ![Int]-instance FromJSON Fold where- parseJSON = withObject "fold" $ \o -> Fold <$> o .: "train" <*> o .: "test"--newtype Folds = Folds [Fold]-instance FromJSON Folds where- parseJSON = withObject "folds" $ \o -> Folds <$> o .: "folds"--data Fixture = Fixture ![Int] ![T.Text]-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).-cartCfg :: TreeConfig-cartCfg = defaultTreeConfig{maxTreeDepth = 4, minLeafSize = 1}--cartCases :: [(String, Int)]-cartCases =- [("wine", i) | i <- [0 .. 4]] ++ [("bcw", i) | i <- [0 .. 4]] ++ [("adult", 0)]--tests :: [Test]-tests =- [ TestLabel ("cart: " ++ n ++ " fold " ++ show i) (TestCase (runCase n i))- | (n, i) <- cartCases- ]--readJson :: (FromJSON a) => FilePath -> IO (Either String a)-readJson fp = do- e <- try (BL.readFile fp) :: IO (Either SomeException BL.ByteString)- pure $ case e of- Left _ -> Left "missing"- Right raw -> eitherDecode raw--runCase :: String -> Int -> IO ()-runCase name i = do- efx <- readJson ("tests/fixtures/cart/" ++ name ++ "_fold" ++ show i ++ ".json")- case efx of- Left "missing" ->- putStrLn- ( " [skip] cart "- ++ name- ++ " fold "- ++ show i- ++ ": fixture missing (run bench/export_cart_fixtures.py)"- )- Left e -> assertFailure ("fixture parse (" ++ name ++ "): " ++ e)- Right (Fixture _ predExpected) -> do- efolds <- readJson ("data/folds/" ++ name ++ ".json")- case efolds of- Left e -> assertFailure ("folds parse (" ++ name ++ "): " ++ e)- Right (Folds fs) -> do- df <- D.readCsv ("data/uci/" ++ name ++ "_clean.csv")- let Fold trainIdx testIdx = fs !! i- trainDf = DSub.selectRows trainIdx df- tree = buildCartTree @Int cartCfg "target" trainDf- preds =- map- (T.pack . show)- (V.toList (predictManyWithTree tree df (V.fromList testIdx)))- -- wine is tie-free ⇒ sklearn is deterministic ⇒ exact match is the bar.- -- bcw/adult have equal-gain ties that sklearn breaks with a seeded per-node- -- feature permutation (verified: 4/5 bcw folds change with random_state); our- -- builder breaks ties deterministically by feature order and is gain-optimal- -- (verified bit-identical to an independent deterministic-CART reference), so- -- we only report the match fraction there rather than chase sklearn's RNG.- if name == "wine"- then assertEqual ("cart " ++ name ++ " fold " ++ show i) predExpected preds- else do- let n = length predExpected- m = length (filter id (zipWith (==) predExpected preds))- putStrLn- ( " [diagnostic] cart "- ++ name- ++ " fold "- ++ show i- ++ ": "- ++ show m- ++ "/"- ++ show n- ++ " predictions match sklearn(random_state=0) (remainder = sklearn's seeded equal-gain tie-break)"- )
− tests/DecisionTree.hs
@@ -1,1384 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-}--module DecisionTree where--import qualified DataFrame as D-import DataFrame.DecisionTree-import qualified DataFrame.Functions as F-import qualified DataFrame.Internal.Column as DI-import DataFrame.Internal.Expression (Expr (..), eqExpr, getColumns)-import DataFrame.Internal.Interpreter (interpret)-import qualified DataFrame.LinearSolver-import DataFrame.Operators--import Data.Function (on)-import Data.List (maximumBy, sort)-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 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.--}-requireTargetInfo :: T.Text -> D.DataFrame -> TargetInfo T.Text-requireTargetInfo target df = case mkTargetInfo @T.Text target df of- Just ti -> ti- Nothing -> error ("requireTargetInfo: no target info for " <> T.unpack target)---- 4 rows: label = ["A","B","A","C"], x = [1.0,2.0,3.0,4.0]-fixtureDF :: D.DataFrame-fixtureDF =- D.fromNamedColumns- [ ("label", DI.fromList (["A", "B", "A", "C"] :: [T.Text]))- , ("x", DI.fromList ([1.0, 2.0, 3.0, 4.0] :: [Double]))- ]--allIndices :: V.Vector Int-allIndices = V.fromList [0, 1, 2, 3]--leftTree :: Tree T.Text-leftTree = Leaf "A"--rightTree :: Tree T.Text-rightTree = Leaf "B"---- x <= 2.5: True for idx 0,1 (→ left); False for idx 2,3 (→ right)-splitCond :: Expr Bool-splitCond = F.col @Double "x" .<= F.lit (2.5 :: Double)---- Pre-computed care points for the full fixture-carePoints3 :: [CarePoint]-carePoints3 =- identifyCarePoints @T.Text "label" fixtureDF allIndices leftTree rightTree----------------------------------------------------------------------------- Unit tests: identifyCarePoints---------------------------------------------------------------------------carePointsBothWrong :: Test-carePointsBothWrong =- TestCase $- assertBool- "idx 3 (label=C, neither A nor B) should not be a care point"- (3 `notElem` map cpIndex carePoints3)--carePointsLeftCorrect :: Test-carePointsLeftCorrect = TestCase $ do- let cp0 = filter ((== 0) . cpIndex) carePoints3- assertBool "idx 0 should be a care point" (not (null cp0))- assertEqual- "idx 0 (label=A matches left Leaf A) should route GoLeft"- GoLeft- (cpCorrectDir (head cp0))--carePointsRightCorrect :: Test-carePointsRightCorrect = TestCase $ do- let cp1 = filter ((== 1) . cpIndex) carePoints3- assertBool "idx 1 should be a care point" (not (null cp1))- assertEqual- "idx 1 (label=B matches right Leaf B) should route GoRight"- GoRight- (cpCorrectDir (head cp1))--carePointsMixed :: Test-carePointsMixed = TestCase $ do- assertEqual "exactly 3 care points" 3 (length carePoints3)- let idxs = map cpIndex carePoints3- assertBool "idx 0 present" (0 `elem` idxs)- assertBool "idx 1 present" (1 `elem` idxs)- assertBool "idx 2 present" (2 `elem` idxs)- assertBool "idx 3 absent" (3 `notElem` idxs)--carePointsBothCorrect :: Test-carePointsBothCorrect = TestCase $ do- let df2 =- D.fromNamedColumns- [ ("label", DI.fromList (["A", "A"] :: [T.Text]))- , ("x", DI.fromList ([1.0, 2.0] :: [Double]))- ]- cps =- identifyCarePoints @T.Text- "label"- df2- (V.fromList [0, 1])- (Leaf "A")- (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- [ ("label", DI.fromList (["cat", "dog", "cat", "cat"] :: [T.Text]))- , ("x", DI.fromList ([1.0, 2.0, 3.0, 4.0] :: [Double]))- ]- assertEqual- "majority is cat (3 votes)"- "cat"- (majorityValueFromIndices @T.Text "label" df (V.fromList [0, 1, 2, 3]))--majorityVoteSubset :: Test-majorityVoteSubset = TestCase $ do- let df =- D.fromNamedColumns- [ ("label", DI.fromList (["cat", "dog", "cat", "cat"] :: [T.Text]))- , ("x", DI.fromList ([1.0, 2.0, 3.0, 4.0] :: [Double]))- ]- -- indices [0,1,3]: cat×2, dog×1 → "cat" wins clearly- 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- -- target = ["A","A","B","B"]: perfect split on x <= 2.5- let df =- D.fromNamedColumns- [ ("label", DI.fromList (["A", "A", "B", "B"] :: [T.Text]))- , ("x", DI.fromList ([1.0, 2.0, 3.0, 4.0] :: [Double]))- ]- stump = Branch splitCond (Leaf "A") (Leaf "B") :: Tree T.Text- loss = computeTreeLoss @T.Text "label" df (V.fromList [0, 1, 2, 3]) stump- assertEqual "perfect stump has zero loss" 0.0 loss--computeLossHalf :: Test-computeLossHalf = TestCase $ do- let df =- D.fromNamedColumns- [ ("label", DI.fromList (["A", "A", "B", "B"] :: [T.Text]))- , ("x", DI.fromList ([1.0, 2.0, 3.0, 4.0] :: [Double]))- ]- constTree = Leaf "A" :: Tree T.Text- 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- leftSet = V.toList lft- rightSet = V.toList rgt- intersection = filter (`elem` rightSet) leftSet- assertEqual "left and right partitions are disjoint" [] intersection--partitionUnion :: Test-partitionUnion = TestCase $ do- let (lft, rgt) = partitionIndices splitCond fixtureDF allIndices- combined = sort (V.toList lft ++ V.toList rgt)- assertEqual- "union of partitions equals the original index set"- [0, 1, 2, 3]- combined----------------------------------------------------------------------------- Unit tests: countCarePointErrors---------------------------------------------------------------------------countErrorsAllCorrect :: Test-countErrorsAllCorrect = TestCase $ do- -- x <= 1.5: idx 0 goes left (True), idx 1 goes right (False)- -- CarePoint 0 GoLeft → goesLeft=True, shouldGoLeft=True → correct- -- CarePoint 1 GoRight → goesLeft=False, shouldGoLeft=False → correct- let cps = [CarePoint 0 GoLeft, CarePoint 1 GoRight]- cond = F.col @Double "x" .<= F.lit (1.5 :: Double)- errs = countCarePointErrors cond fixtureDF cps- assertEqual "condition routes all care points correctly" 0 errs--countErrorsAllWrong :: Test-countErrorsAllWrong = TestCase $ do- -- x > 1.5: idx 0 goes right (False), idx 1 goes left (True) — both wrong- -- CarePoint 0 GoLeft → goesLeft=False, shouldGoLeft=True → wrong- -- CarePoint 1 GoRight → goesLeft=True, shouldGoLeft=False → wrong- let cps = [CarePoint 0 GoLeft, CarePoint 1 GoRight]- cond = F.col @Double "x" .> F.lit (1.5 :: Double)- errs = countCarePointErrors cond fixtureDF cps- assertEqual "reversed condition misroutes all care points" 2 errs----------------------------------------------------------------------------- Unit tests: predictWithTree---------------------------------------------------------------------------predictLeaf :: Test-predictLeaf =- TestCase $- assertEqual- "leaf prediction ignores row index"- "Z"- (predictWithTree @T.Text "label" fixtureDF 0 (Leaf "Z"))--predictBranch :: Test-predictBranch = TestCase $ do- let stump = Branch splitCond (Leaf "A") (Leaf "B") :: Tree T.Text- assertEqual- "idx 0 (x=1.0 <= 2.5) routes left -> A"- "A"- (predictWithTree @T.Text "label" fixtureDF 0 stump)- assertEqual- "idx 3 (x=4.0 > 2.5) routes right -> B"- "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- [ ("label", DI.fromList labels)- , ("x", DI.fromList xs)- ]---- Candidate conditions that bracket the decision boundary-sepConds :: [Expr Bool]-sepConds =- [ F.col @Double "x" .<= F.lit (10.5 :: Double)- , F.col @Double "x" .> F.lit (10.5 :: Double)- ]--testCfg :: TreeConfig-testCfg =- defaultTreeConfig- { taoIterations = 5- , expressionPairs = 4- , minLeafSize = 1- }---- Initial tree deliberately wrong: routes "pos" rows to the "neg" leaf-wrongStump :: Tree T.Text-wrongStump =- Branch- (F.col @Double "x" .> F.lit (10.5 :: Double))- (Leaf "pos")- (Leaf "neg")--taoNoDegradation :: Test-taoNoDegradation = TestCase $ do- let indices = V.enumFromN 0 20- initialLoss = computeTreeLoss @T.Text "label" sepDF indices wrongStump- optimized =- taoOptimize @T.Text testCfg "label" sepConds sepDF indices wrongStump- finalLoss = computeTreeLoss @T.Text "label" sepDF indices optimized- assertBool- "taoOptimize must not increase loss"- (finalLoss <= initialLoss + 1e-9)--taoMonotone :: Test-taoMonotone = TestCase $ do- let indices = V.enumFromN 0 20- initLoss = computeTreeLoss @T.Text "label" sepDF indices wrongStump- stepTree = taoIteration @T.Text testCfg "label" sepConds sepDF indices- -- Track (tree, loss) pairs: take 6 snapshots (initial + 5 steps)- step (tree, _) =- let tree' = stepTree tree- in (tree', computeTreeLoss @T.Text "label" sepDF indices tree')- snapshots = take 6 $ iterate step (wrongStump, initLoss)- losses = map snd snapshots- pairs = zip losses (tail losses)- assertBool- "loss must be non-increasing across taoIteration steps"- (all (\(a, b) -> b <= a + 1e-9) pairs)--taoConvergesPureLabels :: Test-taoConvergesPureLabels = TestCase $ do- let df =- D.fromNamedColumns- [ ("label", DI.fromList (replicate 10 ("A" :: T.Text)))- , ("x", DI.fromList ([1.0 .. 10.0] :: [Double]))- ]- indices = V.enumFromN 0 10- initTree = Leaf "A" :: Tree T.Text- initLoss = computeTreeLoss @T.Text "label" df indices initTree- result =- taoOptimize @T.Text testCfg "label" sepConds df indices initTree- finalLoss = computeTreeLoss @T.Text "label" df indices result- assertEqual "pure-label initial loss must be zero" 0.0 initLoss- assertEqual "pure-label final loss must still be zero" 0.0 finalLoss--taoDeadBranchNoCrash :: Test-taoDeadBranchNoCrash = TestCase $ do- -- Threshold below all x values: x <= 0.5 is False for every row- -- → all indices route to the right child; left partition is always empty- let badCond = F.col @Double "x" .<= F.lit (0.5 :: Double)- indices = V.enumFromN 0 20- initTree = Branch badCond (Leaf "pos") (Leaf "neg") :: Tree T.Text- result =- taoOptimize @T.Text testCfg "label" [badCond] sepDF indices initTree- finalLoss = computeTreeLoss @T.Text "label" sepDF indices result- assertBool- "dead-branch tree must produce a valid loss in [0,1]"- (finalLoss >= 0.0 && finalLoss <= 1.0)----------------------------------------------------------------------------- Shared fixtures: 4x4 grid---------------------------------------------------------------------------gridPairs :: [(Double, Double)]-gridPairs = [(x, y) | y <- [1 .. 4], x <- [1 .. 4]]--gridBaseDF :: D.DataFrame-gridBaseDF =- D.fromNamedColumns- [ ("x", DI.fromList (map fst gridPairs))- , ("y", DI.fromList (map snd gridPairs))- ]----------------------------------------------------------------------------- Oblique recovery tests---------------------------------------------------------------------------taoRecoversSingleObliqueDerived :: Test-taoRecoversSingleObliqueDerived = TestCase $ do- let labelExpr =- F.ifThenElse- ((F.col @Double "x" + F.col @Double "y") .<= F.lit (4.5 :: Double))- (F.lit ("pos" :: T.Text))- (F.lit ("neg" :: T.Text))- df = D.derive @T.Text "label" labelExpr gridBaseDF- indices = V.enumFromN 0 16- initTree =- Branch- (F.col @Double "x" .<= F.lit (2.5 :: Double))- (Leaf "pos")- (Leaf "neg") ::- Tree T.Text- conds =- [ (F.col @Double "x" + F.col @Double "y") .<= F.lit (4.5 :: Double)- , (F.col @Double "x" + F.col @Double "y") .> F.lit (4.5 :: Double)- ]- cfg = defaultTreeConfig{taoIterations = 5, expressionPairs = 4, minLeafSize = 1}- result = taoOptimize @T.Text cfg "label" conds df indices initTree- finalLoss = computeTreeLoss @T.Text "label" df indices result- assertEqual- "TAO recovers single oblique (x+y) split with zero loss"- 0.0- finalLoss--taoRecoversNestedObliqueDerived :: Test-taoRecoversNestedObliqueDerived = TestCase $ do- let labelExpr =- F.ifThenElse- ((F.col @Double "x" + F.col @Double "y") .<= F.lit (4.5 :: Double))- (F.lit ("low" :: T.Text))- ( F.ifThenElse- ((F.col @Double "x" - F.col @Double "y") .<= F.lit (0.5 :: Double))- (F.lit "mid")- (F.lit "high")- )- df = D.derive @T.Text "label" labelExpr gridBaseDF- indices = V.enumFromN 0 16- initTree =- Branch- (F.col @Double "x" .<= F.lit (1.5 :: Double))- (Leaf "low")- ( Branch- (F.col @Double "y" .<= F.lit (3.5 :: Double))- (Leaf "mid")- (Leaf "high")- ) ::- Tree T.Text- conds =- [ (F.col @Double "x" + F.col @Double "y") .<= F.lit (4.5 :: Double)- , (F.col @Double "x" + F.col @Double "y") .> F.lit (4.5 :: Double)- , (F.col @Double "x" - F.col @Double "y") .<= F.lit (0.5 :: Double)- , (F.col @Double "x" - F.col @Double "y") .> F.lit (0.5 :: Double)- ]- cfg = defaultTreeConfig{taoIterations = 5, expressionPairs = 4, minLeafSize = 1}- result = taoOptimize @T.Text cfg "label" conds df indices initTree- finalLoss = computeTreeLoss @T.Text "label" df indices result- assertEqual- "TAO recovers nested oblique (x+y)/(x-y) tree with zero loss"- 0.0- finalLoss---- Shared setup for C2 (a) and (b): axis-aligned pool only, oblique label.-obliqueAxisAlignedFixture ::- (D.DataFrame, V.Vector Int, [Expr Bool], Tree T.Text)-obliqueAxisAlignedFixture =- let labelExpr =- F.ifThenElse- ((F.col @Double "x" + F.col @Double "y") .<= F.lit (4.5 :: Double))- (F.lit ("pos" :: T.Text))- (F.lit ("neg" :: T.Text))- df = D.derive @T.Text "label" labelExpr gridBaseDF- indices = V.enumFromN 0 16- axisConds =- [F.col @Double "x" .<= F.lit (t :: Double) | t <- [1.5, 2.5, 3.5]]- ++ [F.col @Double "y" .<= F.lit (t :: Double) | t <- [1.5, 2.5, 3.5]]- initTree =- Branch- (F.col @Double "x" .<= F.lit (2.5 :: Double))- (Leaf "pos")- (Leaf "neg") ::- Tree T.Text- in (df, indices, axisConds, initTree)---- C2 (a): with the linear solver OFF, axis-aligned pool cannot recover the--- oblique decision boundary. Preserves the original guarantee of the test.-taoAxisAlignedInsufficientForObliqueDiscreteOnly :: Test-taoAxisAlignedInsufficientForObliqueDiscreteOnly = TestCase $ do- let (df, indices, axisConds, initTree) = obliqueAxisAlignedFixture- cfg =- defaultTreeConfig- { taoIterations = 10- , expressionPairs = 6- , minLeafSize = 1- , useLinearSolver = False- }- result = taoOptimize @T.Text cfg "label" axisConds df indices initTree- finalLoss = computeTreeLoss @T.Text "label" df indices result- assertBool- "axis-aligned stump cannot recover oblique label without linear solver (loss > 0.1)"- (finalLoss > 0.1)---- C2 (b): with the linear solver ON, the L1-LR fit discovers the oblique--- (x + y) hyperplane even though only axis-aligned conditions are in the--- candidate pool. This is the test that licenses calling the implementation--- canonical TAO.-taoLinearRecoversObliqueFromAxisAlignedPool :: Test-taoLinearRecoversObliqueFromAxisAlignedPool = TestCase $ do- let (df, indices, axisConds, initTree) = obliqueAxisAlignedFixture- cfg =- defaultTreeConfig- { taoIterations = 10- , expressionPairs = 6- , minLeafSize = 1- , useLinearSolver = True- , minCarePointsForLinear = 2- }- result = taoOptimize @T.Text cfg "label" axisConds df indices initTree- finalLoss = computeTreeLoss @T.Text "label" df indices result- assertEqual- "linear solver recovers oblique split from axis-aligned-only pool"- 0.0- finalLoss----------------------------------------------------------------------------- Nullable numeric feature tests----------------------------------------------------------------------------- Cleanly separable: Just 1..6 -> "pos", Just 7..12 -> "neg", no nulls.--- Uses OptionalColumn directly to exercise the new nullable numeric path.-nullableSepDF :: D.DataFrame-nullableSepDF =- D.fromNamedColumns- [ ("label", DI.fromList (replicate 6 "pos" ++ replicate 6 "neg" :: [T.Text]))- ,- ( "x"- , DI.fromVector- ( V.fromList $- map (Just . fromIntegral) ([1 .. 6] :: [Int])- ++ map (Just . fromIntegral) ([7 .. 12] :: [Int]) ::- V.Vector (Maybe Double)- )- )- ]---- DF with genuine nulls interspersed.-nullsMixedDF :: D.DataFrame-nullsMixedDF =- D.fromNamedColumns- [ ("label", DI.fromList (["pos", "pos", "pos", "neg", "neg", "neg"] :: [T.Text]))- ,- ( "x"- , DI.fromVector- ( V.fromList- [Just 1.0, Nothing, Just 3.0, Just 7.0, Nothing, Just 9.0] ::- V.Vector (Maybe Double)- )- )- ]---- numericCols picks up DI.fromVector (Maybe Double) as NMaybeDouble.-numericColsNullableDoubleTest :: Test-numericColsNullableDoubleTest = TestCase $ do- let exprs = numericCols nullableSepDF- hasMD = any (\case NMaybeDouble _ -> True; _ -> False) exprs- assertBool- "numericCols finds NMaybeDouble for DI.fromVector (Maybe Double)"- hasMD---- numericCols picks up DI.fromVector (Maybe Int) as NMaybeDouble (via whenPresent).-numericColsNullableIntTest :: Test-numericColsNullableIntTest = TestCase $ do- let df =- D.fromNamedColumns- [ ("label", DI.fromList (["pos", "neg"] :: [T.Text]))- ,- ( "n"- , DI.fromVector (V.fromList [Just (1 :: Int), Just 2] :: V.Vector (Maybe Int))- )- ]- 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).-numericCondsNullableNonEmptyTest :: Test-numericCondsNullableNonEmptyTest =- TestCase $- assertBool- "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).-nullValueRoutesFalseTest :: Test-nullValueRoutesFalseTest = TestCase $ do- let df =- D.fromNamedColumns- [ ("label", DI.fromList (["A", "B"] :: [T.Text]))- ,- ( "x"- , DI.fromVector- (V.fromList [Nothing, Just (5.0 :: Double)] :: V.Vector (Maybe Double))- )- ]- -- Nothing <= 6.0 = Nothing -> fromMaybe False = False -> right- -- Just 5.0 <= 6.0 = Just True -> fromMaybe False = True -> left- cond = F.fromMaybe False (F.col @(Maybe Double) "x" .<= F.lit (6.0 :: Double))- (lft, rgt) = partitionIndices cond df (V.fromList [0, 1])- 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)---- fitDecisionTree with an OptionalColumn nullable feature achieves zero loss--- on cleanly separable data (no actual nulls in the column).-nullableFitZeroLossTest :: Test-nullableFitZeroLossTest = TestCase $ do- let cfg = defaultTreeConfig{taoIterations = 5, expressionPairs = 4, minLeafSize = 1}- featureDf = D.exclude ["label"] nullableSepDF- conds = generateNumericConds cfg featureDf- initTree = buildCartTree @T.Text cfg "label" nullableSepDF- indices = V.enumFromN 0 12- result = taoOptimize @T.Text cfg "label" conds nullableSepDF indices initTree- loss = computeTreeLoss @T.Text "label" nullableSepDF indices result- assertEqual "zero loss on cleanly separable OptionalColumn data" 0.0 loss---- fitDecisionTree with genuine nulls: loss is a valid probability and no crash.-nullableFitWithNullsNoCrashTest :: Test-nullableFitWithNullsNoCrashTest = TestCase $ do- let cfg = defaultTreeConfig{taoIterations = 3, expressionPairs = 4, minLeafSize = 1}- featureDf = D.exclude ["label"] nullsMixedDF- conds = generateNumericConds cfg featureDf- initTree = buildCartTree @T.Text cfg "label" nullsMixedDF- indices = V.enumFromN 0 6- result = taoOptimize @T.Text cfg "label" conds nullsMixedDF indices initTree- loss = computeTreeLoss @T.Text "label" nullsMixedDF indices result- assertBool- "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.-numericExprsWithTermsMixedTest :: Test-numericExprsWithTermsMixedTest = TestCase $ do- let df =- D.fromNamedColumns- [- ( "x"- , DI.fromVector- (V.fromList [Just 1.0, Just 2.0, Just 3.0] :: V.Vector (Maybe Double))- )- , ("y", DI.fromList ([4.0, 5.0, 6.0] :: [Double]))- ]- cfg = defaultSynthConfig{maxExprDepth = 2, enableArithOps = True}- exprs = numericExprsWithTerms cfg df- assertBool- "more than 2 expressions: base cols + combinations"- (length exprs > 2)- assertBool- "combined exprs include NMaybeDouble (nullable arithmetic)"- (any (\case NMaybeDouble _ -> True; _ -> False) exprs)----------------------------------------------------------------------------- Probability tree tests----------------------------------------------------------------------------- probsFromIndices: counts correct on a 3-row slice-probsFromIndicesBasic :: Test-probsFromIndicesBasic = TestCase $ do- let df =- D.fromNamedColumns- [ ("label", DI.fromList (["A", "A", "B"] :: [T.Text]))- , ("x", DI.fromList ([1.0, 2.0, 3.0] :: [Double]))- ]- probs = probsFromIndices @T.Text "label" df (V.fromList [0, 1, 2])- assertBool "A prob ≈ 2/3" (abs (probs M.! "A" - 2 / 3) < 1e-9)- assertBool "B prob ≈ 1/3" (abs (probs M.! "B" - 1 / 3) < 1e-9)---- probsFromIndices: only a subset of rows counted-probsFromIndicesSubset :: Test-probsFromIndicesSubset = TestCase $ do- let df =- D.fromNamedColumns- [ ("label", DI.fromList (["A", "A", "B", "B"] :: [T.Text]))- , ("x", DI.fromList ([1.0, 2.0, 3.0, 4.0] :: [Double]))- ]- probs = probsFromIndices @T.Text "label" df (V.fromList [0, 1])- assertEqual "only rows 0,1 → A:1.0" (M.fromList [("A", 1.0)]) probs---- probsFromIndices: single class → probability 1.0-probsFromIndicesSingleClass :: Test-probsFromIndicesSingleClass = TestCase $ do- let probs = probsFromIndices @T.Text "label" fixtureDF (V.fromList [0, 2])- assertEqual "rows 0,2 both A → A:1.0" (M.fromList [("A", 1.0)]) probs---- buildProbTree: Leaf preserves distribution-buildProbTreeLeaf :: Test-buildProbTreeLeaf = TestCase $ do- let df =- D.fromNamedColumns- [ ("label", DI.fromList (["A", "A", "A"] :: [T.Text]))- , ("x", DI.fromList ([1.0, 2.0, 3.0] :: [Double]))- ]- pt = buildProbTree @T.Text (Leaf "A") "label" df (V.fromList [0, 1, 2])- case pt of- Leaf m -> assertEqual "pure-A leaf → {A:1.0}" (M.fromList [("A", 1.0)]) m- _ -> assertFailure "expected Leaf"---- buildProbTree: Branch distributes rows to left/right leaves correctly-buildProbTreeBranch :: Test-buildProbTreeBranch = TestCase $ do- -- splitCond: x <= 2.5 → idx 0,1 go left; idx 2,3 go right- -- left (idx 0,1): labels ["A","B"] → {A:0.5, B:0.5}- -- right (idx 2,3): labels ["A","C"] → {A:0.5, C:0.5}- let stump = Branch splitCond (Leaf "A") (Leaf "B") :: Tree T.Text- pt = buildProbTree @T.Text stump "label" fixtureDF allIndices- case pt of- Branch _ (Leaf lm) (Leaf rm) -> do- assertBool "left leaf has A:0.5" (abs (M.findWithDefault 0 "A" lm - 0.5) < 1e-9)- assertBool "left leaf has B:0.5" (abs (M.findWithDefault 0 "B" lm - 0.5) < 1e-9)- assertBool- "right leaf has A:0.5"- (abs (M.findWithDefault 0 "A" rm - 0.5) < 1e-9)- assertBool- "right leaf has C:0.5"- (abs (M.findWithDefault 0 "C" rm - 0.5) < 1e-9)- _ -> assertFailure "expected Branch with two Leaves"---- probExprs: leaf tree produces Lit values-probExprsLeaf :: Test-probExprsLeaf = TestCase $ do- let pt = Leaf (M.fromList [("A", 0.75), ("B", 0.25)]) :: ProbTree T.Text- pe = probExprs pt- assertBool "A expr is Lit 0.75" (eqExpr (Lit 0.75) (pe M.! "A"))- assertBool "B expr is Lit 0.25" (eqExpr (Lit 0.25) (pe M.! "B"))---- probExprs: class absent from one leaf gets Lit 0.0 on that side-probExprsMissingClass :: Test-probExprsMissingClass = TestCase $ do- let pt =- Branch- splitCond- (Leaf (M.fromList [("A", 1.0)]))- (Leaf (M.fromList [("B", 1.0)])) ::- ProbTree T.Text- pe = probExprs pt- assertBool- "A expr: If cond (Lit 1.0) (Lit 0.0)"- (eqExpr (F.ifThenElse splitCond (Lit 1.0) (Lit 0.0)) (pe M.! "A"))- assertBool- "B expr: If cond (Lit 0.0) (Lit 1.0)"- (eqExpr (F.ifThenElse splitCond (Lit 0.0) (Lit 1.0)) (pe M.! "B"))---- probExprs: keys equal all classes that appear across any leaf-probExprsAllClasses :: Test-probExprsAllClasses = TestCase $ do- let pt =- Branch- splitCond- (Leaf (M.fromList [("A", 1.0)]))- (Leaf (M.fromList [("B", 0.6), ("C", 0.4)])) ::- ProbTree T.Text- pe = probExprs pt- assertEqual "three classes in result" (sort ["A", "B", "C"]) (sort (M.keys pe))---- Probabilities sum to 1.0 at every row after applying probExprs-probsSumToOne :: Test-probsSumToOne = TestCase $ do- let stump = Branch splitCond (Leaf "A") (Leaf "B") :: Tree T.Text- pt = buildProbTree @T.Text stump "label" fixtureDF allIndices- pe = probExprs pt- sumExpr = foldl1 (.+) (M.elems pe)- case interpret @Double fixtureDF sumExpr of- Left e -> assertFailure (show e)- Right (DI.TColumn sumCol) ->- case DI.toVector @Double sumCol of- Left e2 -> assertFailure (show e2)- Right vals ->- mapM_- (\v -> assertBool ("sum ≈ 1.0, got " ++ show v) (abs (v - 1.0) < 1e-9))- (V.toList vals)---- argmax of probExprs agrees with fitDecisionTree on sepDF-probArgmaxMatchesClassifier :: Test-probArgmaxMatchesClassifier = TestCase $ do- let cfg = defaultTreeConfig{taoIterations = 5, expressionPairs = 4, minLeafSize = 1}- hardExpr = fitDecisionTree @T.Text cfg (Col "label") sepDF- pe = fitProbTree @T.Text cfg (Col "label") sepDF- indices = [0 .. D.nRows sepDF - 1]- case interpret @T.Text sepDF hardExpr of- Left e -> assertFailure (show e)- Right (DI.TColumn hardCol) ->- case DI.toVector @T.Text hardCol of- Left e2 -> assertFailure (show e2)- Right hardVals -> do- probCols <-- mapM- ( \(cls, expr) -> case interpret @Double sepDF expr of- Left e3 -> assertFailure (show e3) >> return (cls, V.empty)- Right (DI.TColumn col2) -> case DI.toVector @Double col2 of- Left e4 -> assertFailure (show e4) >> return (cls, V.empty)- Right v -> return (cls, v)- )- (M.toList pe)- mapM_- ( \i ->- let argmax = fst $ maximumBy (compare `on` (V.! i) . snd) probCols- hard = hardVals V.! i- in assertEqual ("row " ++ show i) hard argmax- )- indices----------------------------------------------------------------------------- C4-C9 / D-series: linear solver integration tests----------------------------------------------------------------------------- C4: Nested oblique recovery without supplying any oblique hints.--- The label is determined by two oblique boundaries: (x+y <= 4.5) and--- (x-y <= 0.5). Only axis-aligned thresholds are in the candidate pool.--- With the linear solver, both oblique splits should be learned and the--- tree should reach zero loss.-taoRecoversNestedObliqueWithoutHint :: Test-taoRecoversNestedObliqueWithoutHint = TestCase $ do- let labelExpr =- F.ifThenElse- ((F.col @Double "x" + F.col @Double "y") .<= F.lit (4.5 :: Double))- (F.lit ("low" :: T.Text))- ( F.ifThenElse- ((F.col @Double "x" - F.col @Double "y") .<= F.lit (0.5 :: Double))- (F.lit "mid")- (F.lit "high")- )- df = D.derive @T.Text "label" labelExpr gridBaseDF- indices = V.enumFromN 0 16- initTree =- Branch- (F.col @Double "x" .<= F.lit (1.5 :: Double))- (Leaf "low")- ( Branch- (F.col @Double "y" .<= F.lit (3.5 :: Double))- (Leaf "mid")- (Leaf "high")- ) ::- Tree T.Text- axisOnlyConds =- [F.col @Double "x" .<= F.lit (t :: Double) | t <- [1.5, 2.5, 3.5]]- ++ [F.col @Double "y" .<= F.lit (t :: Double) | t <- [1.5, 2.5, 3.5]]- cfg =- defaultTreeConfig- { taoIterations = 20- , expressionPairs = 6- , minLeafSize = 1- , useLinearSolver = True- , minCarePointsForLinear = 2- }- result = taoOptimize @T.Text cfg "label" axisOnlyConds df indices initTree- finalLoss = computeTreeLoss @T.Text "label" df indices result- assertEqual- "linear solver recovers nested oblique tree from axis-aligned-only pool"- 0.0- finalLoss---- C5: Monotone loss across iterations with the linear solver enabled.--- Resolves Issue 1 from the prior plan (currentCond included in the--- competition pool).-taoMonotoneWithLinear :: Test-taoMonotoneWithLinear = TestCase $ do- let indices = V.enumFromN 0 20- cfg = defaultTreeConfig{taoIterations = 5, expressionPairs = 4, minLeafSize = 1}- initLoss = computeTreeLoss @T.Text "label" sepDF indices wrongStump- stepTree = taoIteration @T.Text cfg "label" sepConds sepDF indices- step (tree, _) =- let tree' = stepTree tree- in (tree', computeTreeLoss @T.Text "label" sepDF indices tree')- snapshots = take 6 $ iterate step (wrongStump, initLoss)- losses = map snd snapshots- pairs = zip losses (tail losses)- assertBool- ("loss must be non-increasing across iterations (got " ++ show losses ++ ")")- (all (\(a, b) -> b <= a + 1e-9) pairs)---- C6: When the discrete pool contains an exact-zero-error split (axis-aligned--- works perfectly), the competition picks the simpler discrete candidate--- rather than a similarly-good but more complex linear one.-taoLinearVsDiscreteCompetition :: Test-taoLinearVsDiscreteCompetition = TestCase $ do- -- sepDF is axis-aligned-separable by x <= 10.5. The discrete pool- -- sepConds contains this exact condition. Linear solver may also- -- produce a hyperplane that works, but the discrete one has smaller- -- eSize, so the tie-breaker should pick it.- let indices = V.enumFromN 0 20- cfg =- defaultTreeConfig- { taoIterations = 5- , expressionPairs = 4- , minLeafSize = 1- , useLinearSolver = True- , minCarePointsForLinear = 2- }- result = taoOptimize @T.Text cfg "label" sepConds sepDF indices wrongStump- finalLoss = computeTreeLoss @T.Text "label" sepDF indices result- assertEqual- "axis-aligned separable data should fit to zero loss"- 0.0- finalLoss---- C8: Linear solver respects the L1 penalty and produces sparse hyperplanes--- on data where only some features are informative.-taoLinearProducesSparsity :: Test-taoLinearProducesSparsity = TestCase $ do- -- 50 rows, 4 features. label depends only on (a + b). c and d are noise.- -- With sufficient L1 strength, the chosen split should mention only a and b.- let n = 50 :: Int- xs = [fromIntegral i / 10 - 2.5 :: Double | i <- [0 .. n - 1]]- avals = xs- bs = map (* 0.7) xs- -- noise: take xs and shift them so they don't correlate with a+b- cs = [fromIntegral ((i * 7) `mod` 11) / 5 - 1 :: Double | i <- [0 .. n - 1]]- ds = [fromIntegral ((i * 13) `mod` 7) / 3 - 1 :: Double | i <- [0 .. n - 1]]- labels =- [ if (avals !! i) + (bs !! i) > 0 then "pos" else "neg" :: T.Text- | i <- [0 .. n - 1]- ]- df =- D.fromNamedColumns- [ ("label", DI.fromList labels)- , ("a", DI.fromList avals)- , ("b", DI.fromList bs)- , ("c", DI.fromList cs)- , ("d", DI.fromList ds)- ]- cfg =- defaultTreeConfig- { maxTreeDepth = 1- , taoIterations = 10- , minLeafSize = 1- , useLinearSolver = True- , minCarePointsForLinear = 2- , linearSolverConfig =- (linearSolverConfig defaultTreeConfig)- { DataFrame.LinearSolver.scL1Lambda = 0.05- }- }- result = fitDecisionTree @T.Text cfg (Col "label") df- rootCols = getColumns result- -- Hard fail only if NONE of a/b show up — that would mean the model- -- is ignoring the signal. We expect at most 4 columns; the H3 target- -- is that fewer than 4 (some noise columns dropped) -- but the test- -- only asserts the signal columns appear.- assertBool- ( "informative columns 'a' or 'b' must appear in the fitted Expr (got "- ++ show rootCols- ++ ")"- )- ("a" `elem` rootCols || "b" `elem` rootCols)---- C9: Determinism — same training data produces an equal (eqExpr) tree.-taoLinearDeterministic :: Test-taoLinearDeterministic = TestCase $ do- let cfg =- defaultTreeConfig- { taoIterations = 5- , expressionPairs = 4- , minLeafSize = 1- , useLinearSolver = True- , minCarePointsForLinear = 2- }- r1 = fitDecisionTree @T.Text cfg (Col "label") sepDF- 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.-taoLinearTinyCareSet :: Test-taoLinearTinyCareSet = TestCase $ do- -- Use the toy sepDF, but force minCarePointsForLinear = 100 so the- -- linear path is always skipped. The result should match the- -- linear-off baseline.- let cfg =- defaultTreeConfig- { taoIterations = 5- , expressionPairs = 4- , minLeafSize = 1- , useLinearSolver = True- , minCarePointsForLinear = 100- }- result = fitDecisionTree @T.Text cfg (Col "label") sepDF- -- Sanity: the tree should still classify correctly.- cfgOff = cfg{useLinearSolver = False}- resultOff = fitDecisionTree @T.Text cfgOff (Col "label") sepDF- assertBool- "skipping linear solver yields same expression as linear-off baseline"- (eqExpr result resultOff)----------------------------------------------------------------------------- Categorical-condition generator tests (Phase 1-2 of the plan)----------------------------------------------------------------------------- A binary-target DataFrame with a 5-level Text column whose levels have--- monotonically-increasing positive rates. Breiman's algorithm should--- enumerate the 4 contiguous-prefix splits in that exact rate order.-breimanBinaryDF :: D.DataFrame-breimanBinaryDF =- let n = 100 :: Int- -- Levels chosen so positive rates after Laplace are:- -- a: 0/n+1 / 2+n+2 → very low- -- b: 0.25- -- c: 0.5- -- d: 0.75- -- e: ~1.0- mkLabel "a" = "neg"- mkLabel "b" = "neg"- mkLabel "c" = "pos"- mkLabel "d" = "pos"- mkLabel "e" = "pos"- mkLabel _ = "neg"- levels = cycle ["a", "b", "c", "d", "e"]- feats = take n levels- labs = map mkLabel feats- in D.fromUnnamedColumns- [ DI.fromList (map T.pack feats :: [T.Text])- , DI.fromList (map T.pack labs :: [T.Text])- ]- |> D.rename "0" "feat"- |> D.rename "1" "label"--testCategoricalBreimanBinary :: Test-testCategoricalBreimanBinary = TestCase $ do- let ti = requireTargetInfo "label" breimanBinaryDF- conds =- discreteConditions @T.Text- ti- defaultTreeConfig- (D.exclude ["label"] breimanBinaryDF)- feat = "feat"- -- Filter only conditions over "feat" (cross-column equality could- -- mix in if there were other categoricals; here there aren't).- feats = filter (\c -> feat `elem` getColumns c) conds- -- 5 levels → 4 prefixes- assertEqual "Breiman emits k-1 prefixes" 4 (length feats)--testCategoricalSubsetsMulticlassLowCard :: Test-testCategoricalSubsetsMulticlassLowCard = TestCase $ do- -- 3-class target, 3-level Text column. Subset enumeration: 2^3 - 2 = 6.- let n = 30 :: Int- feats = take n (cycle ["x", "y", "z"])- labs = take n (cycle ["A", "B", "C"])- df =- D.fromUnnamedColumns- [ DI.fromList (map T.pack feats :: [T.Text])- , DI.fromList (map T.pack labs :: [T.Text])- ]- |> D.rename "0" "feat"- |> D.rename "1" "label"- ti = requireTargetInfo "label" df- conds = discreteConditions @T.Text ti defaultTreeConfig (D.exclude ["label"] df)- feat = "feat"- feats' = filter (\c -> feat `elem` getColumns c) conds- -- 3 classes → multi-class path → subsets at cap=4 → 2^3 - 2 = 6- assertEqual "subsets at low cardinality" 6 (length feats')--testCategoricalSingletonsMulticlassHighCard :: Test-testCategoricalSingletonsMulticlassHighCard = TestCase $ do- -- 3-class target, 6-level Text column. Above cap=4 → singletons (6).- let n = 60 :: Int- feats = take n (cycle ["a", "b", "c", "d", "e", "f"])- labs = take n (cycle ["A", "B", "C"])- df =- D.fromUnnamedColumns- [ DI.fromList (map T.pack feats :: [T.Text])- , DI.fromList (map T.pack labs :: [T.Text])- ]- |> D.rename "0" "feat"- |> D.rename "1" "label"- ti = requireTargetInfo "label" df- conds = discreteConditions @T.Text ti defaultTreeConfig (D.exclude ["label"] df)- feat = "feat"- feats' = filter (\c -> feat `elem` getColumns c) conds- -- 6 > cap=4 → singletons → 6 conditions- assertEqual "singletons at high cardinality" 6 (length feats')--testCategoricalCardZero :: Test-testCategoricalCardZero = TestCase $ do- -- Empty column → no conditions.- let df =- D.fromUnnamedColumns- [ DI.fromList ([] :: [T.Text])- , DI.fromList ([] :: [T.Text])- ]- |> D.rename "0" "feat"- |> D.rename "1" "label"- ti = requireTargetInfo "label" df- conds = discreteConditions @T.Text ti defaultTreeConfig (D.exclude ["label"] df)- feat = "feat"- feats' = filter (\c -> feat `elem` getColumns c) conds- assertEqual "no candidates on empty column" 0 (length feats')--testCategoricalNullableBinary :: Test-testCategoricalNullableBinary = TestCase $ do- -- Maybe Text feature with nulls, binary target. Breiman should fire on- -- the non-null distinct values; nulls drop out via validBoxedValues.- let feats =- [ Just "a"- , Just "b"- , Just "c"- , Nothing- , Just "a"- , Just "b"- , Just "c"- , Nothing- , Just "a"- , Just "b"- , Just "c"- , Just "a"- , Just "b"- , Just "c"- , Just "a"- , Just "b"- ]- labs =- [ "neg"- , "neg"- , "pos"- , "neg"- , "neg"- , "neg"- , "pos"- , "neg"- , "neg"- , "neg"- , "pos"- , "neg"- , "neg"- , "pos"- , "neg"- , "pos"- ]- df =- D.fromUnnamedColumns- [ DI.fromList (feats :: [Maybe T.Text])- , DI.fromList (map T.pack labs :: [T.Text])- ]- |> D.rename "0" "feat"- |> D.rename "1" "label"- ti = requireTargetInfo "label" df- conds = discreteConditions @T.Text ti defaultTreeConfig (D.exclude ["label"] df)- feat = "feat" :: T.Text- feats' = filter (\c -> feat `elem` getColumns c) conds- -- 3 non-null distinct levels → k-1 = 2 Breiman prefixes- assertEqual "Breiman prefixes on nullable column ignore nulls" 2 (length feats')----------------------------------------------------------------------------- PR 2 extended: threshold-consolidation rewrite in combineAndVec /--- combineOrVec. Eight positive cases (one per <, ≤, >, ≥ × AND / OR),--- six negative cases (rule must NOT fire), one semantic-preservation--- QuickCheck-style spot check.----------------------------------------------------------------------------- A small synthetic DataFrame to materialize CondVecs against.-threshFixtureDF :: D.DataFrame-threshFixtureDF =- D.fromNamedColumns- [ ("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]))- ]--materializeOrFail :: Expr Bool -> CondVec-materializeOrFail e = case materializeCondVec threshFixtureDF e of- Just cv -> cv- Nothing -> error "materializeOrFail: condition could not be materialized"---- | Helper: assert that two `Expr Bool`s agree by 'eqExpr'.-assertEqExpr :: String -> Expr Bool -> Expr Bool -> Assertion-assertEqExpr msg expected actual =- assertBool- (msg ++ "\n expected: " ++ show expected ++ "\n actual: " ++ show actual)- (eqExpr expected actual)---- Eight positive cases.--threshAndLeq :: Test-threshAndLeq = TestCase $ do- let a = materializeOrFail (F.col @Double "x" .<=. F.lit (3.0 :: Double))- b = materializeOrFail (F.col @Double "x" .<=. F.lit (1.0 :: Double))- r = combineAndVec a b- assertEqExpr- "AND of x≤3 and x≤1 collapses to x≤1"- (F.col @Double "x" .<=. F.lit (1.0 :: Double))- (cvExpr r)--threshOrLeq :: Test-threshOrLeq = TestCase $ do- let a = materializeOrFail (F.col @Double "x" .<=. F.lit (3.0 :: Double))- b = materializeOrFail (F.col @Double "x" .<=. F.lit (1.0 :: Double))- r = combineOrVec a b- assertEqExpr- "OR of x≤3 and x≤1 collapses to x≤3"- (F.col @Double "x" .<=. F.lit (3.0 :: Double))- (cvExpr r)--threshAndLt :: Test-threshAndLt = TestCase $ do- let a = materializeOrFail (F.col @Double "x" .<. F.lit (3.0 :: Double))- b = materializeOrFail (F.col @Double "x" .<. F.lit (1.0 :: Double))- r = combineAndVec a b- assertEqExpr- "AND of x<3 and x<1 collapses to x<1"- (F.col @Double "x" .<. F.lit (1.0 :: Double))- (cvExpr r)--threshOrLt :: Test-threshOrLt = TestCase $ do- let a = materializeOrFail (F.col @Double "x" .<. F.lit (3.0 :: Double))- b = materializeOrFail (F.col @Double "x" .<. F.lit (1.0 :: Double))- r = combineOrVec a b- assertEqExpr- "OR of x<3 and x<1 collapses to x<3"- (F.col @Double "x" .<. F.lit (3.0 :: Double))- (cvExpr r)--threshAndGeq :: Test-threshAndGeq = TestCase $ do- let a = materializeOrFail (F.col @Double "x" .>=. F.lit (1.0 :: Double))- b = materializeOrFail (F.col @Double "x" .>=. F.lit (3.0 :: Double))- r = combineAndVec a b- assertEqExpr- "AND of x≥1 and x≥3 collapses to x≥3"- (F.col @Double "x" .>=. F.lit (3.0 :: Double))- (cvExpr r)--threshOrGeq :: Test-threshOrGeq = TestCase $ do- let a = materializeOrFail (F.col @Double "x" .>=. F.lit (1.0 :: Double))- b = materializeOrFail (F.col @Double "x" .>=. F.lit (3.0 :: Double))- r = combineOrVec a b- assertEqExpr- "OR of x≥1 and x≥3 collapses to x≥1"- (F.col @Double "x" .>=. F.lit (1.0 :: Double))- (cvExpr r)--threshAndGt :: Test-threshAndGt = TestCase $ do- let a = materializeOrFail (F.col @Double "x" .>. F.lit (1.0 :: Double))- b = materializeOrFail (F.col @Double "x" .>. F.lit (3.0 :: Double))- r = combineAndVec a b- assertEqExpr- "AND of x>1 and x>3 collapses to x>3"- (F.col @Double "x" .>. F.lit (3.0 :: Double))- (cvExpr r)--threshOrGt :: Test-threshOrGt = TestCase $ do- let a = materializeOrFail (F.col @Double "x" .>. F.lit (1.0 :: Double))- b = materializeOrFail (F.col @Double "x" .>. F.lit (3.0 :: Double))- r = combineOrVec a b- assertEqExpr- "OR of x>1 and x>3 collapses to x>1"- (F.col @Double "x" .>. F.lit (1.0 :: Double))- (cvExpr r)---- Six negative cases: rewrite must NOT fire.--threshNegMixedDirection :: Test-threshNegMixedDirection = TestCase $ do- let a = materializeOrFail (F.col @Double "x" .<. F.lit (3.0 :: Double))- b = materializeOrFail (F.col @Double "x" .>=. F.lit (1.0 :: Double))- r = combineAndVec a b- -- Mixed directions (< vs ≥): consolidation deliberately out-of-scope.- -- Expect the generic F.and form.- assertEqExpr- "mixed-direction AND keeps generic F.and form"- (F.and (cvExpr a) (cvExpr b))- (cvExpr r)--threshNegCrossColumn :: Test-threshNegCrossColumn = TestCase $ do- let a = materializeOrFail (F.col @Double "x" .>. F.lit (1.0 :: Double))- b = materializeOrFail (F.col @Double "y" .>. F.lit (3.0 :: Double))- r = combineAndVec a b- -- Same op, different columns: no rewrite.- assertEqExpr- "cross-column AND keeps generic F.and form"- (F.and (cvExpr a) (cvExpr b))- (cvExpr r)--threshNegMixedOpFamily :: Test-threshNegMixedOpFamily = TestCase $ do- let a = materializeOrFail (F.col @Double "x" .>. F.lit (1.0 :: Double))- b = materializeOrFail (F.col @Double "x" .<. F.lit (4.0 :: Double))- r = combineAndVec a b- -- > and < are different op families: no rewrite.- assertEqExpr- "different-op-family AND keeps generic F.and form"- (F.and (cvExpr a) (cvExpr b))- (cvExpr r)--threshNegEqualityOp :: Test-threshNegEqualityOp = TestCase $ do- let a = materializeOrFail (F.col @Double "x" .==. F.lit (3.0 :: Double))- b = materializeOrFail (F.col @Double "x" .==. F.lit (1.0 :: Double))- r = combineOrVec a b- -- Equality is not in the threshold family; consolidate doesn't fire.- assertEqExpr- "equality OR keeps generic F.or form"- (F.or (cvExpr a) (cvExpr b))- (cvExpr r)--threshNegLitOnLeft :: Test-threshNegLitOnLeft = TestCase $ do- -- Lit on LEFT of the comparison: pattern requires (Col, Lit) ordering.- let a = materializeOrFail (F.lit (1.0 :: Double) .<. F.col @Double "x")- b = materializeOrFail (F.lit (3.0 :: Double) .<. F.col @Double "x")- r = combineAndVec a b- assertEqExpr- "Lit-on-left AND keeps generic F.and form"- (F.and (cvExpr a) (cvExpr b))- (cvExpr r)--threshNegNonLiteralRhs :: Test-threshNegNonLiteralRhs = TestCase $ do- -- RHS is a Col, not a Lit: pattern doesn't match.- let a = materializeOrFail (F.col @Double "x" .>. F.col @Double "y")- b = materializeOrFail (F.col @Double "x" .>. F.lit (3.0 :: Double))- r = combineAndVec a b- assertEqExpr- "non-literal RHS AND keeps generic F.and form"- (F.and (cvExpr a) (cvExpr b))- (cvExpr r)---- Semantic-preservation spot check (in lieu of a full QuickCheck property--- which would require generators for strict-op Expr Bool — followup work).--- Verifies that the consolidated cvVec matches the elementwise AND/OR of--- the inputs at every row of a synthetic DataFrame.-threshSemanticPreservation :: Test-threshSemanticPreservation = TestCase $ do- let a = materializeOrFail (F.col @Double "x" .>. F.lit (1.0 :: Double))- b = materializeOrFail (F.col @Double "x" .>. F.lit (3.0 :: Double))- rAnd = combineAndVec a b- rOr = combineOrVec a b- expectedAnd = VU.zipWith (&&) (cvVec a) (cvVec b)- expectedOr = VU.zipWith (||) (cvVec a) (cvVec b)- assertEqual- "consolidated AND vec matches elementwise &&"- expectedAnd- (cvVec rAnd)- assertEqual- "consolidated OR vec matches elementwise ||"- expectedOr- (cvVec rOr)----------------------------------------------------------------------------- Test list---------------------------------------------------------------------------tests :: [Test]-tests =- [ TestLabel "carePointsBothWrong" carePointsBothWrong- , TestLabel "carePointsLeftCorrect" carePointsLeftCorrect- , TestLabel "carePointsRightCorrect" carePointsRightCorrect- , TestLabel "carePointsMixed" carePointsMixed- , TestLabel "carePointsBothCorrect" carePointsBothCorrect- , TestLabel "majorityVoteTest" majorityVoteTest- , TestLabel "majorityVoteSubset" majorityVoteSubset- , TestLabel "computeLossZero" computeLossZero- , TestLabel "computeLossHalf" computeLossHalf- , TestLabel "partitionDisjoint" partitionDisjoint- , TestLabel "partitionUnion" partitionUnion- , TestLabel "countErrorsAllCorrect" countErrorsAllCorrect- , TestLabel "countErrorsAllWrong" countErrorsAllWrong- , TestLabel "predictLeaf" predictLeaf- , TestLabel "predictBranch" predictBranch- , TestLabel "taoNoDegradation" taoNoDegradation- , TestLabel "taoMonotone" taoMonotone- , TestLabel "taoConvergesPureLabels" taoConvergesPureLabels- , TestLabel "taoDeadBranchNoCrash" taoDeadBranchNoCrash- , TestLabel "taoRecoversSingleObliqueDerived" taoRecoversSingleObliqueDerived- , TestLabel "taoRecoversNestedObliqueDerived" taoRecoversNestedObliqueDerived- , TestLabel- "C2a taoAxisAlignedInsufficientForObliqueDiscreteOnly"- taoAxisAlignedInsufficientForObliqueDiscreteOnly- , TestLabel- "C2b taoLinearRecoversObliqueFromAxisAlignedPool"- taoLinearRecoversObliqueFromAxisAlignedPool- , TestLabel "numericColsNullableDouble" numericColsNullableDoubleTest- , TestLabel "numericColsNullableInt" numericColsNullableIntTest- , TestLabel "numericCondsNullableNonEmpty" numericCondsNullableNonEmptyTest- , TestLabel "nullValueRoutesFalse" nullValueRoutesFalseTest- , TestLabel "nullableFitZeroLoss" nullableFitZeroLossTest- , TestLabel "nullableFitWithNullsNoCrash" nullableFitWithNullsNoCrashTest- , TestLabel "numericExprsWithTermsMixed" numericExprsWithTermsMixedTest- , TestLabel "probsFromIndicesBasic" probsFromIndicesBasic- , TestLabel "probsFromIndicesSubset" probsFromIndicesSubset- , TestLabel "probsFromIndicesSingleClass" probsFromIndicesSingleClass- , TestLabel "buildProbTreeLeaf" buildProbTreeLeaf- , TestLabel "buildProbTreeBranch" buildProbTreeBranch- , TestLabel "probExprsLeaf" probExprsLeaf- , TestLabel "probExprsMissingClass" probExprsMissingClass- , TestLabel "probExprsAllClasses" probExprsAllClasses- , TestLabel "probsSumToOne" probsSumToOne- , TestLabel "probArgmaxMatchesClassifier" probArgmaxMatchesClassifier- , TestLabel- "C4 taoRecoversNestedObliqueWithoutHint"- taoRecoversNestedObliqueWithoutHint- , TestLabel "C5 taoMonotoneWithLinear" taoMonotoneWithLinear- , TestLabel "C6 taoLinearVsDiscreteCompetition" taoLinearVsDiscreteCompetition- , TestLabel "C8 taoLinearProducesSparsity" taoLinearProducesSparsity- , TestLabel "C9 taoLinearDeterministic" taoLinearDeterministic- , TestLabel "D1 taoLinearTinyCareSet" taoLinearTinyCareSet- , TestLabel "E1 categoricalBreimanBinary" testCategoricalBreimanBinary- , TestLabel- "E2 categoricalSubsetsMulticlassLowCard"- testCategoricalSubsetsMulticlassLowCard- , TestLabel- "E3 categoricalSingletonsMulticlassHighCard"- testCategoricalSingletonsMulticlassHighCard- , TestLabel "E4 categoricalCardZero" testCategoricalCardZero- , TestLabel "E5 categoricalNullableBinary" testCategoricalNullableBinary- , -- PR 2 extended: threshold-consolidation rewrite (positive cases).- TestLabel "F1 threshAndLeq" threshAndLeq- , TestLabel "F2 threshOrLeq" threshOrLeq- , TestLabel "F3 threshAndLt" threshAndLt- , TestLabel "F4 threshOrLt" threshOrLt- , TestLabel "F5 threshAndGeq" threshAndGeq- , TestLabel "F6 threshOrGeq" threshOrGeq- , TestLabel "F7 threshAndGt" threshAndGt- , TestLabel "F8 threshOrGt" threshOrGt- , -- PR 2 extended: negative cases (rewrite must NOT fire).- TestLabel "F9 threshNegMixedDirection" threshNegMixedDirection- , TestLabel "F10 threshNegCrossColumn" threshNegCrossColumn- , TestLabel "F11 threshNegMixedOpFamily" threshNegMixedOpFamily- , TestLabel "F12 threshNegEqualityOp" threshNegEqualityOp- , TestLabel "F13 threshNegLitOnLeft" threshNegLitOnLeft- , TestLabel "F14 threshNegNonLiteralRhs" threshNegNonLiteralRhs- , TestLabel "F15 threshSemanticPreservation" threshSemanticPreservation- ]
tests/IO/CsvGolden.hs view
@@ -3,9 +3,8 @@ {-# LANGUAGE TypeApplications #-} {- | Golden semantics for the default CSV reader, pinned against the-cassava-based implementation (oracle runs of 2026-06-12) before the-strict-scanner rewrite. Ragged-row cases encode the new pad-with-null-behavior (audit D6) — the one intentional change.+cassava-based oracle (2026-06-12) before the strict-scanner rewrite.+Ragged-row cases encode the one intentional change: pad-with-null (audit D6). -} module IO.CsvGolden (tests) where @@ -25,8 +24,8 @@ forceDataFrame, getColumn, )-import DataFrame.Internal.Schema (schemaType) import DataFrame.Operations.Typing (SafeReadMode (..))+import DataFrame.Schema (schemaType) import Test.HUnit data Expect@@ -156,8 +155,7 @@ , "a,b\n\t1\t,\tx\t\n2,y\n" , Cols (2, 2) [("a", ints [1, 2]), ("b", texts ["x", "y"])] )- , -- D6: short rows now pad trailing columns with null (was: misaligned).-+ , ( "ragged_short_D6" , defaultReadOptions , "a,b,c\n1,2,3\n4,5\n6,7,8\n"@@ -224,8 +222,7 @@ , "1,2\n3,4\n" , Cols (2, 2) [("x", ints [1, 3]), ("1", ints [2, 4])] )- , -- D6: the always-short padded column is now row-aligned (all null).-+ , ( "providenames_more_D6" , defaultReadOptions{headerSpec = ProvideNames ["x", "y", "z"]} , "1,2\n3,4\n"@@ -416,8 +413,7 @@ , "a,b\nNA,1\n2,2\n" , Cols (2, 2) [("a", texts ["NA", "2"]), ("b", eti [Right 1, Right 2])] )- , -- D6: the column after the EOF-truncated quote field is now padded.-+ , ( "unclosed_quote_D6" , defaultReadOptions , "a,b\n\"x,2\n"
+ tests/IR/ExprJsonRoundtrip.hs view
@@ -0,0 +1,209 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++{- | Round-trip, pipeline, end-to-end, and wire-shape contract tests for the+expression/pipeline serializer.+-}+module IR.ExprJsonRoundtrip (tests) where++import qualified Data.Aeson as Aeson+import qualified Data.ByteString.Char8 as BS8+import Data.Either (fromRight, isLeft)+import Test.HUnit++import qualified Data.Vector.Unboxed as VU+import qualified DataFrame as D+import qualified DataFrame.Functions as F+import DataFrame.Internal.Column (Columnable, TypedColumn (..), toVector)+import qualified DataFrame.Internal.Column as DI+import DataFrame.Internal.Expression (Expr, UExpr (..))+import DataFrame.Internal.Interpreter (interpret)+import DataFrame.Operators (ifThenElse, (.>.))++import DataFrame.LinearModel (defaultLinearConfig)+import DataFrame.Model (fit, predict)+import DataFrame.Transform (Transform (..), applyTransform)+import DataFrame.Transform.Serialize (+ loadTransformFromFile,+ saveTransformToFile,+ )++import DataFrame.Expr.Serialize (+ SomeExpr (..),+ decodeExprAny,+ decodeExprAt,+ decodeExprFromBytes,+ encodeExpr,+ loadExprAtFromFile,+ loadPipelineFromFile,+ saveExprToFile,+ savePipelineToFile,+ )+import System.IO.Temp (withSystemTempDirectory)++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)+ Left err -> error (show err)++close :: [Double] -> [Double] -> Bool+close a b = length a == length b && and (zipWith (\x y -> abs (x - y) <= 1e-9) a b)++df3 :: D.DataFrame+df3 = D.fromNamedColumns [("x", DI.fromList [1, 2, 3 :: Double])]++regDF :: D.DataFrame+regDF =+ D.fromNamedColumns+ [ ("x1", DI.fromList xs1)+ , ("x2", DI.fromList xs2)+ , ("y", DI.fromList [2 * a - 3 * b + 1 | (a, b) <- zip xs1 xs2])+ ]+ where+ xs1 = [1, 2, 3, 4, 5, 6, 7, 8] :: [Double]+ xs2 = [2, 1, 4, 3, 6, 5, 8, 7] :: [Double]++{- | An expression round-trips when encode → decode → re-encode yields the same+JSON. Avoids needing an 'Eq' instance on the GADT.+-}+roundtrips :: (Columnable a) => Expr a -> Bool+roundtrips e = fromRight False $ do+ v1 <- encodeExpr e+ SomeExpr _ e' <- decodeExprAny v1+ v2 <- encodeExpr e'+ Right (v1 == v2)++testCase :: String -> Bool -> Test+testCase name ok = TestCase (assertBool name ok)++-- Row-wise expression node kinds.+exprRoundtripTests :: [Test]+exprRoundtripTests =+ [ testCase "col" (roundtrips (F.col @Double "x"))+ , testCase "lit" (roundtrips (F.lit @Int 42))+ , testCase "arithmetic" (roundtrips (F.col @Double "x" * F.lit 2 + F.lit 1))+ , testCase "division" (roundtrips (F.col @Double "x" / F.lit 2))+ , testCase "comparison" (roundtrips (F.col @Double "x" .>. F.lit 0))+ , testCase "unary sqrt" (roundtrips (sqrt (F.col @Double "x")))+ , testCase+ "if/then/else"+ ( roundtrips+ ( ifThenElse (F.col @Double "x" .>. F.lit 0) (F.lit 1.0) (F.lit (-1.0)) ::+ Expr Double+ )+ )+ ]++-- Aggregation and window node kinds (the decoder cases added for full parity).+aggRoundtripTests :: [Test]+aggRoundtripTests =+ [ testCase "sum" (roundtrips (F.sum (F.col @Double "x")))+ , testCase "count" (roundtrips (F.count (F.col @Double "x")))+ , testCase "minimum" (roundtrips (F.minimum (F.col @Double "x")))+ , testCase "maximum" (roundtrips (F.maximum (F.col @Int "x")))+ , testCase "mean" (roundtrips (F.mean (F.col @Double "x")))+ , testCase "variance" (roundtrips (F.variance (F.col @Double "x")))+ , testCase "median" (roundtrips (F.median (F.col @Double "x")))+ , testCase "over" (roundtrips (F.over ["g"] (F.sum (F.col @Double "x"))))+ ]++-- Documented limitation: collect's list-typed output has no type tag, so it+-- cannot be encoded.+limitationTests :: [Test]+limitationTests =+ [ testCase+ "collect cannot encode"+ (isLeft (encodeExpr (F.collect (F.col @Double "x"))))+ ]++-- Pin the wire shape Python decodes against: (x * 2) + 1 over doubles.+contractTests :: [Test]+contractTests =+ [ TestCase $ case Aeson.eitherDecodeStrict (BS8.pack contractJson) >>= decodeExprAt @Double of+ Left err -> assertFailure ("contract decode failed: " <> err)+ Right e ->+ assertBool "contract interprets to [3,5,7]" (close (interpD df3 e) [3, 5, 7])+ , testCase+ "collect agg node fails to decode"+ (isLeft (decodeExprFromBytes (BS8.pack collectJson)))+ ]++contractJson :: String+contractJson =+ "{\"node\":\"binary\",\"out_type\":\"double\",\"op\":\"add\",\"arg_type\":\"double\","+ <> "\"lhs\":{\"node\":\"binary\",\"out_type\":\"double\",\"op\":\"mult\",\"arg_type\":\"double\","+ <> "\"lhs\":{\"node\":\"col\",\"out_type\":\"double\",\"name\":\"x\"},"+ <> "\"rhs\":{\"node\":\"lit\",\"out_type\":\"double\",\"value\":2.0}},"+ <> "\"rhs\":{\"node\":\"lit\",\"out_type\":\"double\",\"value\":1.0}}"++collectJson :: String+collectJson =+ "{\"node\":\"agg\",\"out_type\":\"double\",\"agg\":\"collect\",\"arg_type\":\"double\","+ <> "\"arg\":{\"node\":\"col\",\"out_type\":\"double\",\"name\":\"x\"}}"++-- File round-trips for a single expression, a pipeline, and a fitted model.+ioTests :: [Test]+ioTests =+ [ TestCase $ withSystemTempDirectory "expr-ser" $ \dir -> do+ let fp = dir ++ "/expr.json"+ e = F.col @Double "x" * F.lit 2 + F.lit 1+ sr <- saveExprToFile fp e+ assertEqual "save expr ok" (Right ()) sr+ loaded <- loadExprAtFromFile @Double fp+ case loaded of+ Left err -> assertFailure ("load expr failed: " <> err)+ Right e' ->+ assertBool+ "loaded expr interprets equal"+ (close (interpD df3 e') (interpD df3 e))+ , TestCase $ withSystemTempDirectory "expr-ser" $ \dir -> do+ let fp = dir ++ "/pipeline.json"+ nes =+ [ ("z", UExpr (F.col @Double "x" * F.lit 2))+ , ("w", UExpr (F.col @Double "x" + F.lit 10))+ ]+ sr <- savePipelineToFile fp nes+ assertEqual "save pipeline ok" (Right ()) sr+ loaded <- loadPipelineFromFile fp+ case loaded of+ Left err -> assertFailure ("load pipeline failed: " <> err)+ Right nes' -> do+ let df' = applyTransform (Transform nes') df3+ assertBool "z = 2x" (close (interpD df' (F.col @Double "z")) [2, 4, 6])+ assertBool "w = x+10" (close (interpD df' (F.col @Double "w")) [11, 12, 13])+ , TestCase $ withSystemTempDirectory "expr-ser" $ \dir -> do+ let fp = dir ++ "/transform.json"+ t = Transform [("z", UExpr (F.col @Double "x" * F.lit 2))]+ sr <- saveTransformToFile fp t+ assertEqual "save transform ok" (Right ()) sr+ loaded <- loadTransformFromFile fp+ case loaded of+ Left err -> assertFailure ("load transform failed: " <> err)+ Right t' ->+ assertBool+ "transform z = 2x"+ (close (interpD (applyTransform t' df3) (F.col @Double "z")) [2, 4, 6])+ , TestCase $ withSystemTempDirectory "expr-ser" $ \dir -> do+ -- End-to-end: fit OLS, persist its prediction, reload, compare outputs.+ let fp = dir ++ "/model.json"+ m = fit defaultLinearConfig (F.col @Double "y") regDF+ sr <- saveExprToFile fp (predict m)+ assertEqual "save model ok" (Right ()) sr+ loaded <- loadExprAtFromFile @Double fp+ case loaded of+ Left err -> assertFailure ("load model failed: " <> err)+ Right e' ->+ assertBool+ "reloaded prediction matches original"+ (close (interpD regDF e') (interpD regDF (predict m)))+ ]++tests :: [Test]+tests =+ exprRoundtripTests+ ++ aggRoundtripTests+ ++ limitationTests+ ++ contractTests+ ++ ioTests
tests/Internal/Markdown.hs view
@@ -1,14 +1,15 @@ {-# LANGUAGE OverloadedStrings #-} --- | Markdown rendering must escape pipe-table metacharacters in cell values,--- or an operator name like @<|>@ splits the row into the wrong columns.+{- | Markdown rendering must escape pipe-table metacharacters in cell values,+or an operator name like @<|>@ splits the row into the wrong columns.+-} module Internal.Markdown (tests) where import qualified Data.Text as T +import DataFrame.Display.Terminal.PrettyPrint (escapeMarkdownCell) import DataFrame.Internal.Column (fromList) import qualified DataFrame.Internal.DataFrame as D-import DataFrame.Display.Terminal.PrettyPrint (escapeMarkdownCell) import Test.HUnit -- Count the column-delimiter pipes in a rendered row: a bare '|' delimits a
tests/LazyParity.hs view
@@ -2,14 +2,10 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} -{- | The HARD GATE for the lazy engine: for a bounded source, the lazy result-must be BYTE-IDENTICAL to the eager result computed with the same eager ops-('Join.join' / 'Agg.aggregate' . 'Agg.groupBy' / 'Perm.sortBy').--The lazy executor routes bounded HashJoin/HashAggregate through the whole-frame-eager fast paths, so 'show' of the two results must agree exactly. Both a LEFT-join pipeline (join -> groupBy -> aggregate -> sort) and a pure groupBy pipeline-are covered.+{- | The HARD GATE for the lazy engine: for a bounded source the lazy result+must be BYTE-IDENTICAL to the eager result of the same ops (bounded joins and+aggregates route through the eager fast paths). Covers a LEFT-join pipeline+(join -> groupBy -> aggregate -> sort) and a pure groupBy pipeline. -} module LazyParity (tests) where @@ -21,14 +17,14 @@ import qualified DataFrame.IO.CSV as Csv import qualified DataFrame.Internal.Column as DI import qualified DataFrame.Internal.Expression as E-import DataFrame.Internal.Schema (Schema (..), schemaType)+import DataFrame.Lazy (SortOrder (Descending)) import qualified DataFrame.Lazy as L-import DataFrame.Lazy.Internal.LogicalPlan (SortOrder (Descending)) import qualified DataFrame.Operations.Aggregation as Agg import DataFrame.Operations.Join (JoinType (LEFT)) import qualified DataFrame.Operations.Join as Join import qualified DataFrame.Operations.Permutation as Perm import DataFrame.Operators (as, (|>))+import DataFrame.Schema (Schema (..), schemaType) import System.Directory (removeFile) import System.IO.Temp (emptySystemTempFile) import Test.HUnit@@ -102,15 +98,13 @@ [ F.sum (amount - discount) `as` "revenue" , F.count amount `as` "orders" ]- -- Eager: the exact ops the lazy executor delegates to. ordersDf <- Csv.readCsvWithSchema ordersSchema ordersPath customersDf <- Csv.readCsvWithSchema customersSchema customersPath let eager = Perm.sortBy [Perm.Desc (E.Col @Double "revenue")] $ Agg.aggregate aggs $ Agg.groupBy ["region", "plan"] $- Join.join LEFT ["customer_id"] customersDf ordersDf- -- Lazy: same query through the bounded-source fast path.+ Join.join LEFT ["customer_id"] ordersDf customersDf let customersQ = L.scanCsv customersSchema (T.pack customersPath) lazy <- L.scanCsv ordersSchema (T.pack ordersPath)
tests/LazyParquet.hs view
@@ -9,9 +9,9 @@ import Data.Time (UTCTime) import qualified DataFrame as D import qualified DataFrame.Functions as F-import DataFrame.Internal.Schema (Schema (..), schemaType)+import DataFrame.Lazy (SortOrder (..)) import qualified DataFrame.Lazy as L-import DataFrame.Lazy.Internal.LogicalPlan (SortOrder (..))+import DataFrame.Schema (Schema (..), schemaType) import Test.HUnit -- | Schema matching all columns in alltypes_plain.parquet.
− tests/Learn/EdgeCases.hs
@@ -1,481 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}--{- | Edge-case / degeneracy tests (tests.md category 7) and numerical-stability-tests (category 8) for @dataframe-learn@.--Each test asserts the *mathematically correct* result (computed by hand, with-the derivation in a comment) or a *specific* documented degenerate behaviour ---never "it returned something". Where the library's contract is to clamp/guard a-degeneracy (e.g. @k > n@, constant columns) we assert the concrete clamped-result; where the underlying routine is stable we assert it matches the closed-form a naive implementation would get wrong.--}-module Learn.EdgeCases (tests) where--import qualified Data.Map.Strict as M-import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as VU--import qualified DataFrame as D-import qualified DataFrame.Functions as F-import DataFrame.Internal.Column (TypedColumn (..), toVector)-import qualified DataFrame.Internal.Column as DI-import DataFrame.Internal.Expression (Expr)-import DataFrame.Internal.Interpreter (interpret)--import DataFrame.GMM-import DataFrame.KMeans-import DataFrame.LinearAlgebra (logSumExp)-import DataFrame.LinearAlgebra.Eigen (jacobiEigenSym)-import DataFrame.LinearAlgebra.Solve (choleskySolve)-import DataFrame.LinearModel-import DataFrame.LinearSolver (sigmoid)-import DataFrame.Model (fit, predict)-import DataFrame.PCA--import DataFrame.Internal.Statistics (correlation', 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)- Left err -> error (show err)--interpI :: D.DataFrame -> Expr Int -> [Int]-interpI df e = case interpret @Int df e of- Right (TColumn c) -> either (const []) VU.toList (toVector @Int @VU.Vector c)- Left err -> error (show err)--mat :: [[Double]] -> V.Vector (VU.Vector Double)-mat = V.fromList . map VU.fromList--close :: Double -> Double -> Double -> Bool-close tol a b = abs (a - b) <= tol--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)- e^-2 = 0.1353352832366127, e^-1 = 0.36787944117144233- sum = 1.5032147243... ; log(sum) = 0.40760596444...- => 1002.4076059644...- A naive `log . sum . map exp` overflows to +Inf here. -}-testLogSumExpLargePositive :: Test-testLogSumExpLargePositive = TestCase $ do- let lse = logSumExp (VU.fromList [1000, 1001, 1002])- expected = 1002 + log (exp (-2) + exp (-1) + 1)- assertBool "lse large-positive is finite" (finite lse)- assertBool- "lse [1000,1001,1002] == 1002 + log(e^-2+e^-1+1)"- (close 1e-9 lse expected)- -- sanity on the literal so the test pins the actual number, not just the formula- 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) [max is -1000]- = -1000 + 0.40760596444...- = -999.59239403556...- A naive implementation underflows every term to 0 -> log 0 = -Inf. -}-testLogSumExpLargeNegative :: Test-testLogSumExpLargeNegative = TestCase $ do- let lse = logSumExp (VU.fromList [-1000, -1001, -1002])- expected = -1000 + log (1 + exp (-1) + exp (-2))- assertBool "lse large-negative is finite" (finite lse)- assertBool- "lse [-1000,-1001,-1002] == -1000 + log(1+e^-1+e^-2)"- (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). -}-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) is 1 up to rounding (1 - ~0); sigmoid(-1000) is 0.- The naive 1/(1+exp(-z)) overflows exp(1000)=Inf at z=-1000 -> 1/Inf = 0 ok,- but exp(-(-1000)) path; the stable branch in DataFrame.LinearSolver.sigmoid- picks ez/(1+ez) for z<0 so e^-1000 underflows to 0 cleanly -> 0. -}-testSigmoidExtreme :: Test-testSigmoidExtreme = TestCase $ do- let sp = sigmoid 1000- sn = sigmoid (-1000)- assertBool "sigmoid(1000) finite" (finite sp)- assertBool "sigmoid(-1000) finite" (finite sn)- assertBool "sigmoid(1000) in [0,1]" (sp >= 0 && sp <= 1)- assertBool "sigmoid(-1000) in [0,1]" (sn >= 0 && sn <= 1)- -- saturated values: 1 and 0 to within machine epsilon- assertBool "sigmoid(1000) == 1" (close 1e-12 sp 1)- assertBool "sigmoid(-1000) == 0" (close 1e-12 sn 0)- -- sigmoid(0) is exactly 0.5- assertBool "sigmoid(0) == 0.5" (close 1e-15 (sigmoid 0) 0.5)- -- antisymmetry: sigmoid(-z) == 1 - sigmoid(z) at a moderate z- assertBool- "sigmoid antisymmetric at 3"- (close 1e-12 (sigmoid (-3)) (1 - sigmoid 3))--{- Variance of large-but-low-variance data: [1e8+1, 1e8+2, 1e8+3].- True sample variance (n-1) of {1,2,3} shifted by 1e8 is 1.0 exactly.- A naive sum-of-squares-minus-square-of-sum formula loses all precision here- (catastrophic cancellation) -> 0 or negative. Welford keeps it ~1. -}-testVarianceCatastrophicCancellation :: Test-testVarianceCatastrophicCancellation = TestCase $ do- let xs = VU.fromList [1e8 + 1, 1e8 + 2, 1e8 + 3] :: VU.Vector Double- v = variance' xs- assertBool "variance finite" (finite v)- assertBool "variance is positive" (v > 0)- -- sample variance of {1,2,3} = ((1-2)^2 + 0 + (3-2)^2)/(3-1) = 2/2 = 1- 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). -}-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. -}-testVarianceSingleton :: Test-testVarianceSingleton = TestCase $ do- assertEqual- "variance of one sample is 0"- 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. -}-testCorrelationPerfect :: Test-testCorrelationPerfect = TestCase $ do- let xs = VU.fromList [1, 2, 3, 4, 5] :: VU.Vector Double- ys = VU.map (\x -> 2 * x + 1) xs- yneg = VU.map (\x -> -(2 * x) + 1) xs- case correlation' xs ys of- Just r -> assertBool "corr(x, 2x+1) == 1" (close 1e-9 r 1)- Nothing -> assertFailure "expected a correlation"- case correlation' xs yneg of- 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- sqrt(... * (n*Syy - Sy^2)) is 0, so the library returns Just NaN. This pins- the ACTUAL behaviour: it does not throw, but it does produce a NaN that the- caller must guard. If a future fix makes it return Nothing or 0 this test- flags the contract change. -}-testCorrelationConstantColumnIsNaN :: Test-testCorrelationConstantColumnIsNaN = TestCase $ do- let xs = VU.fromList [1, 2, 3, 4, 5] :: VU.Vector Double- ys = VU.replicate 5 (9.0 :: Double)- case correlation' xs ys of- Just r ->- assertBool- "corr with a zero-variance column is NaN (degenerate denom)"- (isNaN r)- Nothing -> assertFailure "correlation' returned Nothing (contract changed)"--{- correlation' on n<2 returns Nothing (guarded), not a NaN. -}-testCorrelationTooFew :: Test-testCorrelationTooFew = TestCase $ do- assertEqual- "correlation of one point is Nothing"- Nothing- (correlation' (VU.fromList [1]) (VU.fromList [2]))---- ===========================================================================--- Category 8: stability inside the model expr layer--- ===========================================================================--{- Logistic probability expressions at extreme feature values must remain in- [0,1] and finite. The prob expr is 1/(1+exp(-margin)); with a separating- model and |x| pushed to 1e6 the margin is huge, so a non-stable evaluation- could overflow. We assert every probability is finite and in [0,1] and that- the two one-vs-rest class probabilities are present. -}-testLogisticProbsExtremeFeatures :: Test-testLogisticProbsExtremeFeatures = TestCase $ do- let trainDf =- D.fromNamedColumns- [ ("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- -- evaluate the class-1 probability at extreme inputs- extremeDf =- D.fromNamedColumns- [("x", DI.fromList ([-1e6, -1, 0, 1, 1e6] :: [Double]))]- assertEqual "two one-vs-rest probability exprs" 2 (M.size probs)- let allProbVals =- concat [interpD extremeDf e | e <- M.elems probs]- assertBool "all logistic probabilities finite" (all finite allProbVals)- assertBool- "all logistic probabilities in [0,1]"- (all (\p -> p >= 0 && p <= 1) allProbVals)---- ===========================================================================--- Category 7: edge cases / degeneracy on models--- ===========================================================================--{- One-row OLS: a single point (x=2, y=7). With one observation OLS is- under-determined; the QR design [1, 2] is rank deficient (n=1 < d=2 cols of- the intercept-augmented matrix) so olsSolve falls back to ridge(1e-8). The- fitted line must at minimum interpolate the single training point: the- prediction at x=2 must equal 7 (within tolerance). It must NOT be NaN/Inf. -}-testOLSOneRow :: Test-testOLSOneRow = TestCase $ do- let df =- D.fromNamedColumns- [ ("x", DI.fromList ([2] :: [Double]))- , ("y", DI.fromList ([7] :: [Double]))- ]- m = fit defaultLinearConfig (F.col @Double "y") df- preds = interpD df (predict m)- assertBool "single OLS prediction finite" (all finite preds)- assertBool- "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). -}-testLogisticSingleClass :: Test-testLogisticSingleClass = TestCase $ do- let df =- D.fromNamedColumns- [ ("x", DI.fromList ([-2, -1, 0, 1, 2] :: [Double]))- , ("label", DI.fromList ([1, 1, 1, 1, 1] :: [Int]))- ]- m = fit defaultLogisticConfig (F.col @Int "label") df- preds = interpI df (predict m)- assertEqual- "single-class logistic predicts that class everywhere"- [1, 1, 1, 1, 1]- preds--{- Perfectly separable logistic data with a constant (zero-variance) feature- added. The constant column has variance 0 and is dropped by keptIndices- (>= 1e-12 threshold); the informative column still separates the classes.- Prediction must recover the labels exactly and not be corrupted by the- constant column. -}-testLogisticConstantFeatureIgnored :: Test-testLogisticConstantFeatureIgnored = TestCase $ do- let df =- D.fromNamedColumns- [ ("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]))- ]- m = fit defaultLogisticConfig (F.col @Int "label") df- preds = interpI df (predict m)- assertEqual- "logistic ignores constant column and separates"- [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. -}-testLinearConstantFeatureZeroWeight :: Test-testLinearConstantFeatureZeroWeight = TestCase $ do- let xs = [1, 2, 3, 4, 5, 6] :: [Double]- df =- D.fromNamedColumns- [ ("x", DI.fromList xs)- , ("const", DI.fromList (replicate 6 (5.0 :: Double)))- , ("y", DI.fromList [3 * x + 4 | x <- xs])- ]- m = fit defaultLinearConfig (F.col @Double "y") df- coefs = VU.toList (regCoef m)- names = V.toList (regFeatureNames m)- byName = zip names coefs- -- find the const column weight; it must be ~0 (no information, possibly- -- collinear with the intercept)- case lookup "const" byName of- Just w -> assertBool "constant feature gets ~zero weight" (close 1e-6 w 0)- Nothing -> assertFailure "const column missing from feature names"- let preds = interpD df (predict m)- truth = [3 * x + 4 | x <- xs]- assertBool- "regression with constant feature still fits y=3x+4"- (and (zipWith (close 1e-4) preds truth))--{- k-means with k > n: requesting more clusters than data points. The library- clamps k = min k (max 1 n), so with 3 rows and kmK=10 we must get exactly 3- centres (one per point), labels in range, and finite centres -- not a crash- or empty/duplicate-degenerate centres. -}-testKMeansKGreaterThanN :: Test-testKMeansKGreaterThanN = TestCase $ do- let df =- D.fromNamedColumns- [ ("a", DI.fromList ([0, 5, 10] :: [Double]))- , ("b", DI.fromList ([0, 5, 10] :: [Double]))- ]- cfg = defaultKMeansConfig{kmK = 10, kmNInit = 3, kmSeed = 1}- m = fit cfg [F.col @Double "a", F.col @Double "b"] df- assertEqual "k clamped to n=3 centres" 3 (V.length (kmCenters m))- let labels = VU.toList (kmLabels m)- assertBool "all labels in [0,2]" (all (\l -> l >= 0 && l < 3) labels)- assertBool- "all centre coordinates finite"- (all (VU.all finite) (V.toList (kmCenters m)))- -- with 3 distinct points and 3 clusters, inertia must be ~0 (each point is- -- its own centre)- assertBool "k=n clustering has ~zero inertia" (close 1e-9 (kmInertia m) 0)--{- k-means on an all-identical (zero-variance) feature set: every row is the same- point. Any clustering has inertia 0; centres must all equal that point and be- finite (no NaN from dividing by an empty cluster or by a zero distance sum in- k-means++ sampling). -}-testKMeansAllIdentical :: Test-testKMeansAllIdentical = TestCase $ do- let df =- D.fromNamedColumns- [ ("a", DI.fromList (replicate 6 (4.0 :: Double)))- , ("b", DI.fromList (replicate 6 (4.0 :: Double)))- ]- cfg = defaultKMeansConfig{kmK = 2, kmNInit = 3, kmSeed = 1}- m = fit cfg [F.col @Double "a", F.col @Double "b"] df- assertBool- "centres finite on degenerate identical data"- (all (VU.all finite) (V.toList (kmCenters m)))- assertBool "inertia is 0 for identical points" (close 1e-12 (kmInertia m) 0)- -- predict must still assign a valid (finite, in-range) label to every row- 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. -}-testGMMKGreaterThanN :: Test-testGMMKGreaterThanN = TestCase $ do- let df =- D.fromNamedColumns- [ ("a", DI.fromList ([0, 10] :: [Double]))- , ("b", DI.fromList ([0, 10] :: [Double]))- ]- cfg = defaultGMMConfig{gmmK = 5, gmmSeed = 1}- m = fit cfg [F.col @Double "a", F.col @Double "b"] df- assertEqual "GMM k clamped to n=2" 2 (VU.length (gmmWeights m))- assertBool "GMM weights finite" (VU.all finite (gmmWeights m))- assertBool "GMM weights sum to ~1" (close 1e-6 (VU.sum (gmmWeights m)) 1)- assertBool "GMM log-likelihood finite" (finite (gmmLogLikelihood m))--{- PCA on a single informative axis plus a constant column: the constant column- carries zero variance, so its explained-variance ratio must be ~0 and the- ratios must still sum to ~1 and stay finite. The first component should align- with the varying axis. Catches a divide-by-zero in the ratio normalisation- when one eigenvalue is 0. -}-testPCAConstantColumn :: Test-testPCAConstantColumn = TestCase $ do- let df =- D.fromNamedColumns- [ ("x", DI.fromList ([-2, -1, 0, 1, 2] :: [Double]))- , ("const", DI.fromList (replicate 5 (3.0 :: Double)))- ]- m =- fit- (PCAConfig (NComp 2) False)- [F.col @Double "x", F.col @Double "const"]- df- ratio = VU.toList (pcaExplainedVarianceRatio m)- assertBool "explained ratios finite" (all finite ratio)- assertBool "explained ratios sum to ~1" (close 1e-9 (sum ratio) 1)- -- the variance is entirely along x, so the top ratio must be ~1- assertBool "first PC explains ~all variance" (close 1e-9 (head ratio) 1)- -- projection exprs must evaluate to finite numbers- let es = map snd (pcaExprs m)- assertBool- "pca exprs finite on constant column"- (all (all finite . interpD df) es)--{- PCA on extreme-scale features (1e8-shifted) without standardisation: the- covariance entries are ~1 (variance of {1,2,3}) despite the 1e8 offset.- Components must stay unit-length and finite -- catches cancellation in the- covariance / eigendecomposition at large magnitudes. -}-testPCAExtremeScale :: Test-testPCAExtremeScale = TestCase $ do- let df =- D.fromNamedColumns- [ ("x", DI.fromList ([1e8 + 1, 1e8 + 2, 1e8 + 3, 1e8 + 4] :: [Double]))- , ("y", DI.fromList ([1e8 + 1, 1e8 + 2, 1e8 + 3, 1e8 + 4] :: [Double]))- ]- m =- fit- (PCAConfig (NComp 1) False)- [F.col @Double "x", F.col @Double "y"]- df- comp0 = pcaComponents m V.! 0- nrm = sqrt (VU.sum (VU.map (^ (2 :: Int)) comp0))- assertBool "component finite at 1e8 scale" (VU.all finite comp0)- assertBool "component unit length at 1e8 scale" (close 1e-6 nrm 1)- assertBool- "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. -}-testCholeskyNonPD :: Test-testCholeskyNonPD = TestCase $ do- assertEqual- "cholesky of singular zero matrix is Nothing"- 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). -}-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). -}-testJacobiIdentity :: Test-testJacobiIdentity = TestCase $ do- let (ev, vecs) = jacobiEigenSym (mat [[1, 0], [0, 1]])- assertBool "identity eigenvalues both 1" (VU.all (close 1e-12 1) ev)- assertBool "identity eigenvectors finite" (all (VU.all finite) (V.toList vecs))--tests :: [Test]-tests =- [ testLogSumExpLargePositive- , testLogSumExpLargeNegative- , testLogSumExpSingleton- , testSigmoidExtreme- , testVarianceCatastrophicCancellation- , testVarianceConstant- , testVarianceSingleton- , testCorrelationPerfect- , testCorrelationConstantColumnIsNaN- , testCorrelationTooFew- , testLogisticProbsExtremeFeatures- , testOLSOneRow- , testLogisticSingleClass- , testLogisticConstantFeatureIgnored- , testLinearConstantFeatureZeroWeight- , testKMeansKGreaterThanN- , testKMeansAllIdentical- , testGMMKGreaterThanN- , testPCAConstantColumn- , testPCAExtremeScale- , testCholeskyNonPD- , testJacobi1x1- , testJacobiIdentity- ]
tests/Learn/Ensembles.hs view
@@ -14,11 +14,10 @@ import DataFrame.DBSCAN import DataFrame.GMM import DataFrame.LinearModel-import DataFrame.LinearSolver (defaultSolverConfig) import DataFrame.Metrics (r2) import DataFrame.ModelSelection -import Data.Maybe (isJust, isNothing)+import Data.Maybe (isJust, isNothing, listToMaybe) import qualified Data.Vector.Unboxed as VU import DataFrame.Model (fit, predict) import Test.HUnit@@ -97,7 +96,9 @@ blobs assigns = interpI blobs (predict m) assertBool "GMM converged" (gmmConverged m)- assertBool "GMM splits the blobs" (head assigns /= last assigns)+ assertBool+ "GMM splits the blobs"+ (listToMaybe assigns /= listToMaybe (reverse assigns)) let m2 = fit defaultGMMConfig{gmmK = 2, gmmSeed = 1}@@ -138,12 +139,15 @@ , DI.fromList ([2 * fromIntegral i + 5 | i <- [1 .. 40 :: Int]] :: [Double]) ) ]- score alpha train test =+ score alpha train test' = let mdl =- fit (LinearConfig (Ridge alpha) defaultSolverConfig) (F.col @Double "y") train+ fit+ (LinearConfig (Ridge alpha) defaultSolverConfig)+ (F.col @Double "y")+ (train :: D.DataFrame) in r2- (VU.fromList (interpD test (predict mdl)))- (VU.fromList (interpD test (F.col @Double "y")))+ (VU.fromList (interpD test' (predict mdl)))+ (VU.fromList (interpD test' (F.col @Double "y"))) res = gridSearch 4 7 [0.0, 1.0, 100.0] score df assertBool "best score high" (gsBestScore res > 0.99) assertEqual "all configs scored" 3 (length (gsAll res))
tests/Learn/MetricsTests.hs view
@@ -8,7 +8,6 @@ import qualified DataFrame.Internal.Column as DI import DataFrame.LinearModel-import DataFrame.LinearSolver (defaultSolverConfig) import DataFrame.Metrics import DataFrame.Metrics.Report import DataFrame.ModelSelection@@ -48,14 +47,12 @@ testMulticlassMetrics :: Test testMulticlassMetrics = TestCase $ do assertBool "accuracy" (close 1e-9 (accuracy preds3 truth3) 0.875)- -- class 1: tp=2 (idx2,6), fp=1 (idx3) -> precision 2/3 assertBool "binary precision class 1" (close 1e-9 (precision (Binary 1) preds3 truth3) (2 / 3)) assertBool "macro f1 sane" (f1 Macro preds3 truth3 > 0.8 && f1 Macro preds3 truth3 <= 1)- -- micro f1 == accuracy for single-label assertBool "micro f1 == accuracy" (close 1e-9 (f1 Micro preds3 truth3) (accuracy preds3 truth3))@@ -74,7 +71,6 @@ assertBool "report accuracy" (close 1e-9 (crAccuracy cr) 0.875) let rr = regressionReport (VU.fromList [1, 2, 3]) (VU.fromList [1, 2, 4]) assertBool "regression report rmse" (rrRMSE rr > 0)- -- Show instances don't crash assertBool "classification report shows" (not (null (show cr))) assertBool "confusion shows" (not (null (show (confusionMatrix preds3 truth3)))) @@ -103,7 +99,6 @@ testTransformCompose = TestCase $ do let scaler = standardScaler ["x"] reg pca = fit (PCAConfig (NComp 1) False) [F.col @Double "x"] reg- -- the whole point: scaler <> pcaTransform compose as a monoid pipeline = scalerTransform scaler <> pcaTransform pca out = applyTransform pipeline reg assertBool "pipeline produced a frame" (D.columnNames out /= [])
tests/Learn/Models.hs view
@@ -14,15 +14,17 @@ import DataFrame.DecisionTree.Regression import DataFrame.KMeans import DataFrame.LinearModel-import DataFrame.LinearSolver (SolverConfig (..), defaultSolverConfig) import DataFrame.PCA import DataFrame.SVM import DataFrame.Transform +import Control.Exception (evaluate, try)+import Data.List (isInfixOf) 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.Model (fit, predict) import Test.HUnit @@ -50,6 +52,19 @@ xs1 = [1, 2, 3, 4, 5, 6, 7, 8] :: [Double] xs2 = [2, 1, 4, 3, 6, 5, 8, 7] :: [Double] +-- | A custom enum label type — logistic regression must classify into it.+data Flower = Rose | Tulip | Daisy deriving (Show, Eq, Ord)++flowerDF :: D.DataFrame+flowerDF =+ D.fromNamedColumns+ [ ("x", DI.fromList ([-5, -4, -3, 0, 0.3, 0.6, 5, 6, 7] :: [Double]))+ ,+ ( "flower"+ , DI.fromList [Rose, Rose, Rose, Tulip, Tulip, Tulip, Daisy, Daisy, Daisy]+ )+ ]+ clsDF :: D.DataFrame clsDF = D.fromNamedColumns@@ -68,6 +83,58 @@ truth = interpD regDF (F.col @Double "y") assertBool "OLS expr matches y" (and (zipWith (close 1e-6) preds truth)) +{- | A regression frame whose feature column @x@ is stored as @Int@; the target+@y@ is @Double@. Fitting must reject the Int feature at the boundary.+-}+intFeatureDF :: D.DataFrame+intFeatureDF =+ D.fromNamedColumns+ [ ("x", DI.fromList @Int [1 .. 8])+ , ("y", DI.fromList @Double [2, 4, 6, 8, 10, 12, 14, 16])+ ]++{- | The fit boundary mandates Double: a non-Double feature column is a fit-time+error (naming the column and pointing at the fix), not a silent coercion.+-}+testFitRequiresDouble :: Test+testFitRequiresDouble = TestCase $ do+ let m = fit defaultLinearConfig (F.col @Double "y") intFeatureDF+ result <-+ try (evaluate (VU.sum (regCoef m))) :: IO (Either DataFrameException Double)+ case result of+ Left e -> do+ let msg = show e+ assertBool "error mentions the Double requirement" ("Double" `isInfixOf` msg)+ assertBool "error names the offending column x" ("x" `isInfixOf` msg)+ Right _ -> assertFailure "expected a Double-input error for the Int feature column"++{- | A regression frame whose feature @x@ is nullable (@Maybe Double@). Fitting+must reject it rather than letting nulls poison the solve into NaN.+-}+nullableFeatureDF :: D.DataFrame+nullableFeatureDF =+ D.fromNamedColumns+ [ ("x", DI.fromList @(Maybe Double) (Nothing : map Just [2, 3, 4, 5, 6, 7, 8]))+ , ("y", DI.fromList @Double [2, 4, 6, 8, 10, 12, 14, 16])+ ]++{- | The fit boundary rejects a nullable (Maybe Double) input column with an+actionable error, instead of silently producing NaN coefficients.+-}+testFitRejectsNullable :: Test+testFitRejectsNullable = TestCase $ do+ let m = fit defaultLinearConfig (F.col @Double "y") nullableFeatureDF+ result <-+ try (evaluate (VU.sum (regCoef m))) :: IO (Either DataFrameException Double)+ case result of+ Left e -> do+ let msg = show e+ assertBool+ "error flags the non-null requirement"+ ("non-null Double" `isInfixOf` msg)+ assertBool "error names the nullable column x" ("x" `isInfixOf` msg)+ Right _ -> assertFailure "expected a nullable-input error for the Maybe Double feature"+ testRidgeShrinks :: Test testRidgeShrinks = TestCase $ do let r0 =@@ -86,6 +153,18 @@ let probs = logisticProbExprs m assertBool "prob exprs present for both classes" (M.size probs == 2) +{- | Logistic regression must work with any enum label type, not just Int —+multiclass classification into a user-defined sum type.+-}+testLogisticEnumLabel :: Test+testLogisticEnumLabel = TestCase $ do+ let m = fit defaultLogisticConfig (F.col @Flower "flower") flowerDF+ preds = case interpret @Flower flowerDF (predict m) of+ Right (TColumn c) -> either (const []) V.toList (toVector @Flower @V.Vector c)+ Left e -> error (show e)+ truth = [Rose, Rose, Rose, Tulip, Tulip, Tulip, Daisy, Daisy, Daisy]+ assertEqual "logistic recovers enum-typed labels" truth preds+ testSVC :: Test testSVC = TestCase $ do let m = fit defaultSVCConfig (F.col @Int "label") clsDF@@ -146,7 +225,6 @@ let scaler = standardScaler ["x1", "x2"] regDF t = scalerTransform scaler scaledDf = applyTransform t regDF- -- fit model on scaled features, then compile scaling into the expr m = fit defaultLinearConfig (F.col @Double "y") scaledDf composed = compileThrough t (predict m) viaCompose = interpD regDF composed@@ -158,8 +236,11 @@ tests :: [Test] tests = [ testOLS+ , testFitRequiresDouble+ , testFitRejectsNullable , testRidgeShrinks , testLogistic+ , testLogisticEnumLabel , testSVC , testRegressionTree , testClassifierStats
− tests/Learn/NumericalRigor.hs
@@ -1,438 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}--{- | Numerical-rigor suite: gradient checks (cat 4), reproducibility across the-stochastic models (cat 16), and statistical / distributional properties of the-RNG and splitters (cat 5). Every test is constructed to FAIL on a real bug — no-@assertEqual v v@, no rubber tolerances.--}-module Learn.NumericalRigor (tests) where--import qualified DataFrame as D-import qualified DataFrame.Functions as F-import qualified DataFrame.Internal.Column as DI--import DataFrame.GMM-import DataFrame.KMeans-import DataFrame.LinearSolver.Loss (- SmoothLoss (..),- logisticLoss,- sigmoid,- sqHingeLoss,- squaredLoss,- )-import DataFrame.Model (fit)-import DataFrame.ModelSelection (trainTestSplit)-import DataFrame.Random-import DataFrame.SVM.RFF--import qualified Data.Vector.Unboxed as VU-import Test.HUnit---- ------------------------------------------------------------------------------ Independent reference loss VALUE functions.------ The library only exposes the gradient 'slGradZ'; the per-loss scalar value is--- reconstructed here straight from the module's own documented definitions, so--- the finite difference below is computed INDEPENDENTLY of the analytic--- gradient (anti-tautology: never finite-difference a gradient against itself).--- ------------------------------------------------------------------------------- | @½ (z - y)²@ (squaredLoss).-squaredValue :: Double -> Double -> Double-squaredValue y z = 0.5 * (z - y) * (z - y)---- | @log (1 + exp (-y z))@ (logisticLoss). softplus form, numerically stable.-logisticValue :: Double -> Double -> Double-logisticValue y z =- let m = negate (y * z)- in if m >= 0 then m + log1pExp (negate m) else log1pExp m- where- log1pExp x = log (1 + exp x)---- | @(max 0 (1 - y z))²@ (sqHingeLoss).-sqHingeValue :: Double -> Double -> Double-sqHingeValue y z = let m = 1 - y * z in if m > 0 then m * m else 0---- | Central finite difference of @f@ in @z@ at @(y, z)@.-centralDiff ::- (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 (both labels in @{ -1, +1 }@, many margins including the hinge-kink neighbourhood). Fails if the analytic gradient differs from the finite-difference anywhere beyond @tol@.--}-gradCheck ::- String ->- SmoothLoss ->- (Double -> Double -> Double) ->- Double ->- Test-gradCheck nm loss valueFn tol =- TestCase $- mapM_ check [(y, z) | y <- [-1, 1], z <- zs]- where- -- margins, deliberately avoiding the exact hinge kink z = y (m = 0) where- -- the squared-hinge second derivative is discontinuous; central diff is- -- still valid away from the kink.- zs = [-3.7, -2.1, -1.25, -0.6, -0.15, 0.22, 0.55, 1.4, 1.9, 2.8, 4.3]- check (y, z) = do- let analytic = slGradZ loss y z- fd = centralDiff valueFn 1e-6 y z- ok = abs (analytic - fd) <= tol * (1 + abs fd)- assertBool- ( nm- ++ " grad mismatch at (y="- ++ show y- ++ ", z="- ++ show z- ++ "): analytic="- ++ show analytic- ++ " finite-diff="- ++ show fd- )- ok---- | The squared-loss gradient @z - y@ checked against ½(z-y)².-testSquaredGradient :: Test-testSquaredGradient = gradCheck "squared" squaredLoss squaredValue 1e-5---- | The logistic gradient @-y·σ(-y z)@ checked against log(1+exp(-yz)).-testLogisticGradient :: Test-testLogisticGradient = gradCheck "logistic" logisticLoss logisticValue 1e-5---- | The squared-hinge gradient @-2y·max(0,1-yz)@ checked against (max 0 (1-yz))².-testSqHingeGradient :: Test-testSqHingeGradient = gradCheck "squared_hinge" sqHingeLoss sqHingeValue 1e-5--{- | Sign sanity that cannot be passed by a self-referential check: at a point-where the loss is strictly increasing in @z@ the analytic gradient must be-positive (and vice versa). Catches a flipped-sign gradient even if its-magnitude were somehow right. logistic with y=+1 decreases in z, so grad < 0;-squared with z>y increases, so grad > 0.--}-testGradientSigns :: Test-testGradientSigns = TestCase $ do- assertBool- "squared: grad>0 when z>y (loss rising)"- (slGradZ squaredLoss 1.0 3.0 > 0)- assertBool- "squared: grad<0 when z<y (loss falling)"- (slGradZ squaredLoss 1.0 (-2.0) < 0)- assertBool- "logistic y=+1: grad<0 (more positive margin lowers loss)"- (slGradZ logisticLoss 1.0 0.5 < 0)- assertBool- "logistic y=-1: grad>0"- (slGradZ logisticLoss (-1.0) 0.5 > 0)- assertBool- "sqHinge active margin y=+1: grad<0"- (slGradZ sqHingeLoss 1.0 0.0 < 0)- assertBool- "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; with N = 100k the standard--- error of a uniform-mean estimate is ~ (1/sqrt12)/sqrt(N) ~ 8.3e-4, so a 6σ--- band is ~ 5e-3. A broken sampler (e.g. one that returns the same value, 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 []- where- go 0 _ acc = acc- go k g acc = let (x, g') = nextDouble g in go (k - 1) g' (x : acc)--mean :: [Double] -> Double-mean xs = sum xs / fromIntegral (length xs)--variance :: [Double] -> Double-variance xs =- 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.--}-testUniformDistribution :: Test-testUniformDistribution = TestCase $ do- let n = 100000 :: Int- xs = drawUniforms n (mkGen 20240613)- m = mean xs- v = variance xs- seMean = (1 / sqrt 12) / sqrt (fromIntegral n)- assertBool "all uniforms in [0,1)" (all (\x -> x >= 0 && x < 1) xs)- assertBool- ("uniform mean ~0.5, got " ++ show m)- (abs (m - 0.5) <= 6 * seMean)- assertBool- ("uniform variance ~1/12, got " ++ show v)- (abs (v - 1 / 12) <= 0.01)- -- not a constant: spread across the unit interval- 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. SE of the mean is 1/sqrt(N) ~ 3.2e-3, so a 6σ-band ~ 2e-2. Catches a Box-Muller bug (wrong radius/angle, missing log) that-shifts the mean or scales the variance.--}-testGaussianMoments :: Test-testGaussianMoments = TestCase $ do- let n = 100000 :: Int- (vec, _) = gaussianVector n (mkGen 777)- xs = VU.toList vec- m = mean xs- v = variance xs- seMean = 1 / sqrt (fromIntegral n)- assertBool "gaussianVector length" (VU.length vec == n)- assertBool- "gaussian samples finite"- (all (\x -> not (isNaN x) && not (isInfinite x)) xs)- assertBool- ("gaussian mean ~0, got " ++ show m)- (abs m <= 6 * seMean)- assertBool- ("gaussian variance ~1, got " ++ show v)- (abs (v - 1) <= 0.03)- -- tail mass: ~4.55% should be |x|>2 for a true N(0,1); allow a wide band.- let tail2 = fromIntegral (length (filter (\x -> abs x > 2) xs)) / fromIntegral n- assertBool- ("gaussian |x|>2 frequency ~0.0455, got " ++ show tail2)- (abs (tail2 - 0.0455) <= 0.01)--{- | @trainTestSplit 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.--}-testSplitProportions :: Test-testSplitProportions = TestCase $ do- let nRows = 4000- frac = 0.7 :: Double- df = D.fromNamedColumns [("x", DI.fromList [1 .. nRows :: Int])]- seeds = [1 .. 25] :: [Int]- -- binomial SE of the fraction for n=4000 ~ sqrt(0.7*0.3/4000) ~ 7.2e-3- seFrac = sqrt (frac * (1 - frac) / fromIntegral nRows)- mapM_- ( \s -> do- let (tr, te) = trainTestSplit frac s df- nTr = fst (D.dimensions tr)- nTe = fst (D.dimensions te)- realized = fromIntegral nTr / fromIntegral nRows- assertEqual- ("split preserves rows (seed " ++ show s ++ ")")- nRows- (nTr + nTe)- assertBool- ( "split fraction ~"- ++ show frac- ++ " (seed "- ++ show s- ++ "), got "- ++ show realized- )- (abs (realized - frac) <= 5 * seFrac)- )- seeds--{- | k-means inertia on a clean, well-separated blob is stable across many-seeds and never beats the true within-cluster sum of squares of the generating-partition (the global optimum here is the obvious 2-cluster split). A broken-inertia (wrong distance, double counting) would report values below the optimum-or wildly seed-dependent.--}-testKMeansInertiaStable :: Test-testKMeansInertiaStable = TestCase $ do- let- -- two tight gaussian-ish blobs around (0,0) and (10,10)- 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)]- fitSeed s =- kmInertia $- fit- defaultKMeansConfig{kmK = 2, kmNInit = 1, kmSeed = s}- [F.col @Double "a", F.col @Double "b"]- df- inertias = map fitSeed [0 .. 19]- -- optimum: each blob's SS about its own mean. Blob means are ~ the- -- centroid; compute the true within-cluster SS for the 2-cluster split.- blob1 = take 5 (zip as bs)- blob2 = zip (drop 5 as) (drop 5 bs)- ssOf pts =- let mx = sum (map fst pts) / 5- my = sum (map snd pts) / 5- in sum [(x - mx) ^ (2 :: Int) + (y - my) ^ (2 :: Int) | (x, y) <- pts]- optimum = ssOf blob1 + ssOf blob2- best = minimum inertias- worst = maximum inertias- assertBool- "k-means inertia finite"- (all (\i -> not (isNaN i) && not (isInfinite i)) inertias)- assertBool- ( "k-means inertia never below optimum ("- ++ show optimum- ++ "), best="- ++ show best- )- (best >= optimum - 1e-9)- assertBool- ( "k-means inertia stable across seeds, best="- ++ show best- ++ " worst="- ++ show worst- )- (worst - best <= 1e-6 + 1e-3 * optimum)---- ------------------------------------------------------------------------------ Reproducibility tests (cat 16).------ Each compares two SEPARATE fits with the same seed (determinism) AND, where--- the seed is a real input, asserts that a DIFFERENT seed CAN change the model--- (so "always returns a constant" wouldn't pass). Models that derive Eq are--- compared with ==; others by a representative field or predicted expr.--- -----------------------------------------------------------------------------blobsDF :: D.DataFrame-blobsDF =- D.fromNamedColumns- [- ( "a"- , DI.fromList ([0, 0.2, -0.1, 0.1, 8, 8.1, 7.9, 8.2, 0.05, 8.05] :: [Double])- )- ,- ( "b"- , DI.fromList ([0, -0.1, 0.2, 0.0, 5, 5.2, 4.9, 5.1, 0.1, 5.05] :: [Double])- )- ]---- | Many-cluster frame so k-means++ seeding genuinely depends on the seed.-spreadDF :: D.DataFrame-spreadDF =- D.fromNamedColumns- [ ("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.--}-testKMeansReproducible :: Test-testKMeansReproducible = TestCase $ do- let cfg s = defaultKMeansConfig{kmK = 4, kmNInit = 1, kmMaxIter = 1, kmSeed = s}- run s = fit (cfg s) [F.col @Double "a", F.col @Double "b"]- a = run 1 spreadDF- b = run 1 spreadDF- assertEqual "k-means same seed identical model" a b- -- different seeds CAN differ: scan several and require at least one diff in- -- the initial centroids (1 iteration keeps the init's footprint).- let centersFor s = kmCenters (run s spreadDF)- base = centersFor 1- 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).--}-testGMMReproducible :: Test-testGMMReproducible = TestCase $ do- let cfg s = defaultGMMConfig{gmmK = 2, gmmMaxIter = 1, gmmSeed = s}- run s = fit (cfg s) [F.col @Double "a", F.col @Double "b"] blobsDF- a = run 1- b = run 1- assertEqual "GMM same seed identical model" a b- let meansFor s = gmmMeans (run s)- base = meansFor 1- 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.--}-testRFFReproducible :: Test-testRFFReproducible = TestCase $ do- let clsDF =- D.fromNamedColumns- [ ("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]))- ]- cfg s = defaultRFFConfig{rffD = 40, rffGamma = 0.2, rffSeed = s}- run s = fit (cfg s) (F.col @Int "label") clsDF- a = run 5- b = run 5- -- projection matrix and the fitted SVC coefficients must match bit-for-bit.- assertEqual "RFF same seed: same projection B" (rffB a) (rffB b)- assertEqual "RFF same seed: same coefficients" (rffCoef a) (rffCoef b)- assertEqual "RFF same seed: same intercept" (rffIntercept a) (rffIntercept b)- -- different seed: the random projection should differ.- let projFor s = rffB (run s)- base = projFor 5- anyDiffer = any (\s -> projFor s /= base) [1, 2, 3, 6, 7, 8]- assertBool "RFF: a different seed changes the projection" anyDiffer---- ------------------------------------------------------------------------------ randomSplit / trainTestSplit determinism + row-count invariant (cat 16 + 2).--- -----------------------------------------------------------------------------{- | @trainTestSplit@ 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])]- (tr1, te1) = trainTestSplit 0.6 42 df- (tr2, te2) = trainTestSplit 0.6 42 df- assertBool "trainTestSplit same seed: same train" (tr1 == tr2)- assertBool "trainTestSplit same seed: same test" (te1 == te2)- assertEqual- "trainTestSplit preserves row count"- 200- (fst (D.dimensions tr1) + fst (D.dimensions te1))- let trainFor s = fst (trainTestSplit 0.6 s df)- base = trainFor 42- anyDiffer = any (\s -> trainFor s /= base) [1, 2, 3, 7, 99]- assertBool "trainTestSplit: 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- "squaredValue at (y=2,z=5) == 4.5"- (abs (squaredValue 2 5 - 4.5) < 1e-12)- assertBool- "logisticValue at (y=1,z=0) == log 2"- (abs (logisticValue 1 0 - log 2) < 1e-12)- assertBool "sqHingeValue at (y=1,z=0) == 1" (abs (sqHingeValue 1 0 - 1) < 1e-12)- assertBool "sigmoid 0 == 0.5" (abs (sigmoid 0 - 0.5) < 1e-12)--tests :: [Test]-tests =- [ testReferenceValueSanity- , testSquaredGradient- , testLogisticGradient- , testSqHingeGradient- , testGradientSigns- , testUniformDistribution- , testGaussianMoments- , testSplitProportions- , testKMeansInertiaStable- , testKMeansReproducible- , testGMMReproducible- , testRFFReproducible- , testSplitReproducible- ]
− tests/Learn/Numerics.hs
@@ -1,99 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--module Learn.Numerics (tests) where--import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as VU-import DataFrame.Model (fit, predict)-import Test.HUnit--import DataFrame.LinearAlgebra-import DataFrame.LinearAlgebra.Eigen-import DataFrame.LinearAlgebra.Solve-import DataFrame.Random--mat :: [[Double]] -> Matrix-mat = V.fromList . map VU.fromList--approx :: Double -> Double -> Double -> Bool-approx tol a b = abs (a - b) <= tol--vApprox :: Double -> VU.Vector Double -> VU.Vector Double -> Bool-vApprox tol a b =- VU.length a == VU.length b && VU.and (VU.zipWith (approx tol) a b)--testQR :: Test-testQR = TestCase $ do- let a = mat [[1, 1], [1, 2], [1, 3], [1, 4]]- b = VU.fromList [3, 5, 7, 9]- case qrLeastSquares a b of- Right x ->- assertBool "QR recovers [1,2]" (vApprox 1e-9 x (VU.fromList [1, 2]))- Left cols -> assertFailure ("unexpected rank deficiency: " ++ show cols)--testQRRankDeficient :: Test-testQRRankDeficient = TestCase $ do- let a = mat [[1, 2], [2, 4], [3, 6]]- case qrLeastSquares a (VU.fromList [1, 2, 3]) of- Left _ -> pure ()- Right _ -> assertFailure "expected rank deficiency on collinear columns"--testCholesky :: Test-testCholesky = TestCase $ do- let a = mat [[4, 2], [2, 3]]- case choleskySolve a (VU.fromList [2, 1]) of- Just x ->- assertBool "cholesky solves" (vApprox 1e-9 x (VU.fromList [0.5, 0]))- Nothing -> assertFailure "expected PD"- assertEqual "non-PD rejected" Nothing (cholesky (mat [[1, 2], [2, 1]]))--testJacobi :: Test-testJacobi = TestCase $ do- let (ev, vecs) = jacobiEigenSym (mat [[2, 1], [1, 2]])- assertBool "eigenvalues [3,1]" (vApprox 1e-9 ev (VU.fromList [3, 1]))- let v0 = vecs V.! 0- recon = matVec (mat [[2, 1], [1, 2]]) v0- assertBool- "A v = lambda v"- (vApprox 1e-9 recon (scaleV (ev VU.! 0) v0))--testPowerIter :: Test-testPowerIter = TestCase $ do- let (lam, _) = powerIterTop 200 (mat [[2, 1], [1, 2]])- assertBool "dominant eigenvalue ~3" (approx 1e-6 lam 3)--testLogSumExp :: Test-testLogSumExp = TestCase $ do- let xs = VU.fromList [1000, 1001, 1002]- lse = logSumExp xs- assertBool "logSumExp stable, finite" (not (isNaN lse) && not (isInfinite lse))- assertBool "logSumExp >= max" (lse >= 1002)--testRngDeterminism :: Test-testRngDeterminism = TestCase $ do- let (a, _) = shuffleInts 50 (mkGen 11)- (b, _) = shuffleInts 50 (mkGen 11)- assertEqual "same seed same shuffle" a b- assertBool- "is a permutation"- (VU.toList (VU.modify (const (pure ())) a) /= [] && all (`VU.elem` a) [0 .. 49])--testRngRange :: Test-testRngRange = TestCase $ do- let go 0 _ acc = acc- go k g acc =- let (x, g') = nextIntR (3, 7) g in go (k - 1 :: Int) g' (x : acc)- xs = go 1000 (mkGen 5) []- assertBool "ints within range" (all (\x -> x >= 3 && x <= 7) xs)--tests :: [Test]-tests =- [ testQR- , testQRRankDeficient- , testCholesky- , testJacobi- , testPowerIter- , testLogSumExp- , testRngDeterminism- , testRngRange- ]
+ tests/Learn/Segmented.hs view
@@ -0,0 +1,316 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module Learn.Segmented (tests) where++import Control.Exception (SomeException, evaluate, try)+import Data.List (isInfixOf)+import qualified Data.Text as T+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as VU++import qualified DataFrame as D+import qualified DataFrame.Functions as F+import DataFrame.Internal.Column (TypedColumn (..), toVector)+import qualified DataFrame.Internal.Column as DI+import DataFrame.Internal.Expression (Expr)+import DataFrame.Internal.Interpreter (interpret)++import DataFrame.LinearModel.Logistic (defaultLogisticConfig)+import DataFrame.LinearModel.Regression (+ LinearRegressor (..),+ defaultLinearConfig,+ )+import DataFrame.Metrics (rmse)+import DataFrame.ModelSelection (crossValidate)+import DataFrame.Segmented+import DataFrame.SymbolicRegression (SRConfig (..), SRModel, defaultSRConfig)++import Test.HUnit++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)+ Left err -> error (show err)++interpT :: D.DataFrame -> Expr T.Text -> [T.Text]+interpT df e = case interpret @T.Text df e of+ Right (TColumn c) -> either (const []) V.toList (toVector @T.Text @V.Vector c)+ Left err -> error (show err)++close :: Double -> Double -> Double -> Bool+close tol a b = abs (a - b) <= tol++-- | A two-segment frame: y = 2x+1 on group "a", y = -3x+5 on group "b".+twoSegDF :: D.DataFrame+twoSegDF =+ D.fromNamedColumns+ [ ("g", DI.fromList (replicate 4 ("a" :: T.Text) ++ replicate 4 "b"))+ , ("x", DI.fromList xs)+ ,+ ( "y"+ , DI.fromList ([2 * x + 1 | x <- take 4 xs] ++ [(-3) * x + 5 | x <- drop 4 xs])+ )+ ]+ where+ xs = [1, 2, 3, 4, 1, 2, 3, 4] :: [Double]++segByKey ::+ [T.Text] -> SegmentedModel a LinearRegressor -> Segment LinearRegressor+segByKey k m = head [s | s <- smSegments m, segKey s == k]++lowFloor :: Segmented cfg -> Segmented cfg+lowFloor s = s{segMinRows = 3}++recoveryTests :: [Test]+recoveryTests =+ [ "per-segment OLS recovered" ~: do+ let m = fit (lowFloor (segmented defaultLinearConfig)) (F.col @Double "y") twoSegDF+ a = segModel (segByKey ["a"] m)+ b = segModel (segByKey ["b"] m)+ assertBool "two segments" (length (smSegments m) == 2)+ assertBool "a slope ~ 2" (close 1e-9 (regCoef a VU.! 0) 2)+ assertBool "a intercept ~ 1" (close 1e-9 (regIntercept a) 1)+ assertBool "b slope ~ -3" (close 1e-9 (regCoef b VU.! 0) (-3))+ assertBool "b intercept ~ 5" (close 1e-9 (regIntercept b) 5)+ , "prediction reproduces y" ~: do+ let m = fit (lowFloor (segmented defaultLinearConfig)) (F.col @Double "y") twoSegDF+ preds = interpD twoSegDF (predict m)+ truth = interpD twoSegDF (F.col @Double "y")+ assertBool "routed predictions match y" (and (zipWith (close 1e-6) preds truth))+ ]++routingTests :: [Test]+routingTests =+ [ "unseen category routes to fallback" ~: do+ let m = fit (lowFloor (segmented defaultLinearConfig)) (F.col @Double "y") twoSegDF+ fb = smFallback m+ unseen =+ D.fromNamedColumns+ [ ("g", DI.fromList (["c"] :: [T.Text]))+ , ("x", DI.fromList ([2.0] :: [Double]))+ , ("y", DI.fromList ([0.0] :: [Double]))+ ]+ p = case interpD unseen (predict m) of+ [p'] -> p'+ _ -> error "Expecting only a single segment"+ expected = regIntercept fb + regCoef fb VU.! 0 * 2.0+ assertBool "unseen -> fallback affine" (close 1e-9 p expected)+ ]++genericityTests :: [Test]+genericityTests =+ [ "logistic base composes" ~: do+ let labels = replicate 4 ("pos" :: T.Text) ++ replicate 4 "neg"+ df =+ D.fromNamedColumns+ [ ("g", DI.fromList (replicate 4 ("a" :: T.Text) ++ replicate 4 "b"))+ , ("x", DI.fromList ([1, 2, 3, 4, 1, 2, 3, 4] :: [Double]))+ , ("label", DI.fromList labels)+ ]+ m = fit (lowFloor (segmented defaultLogisticConfig)) (F.col @T.Text "label") df+ preds = interpT df (predict m)+ assertBool "logistic predicts one label per row" (length preds == 8)+ , "symbolic base composes" ~: do+ let cfg = defaultSRConfig{srGenerations = 2, srPopSize = 12}+ m = fit (lowFloor (segmented cfg)) (F.col @Double "y") twoSegDF+ preds = interpD twoSegDF (predict m)+ assertBool "symbolic predicts one value per row" (length preds == 8)+ ]++selectionTests :: [Test]+selectionTests =+ [ "segmentOn picks only the named column" ~: do+ let df =+ D.fromNamedColumns+ [ ("g", DI.fromList (replicate 4 ("a" :: T.Text) ++ replicate 4 "b"))+ , ("h", DI.fromList (cycle3 8))+ , ("x", DI.fromList ([1, 2, 3, 4, 1, 2, 3, 4] :: [Double]))+ , ("y", DI.fromList ([1, 2, 3, 4, 5, 6, 7, 8] :: [Double]))+ ]+ m =+ fit+ (segmentOn (lowFloor (segmented defaultLinearConfig)) ["g"])+ (F.col @Double "y")+ df+ assertEqual "only g" ["g"] (smCatCols m)+ , "cardinality cap skips high-cardinality text" ~: do+ let df =+ D.fromNamedColumns+ [ ("g", DI.fromList (replicate 4 ("a" :: T.Text) ++ replicate 4 "b"))+ , ("k", DI.fromList (map (T.pack . show) [1 .. 8 :: Int]))+ , ("x", DI.fromList ([1, 2, 3, 4, 1, 2, 3, 4] :: [Double]))+ , ("y", DI.fromList ([1, 2, 3, 4, 5, 6, 7, 8] :: [Double]))+ ]+ cfg = (lowFloor (segmented defaultLinearConfig)){segMaxCard = 2}+ m = fit cfg (F.col @Double "y") df+ assertEqual "k (8 distinct) skipped, g kept" ["g"] (smCatCols m)+ ]+ where+ cycle3 n = take n (cycle (["p", "q", "r"] :: [T.Text]))++nullTests :: [Test]+nullTests =+ [ "null categorical routes to fallback" ~: do+ let gcol =+ [Just "a", Just "a", Just "a", Nothing, Just "b", Just "b", Just "b", Nothing] ::+ [Maybe T.Text]+ df =+ D.fromNamedColumns+ [ ("g", DI.fromList gcol)+ , ("x", DI.fromList ([1, 2, 3, 9, 1, 2, 3, 9] :: [Double]))+ , ("y", DI.fromList ([3, 5, 7, 0, 2, -1, -4, 0] :: [Double]))+ ]+ m = fit (lowFloor (segmented defaultLinearConfig)) (F.col @Double "y") df+ -- Only "a" and "b" appear as segments; "null" is never a key.+ assertBool+ "no null-keyed segment"+ (["null"] `notElem` map segKey (smSegments m))+ assertBool "two real segments" (length (smSegments m) == 2)+ ]++-- | Fit a segmented linear model, capturing any fit-time error message.+fitErr ::+ D.DataFrame -> IO (Either SomeException (SegmentedModel Double LinearRegressor))+fitErr df =+ try+ (evaluate (fit (lowFloor (segmented defaultLinearConfig)) (F.col @Double "y") df))++guardTests :: [Test]+guardTests =+ [ "int feature error points at toDouble" ~: do+ let df =+ D.fromNamedColumns+ [ ("g", DI.fromList (replicate 4 ("a" :: T.Text) ++ replicate 4 "b"))+ , ("n", DI.fromList ([1, 2, 3, 4, 5, 6, 7, 8] :: [Int]))+ , ("y", DI.fromList ([1, 2, 3, 4, 5, 6, 7, 8] :: [Double]))+ ]+ r <- fitErr df+ case r of+ Left e ->+ assertBool+ "names column n and toDouble"+ ("n" `isInfixOf` show e && "toDouble" `isInfixOf` show e)+ Right _ -> assertFailure "expected an actionable error for the Int feature"+ , "nullable feature error points at dropping" ~: do+ let df =+ D.fromNamedColumns+ [ ("g", DI.fromList (replicate 4 ("a" :: T.Text) ++ replicate 4 "b"))+ ,+ ( "z"+ , DI.fromList+ ( [Just 1, Nothing, Just 3, Just 4, Just 5, Just 6, Just 7, Just 8] ::+ [Maybe Double]+ )+ )+ , ("y", DI.fromList ([1, 2, 3, 4, 5, 6, 7, 8] :: [Double]))+ ]+ r <- fitErr df+ case r of+ Left e ->+ assertBool+ "names column z and filterJust"+ ("z" `isInfixOf` show e && "filterJust" `isInfixOf` show e)+ Right _ -> assertFailure "expected an actionable error for the nullable feature"+ , "well-typed frame fits after casting/dropping" ~: do+ let df =+ D.fromNamedColumns+ [ ("g", DI.fromList (replicate 4 ("a" :: T.Text) ++ replicate 4 "b"))+ , ("n", DI.fromList ([1, 2, 3, 4, 5, 6, 7, 8] :: [Double]))+ , ("y", DI.fromList ([1, 2, 3, 4, 5, 6, 7, 8] :: [Double]))+ ]+ m = fit (lowFloor (segmented defaultLinearConfig)) (F.col @Double "y") df+ assertEqual "two segments" 2 (length (smSegments m))+ ]++diagnosticTests :: [Test]+diagnosticTests =+ [ "undersized segment falls back, diagnostics correct" ~: do+ let df =+ D.fromNamedColumns+ [ ("g", DI.fromList (replicate 4 ("a" :: T.Text) ++ ["b"]))+ , ("x", DI.fromList ([1, 2, 3, 4, 9] :: [Double]))+ , ("y", DI.fromList ([3, 5, 7, 9, 0] :: [Double]))+ ]+ m = fit (lowFloor (segmented defaultLinearConfig)) (F.col @Double "y") df+ assertEqual "one local segment" 1 (length (smSegments m))+ assertEqual "segment a has 4 rows" 4 (segN (segByKey ["a"] m))+ assertEqual "b fell back with 1 row" [(["b"], 1)] (smFellBack m)+ ]++cvTests :: [Test]+cvTests =+ [ "composes with crossValidate" ~: do+ let scores =+ crossValidate+ 2+ 0+ rmse+ (F.col @Double "y")+ ( predict+ . fit ((segmented defaultLinearConfig){segMinRows = 2}) (F.col @Double "y")+ )+ twoSegDF+ assertBool "two fold scores" (length scores == 2)+ assertBool+ "scores are finite"+ (all (\s -> not (isNaN s || isInfinite s)) scores)+ ]++poolingTests :: [Test]+poolingTests =+ [ "lambda limits and interior monotonicity" ~: do+ let fitL lam =+ fit+ (pooled (lowFloor (segmented defaultLinearConfig)) lam)+ (F.col @Double "y")+ twoSegDF+ m0 = fitL 0+ mInf = fitL 1e9+ mMid = fitL 5+ slope k mm = regCoef (segModel (segByKey k mm)) VU.! 0+ inter k mm = regIntercept (segModel (segByKey k mm))+ -- lambda = 0: independent OLS (matches recovery test).+ assertBool "lambda0 a slope 2" (close 1e-9 (slope ["a"] m0) 2)+ assertBool "lambda0 b slope -3" (close 1e-9 (slope ["b"] m0) (-3))+ -- lambda -> inf: both segments converge to the n_g-weighted reference+ -- (raw slope -0.5, raw intercept 3.0 for this balanced fixture).+ assertBool "lambdaInf a slope ~ -0.5" (close 1e-3 (slope ["a"] mInf) (-0.5))+ assertBool "lambdaInf b slope ~ -0.5" (close 1e-3 (slope ["b"] mInf) (-0.5))+ assertBool "lambdaInf a intercept ~ 3" (close 1e-3 (inter ["a"] mInf) 3.0)+ assertBool+ "lambdaInf segments coincide"+ (close 1e-3 (slope ["a"] mInf) (slope ["b"] mInf))+ -- interior: a's slope sits strictly between its OLS (2) and the ref (-0.5).+ assertBool+ "interior between OLS and ref"+ (slope ["a"] mMid < 2 && slope ["a"] mMid > (-0.5))+ , "pooling unsupported for symbolic base" ~: do+ r <-+ try+ ( evaluate+ ( fit+ (pooled (lowFloor (segmented defaultSRConfig)) 1.0)+ (F.col @Double "y")+ twoSegDF+ )+ ) ::+ IO (Either SomeException (SegmentedModel Double SRModel))+ case r of+ Left _ -> return ()+ Right _ -> assertFailure "expected a fit-time error for pooling on a symbolic base"+ ]++tests :: [Test]+tests =+ concat+ [ recoveryTests+ , routingTests+ , genericityTests+ , selectionTests+ , nullTests+ , guardTests+ , diagnosticTests+ , cvTests+ , poolingTests+ ]
tests/Learn/SklearnParity.hs view
@@ -1,10 +1,9 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} -{- | Parity tests against scikit-learn on clean Kaggle-style datasets. The-reference values in @data/ml/golden.json@ are produced by-@scripts/gen_sklearn_golden.py@. Closed-form models (OLS, ridge, PCA) are held to-tight coefficient parity; iterative models to an accuracy/inertia floor.+{- | Parity tests against scikit-learn on clean Kaggle-style datasets; reference+values in @data/ml/golden.json@ come from @scripts/gen_sklearn_golden.py@.+Closed-form models get tight coefficient parity; iterative ones an accuracy floor. -} module Learn.SklearnParity (tests) where @@ -32,7 +31,6 @@ ) import DataFrame.KMeans import DataFrame.LinearModel-import DataFrame.LinearSolver (defaultSolverConfig) import DataFrame.PCA import DataFrame.SVM
− tests/Learn/Symbolic.hs
@@ -1,134 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-}--module Learn.Symbolic (tests) where--import qualified DataFrame as D-import qualified DataFrame.Functions as F-import DataFrame.Internal.Column (TypedColumn (..), toVector)-import qualified DataFrame.Internal.Column as DI-import DataFrame.Internal.Expression (Expr)-import DataFrame.Internal.Interpreter (interpret)--import DataFrame.PCA.Kernel-import DataFrame.SVM.RFF-import DataFrame.SymbolicRegression-import DataFrame.SymbolicRegression.Expr-import DataFrame.SymbolicRegression.Optimize (meanSquaredError)-import DataFrame.SymbolicRegression.Simplify (simplify)--import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as VU-import DataFrame.Model (fit, predict)-import Test.HUnit--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)- Left err -> error (show err)--interpI :: D.DataFrame -> Expr Int -> [Int]-interpI df e = case interpret @Int df e of- Right (TColumn c) -> either (const []) VU.toList (toVector @Int @VU.Vector c)- Left err -> error (show err)--testSRRecovers :: Test-testSRRecovers = TestCase $ do- let xs = [-3, -2, -1, 0, 1, 2, 3, 4, 5, 6] :: [Double]- df =- D.fromNamedColumns- [ ("x", DI.fromList xs)- , ("y", DI.fromList [x * x + x | x <- xs])- ]- m =- fit- defaultSRConfig- { srSeed = 3- , srGenerations = 60- , srPopSize = 300- , srUnaryOps = []- }- (F.col @Double "y")- df- preds = interpD df (srBest m)- truth = interpD df (F.col @Double "y")- err = sum (zipWith (\p t -> (p - t) ^ (2 :: Int)) preds truth) / 10- assertBool "SR recovers x*x+x to low error" (err < 1e-6)- assertBool "Pareto front non-empty" (not (null (srPareto m)))--testSRDeterminism :: Test-testSRDeterminism = TestCase $ do- let xs = [1 .. 8] :: [Double]- df =- D.fromNamedColumns- [ ("x", DI.fromList xs)- , ("y", DI.fromList (map (\x -> 2 * x + 1) xs))- ]- run =- fit- defaultSRConfig{srSeed = 9, srGenerations = 20}- (F.col @Double "y")- df- assertEqual "SR deterministic best MSE" (srBestMSE run) (srBestMSE (rerun df))- where- rerun =- fit- defaultSRConfig{srSeed = 9, srGenerations = 20}- (F.col @Double "y")--testSimplifyPreservesEval :: Test-testSimplifyPreservesEval = TestCase $ do- let feats = V.singleton (VU.fromList [1, 2, 3, 4 :: Double])- n = 4- e = SBin SAdd (SBin SMul (SVar 0) (SConst 1)) (SConst 0)- target = VU.fromList [1, 2, 3, 4]- assertBool- "simplify preserves evaluation"- ( abs- (meanSquaredError feats n target e - meanSquaredError feats n target (simplify e))- < 1e-12- )- assertBool "simplify is size non-increasing" (srSize (simplify e) <= srSize e)- assertEqual "simplify idempotent" (simplify e) (simplify (simplify e))--testKernelPCA :: Test-testKernelPCA = TestCase $ do- let df =- D.fromNamedColumns- [ ("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]))- ]- m =- fit- defaultKernelPCAConfig{kpcaNComponents = 2, kpcaNLandmarks = 8, kpcaSeed = 1}- [F.col @Double "a", F.col @Double "b"]- df- pc1 = interpD df (snd (head (kernelPCAExprs m)))- assertBool "kPCA finite" (not (any isNaN pc1))- assertBool- "kPCA first component separates blobs"- (signum (head pc1) /= signum (last pc1))--testRFFSVM :: Test-testRFFSVM = TestCase $ do- let df =- D.fromNamedColumns- [ ("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- defaultRFFConfig{rffD = 80, rffGamma = 0.2, rffSeed = 2}- (F.col @Int "label")- df- preds = interpI df (predict m)- assertEqual "RFF SVM separates" [0, 0, 0, 0, 1, 1, 1, 1] preds--tests :: [Test]-tests =- [ testSRRecovers- , testSRDeterminism- , testSimplifyPreservesEval- , testKernelPCA- , testRFFSVM- ]
+ tests/Learn/TypedModel.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++{- | 'fit'/'predict' are frame-aware. Training on a 'TypedDataFrame' with a typed+target ('DT.col') returns a 'Fitted' carrying the schema, and 'predict' on it+yields a typed 'TExpr'; training on an untyped 'DataFrame' with an untyped target+('F.col') returns the bare model and an 'Expr'. Both paths must agree numerically.+-}+module Learn.TypedModel (tests) where++import Data.Maybe (fromJust)+import qualified Data.Vector.Unboxed as VU++import qualified DataFrame as D+import qualified DataFrame.Functions as F+import DataFrame.Internal.Column (TypedColumn (..), toVector)+import qualified DataFrame.Internal.Column as DI+import DataFrame.Internal.Expression (Expr)+import DataFrame.Internal.Interpreter (interpret)++import DataFrame.LinearModel.Regression (+ LinearConfig (..),+ LinearRegressor (..),+ Penalty (..),+ defaultLinearConfig,+ )+import DataFrame.Model (Fitted (..), fit, predict)+import qualified DataFrame.Typed as DT++import Test.HUnit++-- | All-Double schema: two features and a Double target.+type Houses =+ '[ DT.Column "x1" Double+ , DT.Column "x2" Double+ , DT.Column "y" Double+ ]++regDF :: D.DataFrame+regDF =+ D.fromNamedColumns+ [ ("x1", DI.fromList xs1)+ , ("x2", DI.fromList xs2)+ , ("y", DI.fromList [2 * a - 3 * b + 1 | (a, b) <- zip xs1 xs2])+ ]+ where+ xs1 = [1, 2, 3, 4, 5, 6, 7, 8] :: [Double]+ xs2 = [2, 1, 4, 3, 6, 5, 8, 7] :: [Double]++housesTDF :: DT.TypedDataFrame Houses+housesTDF = fromJust (DT.freeze @Houses regDF)++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)+ Left err -> error (show err)++close :: Double -> Double -> Double -> Bool+close tol a b = abs (a - b) <= tol++sameModel :: LinearRegressor -> LinearRegressor -> Bool+sameModel a b =+ and (zipWith (close 1e-12) (VU.toList (regCoef a)) (VU.toList (regCoef b)))+ && close 1e-12 (regIntercept a) (regIntercept b)++{- | 'fit' on a 'TypedDataFrame' returns a 'Fitted' whose model matches the+bare model from 'fit' on the equivalent 'DataFrame'.+-}+testTypedFitParity :: Test+testTypedFitParity = TestCase $ do+ let onTyped = fit defaultLinearConfig (DT.col @"y") housesTDF+ onUntyped = fit defaultLinearConfig (F.col @Double "y") regDF+ assertBool+ "fittedModel of typed fit == untyped fit"+ (sameModel (fittedModel onTyped) onUntyped)++{- | 'predict' on the typed fit yields a 'TExpr Houses Double'; unwrapped and+interpreted it matches 'predict' on the untyped fit.+-}+testTypedPredict :: Test+testTypedPredict = TestCase $ do+ let onTyped = fit defaultLinearConfig (DT.col @"y") housesTDF+ onUntyped = fit defaultLinearConfig (F.col @Double "y") regDF+ typedExpr = DT.unTExpr (predict onTyped) -- :: Expr Double via TExpr Houses Double+ untypedExpr = predict onUntyped -- :: Expr Double+ truth = interpD regDF (F.col @Double "y")+ assertBool+ "typed predict matches untyped predict"+ ( and+ (zipWith (close 1e-12) (interpD regDF typedExpr) (interpD regDF untypedExpr))+ )+ assertBool+ "typed predict recovers the target"+ (and (zipWith (close 1e-6) (interpD regDF typedExpr) truth))++-- | The frame-awareness holds for a regularized fit too.+testTypedRidge :: Test+testTypedRidge = TestCase $ do+ let cfg = defaultLinearConfig{lcPenalty = Ridge 0.01}+ onTyped = fit cfg (DT.col @"y") housesTDF+ onUntyped = fit cfg (F.col @Double "y") regDF+ assertBool+ "ridge: fittedModel of typed fit == untyped fit"+ (sameModel (fittedModel onTyped) onUntyped)++tests :: [Test]+tests =+ [ TestLabel "typed fit returns Fitted matching untyped" testTypedFitParity+ , TestLabel "typed predict yields TExpr matching untyped" testTypedPredict+ , TestLabel "typed ridge fit parity" testTypedRidge+ ]
− tests/LinearSolver.hs
@@ -1,828 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-}--module LinearSolver where--import qualified DataFrame as D-import qualified DataFrame.Internal.Column as DI-import DataFrame.Internal.Expression (Expr (..), getColumns)-import DataFrame.Internal.Interpreter (interpret)-import DataFrame.LinearSolver--import Data.List (sort)-import qualified Data.Text as T-import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as VU-import System.Random (StdGen, mkStdGen, randomR)-import Test.HUnit----------------------------------------------------------------------------- Test fixtures and helpers----------------------------------------------------------------------------- Generate n points with d features, each value 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]- in V.fromList (take n rows)- where- step _ (acc, g) =- let (row, g') = genRow d g- in (row : acc, g')- genRow k g0 = go k g0 []- where- go 0 g xs = (VU.fromList (reverse xs), g)- go i g xs =- let (v, g') = randomR (-1.0 :: Double, 1.0) g- in go (i - 1) g' (v : xs)---- Label each row by sign(w . x + b); +1 if score > 0, else -1.-labelsForHyperplane ::- V.Vector (VU.Vector Double) ->- VU.Vector Double ->- Double ->- VU.Vector Double-labelsForHyperplane rows w b =- VU.generate- (V.length rows)- ( \i ->- let score = dotProduct w (rows V.! i) + b- in if score > 0 then 1 else -1- )---- Cosine similarity between two non-zero vectors.-cosineSim :: VU.Vector Double -> VU.Vector Double -> Double-cosineSim u v =- let nu = sqrt (dotProduct u u)- nv = sqrt (dotProduct v v)- in if nu == 0 || nv == 0 then 0 else dotProduct u v / (nu * nv)---- Predict +1 or -1 from a fitted LinearModel.-predict :: LinearModel -> VU.Vector Double -> Double-predict m x =- let score = dotProduct (lmWeights m) x + lmIntercept m- in if score > 0 then 1 else -1---- Predict directly on standardized features (skipping de-standardization).-predictStandardized :: VU.Vector Double -> Double -> VU.Vector Double -> Double-predictStandardized w b x =- if dotProduct w x + b > 0 then 1 else -1---- Average binary logistic loss at (w, b).-logisticLoss ::- V.Vector (VU.Vector Double) ->- VU.Vector Double ->- VU.Vector Double ->- Double ->- Double-logisticLoss features labels w b =- let n = V.length features- loss i =- let yi = labels VU.! i- row = features V.! i- margin = yi * (dotProduct w row + b)- in -- log(1 + exp(-margin)), numerically stable- if margin >= 0- then log (1 + exp (-margin))- else (-margin) + log (1 + exp margin)- in sum [loss i | i <- [0 .. n - 1]] / fromIntegral n----------------------------------------------------------------------------- A1: Recover known hyperplane with no L1---------------------------------------------------------------------------testA1RecoverHyperplane :: Test-testA1RecoverHyperplane = TestCase $ do- let groundTruth = VU.fromList [0.7, -0.5]- groundBias = 0.3- rows = syntheticPoints 1 200 2- labels = labelsForHyperplane rows groundTruth groundBias- cfg =- defaultSolverConfig- { scL1Lambda = 0- , scL2Lambda = 0- , scMaxIter = 500- , scTol = 1e-6- }- model = fitL1Logistic cfg rows labels (V.fromList ["x", "y"])- cosSim = cosineSim (lmWeights model) groundTruth- sameSignAll =- all- (\i -> predict model (rows V.! i) == labels VU.! i)- [0 .. V.length rows - 1]- assertBool- ("recovered weights should align with ground truth (cos = " ++ show cosSim ++ ")")- (cosSim > 0.99)- assertBool "all training points predicted correctly" sameSignAll----------------------------------------------------------------------------- A2: L1 produces sparse weights---------------------------------------------------------------------------testA2L1Sparsity :: Test-testA2L1Sparsity = TestCase $ do- -- 10 features, only feature 1 and feature 4 carry signal.- let groundTruth = VU.fromList [0, 1.2, 0, 0, -1.5, 0, 0, 0, 0, 0]- groundBias = 0- rows = syntheticPoints 7 500 10- labels = labelsForHyperplane rows groundTruth groundBias- cfg =- defaultSolverConfig- { scL1Lambda = 0.1- , scL2Lambda = 0- , scMaxIter = 500- , scTol = 1e-6- }- names = V.fromList [T.pack ("f" ++ show i) | i <- [0 .. 9 :: Int]]- model = fitL1Logistic cfg rows labels names- ws = VU.toList (lmWeights model)- nonZeroIdxs = [i | (i, w) <- zip [0 :: Int ..] ws, w /= 0]- zeroIdxs = [i | (i, w) <- zip [0 :: Int ..] ws, w == 0]- assertBool- ( "informative feature 1 should have non-zero weight (got "- ++ show (ws !! 1)- ++ ")"- )- (ws !! 1 /= 0)- assertBool- ( "informative feature 4 should have non-zero weight (got "- ++ show (ws !! 4)- ++ ")"- )- (ws !! 4 /= 0)- -- Of the 8 noise features (indices 0,2,3,5,6,7,8,9), expect at least 6 to be 0.- let noiseFeatures = [0, 2, 3, 5, 6, 7, 8, 9] :: [Int]- noiseZero = length [i | i <- noiseFeatures, i `elem` zeroIdxs]- assertBool- ( "at least 6 noise features zeroed (got "- ++ show noiseZero- ++ "; non-zero idxs = "- ++ show nonZeroIdxs- ++ ")"- )- (noiseZero >= 6)----------------------------------------------------------------------------- A3: Convergence on well-conditioned input---------------------------------------------------------------------------testA3Convergence :: Test-testA3Convergence = TestCase $ do- let groundTruth = VU.fromList [1.0, -0.5, 0.7]- rows = syntheticPoints 2 300 3- labels = labelsForHyperplane rows groundTruth 0- cfg =- defaultSolverConfig- { scL1Lambda = 0.01- , scL2Lambda = 0- , scMaxIter = 1000- , scTol = 1e-5- }- model = fitL1Logistic cfg rows labels (V.fromList ["a", "b", "c"])- -- Loss at the fitted model- (rowsStd, _, _, _) = standardize rows- ws = lmWeights model- b = lmIntercept model- -- Re-standardize the weights for loss comparison on standardized data- loss0 = logisticLoss rowsStd labels (VU.replicate 3 0) 0- -- Fit gives raw weights; compute loss on raw rows- lossFit = logisticLoss rows labels ws b- assertBool- ( "loss decreased from initial (initial="- ++ show loss0- ++ ", final="- ++ show lossFit- ++ ")"- )- (lossFit < loss0)----------------------------------------------------------------------------- A4: Final loss <= initial loss (monotone or near-monotone in FISTA)---------------------------------------------------------------------------testA4LossNotIncreasing :: Test-testA4LossNotIncreasing = TestCase $ do- let groundTruth = VU.fromList [0.8, 0.4]- rows = syntheticPoints 3 100 2- labels = labelsForHyperplane rows groundTruth 0- cfg = defaultSolverConfig{scL1Lambda = 0.05, scL2Lambda = 0, scMaxIter = 100}- model = fitL1Logistic cfg rows labels (V.fromList ["x", "y"])- loss0 = logisticLoss rows labels (VU.replicate 2 0) 0- lossFit = logisticLoss rows labels (lmWeights model) (lmIntercept model)- assertBool- ( "final loss must be <= initial loss (l0="- ++ show loss0- ++ ", lf="- ++ show lossFit- ++ ")"- )- (lossFit <= loss0 + 1e-9)----------------------------------------------------------------------------- A5: Degenerate input — all labels +1---------------------------------------------------------------------------testA5AllSameDirection :: Test-testA5AllSameDirection = TestCase $ do- let rows = syntheticPoints 4 50 3- labels = VU.replicate 50 1.0- cfg = defaultSolverConfig{scL1Lambda = 0.01, scL2Lambda = 0, scMaxIter = 100}- model = fitL1Logistic cfg rows labels (V.fromList ["a", "b", "c"])- ws = VU.toList (lmWeights model)- b = lmIntercept model- anyNaN = any isNaN ws || isNaN b- anyInf = any isInfinite ws || isInfinite b- allPositive = all (\i -> predict model (rows V.! i) == 1) [0 .. V.length rows - 1]- assertBool "no NaN in weights/intercept" (not anyNaN)- assertBool "no Inf in weights/intercept" (not anyInf)- assertBool- "all-same labels should produce a positive-predicting model"- allPositive----------------------------------------------------------------------------- A6: Degenerate — empty input---------------------------------------------------------------------------testA6Empty :: Test-testA6Empty = TestCase $ do- let cfg = defaultSolverConfig- emptyRows = V.empty :: V.Vector (VU.Vector Double)- emptyLabels = VU.empty :: VU.Vector Double- names = V.fromList ["a", "b"]- model = fitL1Logistic cfg emptyRows emptyLabels names- assertEqual- "empty input -> 2 zero weights"- (VU.fromList [0, 0])- (lmWeights model)- assertEqual "empty input -> zero intercept" 0 (lmIntercept model)----------------------------------------------------------------------------- A7: Degenerate — constant feature---------------------------------------------------------------------------testA7ConstantFeature :: Test-testA7ConstantFeature = TestCase $ do- -- Feature 1 is informative (uniform in [-1,1]); feature 0 is constant at 0.5.- let baseRows = syntheticPoints 5 100 1- rows =- V.map- (\row -> VU.fromList (0.5 : VU.toList row))- baseRows- groundTruth = VU.fromList [0.0, 1.0] -- only feature 1 matters- labels = labelsForHyperplane rows groundTruth 0- cfg =- defaultSolverConfig- { scL1Lambda = 0.01- , scL2Lambda = 0- , scMaxIter = 300- , scTol = 1e-6- }- model = fitL1Logistic cfg rows labels (V.fromList ["constant", "signal"])- ws = VU.toList (lmWeights model)- anyBad = any (\x -> isNaN x || isInfinite x) ws- assertBool- ("constant feature weight ~ 0 (got " ++ show (head ws) ++ ")")- (abs (head ws) < 1e-6)- assertBool- ("signal feature non-zero (got " ++ show (ws !! 1) ++ ")")- (ws !! 1 /= 0)- assertBool "no NaN/Inf" (not anyBad)----------------------------------------------------------------------------- A8: Numerical stability with large feature values---------------------------------------------------------------------------testA8LargeValues :: Test-testA8LargeValues = TestCase $ do- let scale = 1000.0 :: Double- baseRows = syntheticPoints 6 100 2- rows = V.map (VU.map (* scale)) baseRows- groundTruth = VU.fromList [0.5, -0.7]- labels = labelsForHyperplane rows groundTruth 0- cfg = defaultSolverConfig{scL1Lambda = 0.01, scL2Lambda = 0, scMaxIter = 300}- model = fitL1Logistic cfg rows labels (V.fromList ["x", "y"])- ws = VU.toList (lmWeights model)- b = lmIntercept model- anyBad = any (\x -> isNaN x || isInfinite x) (b : ws)- sameSigns =- length- [ () | i <- [0 .. V.length rows - 1], predict model (rows V.! i) == labels VU.! i- ]- assertBool "no NaN/Inf with scaled features" (not anyBad)- assertBool- ( "should correctly classify the vast majority of rows ("- ++ show sameSigns- ++ "/100)"- )- (sameSigns >= 90)----------------------------------------------------------------------------- A9: Standardization round-trip — recovered weights point in the true--- direction even when raw-feature scales differ by orders of magnitude.--- A broken de-standardization formula would scramble the per-feature scale--- of @wRaw@ and the cosine to ground truth would drop sharply.---------------------------------------------------------------------------testA9StandardizationRoundTrip :: Test-testA9StandardizationRoundTrip = TestCase $ do- let nRows = 80 :: Int- -- Column 0 ranges 0..400 (mean ~200, std ~115).- -- Column 1 ranges 0..0.2 (mean ~0.1, std ~0.058).- -- True hyperplane: (col0 - 200) + 1000 * (col1 - 0.1) > 0- -- True raw weights (modulo positive scaling): [1.0, 1000.0]- col0 = [fromIntegral i * 5 :: Double | i <- [0 .. nRows - 1]]- col1 = [fromIntegral i * 0.0025 :: Double | i <- [0 .. nRows - 1]]- rows = V.fromList [VU.fromList [c0, c1] | (c0, c1) <- zip col0 col1]- labels =- VU.fromList- [ if (c0 - 200) + 1000 * (c1 - 0.1) > 0 then 1.0 else -1.0- | (c0, c1) <- zip col0 col1- ]- cfg =- defaultSolverConfig- { scL1Lambda = 1.0e-4- , scL2Lambda = 0- , scMaxIter = 2000- , scTol = 1.0e-7- }- model = fitL1Logistic cfg rows labels (V.fromList ["x", "y"])- truthDir = VU.fromList [1.0, 1000.0]- cs = cosineSim (lmWeights model) truthDir- -- All training points correctly classified- trainPreds =- [predict model (rows V.! i) | i <- [0 .. nRows - 1]]- trainLabs =- [labels VU.! i | i <- [0 .. nRows - 1]]- correct =- length- [() | (p, l) <- zip trainPreds trainLabs, p == l]- assertEqual "all training points correctly classified" nRows correct- assertBool- ( "recovered raw weights align with ground-truth direction across "- ++ "vastly different feature scales (cos = "- ++ show cs- ++ ")"- )- (cs > 0.95)----------------------------------------------------------------------------- A10: Determinism — same input -> same output---------------------------------------------------------------------------testA10Determinism :: Test-testA10Determinism = TestCase $ do- let groundTruth = VU.fromList [0.6, 0.4]- rows = syntheticPoints 9 60 2- labels = labelsForHyperplane rows groundTruth 0- cfg = defaultSolverConfig{scL1Lambda = 0.05, scL2Lambda = 0, scMaxIter = 200}- m1 = fitL1Logistic cfg rows labels (V.fromList ["x", "y"])- m2 = fitL1Logistic cfg rows labels (V.fromList ["x", "y"])- assertEqual "same input -> same weights" (lmWeights m1) (lmWeights m2)- assertEqual "same input -> same intercept" (lmIntercept m1) (lmIntercept m2)----------------------------------------------------------------------------- A11: Two-feature ground truth recovery (w_2/w_1 ratio)---------------------------------------------------------------------------testA11GroundTruthRatio :: Test-testA11GroundTruthRatio = TestCase $ do- -- y = sign(x1 + 2*x2 - 3); pull from a larger range so a non-zero intercept matters.- let groundTruth = VU.fromList [1.0, 2.0]- groundBias = -3.0- n = 500- baseRows = syntheticPoints 10 n 2- -- Scale up so x_i can range over [-3, 3] -- gives wider coverage of the boundary- rows = V.map (VU.map (* 3)) baseRows- labels = labelsForHyperplane rows groundTruth groundBias- cfg =- defaultSolverConfig- { scL1Lambda = 0.001- , scL2Lambda = 0- , scMaxIter = 1000- , scTol = 1e-7- }- model = fitL1Logistic cfg rows labels (V.fromList ["x", "y"])- ws = lmWeights model- b = lmIntercept model- ratio = (ws VU.! 1) / (ws VU.! 0)- biasRatio = b / (ws VU.! 0)- assertBool- ("w2/w1 should approximate 2.0 (got " ++ show ratio ++ ")")- (ratio > 1.7 && ratio < 2.3)- assertBool- ("b/w1 should approximate -3.0 (got " ++ show biasRatio ++ ")")- (biasRatio > -3.4 && biasRatio < -2.6)----------------------------------------------------------------------------- B1: modelToExpr produces a well-typed Expr Bool---------------------------------------------------------------------------testB1ExprWellTyped :: Test-testB1ExprWellTyped = TestCase $ do- let model =- LinearModel- { lmWeights = VU.fromList [1.0, -2.0]- , lmIntercept = 0.5- , lmFeatureNames = V.fromList ["x", "y"]- }- expr = modelToExpr model- -- Evaluate on a 3-row DataFrame- df =- D.fromNamedColumns- [ ("x", DI.fromList ([0.0, 1.0, 2.0] :: [Double]))- , ("y", DI.fromList ([0.0, 0.0, 5.0] :: [Double]))- ]- -- Manual predictions: 1*x - 2*y + 0.5 > 0 ?- manual =- [ (1.0 * 0.0 - 2.0 * 0.0 + 0.5) > 0- , (1.0 * 1.0 - 2.0 * 0.0 + 0.5) > 0- , (1.0 * 2.0 - 2.0 * 5.0 + 0.5) > 0- ]- case interpret @Bool df expr of- Left e -> assertFailure ("interpret failed: " ++ show e)- Right (DI.TColumn col) -> case DI.toVector @Bool col of- Left e -> assertFailure ("toVector failed: " ++ show e)- Right vals ->- assertEqual "Expr matches manual evaluation" manual (V.toList vals)----------------------------------------------------------------------------- B2: Zero weights are dropped from the resulting Expr---------------------------------------------------------------------------testB2ZeroWeightsPruned :: Test-testB2ZeroWeightsPruned = TestCase $ do- let model =- LinearModel- { lmWeights = VU.fromList [0.0, 1.5, 0.0]- , lmIntercept = 0.0- , lmFeatureNames = V.fromList ["a", "b", "c"]- }- expr = modelToExpr model- cols = sort (getColumns expr)- assertEqual "only column b appears in the Expr" ["b"] cols----------------------------------------------------------------------------- A14: Constant feature at large raw value — weight must be exactly 0--- and no NaN/Inf leaks into the rest of the fit.---------------------------------------------------------------------------testA14ConstantHugeValue :: Test-testA14ConstantHugeValue = TestCase $ do- let baseRows = syntheticPoints 14 100 1 -- one informative feature- -- Prepend a constant column at 1e8 to each row.- rows =- V.map- (\row -> VU.fromList (1.0e8 : VU.toList row))- baseRows- -- Label depends only on the informative (second) feature.- labels = labelsForHyperplane rows (VU.fromList [0.0, 1.0]) 0- cfg = defaultSolverConfig{scL1Lambda = 0.01, scL2Lambda = 0, scMaxIter = 300}- model = fitL1Logistic cfg rows labels (V.fromList ["constant", "signal"])- ws = VU.toList (lmWeights model)- b = lmIntercept model- anyBad = any (\v -> isNaN v || isInfinite v) (b : ws)- assertBool "no NaN/Inf with constant-at-1e8 feature" (not anyBad)- assertEqual- "constant feature is dropped — weight is exactly zero"- 0- (head ws)- assertBool- ("signal feature has non-zero weight (got " ++ show (ws !! 1) ++ ")")- (ws !! 1 /= 0)----------------------------------------------------------------------------- A15: Variance exactly zero (all rows identical for that column).---------------------------------------------------------------------------testA15AllZeroFeature :: Test-testA15AllZeroFeature = TestCase $ do- -- A column that is exactly 0 for every row.- let baseRows = syntheticPoints 15 80 1- rows =- V.map- (\row -> VU.fromList (0.0 : VU.toList row))- baseRows- labels = labelsForHyperplane rows (VU.fromList [0.0, 1.0]) 0- cfg = defaultSolverConfig{scL1Lambda = 0.01, scL2Lambda = 0, scMaxIter = 300}- model = fitL1Logistic cfg rows labels (V.fromList ["zero", "signal"])- ws = VU.toList (lmWeights model)- assertEqual "zero-variance column has weight zero" 0 (head ws)- assertBool ("signal weight non-zero (" ++ show (ws !! 1) ++ ")") (ws !! 1 /= 0)----------------------------------------------------------------------------- A16: Severely imbalanced labels (99:1) — should not collapse to a--- constant predictor on the majority class without some learning.---------------------------------------------------------------------------testA16ImbalancedLabels :: Test-testA16ImbalancedLabels = TestCase $ do- let nPos = 99- nNeg = 1- n = nPos + nNeg- rows = syntheticPoints 16 n 2- labels =- VU.fromList- (replicate nPos 1.0 ++ replicate nNeg (-1.0))- cfg = defaultSolverConfig{scL1Lambda = 0.01, scL2Lambda = 0, scMaxIter = 500}- model = fitL1Logistic cfg rows labels (V.fromList ["x", "y"])- ws = VU.toList (lmWeights model)- b = lmIntercept model- anyBad = any (\v -> isNaN v || isInfinite v) (b : ws)- assertBool "no NaN/Inf with 99:1 imbalance" (not anyBad)- -- The intercept should be positive (the easy thing for the model is to- -- predict the majority); weights may or may not be zero depending on lambda.- assertBool ("intercept favors majority class (got b=" ++ show b ++ ")") (b > 0)----------------------------------------------------------------------------- A17: Mixed per-feature raw scales — should not diverge.---------------------------------------------------------------------------testA17ImbalancedRawScales :: Test-testA17ImbalancedRawScales = TestCase $ do- let baseRows = syntheticPoints 17 100 3- -- Per-row: [1e-6 * v, v, 1e6 * v] — three columns with vastly- -- different scales but the same underlying signal.- rows =- V.map- ( \row ->- let v0 = row VU.! 0- v1 = row VU.! 1- v2 = row VU.! 2- in VU.fromList [1.0e-6 * v0, v1, 1.0e6 * v2]- )- baseRows- labels = labelsForHyperplane baseRows (VU.fromList [1.0, -0.5, 0.7]) 0- cfg = defaultSolverConfig{scL1Lambda = 1.0e-4, scL2Lambda = 0, scMaxIter = 500}- model = fitL1Logistic cfg rows labels (V.fromList ["tiny", "unit", "huge"])- ws = VU.toList (lmWeights model)- b = lmIntercept model- anyBad = any (\v -> isNaN v || isInfinite v) (b : ws)- assertBool ("no NaN/Inf with mixed scales (ws=" ++ show ws ++ ")") (not anyBad)- -- The fit should classify the training points correctly on aggregate.- let preds = [predict model (rows V.! i) | i <- [0 .. V.length rows - 1]]- lbls = [labels VU.! i | i <- [0 .. VU.length labels - 1]]- correct = length [() | (p, l) <- zip preds lbls, p == l]- -- The wild per-feature scales make the problem poorly conditioned for- -- L1-regularized FISTA with a fixed Lipschitz upper bound. We don't- -- expect optimal accuracy — the assertion is "not random" (>=65%),- -- catching divergence-to-garbage rather than guaranteeing fit quality.- assertBool- ("non-divergent under wild scales (got " ++ show correct ++ "/100)")- (correct >= 65)----------------------------------------------------------------------------- A12: maxIter = 0 returns the initial point unchanged---------------------------------------------------------------------------testA12MaxIterZero :: Test-testA12MaxIterZero = TestCase $ do- let rows = syntheticPoints 20 50 2- labels = labelsForHyperplane rows (VU.fromList [1.0, -0.5]) 0- cfg = defaultSolverConfig{scMaxIter = 0}- model = fitL1Logistic cfg rows labels (V.fromList ["x", "y"])- assertEqual- "maxIter=0 returns zero weights"- (VU.fromList [0, 0])- (lmWeights model)- assertEqual "maxIter=0 returns zero intercept" 0 (lmIntercept model)----------------------------------------------------------------------------- A13: maxIter = 1 takes exactly one prox step (results differ from--- the initial zero point but may not be near the optimum).---------------------------------------------------------------------------testA13MaxIterOne :: Test-testA13MaxIterOne = TestCase $ do- let rows = syntheticPoints 21 80 2- labels = labelsForHyperplane rows (VU.fromList [1.0, -0.5]) 0- cfg = defaultSolverConfig{scMaxIter = 1, scL1Lambda = 0.001, scL2Lambda = 0}- cfg0 = cfg{scMaxIter = 0}- m1 = fitL1Logistic cfg rows labels (V.fromList ["x", "y"])- m0 = fitL1Logistic cfg0 rows labels (V.fromList ["x", "y"])- anyNonZero v = not (VU.all (== 0) v)- -- maxIter=0 returns zeros- assertEqual "baseline m0 weights are zero" (VU.fromList [0, 0]) (lmWeights m0)- -- maxIter=1 differs from maxIter=0 (one step actually happened)- assertBool- ("maxIter=1 must change at least one weight (got " ++ show (lmWeights m1) ++ ")")- (anyNonZero (lmWeights m1) || lmIntercept m1 /= 0)- -- Final value is finite- let badW = VU.any (\x -> isNaN x || isInfinite x) (lmWeights m1)- badB = isNaN (lmIntercept m1) || isInfinite (lmIntercept m1)- assertBool "no NaN/Inf after one iteration" (not (badW || badB))----------------------------------------------------------------------------- PR 3: Elastic Net recovery on correlated-feature pairs.--- Pure L1 picks ONE of two correlated informative features at random;--- Elastic Net keeps BOTH non-zero (Zou & Hastie 2005 "grouping effect",--- §2.3 Theorem 1).------ Two cases per the ML reviewer: ρ ≈ 0.97 (strong) and ρ ≈ 0.7 (moderate).----------------------------------------------------------------------------- Generate two correlated features f0, f1 with correlation ρ, plus--- noise features f2..f7. Truth is sign(f0 + f1).-correlatedPairData ::- Int -> Double -> (V.Vector (VU.Vector Double), VU.Vector Double)-correlatedPairData seed rho =- let n = 400 :: Int- d = 8 :: Int- g0 = mkStdGen seed- drawUnit = randomR (-1.0 :: Double, 1.0)- drawRow !gIn =- let (z0, g1) = drawUnit gIn- (epsRaw, g2) = drawUnit g1- eps = epsRaw * sqrt (max 0 (1 - rho * rho))- f0 = z0- f1 = rho * z0 + eps -- corr(f0, f1) ≈ rho by construction- drawNoise k g- | k >= d - 2 = ([], g)- | otherwise =- let (x, g') = drawUnit g- (xs, g'') = drawNoise (k + 1) g'- in (x : xs, g'')- (noise, g3) = drawNoise 0 g2- row = f0 : f1 : noise- in (VU.fromList row, g3)- go 0 _ acc = reverse acc- go k g acc =- let (r, g') = drawRow g- in go (k - 1) g' (r : acc)- rows = V.fromList (go n g0 [])- labels =- VU.generate n $ \i ->- let r = rows V.! i- s = VU.unsafeIndex r 0 + VU.unsafeIndex r 1- in if s > 0 then 1.0 else -1.0- in (rows, labels)--testA19ElasticNetRecoveryHigh :: Test-testA19ElasticNetRecoveryHigh = TestCase $ do- -- ρ ≈ 0.97: positive test for Elastic Net's "grouping effect" —- -- both correlated informative features kept non-zero and on the- -- same order of magnitude. (We don't assert pure L1 picks just one;- -- with strong-signal features L1 sometimes keeps both anyway.)- let (rows, labels) = correlatedPairData 31 0.97- names = V.fromList ["f0", "f1", "f2", "f3", "f4", "f5", "f6", "f7"]- cfgEN = defaultSolverConfig{scL1Lambda = 0.05, scL2Lambda = 0.05, scMaxIter = 1000}- men = fitL1Logistic cfgEN rows labels names- wEN = VU.toList (lmWeights men)- nzCount xs = length (filter (/= 0) xs)- (aEN, bEN) = case wEN of- (a : b : _) -> (a, b)- _ -> error "elastic-net test: expected at least two weights"- assertBool- ("ρ=0.97 EN keeps f0 non-zero; wEN[:2] = " ++ show (take 2 wEN))- (aEN /= 0)- assertBool- ("ρ=0.97 EN keeps f1 non-zero; wEN[:2] = " ++ show (take 2 wEN))- (bEN /= 0)- let ratio = abs aEN / max (abs bEN) 1e-9- assertBool- ("ρ=0.97 EN grouping: |w0/w1| ∈ [0.33, 3.0]; got ratio=" ++ show ratio)- (ratio >= 0.33 && ratio <= 3.0)- -- Sanity: shouldn't have spuriously activated all noise features.- assertBool- ("ρ=0.97 EN sparsity: total non-zero ≤ 5; got " ++ show (nzCount wEN))- (nzCount wEN <= 5)--testA19ElasticNetRecoveryMid :: Test-testA19ElasticNetRecoveryMid = TestCase $ do- -- ρ ≈ 0.7: theoretically required regime for grouping (Zou-Hastie 2005 §5.1).- let (rows, labels) = correlatedPairData 37 0.7- names = V.fromList ["f0", "f1", "f2", "f3", "f4", "f5", "f6", "f7"]- cfgEN = defaultSolverConfig{scL1Lambda = 0.05, scL2Lambda = 0.05, scMaxIter = 1000}- men = fitL1Logistic cfgEN rows labels names- wEN = VU.toList (lmWeights men)- (aEN, bEN) = case wEN of- (a : b : _) -> (a, b)- _ -> error "elastic-net test: expected at least two weights"- assertBool- ("ρ=0.7 EN keeps f0 non-zero; wEN[:2] = " ++ show (take 2 wEN))- (aEN /= 0)- assertBool- ("ρ=0.7 EN keeps f1 non-zero; wEN[:2] = " ++ show (take 2 wEN))- (bEN /= 0)- let ratio = abs aEN / max (abs bEN) 1e-9- assertBool- ("ρ=0.7 EN grouping: |w0/w1| ∈ [0.33, 3.0]; got ratio=" ++ show ratio)- (ratio >= 0.33 && ratio <= 3.0)----------------------------------------------------------------------------- PR 3: A20 — class-balanced fit on 95/5 imbalance.--- Without weights the intercept polarises toward logit(0.95) ≈ 2.94.--- With sample weights mean-1 sklearn-form, the intercept sits near 0 and--- predictions become roughly balanced on a symmetric test set.---------------------------------------------------------------------------testA20ClassBalancedFit :: Test-testA20ClassBalancedFit = TestCase $ do- -- Generate 200 rows: 190 positive, 10 negative. Class-conditional- -- means are at ±0.15 with σ ≈ 0.6 — only weakly informative on a- -- single feature, so the unweighted MLE intercept absorbs the- -- class prior @logit(0.95) ≈ 2.94@; class-balanced weighting must- -- pull it back toward zero. Highly-separable features (e.g. mu=±1)- -- would let the slope dominate and mask the intercept effect.- let n = 200 :: Int- nPos = 190 :: Int- g0 = mkStdGen 41- drawN = randomR (-1.0 :: Double, 1.0)- drawRowAt mu g =- let (z, g') = drawN g- x = mu + 0.6 * z- in (VU.singleton x, g')- rowsAndLabels =- let go _ 0 _ acc = reverse acc- go !pCnt k g acc =- let !mu = if pCnt > 0 then 0.15 else -0.15- (row, g') = drawRowAt mu g- !y = if pCnt > 0 then 1.0 else -1.0- in go (pCnt - 1) (k - 1) g' ((row, y) : acc)- in go nPos n g0 []- rows = V.fromList (map fst rowsAndLabels)- labels = VU.fromList (map snd rowsAndLabels)- names = V.fromList ["x"]- cfgUnbal =- defaultSolverConfig- { scL1Lambda = 0.001- , scL2Lambda = 0- , scMaxIter = 2000- , scTol = 1e-7- , scSampleWeights = Nothing- }- nNeg = n - nPos- balanced =- VU.generate n $ \i ->- let !y = VU.unsafeIndex labels i- in if y > 0- then fromIntegral n / (2 * fromIntegral nPos)- else fromIntegral n / (2 * fromIntegral nNeg)- cfgBal = cfgUnbal{scSampleWeights = Just balanced}- mUnbal = fitL1Logistic cfgUnbal rows labels names- mBal = fitL1Logistic cfgBal rows labels names- bUnbal = lmIntercept mUnbal- bBal = lmIntercept mBal- -- Test set: 100 rows at each class-conditional mean. We measure- -- predictions on this BALANCED test set; the unweighted model- -- will predict mostly positive (intercept dominates), the- -- balanced model close to 50/50.- testRows =- V.fromList- ( replicate 100 (VU.singleton 0.15)- ++ replicate 100 (VU.singleton (-0.15))- )- predFracPos m =- let preds = V.map (predict m) testRows- ps = V.length (V.filter (> 0) preds)- in fromIntegral ps / fromIntegral (V.length testRows) :: Double- fracUnbal = predFracPos mUnbal- fracBal = predFracPos mBal- -- Reviewer-tightened intercept bounds (logit(0.95) ≈ 2.94 is the- -- intercept-only solution; the weak slope shrinks this slightly).- assertBool- ("unbalanced |b| > 2.0; got " ++ show bUnbal)- (abs bUnbal > 2.0)- assertBool- ("balanced |b| < 0.3; got " ++ show bBal)- (abs bBal < 0.3)- -- Prediction-class-balance assertion:- assertBool- ("unbalanced fraction-positive on balanced test ≥ 0.90; got " ++ show fracUnbal)- (fracUnbal >= 0.90)- assertBool- ( "balanced fraction-positive on balanced test ∈ [0.40, 0.60]; got "- ++ show fracBal- )- (fracBal >= 0.40 && fracBal <= 0.60)----------------------------------------------------------------------------- Test list---------------------------------------------------------------------------tests :: [Test]-tests =- [ TestLabel "A1 recover known hyperplane" testA1RecoverHyperplane- , TestLabel "A2 L1 sparsity" testA2L1Sparsity- , TestLabel "A3 convergence" testA3Convergence- , TestLabel "A4 loss not increasing" testA4LossNotIncreasing- , TestLabel "A5 all same direction" testA5AllSameDirection- , TestLabel "A6 empty input" testA6Empty- , TestLabel "A7 constant feature" testA7ConstantFeature- , TestLabel "A8 large feature values" testA8LargeValues- , TestLabel "A9 standardization round-trip" testA9StandardizationRoundTrip- , TestLabel "A10 determinism" testA10Determinism- , TestLabel "A11 ground truth ratio" testA11GroundTruthRatio- , TestLabel "A12 maxIter zero" testA12MaxIterZero- , TestLabel "A13 maxIter one" testA13MaxIterOne- , TestLabel "A14 constant huge value" testA14ConstantHugeValue- , TestLabel "A15 all-zero feature" testA15AllZeroFeature- , TestLabel "A16 imbalanced 99:1 labels" testA16ImbalancedLabels- , TestLabel "A17 imbalanced raw scales" testA17ImbalancedRawScales- , TestLabel "B1 Expr well-typed" testB1ExprWellTyped- , TestLabel "B2 zero weights pruned" testB2ZeroWeightsPruned- , -- PR 3: Elastic Net + class-balanced weights.- TestLabel "A19 Elastic Net grouping ρ=0.97" testA19ElasticNetRecoveryHigh- , TestLabel "A19 Elastic Net grouping ρ=0.7" testA19ElasticNetRecoveryMid- , TestLabel "A20 class-balanced fit on 95/5" testA20ClassBalancedFit- ]
tests/Main.hs view
@@ -8,12 +8,11 @@ import Test.HUnit import Test.QuickCheck -import qualified Cart-import qualified DecisionTree import qualified Functions import qualified IO.CSV import qualified IO.CsvGolden import qualified IO.JSON+import qualified IR.ExprJsonRoundtrip import qualified Internal.ColumnBuilder import qualified Internal.DictEncode import qualified Internal.Markdown@@ -22,17 +21,14 @@ import qualified LazyParity import qualified LazyParquet import qualified Learn.Denotation-import qualified Learn.EdgeCases import qualified Learn.Ensembles import qualified Learn.Metamorphic import qualified Learn.MetricsTests import qualified Learn.Models-import qualified Learn.NumericalRigor-import qualified Learn.Numerics+import qualified Learn.Segmented import qualified Learn.SklearnParity-import qualified Learn.Symbolic import qualified Learn.Synthesis-import qualified LinearSolver+import qualified Learn.TypedModel import qualified Monad import qualified Operations.Aggregations import qualified Operations.Apply@@ -64,33 +60,30 @@ import qualified PackedTextMigration import qualified Parquet import qualified Plotting+import qualified PrettyPrint import qualified Properties import qualified Properties.Categorical-import qualified Properties.Simplify import qualified Simplify-import qualified TreePruning-import qualified Worklist+import qualified Typed.IOReaders+import qualified Typed.Parity tests :: Test tests = TestList $- DecisionTree.tests- ++ Internal.ColumnBuilder.tests+ Internal.ColumnBuilder.tests ++ Internal.DictEncode.tests ++ Internal.Markdown.tests ++ Internal.PackedText.tests ++ Internal.Parsing.tests- ++ Learn.Numerics.tests ++ Learn.Denotation.tests ++ Learn.Models.tests+ ++ Learn.TypedModel.tests ++ Learn.Ensembles.tests- ++ Learn.Symbolic.tests ++ Learn.SklearnParity.tests ++ Learn.Synthesis.tests ++ Learn.MetricsTests.tests ++ Learn.Metamorphic.tests- ++ Learn.EdgeCases.tests- ++ Learn.NumericalRigor.tests+ ++ Learn.Segmented.tests ++ Operations.Aggregations.tests ++ Operations.Apply.tests ++ Operations.Core.tests@@ -122,16 +115,16 @@ ++ IO.CSV.tests ++ IO.CsvGolden.tests ++ IO.JSON.tests+ ++ IR.ExprJsonRoundtrip.tests ++ Parquet.tests ++ LazyParquet.tests ++ LazyParity.tests ++ Plotting.tests- ++ LinearSolver.tests ++ Simplify.tests- ++ TreePruning.tests- ++ Worklist.tests- ++ Cart.tests ++ PackedTextMigration.tests+ ++ PrettyPrint.tests+ ++ Typed.Parity.tests+ ++ Typed.IOReaders.tests isSuccessful :: Result -> Bool isSuccessful (Success{}) = True@@ -143,7 +136,6 @@ if failures result > 0 || errors result > 0 then Exit.exitFailure else do- -- Property tests propRes <- mapM (quickCheckWithResult stdArgs)@@ -155,14 +147,10 @@ Internal.ColumnBuilder.props propsRes <- mapM (quickCheckWithResult stdArgs) Properties.tests catRes <- mapM (quickCheckWithResult stdArgs) Properties.Categorical.tests- simpRes <- mapM (quickCheckWithResult stdArgs) Properties.Simplify.tests- wlRes <- mapM (quickCheckWithResult stdArgs) Worklist.props if not (all isSuccessful propRes) || not (all isSuccessful cbRes) || not (all isSuccessful monadRes) || not (all isSuccessful propsRes) || not (all isSuccessful catRes)- || not (all isSuccessful simpRes)- || not (all isSuccessful wlRes) then Exit.exitFailure else Exit.exitSuccess
tests/Operations/Apply.hs view
@@ -17,6 +17,7 @@ import DataFrame.Operations.Transformations (impute) import Assertions+import Data.Maybe (listToMaybe) import Test.HUnit import Type.Reflection (typeRep) @@ -80,6 +81,20 @@ (print $ D.apply @[Char] (const (1 :: Int)) "test9" testData) ) +applyIntroducesNulls :: Test+applyIntroducesNulls =+ TestCase+ ( assertEqual+ "apply with a -> Maybe b yields a nullable column, not a boxed Maybe vector"+ (Just "NullableUnboxed")+ ( DI.columnVersionString+ <$> DI.getColumn "test" (D.apply @String listToMaybe "test" nullableApplyData)+ )+ )+ where+ nullableApplyData =+ D.fromNamedColumns [("test", DI.fromList ["", "b" :: String])]+ applyManyOnlyGivenFields :: Test applyManyOnlyGivenFields = TestCase@@ -270,6 +285,7 @@ , TestLabel "applyWrongType" applyWrongType , TestLabel "applyUnknownColumn" applyUnknownColumn , TestLabel "applyBoxedToBoxed" applyBoxedToBoxed+ , TestLabel "applyIntroducesNulls" applyIntroducesNulls , TestLabel "applyManyBoxedToBoxed" applyManyBoxedToBoxed , TestLabel "applyManyOnlyGivenFields" applyManyOnlyGivenFields , TestLabel "applyManyBoxedToUnboxed" applyManyBoxedToUnboxed
tests/Operations/Record.hs view
@@ -23,8 +23,8 @@ import qualified DataFrame as D import qualified DataFrame.Functions as F import qualified DataFrame.Internal.Column as DI-import qualified DataFrame.Internal.Schema as IS import DataFrame.Operators+import qualified DataFrame.Schema as IS import DataFrame.Typed (Schema) import qualified DataFrame.Typed as DT @@ -39,7 +39,7 @@ deriving (Show, Eq) $(DT.deriveSchemaFromType ''Order)-$(D.deriveSchema ''Order)+$(D.deriveSchemaValues ''Order) -- Nullable fields (Maybe Text -> RNullableBoxed; Maybe Int -> RNullableUnboxed). data User = User@@ -50,7 +50,7 @@ deriving (Show, Eq) $(DT.deriveSchemaFromType ''User)-$(D.deriveSchema ''User)+$(D.deriveSchemaValues ''User) -- Identity-cased: keep the record selector names verbatim. data Account = Account@@ -90,7 +90,7 @@ deriving (Show, Eq) $(DT.deriveSchemaFromType ''Wide)-$(D.deriveSchema ''Wide)+$(D.deriveSchemaValues ''Wide) -- Generics opt-in: derive the schema via Generic, not TH. data Foo = Foo@@ -170,11 +170,12 @@ Left e -> assertFailure (T.unpack e) Right ys -> assertEqual "schema-name override round-trip" xs ys +-- order_id is deliberately Int (not the schema's Int64) to force a mismatch. typeMismatchError :: Test typeMismatchError = TestCase $ do let badDf = D.fromNamedColumns- [ ("order_id", DI.fromList ([1, 2, 3] :: [Int])) -- wrong: Int, not Int64+ [ ("order_id", DI.fromList ([1, 2, 3] :: [Int])) , ("region", DI.fromList (["us", "eu", "ap"] :: [T.Text])) , ("amount", DI.fromList ([10.0, 20.5, 30.0] :: [Double])) ]
tests/Parquet.hs view
@@ -17,6 +17,7 @@ import Data.Maybe (fromMaybe) import qualified Data.Set as S import qualified Data.Text as T+import Data.Time (UTCTime (UTCTime), fromGregorian, picosecondsToDiffTime) import Data.Word import DataFrame.IO.Parquet.Thrift ( cc_meta_data,@@ -1307,9 +1308,33 @@ "score should NOT be nullable" (not (hasMissing (unsafeGetColumn "score" df))) +{- | Nanosecond-precision timestamps (@TIMESTAMP(NANOS)@) must decode to the+correct 'UTCTime'. Regression test for the unit-scaling bug where the NANOS+multiplier @1_000_000 \`div\` 1_000_000_000@ truncated to 0, collapsing every+value to the epoch.+-}+timestampNanos :: Test+timestampNanos = testBothReadParquetPaths $ \readParquet ->+ TestCase $+ assertEqual+ "TIMESTAMP(NANOS) decodes to correct UTCTime"+ ( D.fromNamedColumns+ [+ ( "ts"+ , D.fromList+ [ UTCTime (fromGregorian 2020 1 1) 0+ , UTCTime (fromGregorian 2021 6 15) (picosecondsToDiffTime 45045123456789000)+ , UTCTime (fromGregorian 1999 12 31) (picosecondsToDiffTime 86399999999999000)+ ]+ )+ ]+ )+ (unsafePerformIO (readParquet "./tests/data/timestamp_nanos.parquet"))+ tests :: [Test] tests =- [ allTypesPlain+ [ timestampNanos+ , allTypesPlain , allTypesPlainSnappy , allTypesDictionary , selectedColumnsWithOpts
+ tests/PrettyPrint.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++{- | Golden tests pinning the format of 'prettyPrint'/'prettyPrintWidth': flat+@else if@ ladders, operator-precedence parenthesization, width-aware wrapping of+commutative chains, and short expressions staying on one line.+-}+module PrettyPrint (tests) where++import qualified Data.Text as T+import DataFrame.Internal.Expression (Expr, prettyPrint, prettyPrintWidth)+import DataFrame.Operators+import Test.HUnit++a, b, c :: Expr Double+a = col "a"+b = col "b"+c = col "c"++golden :: String -> String -> String -> Test+golden label want got =+ TestLabel label . TestCase $ assertEqual label want got++tests :: [Test]+tests =+ [ -- A short conditional stays compact; then/else still break onto own lines.+ golden+ "fits on one line"+ "if x .>=. 0.0\nthen \"pos\"\nelse \"neg\""+ ( prettyPrint+ (ifThenElse (col @Double "x" .>=. lit 0.0) (lit @T.Text "pos") (lit "neg"))+ )+ , -- Nested else-if forms a flat ladder (no staircase indentation).+ golden+ "flat else-if ladder"+ "if a .>. 1.0\nthen \"x\"\nelse if b .>. 2.0\nthen \"y\"\nelse \"z\""+ ( prettyPrint+ ( ifThenElse+ (col @Double "a" .>. lit 1.0)+ (lit @T.Text "x")+ (ifThenElse (col @Double "b" .>. lit 2.0) (lit "y") (lit "z"))+ )+ )+ , -- A lower-precedence operand is parenthesized under a higher one.+ golden "precedence: (a + b) * c" "(a + b) * c" (prettyPrint ((a + b) * c))+ , -- No spurious parens when precedence already disambiguates.+ golden "precedence: a + b * c" "a + b * c" (prettyPrint (a + b * c))+ , -- Non-commutative operators are not flattened/reordered.+ golden "left-assoc subtraction" "a - b - c" (prettyPrint (a - b - c))+ , -- A commutative chain stays on one line when it fits the width.+ golden+ "commutative chain fits"+ "alpha + beta + gamma"+ (prettyPrintWidth 80 (col @Double "alpha" + col "beta" + col "gamma"))+ , -- The same chain wraps at the operator with a hanging indent when narrow.+ golden+ "commutative chain wraps"+ "alpha\n + beta\n + gamma"+ (prettyPrintWidth 12 (col @Double "alpha" + col "beta" + col "gamma"))+ , -- A comparison/logical chain that fits stays free of grouping parens.+ golden+ "boolean chain fits: no paren noise"+ "a + b .>=. c .&&. a .>. b"+ (prettyPrintWidth 80 ((a + b .>=. c) .&&. (a .>. b)))+ , -- When a nested operand wraps, parens delimit it; flat operands stay bare.+ golden+ "wrapped operand gets parens"+ "(a + b + c\n .>=. 0.0)\n .&&. a .>. b"+ (prettyPrintWidth 16 ((a + b + c .>=. lit 0.0) .&&. (a .>. b)))+ ]
− tests/Properties/Simplify.hs
@@ -1,172 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}--{- | Property tests for the simplifier and tree-pruning pass: the durable-guarantees the hand-written examples only sample.-- * @simplify@ preserves denotation (@interpret e ≡ interpret (simplify e)@),- over Bool and Maybe Bool, on a DataFrame that includes NaN, null, and- exact-boundary rows.- * @simplify@ is idempotent (reaches a normal form within the fixpoint cap).- * @pruneDead@ preserves the function the tree computes, on every row.--}-module Properties.Simplify (tests) where--import qualified DataFrame as D-import DataFrame.DecisionTree (Tree (..), predictWithTree, pruneDead)-import qualified DataFrame.Functions as F-import DataFrame.Internal.Column (TypedColumn (TColumn), toVector)-import qualified DataFrame.Internal.Column as DI-import DataFrame.Internal.Expression (Expr, eqExpr)-import DataFrame.Internal.Interpreter (interpret)-import DataFrame.Internal.Simplify (simplify)-import DataFrame.Operators--import qualified Data.Text as T-import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as VU-import Test.QuickCheck---- A fixture spanning the interesting rows: exact thresholds, gaps, NaN, null.-fixtureDF :: D.DataFrame-fixtureDF =- D.fromNamedColumns- [- ( "x"- , DI.fromList ([10, 20, 25, 30, 35, 40, 50, 0 / 0, -(1 / 0), 1 / 0] :: [Double])- )- , ("n", DI.fromList ([10, 20, 25, 30, 35, 40, 50, 0, 100, -5] :: [Int]))- ,- ( "m"- , DI.fromList- ( [ Just 10- , Nothing- , Just 30- , Just 35- , Nothing- , Just 50- , Just 0- , Just 30- , Nothing- , Just 40- ] ::- [Maybe Double]- )- )- ]--thresholds :: [Double]-thresholds = [20, 25, 30, 35, 40]---- ---- generators -------- strict-Bool comparison atoms over the Double column "x" and Int column "n"-genAtomBool :: Gen (Expr Bool)-genAtomBool = do- t <- elements thresholds- oneof- [ elements- [ F.col @Double "x" .< F.lit t- , F.col @Double "x" .<= F.lit t- , F.col @Double "x" .> F.lit t- , F.col @Double "x" .>= F.lit t- , F.col @Double "x" .== F.lit t- , F.col @Double "x" ./= F.lit t- ]- , elements- [ F.toDouble (F.col @Int "n") .< F.lit t- , F.toDouble (F.col @Int "n") .<= F.lit t- , F.toDouble (F.col @Int "n") .> F.lit t- , F.toDouble (F.col @Int "n") .>= F.lit t- ]- ]--genBoolExpr :: Int -> Gen (Expr Bool)-genBoolExpr d- | d <= 0 = genAtomBool- | otherwise =- oneof- [ genAtomBool- , F.and <$> genBoolExpr (d - 1) <*> genBoolExpr (d - 1)- , F.or <$> genBoolExpr (d - 1) <*> genBoolExpr (d - 1)- , F.not <$> genBoolExpr (d - 1)- ]---- nullable comparison atoms over the Maybe Double column "m"-genAtomMaybe :: Gen (Expr (Maybe Bool))-genAtomMaybe = do- t <- elements thresholds- elements- [ F.col @(Maybe Double) "m" .< F.lit t- , F.col @(Maybe Double) "m" .<= F.lit t- , F.col @(Maybe Double) "m" .> F.lit t- , F.col @(Maybe Double) "m" .>= F.lit t- , F.col @(Maybe Double) "m" .== F.lit t- , F.col @(Maybe Double) "m" ./= F.lit t- ]--genMaybeExpr :: Int -> Gen (Expr (Maybe Bool))-genMaybeExpr d- | d <= 0 = genAtomMaybe- | otherwise =- oneof- [ genAtomMaybe- , (.&&) <$> genMaybeExpr (d - 1) <*> genMaybeExpr (d - 1)- , (.||) <$> genMaybeExpr (d - 1) <*> genMaybeExpr (d - 1)- ]--genTree :: Int -> Gen (Tree T.Text)-genTree d- | d <= 0 = Leaf <$> elements ["A", "B", "C"]- | otherwise =- oneof- [ Leaf <$> elements ["A", "B", "C"]- , do- cond <- genAtomBool- Branch cond <$> genTree (d - 1) <*> genTree (d - 1)- ]---- ---- evaluation helpers ------evalBool :: D.DataFrame -> Expr Bool -> Maybe (VU.Vector Bool)-evalBool df e = case interpret @Bool df e of- Right (TColumn tcol) -> either (const Nothing) Just (toVector @Bool @VU.Vector tcol)- Left _ -> Nothing--evalMaybe :: D.DataFrame -> Expr (Maybe Bool) -> Maybe (V.Vector (Maybe Bool))-evalMaybe df e = case interpret @(Maybe Bool) df e of- Right (TColumn tcol) -> either (const Nothing) Just (toVector @(Maybe Bool) @V.Vector tcol)- Left _ -> Nothing---- ---- properties ------prop_simplifyPreservesBool :: Property-prop_simplifyPreservesBool =- forAll (genBoolExpr 4) $ \e ->- evalBool fixtureDF e === evalBool fixtureDF (simplify e)--prop_simplifyPreservesMaybe :: Property-prop_simplifyPreservesMaybe =- forAll (genMaybeExpr 3) $ \e ->- evalMaybe fixtureDF e === evalMaybe fixtureDF (simplify e)--prop_simplifyIdempotent :: Property-prop_simplifyIdempotent =- forAll (genBoolExpr 4) $ \e ->- let s = simplify e in property (eqExpr (simplify s) s)--prop_pruneDeadPreserves :: Property-prop_pruneDeadPreserves =- forAll (genTree 4) $ \t ->- let n = D.nRows fixtureDF- predAll tr = [predictWithTree @T.Text "x" fixtureDF i tr | i <- [0 .. n - 1]]- in predAll (pruneDead t) === predAll t--tests :: [Property]-tests =- [ prop_simplifyPreservesBool- , prop_simplifyPreservesMaybe- , prop_simplifyIdempotent- , prop_pruneDeadPreserves- ]
− tests/TreePruning.hs
@@ -1,114 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-}--{- | Specification for the fitted-tree pruning pass ('pruneDead'): path-condition-entailment, the false-edge NaN gate, and same-branch collapse.--}-module TreePruning (tests) where--import DataFrame.DecisionTree (Tree (..), pruneDead)-import qualified DataFrame.Functions as F-import DataFrame.Internal.Expression (eqExpr)-import DataFrame.Operators--import qualified Data.Text as T-import Test.HUnit--treeEq :: (Eq a) => Tree a -> Tree a -> Bool-treeEq (Leaf x) (Leaf y) = x == y-treeEq (Branch c1 l1 r1) (Branch c2 l2 r2) = eqExpr c1 c2 && treeEq l1 l2 && treeEq r1 r2-treeEq _ _ = False--prunesTo :: String -> Tree T.Text -> Tree T.Text -> Test-prunesTo label input want =- TestLabel label . TestCase $- assertBool- (label ++ ": got " ++ show (pruneDead input) ++ " want " ++ show want)- (treeEq (pruneDead input) want)--preserved :: String -> Tree T.Text -> Test-preserved label t = prunesTo label t t--pathEntailment :: [Test]-pathEntailment =- [ prunesTo- "ancestor entails child keeps true subtree"- ( Branch- (F.col @Double "age" .> F.lit (50 :: Double))- (Branch (F.col @Double "age" .> F.lit (30 :: Double)) (Leaf "a") (Leaf "b"))- (Leaf "c")- )- (Branch (F.col @Double "age" .> F.lit (50 :: Double)) (Leaf "a") (Leaf "c"))- , prunesTo- "ancestor refutes child keeps false subtree"- ( Branch- (F.col @Double "age" .> F.lit (50 :: Double))- (Branch (F.col @Double "age" .< F.lit (40 :: Double)) (Leaf "a") (Leaf "b"))- (Leaf "c")- )- (Branch (F.col @Double "age" .> F.lit (50 :: Double)) (Leaf "b") (Leaf "c"))- ]--falseEdgeGate :: [Test]-falseEdgeGate =- [ prunesTo- "integral false edge entails child"- ( Branch- (F.toDouble (F.col @Int "ai") .> F.lit (50 :: Double))- (Leaf "c")- ( Branch- (F.toDouble (F.col @Int "ai") .< F.lit (60 :: Double))- (Leaf "a")- (Leaf "b")- )- )- ( Branch- (F.toDouble (F.col @Int "ai") .> F.lit (50 :: Double))- (Leaf "c")- (Leaf "a")- )- ]--sameBranchCollapse :: [Test]-sameBranchCollapse =- [ prunesTo- "equal leaves collapse the branch"- (Branch (F.col @Double "age" .> F.lit (50 :: Double)) (Leaf "a") (Leaf "a"))- (Leaf "a")- , prunesTo- "collapse cascades upward"- ( Branch- (F.col @Double "age" .> F.lit (50 :: Double))- (Branch (F.col @Double "hours" .> F.lit (40 :: Double)) (Leaf "a") (Leaf "a"))- (Leaf "a")- )- (Leaf "a")- ]--preservedTrees :: [Test]-preservedTrees =- [ preserved- "child not tight enough is kept"- ( Branch- (F.col @Double "age" .> F.lit (50 :: Double))- (Branch (F.col @Double "age" .> F.lit (60 :: Double)) (Leaf "a") (Leaf "b"))- (Leaf "c")- )- , preserved- "double false edge is kept (NaN)"- ( Branch- (F.col @Double "weight" .> F.lit (50 :: Double))- (Leaf "c")- (Branch (F.col @Double "weight" .< F.lit (60 :: Double)) (Leaf "a") (Leaf "b"))- )- , preserved- "cross-column descendant is kept"- ( Branch- (F.col @Double "age" .> F.lit (50 :: Double))- (Branch (F.col @Double "income" .> F.lit (30000 :: Double)) (Leaf "a") (Leaf "b"))- (Leaf "c")- )- ]--tests :: [Test]-tests = concat [pathEntailment, falseEdgeGate, sameBranchCollapse, preservedTrees]
+ tests/Typed/IOReaders.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++{- | Tests for the typed CSV reader: a write\/read round-trip matches the untyped+reader, a wrong schema surfaces as 'Left' via 'readCsvWithError', and the+throwing 'readCsv' raises a 'DataFrameException'. The Parquet reader uses the+identical freeze-on-read path.+-}+module Typed.IOReaders (tests) where++import Control.Exception (evaluate, try)+import Data.Either (isLeft)+import qualified Data.Text as T+import System.IO (hClose)+import System.IO.Temp (withSystemTempFile)++import qualified DataFrame as D+import DataFrame.Errors (DataFrameException)+import qualified DataFrame.Internal.Column as DI+import qualified DataFrame.Typed as DT+import qualified DataFrame.Typed.IO.CSV as TCSV++import Test.HUnit++type S =+ '[ DT.Column "x" Int+ , DT.Column "y" Double+ , DT.Column "g" T.Text+ ]++sampleDF :: D.DataFrame+sampleDF =+ D.fromNamedColumns+ [ ("x", DI.fromList [1, 2, 3 :: Int])+ , ("y", DI.fromList [1.5, 2.5, 3.5 :: Double])+ , ("g", DI.fromList ["a", "b", "c" :: T.Text])+ ]++roundTrip :: Test+roundTrip = TestCase $ withSystemTempFile "typed_parity.csv" $ \fp h -> do+ hClose h+ D.writeCsv fp sampleDF+ untyped <- D.readCsv fp+ typed <- DT.thaw <$> TCSV.readCsv @S fp+ assertEqual "typed readCsv round-trips like untyped readCsv" untyped typed++wrongSchemaEither :: Test+wrongSchemaEither = TestCase $ withSystemTempFile "typed_err.csv" $ \fp h -> do+ hClose h+ D.writeCsv fp sampleDF+ res <- TCSV.readCsvWithError @'[DT.Column "nope" Int] fp+ assertBool "wrong schema => Left" (isLeft res)++wrongSchemaThrows :: Test+wrongSchemaThrows = TestCase $ withSystemTempFile "typed_throw.csv" $ \fp h -> do+ hClose h+ D.writeCsv fp sampleDF+ r <-+ try (TCSV.readCsv @'[DT.Column "nope" Int] fp >>= evaluate . DT.nRows) ::+ IO (Either DataFrameException Int)+ assertBool "wrong schema => throws DataFrameException" (isLeft r)++tests :: [Test]+tests = [roundTrip, wrongSchemaEither, wrongSchemaThrows]
+ tests/Typed/Parity.hs view
@@ -0,0 +1,205 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module Typed.Parity (tests) where++import Data.Either (fromRight)+import qualified Data.Text as T+import System.Random (mkStdGen)++import qualified DataFrame as D+import qualified DataFrame.Functions as F+import qualified DataFrame.Internal.Column as DI+import qualified DataFrame.Typed as DT+import qualified DataFrame.Typed.Statistics as TS++import Test.HUnit++type S =+ '[ DT.Column "x" Int+ , DT.Column "y" Double+ , DT.Column "g" T.Text+ ]++baseDF :: D.DataFrame+baseDF =+ D.fromNamedColumns+ [ ("x", DI.fromList [1, 2, 3, 4, 5, 6 :: Int])+ , ("y", DI.fromList [10.0, 25.0, 30.0, 5.0, 50.0, 12.0 :: Double])+ , ("g", DI.fromList ["a", "b", "a", "b", "a", "b" :: T.Text])+ ]++tdf :: DT.TypedDataFrame S+tdf = either (error . show) id (DT.freezeWithError baseDF)++-- Statistics reducers should match the untyped ones exactly (same code path).+statParity :: Test+statParity =+ TestList+ [ eq "mean" (TS.mean (DT.col @"y") tdf) (D.mean (F.col @Double "y") baseDF)+ , eq "median" (TS.median (DT.col @"y") tdf) (D.median (F.col @Double "y") baseDF)+ , eq+ "variance"+ (TS.variance (DT.col @"y") tdf)+ (D.variance (F.col @Double "y") baseDF)+ , eq+ "stddev"+ (TS.standardDeviation (DT.col @"y") tdf)+ (D.standardDeviation (F.col @Double "y") baseDF)+ , eq "sum" (TS.sum (DT.col @"x") tdf) (D.sum (F.col @Int "x") baseDF)+ , eq+ "percentile"+ (TS.percentile 50 (DT.col @"y") tdf)+ (D.percentile 50 (F.col @Double "y") baseDF)+ , eq+ "iqr"+ (TS.interQuartileRange (DT.col @"y") tdf)+ (D.interQuartileRange (F.col @Double "y") baseDF)+ , eq+ "skewness"+ (TS.skewness (DT.col @"y") tdf)+ (D.skewness (F.col @Double "y") baseDF)+ , eq+ "correlation"+ (TS.correlation @"x" @"y" tdf)+ (D.correlation "x" "y" baseDF)+ ]+ where+ eq :: (Eq a, Show a) => String -> a -> a -> Test+ eq lbl typed untyped = TestCase (assertEqual ("typed stat " ++ lbl) untyped typed)++-- Expression combinators ported in Expr.Extra: derive a column both ways.+exprParity :: Test+exprParity =+ TestList+ [ deriveEq "pow" (DT.pow (DT.col @"x") 2) (F.pow (F.col @Int "x") 2)+ , deriveEq "relu" (DT.relu (DT.col @"x")) (F.relu (F.col @Int "x"))+ , deriveEq "toMaybe" (DT.toMaybe (DT.col @"x")) (F.toMaybe (F.col @Int "x"))+ , deriveEq+ "min"+ (DT.min (DT.col @"x") (DT.lit 3))+ (F.min (F.col @Int "x") (F.lit @Int 3))+ , deriveEq+ "splitOn"+ (DT.splitOn "a" (DT.col @"g"))+ (F.splitOn "a" (F.col @T.Text "g"))+ , deriveEq+ "recodeWithDefault"+ (DT.recodeWithDefault 0 [(1 :: Int, 100 :: Int)] (DT.col @"x"))+ (F.recodeWithDefault 0 [(1 :: Int, 100 :: Int)] (F.col @Int "x"))+ ]+ where+ deriveEq ::+ (DI.Columnable a) =>+ String -> DT.TExpr S a -> D.Expr a -> Test+ deriveEq lbl te ue =+ TestCase+ ( assertEqual+ ("typed derive " ++ lbl)+ (D.derive "r" ue baseDF)+ (DT.thaw (DT.derive @"r" te tdf))+ )++-- apply / valueCounts / horizontal merge.+applyParity :: Test+applyParity =+ TestList+ [ TestCase+ ( assertEqual+ "applyColumn type-change"+ (D.apply (show :: Int -> String) "x" baseDF)+ (DT.thaw (DT.applyColumn @"x" (show :: Int -> String) tdf))+ )+ , TestCase+ ( assertEqual+ "applyMany type-preserving"+ (D.applyMany (+ (1 :: Int)) ["x"] baseDF)+ (DT.thaw (DT.applyMany @'["x"] (+ (1 :: Int)) tdf))+ )+ , TestCase+ ( assertEqual+ "valueCounts"+ (D.valueCounts (F.col @T.Text "g") baseDF)+ (DT.valueCounts (DT.col @"g") tdf)+ )+ , TestCase+ ( assertEqual+ "horizontal merge (|||)"+ (leftDF D.||| rightDF)+ (DT.thaw ((DT.|||) leftT rightT))+ )+ ]++-- Sampling/splitting determinism: same seed => same rows as the untyped form.+samplingParity :: Test+samplingParity =+ TestList+ [ TestCase+ ( assertEqual+ "randomSplit"+ (D.randomSplit (mkStdGen 7) 0.5 baseDF)+ (let (a, b) = DT.randomSplit (mkStdGen 7) 0.5 tdf in (DT.thaw a, DT.thaw b))+ )+ , TestCase+ ( assertEqual+ "kFolds"+ (D.kFolds (mkStdGen 7) 3 baseDF)+ (map DT.thaw (DT.kFolds (mkStdGen 7) 3 tdf))+ )+ ]++-- Matrix / numeric-vector extraction.+accessParity :: Test+accessParity =+ TestList+ [ TestCase+ ( assertEqual+ "columnAsDoubleVector"+ (extract (D.columnAsDoubleVector (F.col @Double "y") baseDF))+ (DT.columnAsDoubleVector @"y" tdf)+ )+ , TestCase+ ( assertEqual+ "toDoubleMatrix"+ (extract (D.toDoubleMatrix numericDF))+ (DT.toDoubleMatrix numericT)+ )+ ]+ where+ extract :: Either e a -> a+ extract = fromRight (error "extraction failed")++-- Disjoint frames for the (|||) test.+leftDF :: D.DataFrame+leftDF = D.fromNamedColumns [("x", DI.fromList [1, 2 :: Int])]++rightDF :: D.DataFrame+rightDF = D.fromNamedColumns [("y", DI.fromList [1.0, 2.0 :: Double])]++leftT :: DT.TypedDataFrame '[DT.Column "x" Int]+leftT = either (error . show) id (DT.freezeWithError leftDF)++rightT :: DT.TypedDataFrame '[DT.Column "y" Double]+rightT = either (error . show) id (DT.freezeWithError rightDF)++-- Numeric-only frame for the matrix test.+numericDF :: D.DataFrame+numericDF =+ D.fromNamedColumns+ [ ("x", DI.fromList [1, 2, 3 :: Int])+ , ("y", DI.fromList [1.5, 2.5, 3.5 :: Double])+ ]++numericT :: DT.TypedDataFrame '[DT.Column "x" Int, DT.Column "y" Double]+numericT = either (error . show) id (DT.freezeWithError numericDF)++tests :: [Test]+tests =+ [ statParity+ , exprParity+ , applyParity+ , samplingParity+ , accessParity+ ]
− tests/Worklist.hs
@@ -1,466 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-}--{- | Up-front (TDD) spec for the saturation worklist 'saturateCandidates' that-will replace the lazy generate-all 'boolExprsVec'. The existing depth-bounded-'boolExprsVec' is kept as the behaviour-preservation oracle.--State: 'saturateCandidates' is the identity stub, so the structural same-set-and truth-vector floor/collapse cases FAIL (red) — that is the spec PR1 must-meet; base-inclusion / dedup / determinism hold under the stub.--}-module Worklist (tests, props) where--import qualified DataFrame as D-import DataFrame.DecisionTree (- CondVec,- DedupMode (Structural, TruthVector),- boolExprsVec,- combineAndVec,- combineOrVec,- cvExpr,- cvVec,- materializeCondVec,- saturateCandidates,- )-import qualified DataFrame.Functions as F-import qualified DataFrame.Internal.Column as DI-import DataFrame.Internal.Expression (- Expr,- compareExpr,- eSize,- eqExpr,- normalize,- )-import DataFrame.Operators--import Data.Function (on)-import Data.List (minimumBy, nubBy)-import qualified Data.Maybe-import qualified Data.Set as Set-import qualified Data.Vector.Unboxed as VU-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.-fixtureDF :: D.DataFrame-fixtureDF =- D.fromNamedColumns- [ ("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]))- ]--mat :: Expr Bool -> CondVec-mat e =- Data.Maybe.fromMaybe- (error "Worklist.mat: could not materialize")- (materializeCondVec fixtureDF e)--xGt, xLt, yGt, yLt, zGt, zLt :: Double -> CondVec-xGt n = mat (F.col @Double "x" .>. F.lit n)-xLt n = mat (F.col @Double "x" .<. F.lit n)-yGt n = mat (F.col @Double "y" .>. F.lit n)-yLt n = mat (F.col @Double "y" .<. F.lit n)-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.-notLe2 :: CondVec-notLe2 = mat (F.not (F.col @Double "x" .<=. F.lit 2))--litTrue :: CondVec-litTrue = mat (F.lit True)--keyOf :: CondVec -> String-keyOf = show . normalize . cvExpr--keySet :: [CondVec] -> Set.Set String-keySet = Set.fromList . map keyOf--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.-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.-argminKey :: [Bool] -> [CondVec] -> String-argminKey lbls = keyOf . minimumBy (compare `on` penBy lbls)---- Oracle: the current depth-bounded generate-all.-ref :: Int -> [CondVec] -> [CondVec]-ref d base = boolExprsVec base base 0 d--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.-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.-wideDF :: D.DataFrame-wideDF =- D.fromNamedColumns- [ ("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]))- ]--matW :: Expr Bool -> CondVec-matW e =- Data.Maybe.fromMaybe- (error "Worklist.matW: could not materialize")- (materializeCondVec wideDF e)--wideBase :: [CondVec]-wideBase =- [ matW (F.col @Double "a" .>. F.lit 3)- , matW (F.col @Double "b" .<. F.lit 5)- , matW (F.col @Double "c" .>=. F.lit 3)- ]----------------------------------------------------------------------------- HUnit cases---------------------------------------------------------------------------tests :: [Test]-tests =- [ TestLabel "structural: same distinct set as oracle" . TestCase $- assertEqual- "keySet"- (keySet (ref 2 base3))- (keySet (saturateCandidates Structural 2 base3))- , TestLabel "structural: output deduped (length == distinct keys)" . TestCase $- let out = saturateCandidates Structural 2 base3- in assertEqual "no eqExpr duplicates" (Set.size (keySet out)) (length out)- , TestLabel "structural: base atoms all present" . TestCase $- assertBool "base subset of output" $- keySet base3 `Set.isSubsetOf` keySet (saturateCandidates Structural 1 base3)- , TestLabel "structural: deterministic" . TestCase $- assertEqual- "two runs identical"- (map keyOf (saturateCandidates Structural 2 base3))- (map keyOf (saturateCandidates Structural 2 base3))- , TestLabel "structural: consolidation flows through the worklist" . TestCase $- -- x>2 ∧ x>4 ↦ x>4, x>2 ∨ x>4 ↦ x>2, so the distinct set is just {x>2, x>4}.- assertEqual- "consolidated set"- (keySet [xGt 2, xGt 4])- (keySet (saturateCandidates Structural 2 [xGt 2, xGt 4]))- , TestLabel "truth-vector: all output truth vectors distinct" . TestCase $- let out = saturateCandidates TruthVector 2 [xGt 2, yLt 3]- in assertEqual "distinct cvVecs" (Set.size (truthSet out)) (length out)- , TestLabel "truth-vector: collapses same-truth atoms (x>2, y<3)" . TestCase $- -- x>2 and y<3 are identical on the data; one representative survives.- assertEqual- "collapsed to one"- 1- (length (saturateCandidates TruthVector 1 [xGt 2, yLt 3]))- , TestLabel "truth-vector: reaches the semantic floor (no split dropped)"- . TestCase- $ assertEqual- "same distinct truth vectors as oracle"- (truthSet (ref 2 base3))- (truthSet (saturateCandidates TruthVector 2 base3))- , TestLabel "truth-vector: strictly fewer candidates when a collision exists"- . TestCase- $- -- collBase has x>2 ≡ y<3, so the truth-vector floor is strictly below the structural set.- assertBool "|truth| < |structural|"- $ length (saturateCandidates TruthVector 2 collBase)- < length (saturateCandidates Structural 2 collBase)- , TestLabel "truth-vector: keeps the minimum-eSize representative" . TestCase $- -- x>2 (eSize 3) and not(x<=2) (eSize 4) share a truth vector; the smaller survives.- let out = saturateCandidates TruthVector 1 [xGt 2, notLe2]- in do- assertEqual "min eSize survivor" [3] (map (eSize . cvExpr) out)- assertEqual "survivor is x>2" [keyOf (xGt 2)] (map keyOf out)- , TestLabel "truth-vector: tie-break independent of input order" . TestCase $- -- x>2 and y<3 tie on eSize 3; whichever survives must not depend on base order.- assertEqual- "order-independent survivor"- (map keyOf (saturateCandidates TruthVector 1 [xGt 2, yLt 3]))- (map keyOf (saturateCandidates TruthVector 1 [yLt 3, xGt 2]))- , TestLabel "edge: empty base" . TestCase $- assertEqual- "empty in, empty out"- Set.empty- (keySet (saturateCandidates Structural 2 []))- , TestLabel "edge: singleton base" . TestCase $- assertEqual- "same as oracle"- (keySet (ref 2 [xGt 2]))- (keySet (saturateCandidates Structural 2 [xGt 2]))- , TestLabel "edge: maxDepth 0 is the base only" . TestCase $- assertEqual- "no expansion"- (keySet base3)- (keySet (saturateCandidates Structural 0 base3))- , TestLabel "edge: duplicate-seeded base" . TestCase $- let base = [xGt 2, xGt 2, yGt 2]- in assertEqual- "dedups seed, same as oracle"- (keySet (ref 2 base))- (keySet (saturateCandidates Structural 2 base))- , TestLabel "edge: literal operand" . TestCase $- let base = [xGt 2, litTrue]- in assertEqual- "same as oracle"- (keySet (ref 2 base))- (keySet (saturateCandidates Structural 2 base))- , TestLabel "law: cvVec is a homomorphism over AND" . TestCase $- -- the law justifying one-representative-per-truth-class dedup.- assertEqual- "cvVec(a∧b) == cvVec a && cvVec b"- (VU.toList (VU.zipWith (&&) (cvVec (xGt 2)) (cvVec (yGt 2))))- (VU.toList (cvVec (combineAndVec (xGt 2) (yGt 2))))- , TestLabel "law: cvVec is a homomorphism over OR" . TestCase $- assertEqual- "cvVec(a∨b) == cvVec a || cvVec b"- (VU.toList (VU.zipWith (||) (cvVec (xGt 2)) (cvVec (yGt 2))))- (VU.toList (cvVec (combineOrVec (xGt 2) (yGt 2))))- , TestLabel "law: consolidated expr re-interprets to its cached vector" . TestCase $- -- x>2 ∧ x>4 consolidates to x>4; the cached vector must match re-materializing it.- let c = combineAndVec (xGt 2) (xGt 4)- in assertEqual- "cached == re-interpreted"- (VU.toList (cvVec c))- (VU.toList (cvVec (mat (cvExpr c))))- , TestLabel "structural: output order matches the deduped oracle" . TestCase $- -- byte-identical to today's boolExprsVec, with eqExpr-duplicates removed (first kept):- -- this is what lets the consumer's first-wins minimumBy pick the same candidate.- assertEqual- "deduped-oracle order"- (map keyOf (nubBy ((==) `on` keyOf) (ref 2 base3)))- (map keyOf (saturateCandidates Structural 2 base3))- , TestLabel- "structural: matches oracle set+order at depth 3+4 (non-consolidating)"- . TestCase- $- -- cross-column base whose closure GROWS with depth (no consolidation); this is where the- -- frontier:=admitted optimisation could diverge from the oracle's frontier:=all-products.- let b = [xGt 2, yGt 2, zGt 1]- deduped d = map keyOf (nubBy ((==) `on` keyOf) (ref d b))- out d = map keyOf (saturateCandidates Structural d b)- in do- assertEqual "set d3" (Set.fromList (deduped 3)) (Set.fromList (out 3))- assertEqual "order d3" (deduped 3) (out 3)- assertEqual "set d4" (Set.fromList (deduped 4)) (Set.fromList (out 4))- assertEqual "order d4" (deduped 4) (out 4)- , TestLabel "structural: stabilizes at fixpoint (depth cap is a no-op past it)"- . TestCase- $- -- all AND/OR consolidate back into the base ⇒ a genuine fixpoint at round 1, so deeper- -- depth caps add nothing. (For a non-consolidating base the closure grows with depth,- -- since 'normalize' does not flatten associativity — there the cap always binds.)- assertEqual- "depth 2 == depth 5"- (keySet (saturateCandidates Structural 2 [xGt 1, xGt 2, xGt 3, xGt 4]))- (keySet (saturateCandidates Structural 5 [xGt 1, xGt 2, xGt 3, xGt 4]))- , TestLabel "truth-vector: reaches the floor on a wider fixture" . TestCase $- assertEqual- "same distinct truth vectors as oracle"- (truthSet (ref 2 wideBase))- (truthSet (saturateCandidates TruthVector 2 wideBase))- , TestLabel "selection: surfaces the oracle's winning combination" . TestCase $- -- labels = x>2 ∧ x<5; the unique min-penalty split is that band (not in the base), so- -- 'minimumBy penalty' over the worklist must pick it just as it does over the oracle.- let lbls = [False, False, False, True, True, False]- base = [xGt 2, xLt 5, yGt 2]- in assertEqual- "same argmin as oracle"- (argminKey lbls (ref 2 base))- (argminKey lbls (saturateCandidates Structural 2 base))- , TestLabel "selection: tie-winner tracks input order, matching the oracle"- . TestCase- $- -- x>2 and y<3 both score the min (0,3); 'minimumBy' keeps the first, so the winner must- -- flip with input order exactly as the oracle does. A worklist that imposes its own- -- (eSize, exprKey) order would pick the same atom for both orders and fail one. (byte-identical)- let lbls = [False, False, False, True, True, True]- in do- assertEqual- "x>2-first order"- (argminKey lbls (ref 2 [xGt 2, yLt 3]))- (argminKey lbls (saturateCandidates Structural 2 [xGt 2, yLt 3]))- assertEqual- "y<3-first order"- (argminKey lbls (ref 2 [yLt 3, xGt 2]))- (argminKey lbls (saturateCandidates Structural 2 [yLt 3, xGt 2]))- , TestLabel- "bounded: output is the distinct closure, below the oracle's materialized count"- . TestCase- $- -- Same-direction thresholds: every AND/OR consolidates, so the closure stays these 4 while- -- the oracle materializes far more. (Peak residency is the +RTS -s integration check.)- let base = [xGt 1, xGt 2, xGt 3, xGt 4]- gen = ref 3 base- in do- assertEqual- "output bounded to the distinct closure"- (Set.size (keySet gen))- (length (saturateCandidates Structural 3 base))- assertBool- "oracle materializes more than the closure (the explosion the worklist avoids)"- (Set.size (keySet gen) < length gen)- , TestLabel "structural: maxDepth 1 is base-only (no combination round)"- . TestCase- $- -- boolExprsVec does no combining until depth 2; the worklist must match it depth-for-depth.- assertEqual- "no combination at depth 1"- (keySet (ref 1 [xGt 2, yGt 2]))- (keySet (saturateCandidates Structural 1 [xGt 2, yGt 2]))- , TestLabel "structural: base atoms survive the combination round" . TestCase $- -- a base atom regenerated by a combination must not be dropped.- -- a base atom regenerated by a combination must not be dropped.- -- a base atom regenerated by a combination must not be dropped.- -- a base atom regenerated by a combination must not be dropped.- -- a base atom regenerated by a combination must not be dropped.- assertBool "base subset of output at depth 2" $- keySet base3 `Set.isSubsetOf` keySet (saturateCandidates Structural 2 base3)- , TestLabel- "structural: re-saturating a closed base is stable (fixpoint idempotence)"- . TestCase- $- -- on a base whose closure is itself, re-saturating changes nothing. (Depth-bounded- -- saturation is NOT idempotent on a growing closure — re-feeding goes one round deeper.)- let b = [xGt 1, xGt 2, xGt 3, xGt 4]- in assertEqual- "saturate ∘ saturate == saturate"- (keySet (saturateCandidates Structural 2 b))- (keySet (saturateCandidates Structural 2 (saturateCandidates Structural 2 b)))- , TestLabel "law: combiner key is order-independent (congruence basis)" . TestCase $- -- combining respects 'normalize', so deduping before combining is sound; also exercises- -- consolidation in both operand orders.- do- assertEqual- "AND consolidation commutes at the key"- (keyOf (combineAndVec (xGt 2) (xGt 4)))- (keyOf (combineAndVec (xGt 4) (xGt 2)))- assertEqual- "OR consolidation commutes at the key"- (keyOf (combineOrVec (xGt 2) (xGt 4)))- (keyOf (combineOrVec (xGt 4) (xGt 2)))- assertEqual- "cross-column AND commutes at the key"- (keyOf (combineAndVec (xGt 2) (yGt 2)))- (keyOf (combineAndVec (yGt 2) (xGt 2)))- , TestLabel- "truth-vector: section is the (eSize, compareExpr)-minimum of the fiber"- . TestCase- $- -- not merely order-independent: the survivor is the deterministic min, never the max.- let fiber = [xGt 2, yLt 3]- cmp a b =- compare (eSize (cvExpr a)) (eSize (cvExpr b))- <> compareExpr (cvExpr a) (cvExpr b)- want = keyOf (minimumBy cmp fiber)- in assertEqual- "min-section survivor"- [want]- (map keyOf (saturateCandidates TruthVector 1 fiber))- ]----------------------------------------------------------------------------- QuickCheck properties (over generated base pools and depths)---------------------------------------------------------------------------genAtom :: Gen CondVec-genAtom =- elements- [xGt 1, xGt 2, xGt 3, xLt 2, xLt 4, yGt 1, yGt 3, yLt 3, zGt 1, zGt 3, zLt 4]--genBase :: Gen [CondVec]-genBase = choose (2, 5) >>= \k -> vectorOf k genAtom---- Random label vector of the fixture's length (6 rows), for selection-preservation.-genLabels :: Gen [Bool]-genLabels = vectorOf 6 (elements [False, True])--prop_structuralSameSet :: Property-prop_structuralSameSet =- forAllBlind genBase $ \base ->- forAll (choose (1, 3)) $ \d ->- counterexample (show (map keyOf base, d)) $- keySet (saturateCandidates Structural d base) === keySet (ref d base)--prop_truthVectorFloor :: Property-prop_truthVectorFloor =- forAllBlind genBase $ \base ->- forAll (choose (1, 3)) $ \d ->- counterexample (show (map keyOf base, d)) $- 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 — that is the byte-identity contract, see the selection tests.)-prop_orderInvariant :: Property-prop_orderInvariant =- forAllBlind genBase $ \base ->- forAllBlind (shuffle base) $ \base' ->- forAll (choose (1, 3)) $ \d ->- counterexample (show (map keyOf base, map keyOf base', d)) $- 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 ->- forAllBlind genLabels $ \lbls ->- forAll (choose (2, 3)) $ \d ->- 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 ->- forAll (choose (2, 3)) $ \d ->- counterexample (show (map keyOf base, d)) $- 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.-genCand :: Gen CondVec-genCand =- oneof- [ genAtom- , combineAndVec <$> genAtom <*> genAtom- , combineOrVec <$> genAtom <*> genAtom- ]--prop_keyFaithful :: Property-prop_keyFaithful =- forAllBlind genCand $ \a ->- forAllBlind genCand $ \b ->- counterexample (keyOf a ++ " vs " ++ keyOf b) $- (keyOf a == keyOf b) === eqExpr (cvExpr a) (cvExpr b)--props :: [Property]-props =- [ prop_structuralSameSet- , prop_truthVectorFloor- , prop_orderInvariant- , prop_selectionPreserved- , prop_orderMatchesOracle- , prop_keyFaithful- ]
+ tests/data/timestamp_nanos.parquet view
binary file changed (absent → 237 bytes)