module Learning (
Dataset (..)
, PCA (..)
, pca
, Classifier
, learn
, learn'
, teacher
, scores
, winnerTakesAll
, errors
, errorRate
) where
import Numeric.LinearAlgebra
import qualified Data.Vector.Storable as V
data Dataset a b = Dataset { _samples :: [a], _labels :: [b] }
pca' :: Int -> [Vector Double] -> Matrix Double
pca' maxDim xs = tr u ? [0..maxDim 1]
where
xs' = fromBlocks $ map ((: []). tr. reshape 1) xs
sigma = snd $ meanCov xs'
(u, _, _) = svd $ unSym sigma
data PCA = PCA
{ _u :: Matrix Double
, _compress :: Vector Double -> Matrix Double
, _decompress :: Matrix Double -> Vector Double
}
pca :: Int
-> [Vector Double]
-> PCA
pca maxDim xs = let u' = pca' maxDim xs
u = tr u'
in PCA
{ _u = u
, _compress = (u' <>). reshape 1
, _decompress = flatten. (u <>)
}
type Classifier a = (Matrix Double -> a)
learn
:: V.Storable a =>
Vector a
-> Matrix Double
-> Matrix Double
-> Either String (Classifier a)
learn klasses xs teacher' =
case learn' xs teacher' of
Just readout -> Right (classify readout klasses)
Nothing -> Left "Couldn't learn: check `xs` matrix properties"
learn'
:: Matrix Double
-> Matrix Double
-> Maybe (Matrix Double)
learn' a b = case ridgeRegression 1e-4 a b of
(Just x) -> Just (tr x)
_ -> Nothing
teacher :: Int -> Int -> Int -> Matrix Double
teacher nLabels correctIndex repeatNo = fromBlocks. map f $ [0..nLabels1]
where ones = konst 1.0 (1, repeatNo)
zeros = konst 0.0 (1, repeatNo)
f i | i == correctIndex = [ones]
| otherwise = [zeros]
ridgeRegression ::
Double
-> Matrix Double
-> Matrix Double
-> Maybe (Matrix Double)
ridgeRegression μ tA tB = linearSolve oA oB
where
oA = (tA <> tr tA) + (scalar μ * ident (rows tA))
oB = tA <> tr tB
_f Nothing = Nothing
_f (Just x) = Just (tr x)
winnerTakesAll
:: V.Storable a
=> Matrix Double
-> Vector a
-> Classifier a
winnerTakesAll readout klasses response = klasses V.! klass
where klass = maxIndex $ scores readout response
scores :: Matrix Double -> Matrix Double -> Vector Double
scores trW response = evalScores
where w = trW <> response
evalScores = w #> vector (replicate (cols w) 1.0)
classify
:: V.Storable a
=> Matrix Double -> Vector a -> Classifier a
classify = winnerTakesAll
errorRate :: (Eq a, Fractional err) => [a] -> [a] -> err
errorRate tgtLbls cLbls = 100 * fromIntegral errNo / fromIntegral (length tgtLbls)
where errNo = length $ errors $ zip tgtLbls cLbls
errors :: Eq a => [(a, a)] -> [(a, a)]
errors = filter (uncurry (/=))