From e5c2f59675c26ae971e1482fb45370751fc2378c Mon Sep 17 00:00:00 2001 From: CarterPerez-dev Date: Wed, 29 Apr 2026 00:35:07 -0400 Subject: [PATCH] feat: add Aenebris.ML.Inference and Aenebris.ML.Calibration - New Aenebris.ML.Inference module: pure tree-walk over the unified Tree SoA produced by Aenebris.ML.Loader. Mirrors LightGBM C++ NumericalDecision exactly: NaN remapped to 0 unless MissingType=NaN; MissingType=Zero/NaN routes via default-left flag; '<=' predicate (not '<'); categorical bitmap test using cat_boundaries slice; average_output divisor for RF mode; sigmoid link for binary logistic objective. kZeroThreshold = 1e-35 matches LightGBM's IsZero exactly. Defensive against NaN/Inf/negative on categorical paths. 35 tests covering leaf-only, numerical splits, missing-value semantics, categorical routing, multi-tree sums, sigmoid saturation, average_output, regression vs binary objectives, and end-to-end against the disk fixture. - New Aenebris.ML.Calibration module: pure calibration of binary classifier outputs. Calibrator ADT (NoCalibrator | PlattCalibrator a b | IsotonicCalibrator bp). Platt scaling uses Newton's method with damped line search on Platt-1999 smoothed targets (N+ + 1)/(N+ + 2) and 1/(N- + 2); numerically stable softplus-based log-loss. Isotonic regression uses Pool Adjacent Violators on a stack with tie pre- grouping, sorted (raw, calibrated) breakpoints, linear interpolation, out-of-range clamping. Sub-2-sample input returns NoCalibrator. 28 tests covering all three calibrator constructors, fit edge cases, Platt convergence on logistic data, isotonic correction of non- monotone data, tie handling, all-same-label degenerate cases, and lookup behavior including clamping and interpolation. - aenebris.cabal: expose both new modules in the library stanza. - 301 total examples passing, 0 GHC warnings on either new module. --- .../haskell-reverse-proxy/aenebris.cabal | 2 + .../src/Aenebris/ML/Calibration.hs | 245 ++++++++++++ .../src/Aenebris/ML/Inference.hs | 124 ++++++ .../haskell-reverse-proxy/test/Spec.hs | 363 ++++++++++++++++++ 4 files changed, 734 insertions(+) create mode 100644 PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/ML/Calibration.hs create mode 100644 PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/ML/Inference.hs diff --git a/PROJECTS/advanced/haskell-reverse-proxy/aenebris.cabal b/PROJECTS/advanced/haskell-reverse-proxy/aenebris.cabal index bd62a5a6..b8a92e95 100644 --- a/PROJECTS/advanced/haskell-reverse-proxy/aenebris.cabal +++ b/PROJECTS/advanced/haskell-reverse-proxy/aenebris.cabal @@ -41,6 +41,8 @@ library , Aenebris.ML.Features , Aenebris.ML.Model , Aenebris.ML.Loader + , Aenebris.ML.Inference + , Aenebris.ML.Calibration default-language: Haskell2010 build-depends: base >= 4.7 && < 5 , warp >= 3.3 diff --git a/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/ML/Calibration.hs b/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/ML/Calibration.hs new file mode 100644 index 00000000..89be68e4 --- /dev/null +++ b/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/ML/Calibration.hs @@ -0,0 +1,245 @@ +{- +©AngelaMos | 2026 +Calibration.hs +-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveGeneric #-} + +module Aenebris.ML.Calibration + ( Calibrator(..) + , calibrate + , fitPlatt + , fitIsotonic + ) where + +import Data.List (sortBy) +import Data.Ord (comparing) +import qualified Data.Vector.Unboxed as VU +import GHC.Generics (Generic) + +maxNewtonIterations :: Int +maxNewtonIterations = 100 + +newtonConvergenceTol :: Double +newtonConvergenceTol = 1.0e-7 + +initialPlattA :: Double +initialPlattA = 0.0 + +initialPlattB :: Double +initialPlattB = 0.0 + +minLineSearchStep :: Double +minLineSearchStep = 1.0e-10 + +initialLineSearchStep :: Double +initialLineSearchStep = 1.0 + +lineSearchShrinkFactor :: Double +lineSearchShrinkFactor = 0.5 + +degenerateHessianThreshold :: Double +degenerateHessianThreshold = 1.0e-12 + +degenerateFallbackStep :: Double +degenerateFallbackStep = 0.01 + +minSamplesForFitting :: Int +minSamplesForFitting = 2 + +singletonBlockWeight :: Double +singletonBlockWeight = 1.0 + +labelTrueValue :: Double +labelTrueValue = 1.0 + +labelFalseValue :: Double +labelFalseValue = 0.0 + +plattLabelSmoothingNumeratorOffset :: Double +plattLabelSmoothingNumeratorOffset = 1.0 + +plattLabelSmoothingDenominatorOffset :: Double +plattLabelSmoothingDenominatorOffset = 2.0 + +data Calibrator + = NoCalibrator + | PlattCalibrator !Double !Double + | IsotonicCalibrator !(VU.Vector (Double, Double)) + deriving (Eq, Show, Generic) + +calibrate :: Calibrator -> Double -> Double +calibrate NoCalibrator p = p +calibrate (PlattCalibrator a b) p = sigmoidPositiveExponent (a * p + b) +calibrate (IsotonicCalibrator bp) p = isotonicLookup bp p + +sigmoidPositiveExponent :: Double -> Double +sigmoidPositiveExponent z = 1.0 / (1.0 + exp z) + +softplus :: Double -> Double +softplus z = max 0.0 z + log (1.0 + exp (negate (abs z))) + +boolToTarget :: Bool -> Double +boolToTarget True = labelTrueValue +boolToTarget False = labelFalseValue + +fitPlatt :: VU.Vector (Double, Bool) -> Calibrator +fitPlatt samples + | VU.length samples < minSamplesForFitting = NoCalibrator + | otherwise = + let !nPos = VU.length (VU.filter snd samples) + !nNeg = VU.length samples - nPos + !targetPos = (fromIntegral nPos + plattLabelSmoothingNumeratorOffset) + / (fromIntegral nPos + plattLabelSmoothingDenominatorOffset) + !targetNeg = plattLabelSmoothingNumeratorOffset + / (fromIntegral nNeg + plattLabelSmoothingDenominatorOffset) + smoothed = VU.map + (\(p, lbl) -> (p, if lbl then targetPos else targetNeg)) + samples + (!a, !b) = plattNewton smoothed + in PlattCalibrator a b + +plattNewton :: VU.Vector (Double, Double) -> (Double, Double) +plattNewton !smoothed = go 0 initialPlattA initialPlattB initialLoss + where + !initialLoss = computeNll smoothed initialPlattA initialPlattB + + go :: Int -> Double -> Double -> Double -> (Double, Double) + go !iter !a !b !prevLoss + | iter >= maxNewtonIterations = (a, b) + | otherwise = + let (!gA, !gB, !hAA, !hAB, !hBB) = gradHessian smoothed a b + !det = hAA * hBB - hAB * hAB + (!stepA, !stepB) + | abs det < degenerateHessianThreshold = + ( negate gA * degenerateFallbackStep + , negate gB * degenerateFallbackStep + ) + | otherwise = + ( negate (hBB * gA - hAB * gB) / det + , negate (negate hAB * gA + hAA * gB) / det + ) + (!newA, !newB, !newLoss) = + lineSearch smoothed a b stepA stepB prevLoss initialLineSearchStep + in if abs (prevLoss - newLoss) < newtonConvergenceTol + then (newA, newB) + else go (iter + 1) newA newB newLoss + +lineSearch + :: VU.Vector (Double, Double) + -> Double -> Double -> Double -> Double -> Double -> Double + -> (Double, Double, Double) +lineSearch !smoothed !a !b !stepA !stepB !prevLoss !step + | step < minLineSearchStep = (a, b, prevLoss) + | otherwise = + let !trialA = a + step * stepA + !trialB = b + step * stepB + !trialLoss = computeNll smoothed trialA trialB + in if trialLoss < prevLoss + then (trialA, trialB, trialLoss) + else lineSearch smoothed a b stepA stepB prevLoss + (step * lineSearchShrinkFactor) + +computeNll :: VU.Vector (Double, Double) -> Double -> Double -> Double +computeNll !smoothed !a !b = VU.foldl' addSample 0.0 smoothed + where + addSample !acc (!p, !t) = + let !z = a * p + b + in acc + softplus z - (1.0 - t) * z + +gradHessian + :: VU.Vector (Double, Double) + -> Double + -> Double + -> (Double, Double, Double, Double, Double) +gradHessian !smoothed !a !b = + VU.foldl' step (0.0, 0.0, 0.0, 0.0, 0.0) smoothed + where + step (!gA, !gB, !hAA, !hAB, !hBB) (!p, !t) = + let !z = a * p + b + !q = sigmoidPositiveExponent z + !d = t - q + !dh = q * (1.0 - q) + in ( gA + d * p + , gB + d + , hAA + dh * p * p + , hAB + dh * p + , hBB + dh + ) + +fitIsotonic :: VU.Vector (Double, Bool) -> Calibrator +fitIsotonic samples + | VU.length samples < minSamplesForFitting = NoCalibrator + | otherwise = + let sorted = sortBy (comparing fst) (VU.toList samples) + grouped = groupTies sorted + smoothed = pav grouped + breakpoints = map blockToBreakpoint smoothed + in IsotonicCalibrator (VU.fromList breakpoints) + +groupTies :: [(Double, Bool)] -> [(Double, Double, Double)] +groupTies [] = [] +groupTies ((r0, l0) : rest) = goGroup r0 singletonBlockWeight (boolToTarget l0) rest + where + goGroup !curR !w !sumL [] = [(curR * w, sumL, w)] + goGroup !curR !w !sumL ((r, l) : rs) + | r == curR = goGroup curR (w + singletonBlockWeight) (sumL + boolToTarget l) rs + | otherwise = (curR * w, sumL, w) + : goGroup r singletonBlockWeight (boolToTarget l) rs + +pav :: [(Double, Double, Double)] -> [(Double, Double, Double)] +pav xs = reverse (foldl' push [] xs) + where + push :: [(Double, Double, Double)] + -> (Double, Double, Double) + -> [(Double, Double, Double)] + push [] b = [b] + push (top : rest) b + | blockMean top > blockMean b = push rest (mergeBlocks top b) + | otherwise = b : top : rest + +blockMean :: (Double, Double, Double) -> Double +blockMean (_, sumL, w) = sumL / w + +blockRawMean :: (Double, Double, Double) -> Double +blockRawMean (sumR, _, w) = sumR / w + +blockToBreakpoint :: (Double, Double, Double) -> (Double, Double) +blockToBreakpoint b = (blockRawMean b, blockMean b) + +mergeBlocks + :: (Double, Double, Double) + -> (Double, Double, Double) + -> (Double, Double, Double) +mergeBlocks (r1, l1, w1) (r2, l2, w2) = (r1 + r2, l1 + l2, w1 + w2) + +isotonicLookup :: VU.Vector (Double, Double) -> Double -> Double +isotonicLookup !bp !p + | VU.null bp = p + | p <= fst (VU.head bp) = snd (VU.head bp) + | p >= fst (VU.last bp) = snd (VU.last bp) + | otherwise = interpolateBp bp p + +interpolateBp :: VU.Vector (Double, Double) -> Double -> Double +interpolateBp !bp !p = + let !i = bisectRight bp p + (!loRaw, !loCal) = VU.unsafeIndex bp (i - 1) + (!hiRaw, !hiCal) = VU.unsafeIndex bp i + !range = hiRaw - loRaw + in if range == 0.0 + then loCal + else + let !frac = (p - loRaw) / range + in loCal + frac * (hiCal - loCal) + +bisectRight :: VU.Vector (Double, Double) -> Double -> Int +bisectRight !bp !p = go 0 (VU.length bp) + where + go !lo !hi + | lo >= hi = lo + | otherwise = + let !mid = lo + (hi - lo) `div` 2 + (!midRaw, _) = VU.unsafeIndex bp mid + in if midRaw > p + then go lo mid + else go (mid + 1) hi diff --git a/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/ML/Inference.hs b/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/ML/Inference.hs new file mode 100644 index 00000000..5440b0e9 --- /dev/null +++ b/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/ML/Inference.hs @@ -0,0 +1,124 @@ +{- +©AngelaMos | 2026 +Inference.hs +-} +{-# LANGUAGE BangPatterns #-} + +module Aenebris.ML.Inference + ( walkTree + , predictRaw + , predictScore + , predictProba + , sigmoidLink + , kZeroThreshold + ) where + +import Data.Bits (shiftR, testBit, (.&.)) +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU + +import Aenebris.ML.Model + ( Ensemble(..) + , MissingType(..) + , Objective(..) + , SplitKind(..) + , Tree(..) + , decisionTypeBits + , defaultRootIndex + , ensembleTreeCount + , nodeIsLeaf + ) + +kZeroThreshold :: Double +kZeroThreshold = 1.0e-35 + +bitsPerWordShift :: Int +bitsPerWordShift = 5 + +bitsPerWordMask :: Int +bitsPerWordMask = 31 + +zeroFeatureValue :: Double +zeroFeatureValue = 0.0 + +sigmoidNumerator :: Double +sigmoidNumerator = 1.0 + +sigmoidBias :: Double +sigmoidBias = 1.0 + +walkTree :: Tree -> VU.Vector Double -> Int +walkTree !tree !fv = go defaultRootIndex + where + go !i + | nodeIsLeaf tree i = i + | otherwise = go (chooseChild tree i fv) + +chooseChild :: Tree -> Int -> VU.Vector Double -> Int +chooseChild !tree !i !fv = + let !dt = treeDecisionType tree VU.! i + !featIdx = treeFeatureIdx tree VU.! i + !rawFval = fv VU.! featIdx + (!kind, !defaultLeft, !mtype) = decisionTypeBits dt + !goLeft = treeLeftChild tree VU.! i + !goRight = treeRightChild tree VU.! i + !fval = if isNaN rawFval && mtype /= MissingTypeNaN + then zeroFeatureValue + else rawFval + in if hitsMissingDefault mtype fval + then if defaultLeft then goLeft else goRight + else case kind of + SplitNumerical + | fval <= treeThreshold tree VU.! i -> goLeft + | otherwise -> goRight + SplitCategorical + | categoricalGoesLeft tree i fval -> goLeft + | otherwise -> goRight + +hitsMissingDefault :: MissingType -> Double -> Bool +hitsMissingDefault MissingTypeZero fval = isZeroLgbm fval +hitsMissingDefault MissingTypeNaN fval = isNaN fval +hitsMissingDefault MissingTypeNone _ = False + +isZeroLgbm :: Double -> Bool +isZeroLgbm fval = + fval > negate kZeroThreshold && fval < kZeroThreshold + +categoricalGoesLeft :: Tree -> Int -> Double -> Bool +categoricalGoesLeft !tree !i !fval + | isNaN fval || isInfinite fval || fval < 0 = False + | otherwise = + let !ifval = floor fval :: Int + !catIdx = floor (treeThreshold tree VU.! i) :: Int + !bStart = treeCatBoundaries tree VU.! catIdx + !bEnd = treeCatBoundaries tree VU.! (catIdx + 1) + !nWords = bEnd - bStart + !off = ifval `shiftR` bitsPerWordShift + in (off < nWords) + && testBit (treeCatThreshold tree VU.! (bStart + off)) + (ifval .&. bitsPerWordMask) + +predictRaw :: Ensemble -> VU.Vector Double -> Double +predictRaw !ens !fv = V.foldl' addLeafValue 0.0 (ensembleTrees ens) + where + addLeafValue !acc !tree = + acc + treeLeafValue tree VU.! walkTree tree fv + +predictScore :: Ensemble -> VU.Vector Double -> Double +predictScore !ens !fv = + let !raw = predictRaw ens fv + !n = ensembleTreeCount ens + in if ensembleAverageOutput ens && n > 0 + then raw / fromIntegral n + else raw + +predictProba :: Ensemble -> VU.Vector Double -> Double +predictProba !ens !fv = + let !s = predictScore ens fv + in case ensembleObjective ens of + ObjectiveBinaryLogistic -> sigmoidLink (ensembleSigmoidScale ens) s + ObjectiveRegression -> s + +sigmoidLink :: Double -> Double -> Double +sigmoidLink !scale !x = + sigmoidNumerator / (sigmoidBias + exp (negate (scale * x))) diff --git a/PROJECTS/advanced/haskell-reverse-proxy/test/Spec.hs b/PROJECTS/advanced/haskell-reverse-proxy/test/Spec.hs index 706efbbf..7b8aa40e 100644 --- a/PROJECTS/advanced/haskell-reverse-proxy/test/Spec.hs +++ b/PROJECTS/advanced/haskell-reverse-proxy/test/Spec.hs @@ -180,6 +180,20 @@ import Aenebris.ML.Features , uaSecChConsistency , userAgentLengthCap ) +import Aenebris.ML.Calibration + ( Calibrator(..) + , calibrate + , fitIsotonic + , fitPlatt + ) +import Aenebris.ML.Inference + ( kZeroThreshold + , predictProba + , predictRaw + , predictScore + , sigmoidLink + , walkTree + ) import Aenebris.ML.Loader ( ParseError(..) , parseEnsemble @@ -333,6 +347,8 @@ main = hspec $ do mlFeaturesSpec mlModelSpec mlLoaderSpec + mlInferenceSpec + mlCalibrationSpec configSpec :: Spec configSpec = describe "Config" $ do @@ -2042,6 +2058,353 @@ mlLoaderSpec = describe "ML.Loader" $ do Left err -> peKey err `shouldBe` "version" Right _ -> expectationFailure "expected Left" +mkCatStump :: Bool -> MissingType -> [Word32] -> Double -> Double -> Tree +mkCatStump defaultLeft mtype bitmap leftV rightV = + let bitmapVec = VU.fromList bitmap + boundaries = VU.fromList [0, VU.length bitmapVec] + dt = makeDecisionType SplitCategorical defaultLeft mtype + in Tree + { treeFeatureIdx = VU.fromList [0, leafSentinel, leafSentinel] + , treeThreshold = VU.fromList [0.0, 0.0, 0.0] + , treeLeftChild = VU.fromList [1, noChildIndex, noChildIndex] + , treeRightChild = VU.fromList [2, noChildIndex, noChildIndex] + , treeLeafValue = VU.fromList [0.0, leftV, rightV] + , treeDecisionType = VU.fromList [dt, 0, 0] + , treeCatBoundaries = boundaries + , treeCatThreshold = bitmapVec + } + +mkSingleFeatureEnsemble :: Objective -> Double -> Bool -> [Tree] -> Ensemble +mkSingleFeatureEnsemble obj sig avg trees = Ensemble + { ensembleVersion = currentEnsembleVersion + , ensembleFeatureCount = 1 + , ensembleObjective = obj + , ensembleBaseScore = 0.0 + , ensembleSigmoidScale = sig + , ensembleAverageOutput = avg + , ensembleTrees = V.fromList trees + } + +binaryEnsemble :: [Tree] -> Ensemble +binaryEnsemble = mkSingleFeatureEnsemble ObjectiveBinaryLogistic defaultSigmoidScale False + +singletonFv :: Double -> VU.Vector Double +singletonFv = VU.singleton + +mlInferenceSpec :: Spec +mlInferenceSpec = describe "ML.Inference" $ do + tinyBytes <- runIO (BS.readFile "test/fixtures/ml/tiny_lgbm_v4.txt") + + describe "walkTree on a leaf-only tree" $ do + it "returns the root index for a stump tree" $ + walkTree (makeLeafTree 0.42) (singletonFv 0.0) `shouldBe` 0 + + it "predictRaw returns the leaf value for a single-leaf single-tree ensemble" $ + predictRaw (binaryEnsemble [makeLeafTree 0.42]) (singletonFv 0.0) + `shouldBe` 0.42 + + describe "walkTree on a numerical stump (defaultLeft=True, MissingTypeNone)" $ do + let tree = makeStumpTreeWithMissing 0 0.5 (-1.0) 1.0 True MissingTypeNone + ens = binaryEnsemble [tree] + + it "fval below threshold goes left (leaf value -1.0)" $ + predictRaw ens (singletonFv 0.0) `shouldBe` (-1.0) + + it "fval above threshold goes right (leaf value 1.0)" $ + predictRaw ens (singletonFv 0.9) `shouldBe` 1.0 + + it "fval exactly at threshold goes left (predicate is <=, not <)" $ + predictRaw ens (singletonFv 0.5) `shouldBe` (-1.0) + + it "NaN with MissingTypeNone is remapped to 0 then compared (0 <= 0.5 -> left)" $ + predictRaw ens (singletonFv (0.0 / 0.0)) `shouldBe` (-1.0) + + describe "MissingType=Zero routes via default-left flag" $ do + let leftTree = makeStumpTreeWithMissing 0 (-10.0) 7.0 (-7.0) True MissingTypeZero + rightTree = makeStumpTreeWithMissing 0 (-10.0) 7.0 (-7.0) False MissingTypeZero + + it "0.0 with defaultLeft=True hits left branch (ignoring threshold)" $ + predictRaw (binaryEnsemble [leftTree]) (singletonFv 0.0) `shouldBe` 7.0 + + it "0.0 with defaultLeft=False hits right branch (ignoring threshold)" $ + predictRaw (binaryEnsemble [rightTree]) (singletonFv 0.0) `shouldBe` (-7.0) + + it "tiny non-zero (2e-36) is treated as zero by IsZero(kZeroThreshold=1e-35)" $ + predictRaw (binaryEnsemble [leftTree]) (singletonFv 2.0e-36) + `shouldBe` 7.0 + + it "value just above kZeroThreshold is NOT treated as zero" $ + predictRaw (binaryEnsemble [leftTree]) (singletonFv 1.0e-30) + `shouldBe` (-7.0) + + describe "MissingType=NaN routes only when feature is NaN" $ do + let nanTree = makeStumpTreeWithMissing 0 0.5 (-1.0) 1.0 True MissingTypeNaN + + it "NaN feature uses default-left (left leaf -1.0)" $ + predictRaw (binaryEnsemble [nanTree]) (singletonFv (0.0 / 0.0)) + `shouldBe` (-1.0) + + it "non-NaN feature still uses normal threshold comparison" $ + predictRaw (binaryEnsemble [nanTree]) (singletonFv 0.9) + `shouldBe` 1.0 + + describe "categorical bitmap routing" $ do + let bitmap5 = [5 :: Word32] + + it "category 0 in bitmap 0b101 routes left" $ + predictRaw (binaryEnsemble [mkCatStump False MissingTypeNone bitmap5 (-2.0) 2.0]) + (singletonFv 0.0) + `shouldBe` (-2.0) + + it "category 1 NOT in bitmap 0b101 routes right" $ + predictRaw (binaryEnsemble [mkCatStump False MissingTypeNone bitmap5 (-2.0) 2.0]) + (singletonFv 1.0) + `shouldBe` 2.0 + + it "category 2 in bitmap 0b101 routes left" $ + predictRaw (binaryEnsemble [mkCatStump False MissingTypeNone bitmap5 (-2.0) 2.0]) + (singletonFv 2.0) + `shouldBe` (-2.0) + + it "category beyond bitmap range routes right" $ + predictRaw (binaryEnsemble [mkCatStump False MissingTypeNone bitmap5 (-2.0) 2.0]) + (singletonFv 99.0) + `shouldBe` 2.0 + + it "negative categorical feature routes right" $ + predictRaw (binaryEnsemble [mkCatStump False MissingTypeNone bitmap5 (-2.0) 2.0]) + (singletonFv (-1.0)) + `shouldBe` 2.0 + + it "categorical NaN with MissingTypeZero routes via default-left" $ + predictRaw (binaryEnsemble [mkCatStump True MissingTypeZero bitmap5 (-2.0) 2.0]) + (singletonFv (0.0 / 0.0)) + `shouldBe` (-2.0) + + describe "multi-tree ensemble sums leaf contributions" $ do + let t1 = makeStumpTreeWithMissing 0 0.0 (-0.3) 0.3 False MissingTypeNone + t2 = makeStumpTreeWithMissing 0 0.5 (-0.2) 0.2 False MissingTypeNone + + it "sums each tree's chosen leaf value" $ + predictRaw (binaryEnsemble [t1, t2]) (singletonFv 0.7) + `shouldBe` 0.5 + + it "different feature value picks different leaves and changes the sum" $ + predictRaw (binaryEnsemble [t1, t2]) (singletonFv (-0.1)) + `shouldBe` (-0.5) + + describe "predictScore: average_output divisor" $ do + let t1 = makeLeafTree 1.0 + t2 = makeLeafTree 3.0 + + it "no average_output: predictScore equals predictRaw" $ do + let ens = mkSingleFeatureEnsemble ObjectiveBinaryLogistic defaultSigmoidScale False [t1, t2] + predictScore ens (singletonFv 0.0) `shouldBe` 4.0 + + it "average_output=True divides raw by num_trees" $ do + let ens = mkSingleFeatureEnsemble ObjectiveBinaryLogistic defaultSigmoidScale True [t1, t2] + predictScore ens (singletonFv 0.0) `shouldBe` 2.0 + + it "average_output=True with empty tree vector falls back to raw (n=0 guard)" $ do + let ens = mkSingleFeatureEnsemble ObjectiveBinaryLogistic defaultSigmoidScale True [] + predictScore ens (singletonFv 0.0) `shouldBe` 0.0 + + describe "sigmoidLink" $ do + it "scale*x = 0 yields 0.5" $ + sigmoidLink 1.0 0.0 `shouldBe` 0.5 + + it "very large positive x saturates near 1.0" $ + sigmoidLink 1.0 1000.0 `shouldBe` 1.0 + + it "very large negative x saturates near 0.0" $ + sigmoidLink 1.0 (-1000.0) `shouldBe` 0.0 + + it "scale=0.5 halves the steepness" $ + sigmoidLink 0.5 2.0 `shouldBe` (1.0 / (1.0 + exp (-1.0))) + + describe "predictProba: objective-specific link function" $ do + it "binary logistic applies sigmoid with the ensemble's scale" $ do + let ens = mkSingleFeatureEnsemble ObjectiveBinaryLogistic 1.0 False [makeLeafTree 0.0] + predictProba ens (singletonFv 0.0) `shouldBe` 0.5 + + it "binary logistic with sigmoidScale=0.5 applies the scale" $ do + let ens = mkSingleFeatureEnsemble ObjectiveBinaryLogistic 0.5 False [makeLeafTree 2.0] + predictProba ens (singletonFv 0.0) `shouldBe` (1.0 / (1.0 + exp (-1.0))) + + it "regression returns the score directly (no sigmoid)" $ do + let ens = mkSingleFeatureEnsemble ObjectiveRegression 1.0 False [makeLeafTree 7.5] + predictProba ens (singletonFv 0.0) `shouldBe` 7.5 + + describe "kZeroThreshold matches LightGBM" $ + it "is exactly 1e-35" $ + kZeroThreshold `shouldBe` 1.0e-35 + + describe "end-to-end against the tiny LightGBM v4 fixture" $ do + case parseEnsemble tinyBytes of + Left err -> it "parses tinyBytes" $ expectationFailure (show err) + Right ens -> do + it "feature vector [0, 0] (cat_feat=0 -> left, num_feat=0 -> left) hits leaf 0 (0.3)" $ + predictRaw ens (VU.fromList [0.0, 0.0]) `shouldBe` 0.3 + + it "feature vector [10, 1] (cat_feat=1 -> left, num_feat=10 -> right) hits leaf 1 (-0.2)" $ + predictRaw ens (VU.fromList [10.0, 1.0]) `shouldBe` (-0.2) + + it "feature vector [0, 2] (cat_feat=2 -> right) hits leaf 2 (-0.4)" $ + predictRaw ens (VU.fromList [0.0, 2.0]) `shouldBe` (-0.4) + + it "predictProba on tinyBytes feeds the sum through binary sigmoid scale=1" $ + predictProba ens (VU.fromList [0.0, 0.0]) + `shouldBe` (1.0 / (1.0 + exp (-0.3))) + +isPlatt :: Calibrator -> Bool +isPlatt (PlattCalibrator _ _) = True +isPlatt _ = False + +isIsotonic :: Calibrator -> Bool +isIsotonic (IsotonicCalibrator _) = True +isIsotonic _ = False + +mlCalibrationSpec :: Spec +mlCalibrationSpec = describe "ML.Calibration" $ do + describe "NoCalibrator" $ + it "is identity for any input" $ do + calibrate NoCalibrator 0.0 `shouldBe` 0.0 + calibrate NoCalibrator 0.5 `shouldBe` 0.5 + calibrate NoCalibrator 1.0 `shouldBe` 1.0 + calibrate NoCalibrator (-3.7) `shouldBe` (-3.7) + + describe "PlattCalibrator basic shape" $ do + it "(a=0, b=0) yields constant 0.5 regardless of p" $ do + calibrate (PlattCalibrator 0.0 0.0) 0.3 `shouldBe` 0.5 + calibrate (PlattCalibrator 0.0 0.0) 1000.0 `shouldBe` 0.5 + + it "negative a produces output increasing in p" $ do + let cal = PlattCalibrator (-2.0) 1.0 + calibrate cal 0.0 `shouldSatisfy` (< calibrate cal 1.0) + + it "positive (a*p + b) saturates near 0 for large p" $ + calibrate (PlattCalibrator 1.0 0.0) 1000.0 `shouldBe` 0.0 + + it "negative (a*p + b) saturates near 1 for large p" $ + calibrate (PlattCalibrator (-1.0) 0.0) 1000.0 `shouldBe` 1.0 + + describe "fitPlatt edge cases" $ do + it "returns NoCalibrator for empty input" $ + fitPlatt VU.empty `shouldBe` NoCalibrator + + it "returns NoCalibrator for single sample" $ + fitPlatt (VU.singleton (0.5, True)) `shouldBe` NoCalibrator + + it "returns PlattCalibrator for >=2 samples" $ + fitPlatt (VU.fromList [(0.1, False), (0.9, True)]) + `shouldSatisfy` isPlatt + + describe "fitPlatt convergence on logistic-like data" $ do + let negativeExamples = [(fromIntegral i / 100.0, False) | i <- [0 :: Int .. 49]] + positiveExamples = [(fromIntegral i / 100.0, True) | i <- [50 :: Int .. 99]] + samples = VU.fromList (negativeExamples ++ positiveExamples) + cal = fitPlatt samples + + it "fit recovers a < 0 (output increases with p)" $ + case cal of + PlattCalibrator a _ -> a `shouldSatisfy` (< 0.0) + _ -> expectationFailure "expected PlattCalibrator" + + it "calibrated output at low p is less than at high p" $ + calibrate cal 0.1 `shouldSatisfy` (< calibrate cal 0.9) + + it "calibrated output stays in (0, 1)" $ do + let mid = calibrate cal 0.5 + mid `shouldSatisfy` (> 0.0) + mid `shouldSatisfy` (< 1.0) + + describe "fitIsotonic edge cases" $ do + it "returns NoCalibrator for empty input" $ + fitIsotonic VU.empty `shouldBe` NoCalibrator + + it "returns NoCalibrator for single sample" $ + fitIsotonic (VU.singleton (0.5, True)) `shouldBe` NoCalibrator + + it "returns IsotonicCalibrator for >=2 samples" $ + fitIsotonic (VU.fromList [(0.1, False), (0.9, True)]) + `shouldSatisfy` isIsotonic + + describe "fitIsotonic on already-monotone data" $ do + let samples = VU.fromList + [(0.1, False), (0.3, False), (0.6, True), (0.9, True)] + cal = fitIsotonic samples + + it "low raw clamps to 0.0" $ + calibrate cal 0.0 `shouldBe` 0.0 + + it "high raw clamps to 1.0" $ + calibrate cal 1.0 `shouldBe` 1.0 + + it "calibrated values are monotone non-decreasing" $ + case cal of + IsotonicCalibrator bp -> + let cals = VU.toList (VU.map snd bp) + in all (uncurry (<=)) (zip cals (drop 1 cals)) `shouldBe` True + _ -> expectationFailure "expected IsotonicCalibrator" + + describe "fitIsotonic corrects non-monotone data" $ do + let samples = VU.fromList + [(0.1, False), (0.4, True), (0.5, False), (0.9, True)] + cal = fitIsotonic samples + + it "produces 3 breakpoints (one PAV merge)" $ + case cal of + IsotonicCalibrator bp -> VU.length bp `shouldBe` 3 + _ -> expectationFailure "expected IsotonicCalibrator" + + it "calibrated values are monotone non-decreasing" $ + case cal of + IsotonicCalibrator bp -> + let cals = VU.toList (VU.map snd bp) + in all (uncurry (<=)) (zip cals (drop 1 cals)) `shouldBe` True + _ -> expectationFailure "expected IsotonicCalibrator" + + describe "fitIsotonic ties" $ do + let samples = VU.fromList [(0.5, True), (0.5, False)] + cal = fitIsotonic samples + + it "merges identical raw values into one breakpoint" $ + case cal of + IsotonicCalibrator bp -> VU.length bp `shouldBe` 1 + _ -> expectationFailure "expected IsotonicCalibrator" + + it "merged breakpoint has averaged label" $ + calibrate cal 0.5 `shouldBe` 0.5 + + describe "fitIsotonic with all-same labels" $ do + it "all True calibrates to 1.0 across the range" $ do + let cal = fitIsotonic (VU.fromList [(0.1, True), (0.5, True), (0.9, True)]) + calibrate cal 0.5 `shouldBe` 1.0 + + it "all False calibrates to 0.0 across the range" $ do + let cal = fitIsotonic (VU.fromList [(0.1, False), (0.5, False), (0.9, False)]) + calibrate cal 0.5 `shouldBe` 0.0 + + describe "isotonic lookup behavior" $ do + let cal = IsotonicCalibrator + (VU.fromList [(0.25, 0.0), (0.5, 0.5), (0.75, 1.0)]) + + it "clamps below first breakpoint" $ + calibrate cal 0.0 `shouldBe` 0.0 + + it "clamps above last breakpoint" $ + calibrate cal 1.5 `shouldBe` 1.0 + + it "returns exact value at a breakpoint" $ + calibrate cal 0.5 `shouldBe` 0.5 + + it "linearly interpolates between breakpoints" $ do + let bp = VU.fromList [(0.0, 0.25), (1.0, 0.75)] + calibrate (IsotonicCalibrator bp) 0.5 `shouldBe` 0.5 + + it "empty breakpoints pass through" $ + calibrate (IsotonicCalibrator VU.empty) 0.42 `shouldBe` 0.42 + headersOnlyRequest :: [(BS.ByteString, BS.ByteString)] -> Request headersOnlyRequest hs = Network.Wai.Test.defaultRequest