-- SPDX-License-Identifier: MPL-2.0

-- | Shared, deliberately small dense reference kernels for the ML estimators.
module HMath.MachineLearning.Internal where

import Control.Monad (foldM)
import Data.Complex (imagPart, realPart)
import Data.List (maximumBy, sortOn, transpose)
import Data.Ord (comparing)
import Data.Word (Word64)
import HMath.Error
import qualified HMath.Matrix as M
import qualified HMath.Matrix.Advanced as A
import qualified HMath.Matrix.LAPACK as L

-- | Finite observations as rows with a fixed, positive feature count.
type Dataset = [[Double]]

-- | Positive iteration limit/tolerance/rate and an explicit reproducible seed.
data MLConfig = MLConfig
    { MLConfig -> Int
mlIterations :: Int
    -- ^ Maximum outer iterations per fitted algorithm.
    , MLConfig -> Double
mlTolerance :: Double
    -- ^ Absolute algorithm-specific stopping residual.
    , MLConfig -> Double
mlRate :: Double
    -- ^ Positive gradient step size, where used.
    , MLConfig -> Word64
mlSeed :: Word64
    -- ^ Seed for initialization, projection, or stochastic updates.
    }
    deriving (MLConfig -> MLConfig -> Bool
(MLConfig -> MLConfig -> Bool)
-> (MLConfig -> MLConfig -> Bool) -> Eq MLConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MLConfig -> MLConfig -> Bool
== :: MLConfig -> MLConfig -> Bool
$c/= :: MLConfig -> MLConfig -> Bool
/= :: MLConfig -> MLConfig -> Bool
Eq, Int -> MLConfig -> ShowS
[MLConfig] -> ShowS
MLConfig -> String
(Int -> MLConfig -> ShowS)
-> (MLConfig -> String) -> ([MLConfig] -> ShowS) -> Show MLConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MLConfig -> ShowS
showsPrec :: Int -> MLConfig -> ShowS
$cshow :: MLConfig -> String
show :: MLConfig -> String
$cshowList :: [MLConfig] -> ShowS
showList :: [MLConfig] -> ShowS
Show)

-- | 500 iterations, absolute residual tolerance 1e-8, rate 0.05, PCG seed 42.
defaultMLConfig :: MLConfig
defaultMLConfig :: MLConfig
defaultMLConfig = Int -> Double -> Double -> Word64 -> MLConfig
MLConfig Int
500 Double
1e-8 Double
0.05 Word64
42

-- | A finite budget is a valid stopping point, distinct from convergence.
data Fit a = Fit
    { forall a. Fit a -> a
fitted :: a
    -- ^ Best fitted model retained when fitting stops.
    , forall a. Fit a -> Int
fitIterations :: Int
    -- ^ Completed fitting iterations.
    , forall a. Fit a -> Double
fitResidual :: Double
    -- ^ Algorithm-specific finite stopping residual at the returned model.
    , forall a. Fit a -> Bool
fitConverged :: Bool
    -- ^ Whether the selected stopping residual met tolerance; a budget stop may return False.
    }
    deriving (Fit a -> Fit a -> Bool
(Fit a -> Fit a -> Bool) -> (Fit a -> Fit a -> Bool) -> Eq (Fit a)
forall a. Eq a => Fit a -> Fit a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Fit a -> Fit a -> Bool
== :: Fit a -> Fit a -> Bool
$c/= :: forall a. Eq a => Fit a -> Fit a -> Bool
/= :: Fit a -> Fit a -> Bool
Eq, Int -> Fit a -> ShowS
[Fit a] -> ShowS
Fit a -> String
(Int -> Fit a -> ShowS)
-> (Fit a -> String) -> ([Fit a] -> ShowS) -> Show (Fit a)
forall a. Show a => Int -> Fit a -> ShowS
forall a. Show a => [Fit a] -> ShowS
forall a. Show a => Fit a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Fit a -> ShowS
showsPrec :: Int -> Fit a -> ShowS
$cshow :: forall a. Show a => Fit a -> String
show :: Fit a -> String
$cshowList :: forall a. Show a => [Fit a] -> ShowS
showList :: [Fit a] -> ShowS
Show)

