Learning (empty) → 0.0.0

raw patch · 8 files changed

+268/−0 lines, 8 filesdep +Learningdep +basedep +hmatrixsetup-changed

Dependencies added: Learning, base, hmatrix, vector

Files

• ChangeLog.md +3/−0
• LICENSE +30/−0
• Learning.cabal +70/−0
• README.md +4/−0
• Setup.hs +2/−0
• app/Main.hs +4/−0
• src/Learning.hs +153/−0
• test/Spec.hs +2/−0

@@ -0,0 +1,3 @@+# Changelog for Learning++## Unreleased changes

@@ -0,0 +1,30 @@+Copyright Bogdan Penkovsky (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Bogdan Penkovsky nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,70 @@+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: cc0645cca2baee4a686a5bc4eebc313fda168d1efe6b0301bccb1ec7e7543c25++name:           Learning+version:        0.0.0+synopsis:       Most frequently used machine learning tools+description:    Please see the README on Github at <https://github.com/masterdezign/Learning#readme>+category:       ML+homepage:       https://github.com/masterdezign/Learning#readme+bug-reports:    https://github.com/masterdezign/Learning/issues+author:         Bogdan Penkovsky+maintainer:     dev at penkovsky [dot] com+copyright:      Bogdan Penkovsky+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    ChangeLog.md+    README.md++source-repository head+  type: git+  location: https://github.com/masterdezign/Learning++library+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+    , hmatrix >=0.18.0.0+    , vector+  exposed-modules:+      Learning+  other-modules:+      Paths_Learning+  default-language: Haskell2010++executable Learning-exe+  main-is: Main.hs+  hs-source-dirs:+      app+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      Learning+    , base >=4.7 && <5+    , hmatrix >=0.18.0.0+    , vector+  other-modules:+      Paths_Learning+  default-language: Haskell2010++test-suite Learning-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      Learning+    , base >=4.7 && <5+    , hmatrix >=0.18.0.0+    , vector+  other-modules:+      Paths_Learning+  default-language: Haskell2010

@@ -0,0 +1,4 @@+# Learning++A micro library containing the most common machine learning tools+written in Haskell.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,4 @@+module Main where++main :: IO ()+main = putStrLn "No demo yet"

@@ -0,0 +1,153 @@+-- |+-- = Machine learning utilities+-- +-- A micro library containing the most common machine learning tools.+-- Check also the mltool package https://hackage.haskell.org/package/mltool.++{-# LANGUAGE UnicodeSyntax #-}+module Learning (+  -- * Datasets+  Dataset (..)++  -- * Principal component analysis+  , PCA (..)+  , pca++  -- * Supervised learning+  , Classifier+  , learn+  , learn'+  , teacher+  , scores+  , winnerTakesAll++  -- * Evaluation+  , errors+  , errorRate+  ) where++import           Numeric.LinearAlgebra+import qualified Data.Vector.Storable as V++-- Supervised dataset+data Dataset a b = Dataset { _samples :: [a], _labels :: [b] }++-- | Computes "covariance matrix", alternative to (snd. meanCov).+-- Source: https://hackage.haskell.org/package/mltool-0.1.0.2/docs/src/MachineLearning.PCA.html+-- covarianceMatrix :: Matrix Double -> Matrix Double+-- covarianceMatrix x = ((tr x) <> x) / (fromIntegral $ rows x)++-- | Produces a compression matrix u'+pca' :: Int -> [Vector Double] -> Matrix Double+pca' maxDim xs = tr u ? [0..maxDim - 1]+  where+    xs' = fromBlocks $ map ((: []). tr. reshape 1) xs+    -- Covariance matrix Sigma+    sigma = snd $ meanCov xs'+    -- Eigenvectors matrix U+    (u, _, _) = svd $ unSym sigma++data PCA = PCA+  { _u :: Matrix Double  -- Compression matrix U+  , _compress :: Vector Double -> Matrix Double+  , _decompress :: Matrix Double -> Vector Double+  }++-- | Principal component analysis (PCA)+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)++-- | Perform supervised learning to create a linear classifier.+-- The ridge regression is run with regularization parameter mu=1e-4.+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"+{-# SPECIALIZE learn+  :: Vector Int+     -> Matrix Double+     -> Matrix Double+     -> Either String (Classifier Int) #-}++-- | Create a linear readout using the ridge regression+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 matrix+teacher :: Int -> Int -> Int -> Matrix Double+teacher nLabels correctIndex repeatNo = fromBlocks. map f $ [0..nLabels-1]+  where ones = konst 1.0 (1, repeatNo)+        zeros = konst 0.0 (1, repeatNo)+        f i | i == correctIndex = [ones]+            | otherwise = [zeros]++-- | Performs the supervised training that results in a linear readout.+-- See https://en.wikipedia.org/wiki/Tikhonov_regularization+ridgeRegression :: +  Double  -- ^ Regularization constant+  -> 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)++-- | Winner-takes-all classification method+winnerTakesAll+  :: V.Storable a+  => Matrix Double  -- ^ Transposed readout matrix+  -> Vector a  -- ^ Vector of possible classes+  -> Classifier a  -- ^ `Classifier`+winnerTakesAll readout klasses response = klasses V.! klass+  where klass = maxIndex $ scores readout response++-- | Evaluate the network state (nonlinear response) according+-- to some readout matrix trW.+scores :: Matrix Double -> Matrix Double -> Vector Double+scores trW response = evalScores+  where w = trW <> response+        -- Sum the elements in each row+        evalScores = w #> vector (replicate (cols w) 1.0)++classify+  :: V.Storable a+     => Matrix Double -> Vector a -> Classifier a+classify = winnerTakesAll+{-# SPECIALIZE classify+  :: Matrix Double -> Vector Int -> Classifier Int+  #-}++-- | Calculates the error rate in %+errorRate :: (Eq a, Fractional err) => [a] -> [a] -> err+errorRate tgtLbls cLbls = 100 * fromIntegral errNo / fromIntegral (length tgtLbls)+  where errNo = length $ errors $ zip tgtLbls cLbls+{-# SPECIALIZE errorRate :: [Int] → [Int] → Double #-}++-- | Returns the misclassified cases+errors :: Eq a => [(a, a)] -> [(a, a)]+errors = filter (uncurry (/=))+{-# SPECIALIZE errors :: [(Int, Int)] -> [(Int, Int)] #-}

@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"