-- | Test whether Double is neither NaN nor infinite.
finite :: Double -> Bool
finite :: Double -> Bool
finite Double
x = Bool -> Bool
not (Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
x Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
x)

-- | Validate a list of finite numerical values, returning Right () or Left NonFiniteResult.
checked :: [Double] -> Either MathError ()
checked :: [Double] -> Either MathError ()
checked [Double]
xs
    | (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Double -> Bool
finite [Double]
xs = () -> Either MathError ()
forall a b. b -> Either a b
Right ()
    | Bool
otherwise = MathError -> Either MathError ()
forall a b. a -> Either a b
Left MathError
NonFiniteResult

{- | Given condition then diagnostic, return Right () or Left InvalidArgument prefixed with
ML context.
-}
require :: Bool -> String -> Either MathError ()
require :: Bool -> String -> Either MathError ()
require Bool
True String
_ = () -> Either MathError ()
forall a b. b -> Either a b
Right ()
require Bool
False String
s = MathError -> Either MathError ()
forall a b. a -> Either a b
Left (String -> MathError
InvalidArgument (String
"ML: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s))

{- | Validate positive iteration count and positive finite tolerance/learning rate of
MLConfig. Invalid settings return Left InvalidArgument.
-}
config :: MLConfig -> Either MathError ()
config :: MLConfig -> Either MathError ()
config MLConfig
c =
    Bool -> String -> Either MathError ()
require
        ( MLConfig -> Int
mlIterations MLConfig
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
            Bool -> Bool -> Bool
&& Double -> Bool
finite (MLConfig -> Double
mlTolerance MLConfig
c)
            Bool -> Bool -> Bool
&& MLConfig -> Double
mlTolerance MLConfig
c Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0
            Bool -> Bool -> Bool
&& Double -> Bool
finite (MLConfig -> Double
mlRate MLConfig
c)
            Bool -> Bool -> Bool
&& MLConfig -> Double
mlRate MLConfig
c Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0
        )
        String
"invalid iteration/tolerance/rate configuration"

{- | Validate a nonempty finite rectangular observation-by-feature list with positive
feature count and Int-safe size. Return (observations,features) or Left MathError.
-}
dataset :: Dataset -> Either MathError (Int, Int)
dataset :: Dataset -> Either MathError (Int, Int)
dataset [] = MathError -> Either MathError (Int, Int)
forall a b. a -> Either a b
Left (String -> MathError
InvalidArgument String
"ML: nonempty dataset required")
dataset xs :: Dataset
xs@([Double]
r : Dataset
_) = do
    let n :: Int
n = Dataset -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Dataset
xs; d :: Int
d = [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
r
    Bool -> String -> Either MathError ()
require (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& ([Double] -> Bool) -> Dataset -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
d) (Int -> Bool) -> ([Double] -> Int) -> [Double] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) Dataset
xs) String
"nonzero, rectangular feature shape required"
    Bool -> String -> Either MathError ()
require (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
d Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
forall a. Bounded a => a
maxBound :: Int)) String
"shape overflow"
    [Double] -> Either MathError ()
checked (Dataset -> [Double]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat Dataset
xs)
    (Int, Int) -> Either MathError (Int, Int)
forall a b. b -> Either a b
Right (Int
n, Int
d)

{- | Given dataset then finite response list, validate dataset and equal
observation/response count. Return dataset dimensions; mismatch/non-finite data fails.
-}
responses :: Dataset -> [Double] -> Either MathError (Int, Int)
responses :: Dataset -> [Double] -> Either MathError (Int, Int)
responses Dataset
xs [Double]
ys = do
    dims@(n, _) <- Dataset -> Either MathError (Int, Int)
dataset Dataset
xs
    require (n == length ys) "response count mismatch"
    checked ys
    Right dims

{- | Given expected feature dimension then query rows, validate every row width and finite
values. Empty queries are allowed; mismatch/non-finite values fail.
-}
queries :: Int -> Dataset -> Either MathError ()
queries :: Int -> Dataset -> Either MathError ()
queries Int
d Dataset
xs = do
    Bool -> String -> Either MathError ()
require (([Double] -> Bool) -> Dataset -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
d) (Int -> Bool) -> ([Double] -> Int) -> [Double] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) Dataset
xs) String
"query feature count mismatch"
    [Double] -> Either MathError ()
checked (Dataset -> [Double]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat Dataset
xs)

{- | Unchecked list inner product using zipWith; unequal lengths truncate. Estimator callers
validate feature shapes first.
-}
dot :: [Double] -> [Double] -> Double
dot :: [Double] -> [Double] -> Double
dot [Double]
x [Double]
y = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Double -> Double -> Double) -> [Double] -> [Double] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> Double -> Double
forall a. Num a => a -> a -> a
(*) [Double]
x [Double]
y)

add, sub :: [Double] -> [Double] -> [Double]

{- | Unchecked coordinatewise list addition, truncating to shorter length; checked estimator
callers validate dimensions.
-}
add :: [Double] -> [Double] -> [Double]
add = (Double -> Double -> Double) -> [Double] -> [Double] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> Double -> Double
forall a. Num a => a -> a -> a
(+)

{- | Unchecked coordinatewise left-minus-right list subtraction, truncating to shorter
length.
-}
sub :: [Double] -> [Double] -> [Double]
sub = (Double -> Double -> Double) -> [Double] -> [Double] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-)

{- | Given scalar then coordinate list, multiply each coordinate without checked finiteness
validation.
-}
scale :: Double -> [Double] -> [Double]
scale :: Double -> [Double] -> [Double]
scale Double
s = (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
*)

{- | Return scaled Euclidean norm of a coordinate list, zero for empty/all-zero input.
Caller validates finite inputs/results when required.
-}
norm :: [Double] -> Double
norm :: [Double] -> Double
norm [Double]
xs | Double
s Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 = Double
0 | Bool
otherwise = Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sqrt ([Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [(Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
s) Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int) | Double
x <- [Double]
xs])
  where
    s :: Double
s = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Double
0 Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Double
forall a. Num a => a -> a
abs [Double]
xs)

{- | Return squared Euclidean distance using sub and dot. Require matching dimensions
externally; this unchecked helper truncates mismatched lists.
-}
dist2 :: [Double] -> [Double] -> Double
dist2 :: [Double] -> [Double] -> Double
dist2 [Double]
x [Double]
y = [Double] -> [Double] -> Double
dot [Double]
z [Double]
z where z :: [Double]
z = [Double] -> [Double] -> [Double]
sub [Double]
x [Double]
y

{- | Return per-feature means for a nonempty equal-width dataset. Empty outer input raises a
pure foldl1 error; use dataset validation before calling.
-}
meanV :: Dataset -> [Double]
meanV :: Dataset -> [Double]
meanV Dataset
xs = ([Double] -> [Double] -> [Double]) -> Dataset -> [Double]
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 [Double] -> [Double] -> [Double]
add (([Double] -> [Double]) -> Dataset -> Dataset
forall a b. (a -> b) -> [a] -> [b]
map (Double -> [Double] -> [Double]
scale (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dataset -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Dataset
xs))) Dataset
xs)

{- | Unchecked dense row-list matrix multiplication via row/column dot products. Caller must
validate rectangular compatible dimensions; zip-based dot otherwise truncates.
-}
matmul :: Dataset -> Dataset -> Dataset
matmul :: Dataset -> Dataset -> Dataset
matmul Dataset
x Dataset
y = [[[Double] -> [Double] -> Double
dot [Double]
r [Double]
c | [Double]
c <- Dataset -> Dataset
forall a. [[a]] -> [[a]]
transpose Dataset
y] | [Double]
r <- Dataset
x]

{- | Return n-by-n Double identity rows for a nonnegative dimension; nonpositive n gives [].
No allocation budget is checked here.
-}
ident :: Int -> Dataset
ident :: Int -> Dataset
ident Int
n = [[if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j then Double
1 else Double
0 | Int
j <- [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]] | Int
i <- [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]

{- | Given index,new value,then list, replace by take/drop reconstruction. The checked
caller must ensure an in-range index; this helper does not reject invalid bounds.
-}
replace :: Int -> a -> [a] -> [a]
replace :: forall a. Int -> a -> [a] -> [a]
replace Int
i a
x [a]
xs = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
i [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
x] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [a]
xs

{- | Validate dataset then construct row-major Matrix Double with matching dimensions.
Empty/ragged/non-finite input fails.
-}
matrix :: Dataset -> Either MathError (M.Matrix Double)
matrix :: Dataset -> Either MathError (Matrix Double)
matrix Dataset
xs = do (n, d) <- Dataset -> Either MathError (Int, Int)
dataset Dataset
xs; M.fromListChecked n d (concat xs)

-- | Convert Matrix to dense row lists, preserving explicit zero-column row count.
rows :: M.Matrix a -> [[a]]
rows :: forall a. Matrix a -> [[a]]
rows Matrix a
m | Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> [a] -> [[a]]
forall a. Int -> a -> [a]
replicate Int
n [] | Bool
otherwise = [Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
d (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
d) (Matrix a -> [a]
forall a. Matrix a -> [a]
M.toList Matrix a
m)) | Int
i <- [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]
  where
    (Int
n, Int
d) = Matrix a -> (Int, Int)
forall a. Matrix a -> (Int, Int)
M.shape Matrix a
m

{- | Compute a validated dataset pseudoinverse using relative singular-value tolerance 1e-12
and return dense rows. Decomposition/backend failures propagate.
-}
pinv :: Dataset -> Either MathError Dataset
pinv :: Dataset -> Either MathError Dataset
pinv Dataset
x = Dataset -> Either MathError (Matrix Double)
matrix Dataset
x Either MathError (Matrix Double)
-> (Matrix Double -> Either MathError (Matrix Double))
-> Either MathError (Matrix Double)
forall a b.
Either MathError a
-> (a -> Either MathError b) -> Either MathError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Double -> Matrix Double -> Either MathError (Matrix Double)
A.pseudoinverse Double
1e-12 Either MathError (Matrix Double)
-> (Matrix Double -> Either MathError Dataset)
-> Either MathError Dataset
forall a b.
Either MathError a
-> (a -> Either MathError b) -> Either MathError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Dataset -> Either MathError Dataset
forall a. a -> Either MathError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dataset -> Either MathError Dataset)
-> (Matrix Double -> Dataset)
-> Matrix Double
-> Either MathError Dataset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix Double -> Dataset
forall a. Matrix a -> [[a]]
rows

{- | Given dataset then response list, solve least squares through the pseudoinverse.
Validate counts/finite data/result; checked failures propagate.
-}
solveLS :: Dataset -> [Double] -> Either MathError [Double]
solveLS :: Dataset -> [Double] -> Either MathError [Double]
solveLS Dataset
x [Double]
y = do
    _ <- Dataset -> [Double] -> Either MathError (Int, Int)
responses Dataset
x [Double]
y
    p <- pinv x
    let answer = ([Double] -> Double) -> Dataset -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map ([Double] -> [Double] -> Double
`dot` [Double]
y) Dataset
p
    checked answer
    Right answer

{- | Validate a square dataset, compute pseudoinverse and require inverse reconstruction
residual below 1e-6*n. Reject singular/invalid matrices or decomposition failures.
-}
inverse :: Dataset -> Either MathError Dataset
inverse :: Dataset -> Either MathError Dataset
inverse Dataset
x = do
    (n, d) <- Dataset -> Either MathError (Int, Int)
dataset Dataset
x
    require (n == d) "square matrix required"
    p <- pinv x
    let residual = [Double] -> Double
norm (Dataset -> [Double]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (([Double] -> [Double] -> [Double]) -> Dataset -> Dataset -> Dataset
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Double] -> [Double] -> [Double]
sub (Dataset -> Dataset -> Dataset
matmul Dataset
x Dataset
p) (Int -> Dataset
ident Int
n)))
    require (residual < 1e-6 * fromIntegral n) "singular matrix"
    Right p

{- | Validate finite square approximately symmetric dataset, symmetrize and eigendecompose.
Return descending real eigenvalues and corresponding eigenvector columns as rows;
invalid spectrum/backend failures propagate.
-}
symmetricEigen :: Dataset -> Either MathError ([Double], Dataset)
symmetricEigen :: Dataset -> Either MathError ([Double], Dataset)
symmetricEigen Dataset
x = do
    (n, d) <- Dataset -> Either MathError (Int, Int)
dataset Dataset
x
    require (n == d) "eigendecomposition requires square matrix"
    require
        ( and
            [ abs (x !! i !! j - x !! j !! i) <= 1e-10 * max 1 (abs (x !! i !! j))
            | i <- [0 .. n - 1]
            , j <- [0 .. n - 1]
            ]
        )
        "symmetric matrix required"
    m <- matrix [[x !! i !! j / 2 + x !! j !! i / 2 | j <- [0 .. n - 1]] | i <- [0 .. n - 1]]
    e <- L.symmetricEigen m
    let vals = Eigen -> [Complex Double]
L.eigenvalues Eigen
e; vs = Matrix (Complex Double) -> [[Complex Double]]
forall a. Matrix a -> [[a]]
rows (Eigen -> Matrix (Complex Double)
L.eigenvectors Eigen
e)
    require (all ((< 1e-8) . abs . imagPart) vals) "unexpected complex symmetric eigenvalue"
    let order = ((Int, Double) -> Int) -> [(Int, Double)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Double) -> Int
forall a b. (a, b) -> a
fst (((Int, Double) -> Double) -> [(Int, Double)] -> [(Int, Double)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Double -> Double
forall a. Num a => a -> a
negate (Double -> Double)
-> ((Int, Double) -> Double) -> (Int, Double) -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Double) -> Double
forall a b. (a, b) -> b
snd) ([Int] -> [Double] -> [(Int, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] ((Complex Double -> Double) -> [Complex Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Complex Double -> Double
forall a. Complex a -> a
realPart [Complex Double]
vals)))
    Right
        ([realPart (vals !! j) | j <- order], [[realPart (vs !! i !! j) | j <- order] | i <- [0 .. n - 1]])

argmin, argmax :: (Ord a) => [a] -> Int

{- | Return zero-based first index of a minimum in a nonempty list. Empty list raises a pure
minimum error; callers must validate nonempty input.
-}
argmin :: forall a. Ord a => [a] -> Int
argmin [a]
xs = (a, Int) -> Int
forall a b. (a, b) -> b
snd ([(a, Int)] -> (a, Int)
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([a] -> [Int] -> [(a, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs [Int
0 ..]))

{- | Return zero-based index selected by maximumBy on a nonempty list, with later equal
maxima preferred. Empty list raises a pure error.
-}
argmax :: forall a. Ord a => [a] -> Int
argmax [a]
xs = (a, Int) -> Int
forall a b. (a, b) -> b
snd (((a, Int) -> (a, Int) -> Ordering) -> [(a, Int)] -> (a, Int)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (((a, Int) -> a) -> (a, Int) -> (a, Int) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (a, Int) -> a
forall a b. (a, b) -> a
fst) ([a] -> [Int] -> [(a, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs [Int
0 ..]))

-- | Deterministic reference iteration; residual is supplied by each estimator.
iterateFit ::
    MLConfig -> (a -> Either MathError a) -> (a -> a -> Double) -> a -> Either MathError (Fit a)
iterateFit :: forall a.
MLConfig
-> (a -> Either MathError a)
-> (a -> a -> Double)
-> a
-> Either MathError (Fit a)
iterateFit MLConfig
c a -> Either MathError a
step a -> a -> Double
difference a
start = do
    MLConfig -> Either MathError ()
config MLConfig
c
    Int -> a -> Either MathError (Fit a)
go Int
0 a
start
  where
    go :: Int -> a -> Either MathError (Fit a)
go Int
k a
old = do
        new <- a -> Either MathError a
step a
old
        let r = a -> a -> Double
difference a
old a
new
        checked [r]
        if r <= mlTolerance c
            then Right (Fit new (k + 1) r True)
            else
                if k + 1 >= mlIterations c
                    then Right (Fit new (k + 1) r False)
                    else go (k + 1) new

{- | Monadic left fold: given checked step,initial accumulator,then list, stop at first Left
MathError and otherwise return final accumulator.
-}
foldEither :: (a -> b -> Either MathError a) -> a -> [b] -> Either MathError a
foldEither :: forall a b.
(a -> b -> Either MathError a) -> a -> [b] -> Either MathError a
foldEither = (a -> b -> Either MathError a) -> a -> [b] -> Either MathError a
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM

-- | Return the first row of nested lists, or [] for an empty outer list.
firstRow :: [[a]] -> [a]
firstRow :: forall a. [[a]] -> [a]
firstRow [] = []
firstRow ([a]
x : [[a]]
_) = [a]
x