Iris dataset example

Author: brunjlar

examples/iris/data.csv

@@ -0,0 +1,150 @@
+5.1,3.5,1.4,0.2,Iris-setosa
+4.9,3.0,1.4,0.2,Iris-setosa
+4.7,3.2,1.3,0.2,Iris-setosa
+4.6,3.1,1.5,0.2,Iris-setosa
+5.0,3.6,1.4,0.2,Iris-setosa
+5.4,3.9,1.7,0.4,Iris-setosa
+4.6,3.4,1.4,0.3,Iris-setosa
+5.0,3.4,1.5,0.2,Iris-setosa
+4.4,2.9,1.4,0.2,Iris-setosa
+4.9,3.1,1.5,0.1,Iris-setosa
+5.4,3.7,1.5,0.2,Iris-setosa
+4.8,3.4,1.6,0.2,Iris-setosa
+4.8,3.0,1.4,0.1,Iris-setosa
+4.3,3.0,1.1,0.1,Iris-setosa
+5.8,4.0,1.2,0.2,Iris-setosa
+5.7,4.4,1.5,0.4,Iris-setosa
+5.4,3.9,1.3,0.4,Iris-setosa
+5.1,3.5,1.4,0.3,Iris-setosa
+5.7,3.8,1.7,0.3,Iris-setosa
+5.1,3.8,1.5,0.3,Iris-setosa
+5.4,3.4,1.7,0.2,Iris-setosa
+5.1,3.7,1.5,0.4,Iris-setosa
+4.6,3.6,1.0,0.2,Iris-setosa
+5.1,3.3,1.7,0.5,Iris-setosa
+4.8,3.4,1.9,0.2,Iris-setosa
+5.0,3.0,1.6,0.2,Iris-setosa
+5.0,3.4,1.6,0.4,Iris-setosa
+5.2,3.5,1.5,0.2,Iris-setosa
+5.2,3.4,1.4,0.2,Iris-setosa
+4.7,3.2,1.6,0.2,Iris-setosa
+4.8,3.1,1.6,0.2,Iris-setosa
+5.4,3.4,1.5,0.4,Iris-setosa
+5.2,4.1,1.5,0.1,Iris-setosa
+5.5,4.2,1.4,0.2,Iris-setosa
+4.9,3.1,1.5,0.2,Iris-setosa
+5.0,3.2,1.2,0.2,Iris-setosa
+5.5,3.5,1.3,0.2,Iris-setosa
+4.9,3.6,1.4,0.1,Iris-setosa
+4.4,3.0,1.3,0.2,Iris-setosa
+5.1,3.4,1.5,0.2,Iris-setosa
+5.0,3.5,1.3,0.3,Iris-setosa
+4.5,2.3,1.3,0.3,Iris-setosa
+4.4,3.2,1.3,0.2,Iris-setosa
+5.0,3.5,1.6,0.6,Iris-setosa
+5.1,3.8,1.9,0.4,Iris-setosa
+4.8,3.0,1.4,0.3,Iris-setosa
+5.1,3.8,1.6,0.2,Iris-setosa
+4.6,3.2,1.4,0.2,Iris-setosa
+5.3,3.7,1.5,0.2,Iris-setosa
+5.0,3.3,1.4,0.2,Iris-setosa
+7.0,3.2,4.7,1.4,Iris-versicolor
+6.4,3.2,4.5,1.5,Iris-versicolor
+6.9,3.1,4.9,1.5,Iris-versicolor
+5.5,2.3,4.0,1.3,Iris-versicolor
+6.5,2.8,4.6,1.5,Iris-versicolor
+5.7,2.8,4.5,1.3,Iris-versicolor
+6.3,3.3,4.7,1.6,Iris-versicolor
+4.9,2.4,3.3,1.0,Iris-versicolor
+6.6,2.9,4.6,1.3,Iris-versicolor
+5.2,2.7,3.9,1.4,Iris-versicolor
+5.0,2.0,3.5,1.0,Iris-versicolor
+5.9,3.0,4.2,1.5,Iris-versicolor
+6.0,2.2,4.0,1.0,Iris-versicolor
+6.1,2.9,4.7,1.4,Iris-versicolor
+5.6,2.9,3.6,1.3,Iris-versicolor
+6.7,3.1,4.4,1.4,Iris-versicolor
+5.6,3.0,4.5,1.5,Iris-versicolor
+5.8,2.7,4.1,1.0,Iris-versicolor
+6.2,2.2,4.5,1.5,Iris-versicolor
+5.6,2.5,3.9,1.1,Iris-versicolor
+5.9,3.2,4.8,1.8,Iris-versicolor
+6.1,2.8,4.0,1.3,Iris-versicolor
+6.3,2.5,4.9,1.5,Iris-versicolor
+6.1,2.8,4.7,1.2,Iris-versicolor
+6.4,2.9,4.3,1.3,Iris-versicolor
+6.6,3.0,4.4,1.4,Iris-versicolor
+6.8,2.8,4.8,1.4,Iris-versicolor
+6.7,3.0,5.0,1.7,Iris-versicolor
+6.0,2.9,4.5,1.5,Iris-versicolor
+5.7,2.6,3.5,1.0,Iris-versicolor
+5.5,2.4,3.8,1.1,Iris-versicolor
+5.5,2.4,3.7,1.0,Iris-versicolor
+5.8,2.7,3.9,1.2,Iris-versicolor
+6.0,2.7,5.1,1.6,Iris-versicolor
+5.4,3.0,4.5,1.5,Iris-versicolor
+6.0,3.4,4.5,1.6,Iris-versicolor
+6.7,3.1,4.7,1.5,Iris-versicolor
+6.3,2.3,4.4,1.3,Iris-versicolor
+5.6,3.0,4.1,1.3,Iris-versicolor
+5.5,2.5,4.0,1.3,Iris-versicolor
+5.5,2.6,4.4,1.2,Iris-versicolor
+6.1,3.0,4.6,1.4,Iris-versicolor
+5.8,2.6,4.0,1.2,Iris-versicolor
+5.0,2.3,3.3,1.0,Iris-versicolor
+5.6,2.7,4.2,1.3,Iris-versicolor
+5.7,3.0,4.2,1.2,Iris-versicolor
+5.7,2.9,4.2,1.3,Iris-versicolor
+6.2,2.9,4.3,1.3,Iris-versicolor
+5.1,2.5,3.0,1.1,Iris-versicolor
+5.7,2.8,4.1,1.3,Iris-versicolor
+6.3,3.3,6.0,2.5,Iris-virginica
+5.8,2.7,5.1,1.9,Iris-virginica
+7.1,3.0,5.9,2.1,Iris-virginica
+6.3,2.9,5.6,1.8,Iris-virginica
+6.5,3.0,5.8,2.2,Iris-virginica
+7.6,3.0,6.6,2.1,Iris-virginica
+4.9,2.5,4.5,1.7,Iris-virginica
+7.3,2.9,6.3,1.8,Iris-virginica
+6.7,2.5,5.8,1.8,Iris-virginica
+7.2,3.6,6.1,2.5,Iris-virginica
+6.5,3.2,5.1,2.0,Iris-virginica
+6.4,2.7,5.3,1.9,Iris-virginica
+6.8,3.0,5.5,2.1,Iris-virginica
+5.7,2.5,5.0,2.0,Iris-virginica
+5.8,2.8,5.1,2.4,Iris-virginica
+6.4,3.2,5.3,2.3,Iris-virginica
+6.5,3.0,5.5,1.8,Iris-virginica
+7.7,3.8,6.7,2.2,Iris-virginica
+7.7,2.6,6.9,2.3,Iris-virginica
+6.0,2.2,5.0,1.5,Iris-virginica
+6.9,3.2,5.7,2.3,Iris-virginica
+5.6,2.8,4.9,2.0,Iris-virginica
+7.7,2.8,6.7,2.0,Iris-virginica
+6.3,2.7,4.9,1.8,Iris-virginica
+6.7,3.3,5.7,2.1,Iris-virginica
+7.2,3.2,6.0,1.8,Iris-virginica
+6.2,2.8,4.8,1.8,Iris-virginica
+6.1,3.0,4.9,1.8,Iris-virginica
+6.4,2.8,5.6,2.1,Iris-virginica
+7.2,3.0,5.8,1.6,Iris-virginica
+7.4,2.8,6.1,1.9,Iris-virginica
+7.9,3.8,6.4,2.0,Iris-virginica
+6.4,2.8,5.6,2.2,Iris-virginica
+6.3,2.8,5.1,1.5,Iris-virginica
+6.1,2.6,5.6,1.4,Iris-virginica
+7.7,3.0,6.1,2.3,Iris-virginica
+6.3,3.4,5.6,2.4,Iris-virginica
+6.4,3.1,5.5,1.8,Iris-virginica
+6.0,3.0,4.8,1.8,Iris-virginica
+6.9,3.1,5.4,2.1,Iris-virginica
+6.7,3.1,5.6,2.4,Iris-virginica
+6.9,3.1,5.1,2.3,Iris-virginica
+5.8,2.7,5.1,1.9,Iris-virginica
+6.8,3.2,5.9,2.3,Iris-virginica
+6.7,3.3,5.7,2.5,Iris-virginica
+6.7,3.0,5.2,2.3,Iris-virginica
+6.3,2.5,5.0,1.9,Iris-virginica
+6.5,3.0,5.2,2.0,Iris-virginica
+6.2,3.4,5.4,2.3,Iris-virginica
+5.9,3.0,5.1,1.8,Iris-virginica

examples/iris/iris.hs

@@ -0,0 +1,110 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE Arrows #-}
+{-# LANGUAGE DataKinds #-}
+
+import           Control.Applicative
+import           Control.Arrow        hiding (loop)
+import           Data.Attoparsec.Text
+import qualified Data.Text            as T
+import           MyPrelude
+import           Neural
+import           Utils
+
+main :: IO ()
+main = do
+    xs <- readSamples
+    printf "read %d samples\n" (length xs)
+    evalComponentM component (mkStdGen 123456) $ do
+
+        let getError' = do
+                c <- get
+                let Just e = fromAnalytic $ getError c err xs
+
+                return e
+
+        let getQuota = do
+                c <- get
+                let c' = predict c
+                    n  = length $ filter (uncurry (==)) [(activate c' a, i) | (a, i) <- xs]
+                    q  = fromIntegral n / fromIntegral (length xs) :: Double
+                return q
+
+        let loop i = do
+                batch <- takeR batchSize xs
+                _     <- descentM err eta batch
+                if i `mod` 1000 == 0 
+                    then do
+                        e <- getError'
+                        q <- getQuota
+                        liftIO $ printf "%6d %8.6f %6.4f\n" i e q
+                        unless (q >= 0.99) $ loop (succ i)
+                    else loop (succ i)
+
+        randomizeM
+        getError' >>= \e -> liftIO $ printf "initial error is %f\n" e
+        loop (1 :: Int)
+
+batchSize :: Int
+batchSize = 10
+
+eta :: Double
+eta = 0.0001
+
+data Iris = Setosa | Versicolor | Virginica deriving (Show, Read, Eq, Ord, Enum)
+
+data Attributes = Attributes Double Double Double Double deriving (Show, Read, Eq, Ord)
+
+type Sample = (Attributes, Iris)
+
+irisParser :: Parser Iris
+irisParser =     string "Iris-setosa"     *> return Setosa
+             <|> string "Iris-versicolor" *> return Versicolor
+             <|> string "Iris-virginica"  *> return Virginica
+
+
+
+sampleParser :: Parser Sample
+sampleParser = f <$> (double <* char ',')
+                 <*> (double <* char ',')
+                 <*> (double <* char ',')
+                 <*> (double <* char ',')
+                 <*> irisParser
+    where f sl sw pl pw i = (Attributes sl sw pl pw, i)
+
+readSamples :: IO [Sample]
+readSamples = do
+    ls <- T.lines . T.pack <$> readFile ("examples" </> "iris" </> "data" <.> "csv")
+    return $ f <$> ls
+
+  where
+
+    f l = let Right x = parseOnly sampleParser l in x
+
+component :: Component Attributes (Vector 3 Analytic)
+component = let l1 = tanhLayer :: Layer 4 2
+                l2 = tanhLayer :: Layer 2 3
+                f (Attributes sl sw pl pw) = cons sl (cons sw (cons pl (cons pw nil)))
+            in  f ^>> fmap fromDouble ^>> l1 >>> l2 >>^ softmax
+
+err :: Err Attributes (Vector 3 Analytic) Sample
+err c = proc (a, i) -> do
+   y <- c -< a
+   let y' = case i of
+                Setosa     -> cons 1 (cons 0 (cons 0 nil))
+                Versicolor -> cons 0 (cons 1 (cons 0 nil))
+                Virginica  -> cons 0 (cons 0 (cons 1 nil))
+       d  = (-) <$> y <*> y'
+       e  = d <%> d
+   returnA -< e
+
+predict :: Component Attributes (Vector 3 Analytic) -> Component Attributes Iris
+predict c = c >>^ f where
+
+    f ys = let Just y0 = ys !? 0
+               Just y1 = ys !? 1
+               Just y2 = ys !? 2
+           in if y0 >= max y1 y2
+                then Setosa
+                else if y1 >= y2 then Versicolor
+                                 else Virginica
+                                 

neural.cabal

@@ -63,7 +63,7 @@ test-suite neural-test
   other-modules:       Neural.DescentSpec
                      , Utils.MatrixSpec
                      , Utils.VectorSpec
-  ghc-options:         -Wall -threaded
+  ghc-options:         -Wall -threaded -rtsopts -O2 -with-rtsopts=-N -fexcess-precision -optc-O3 -optc-ffast-math
   default-language:    Haskell2010
 
 test-suite neural-doctest
@@ -73,7 +73,18 @@ test-suite neural-doctest
   build-depends:       base >= 4.7 && < 5
                      , doctest
                      , neural
-  ghc-options:         -Wall -threaded
+  ghc-options:         -Wall -threaded -rtsopts -O2 -with-rtsopts=-N -fexcess-precision -optc-O3 -optc-ffast-math
+
+  default-language:    Haskell2010
+
+executable iris
+  hs-source-dirs:      examples/iris
+  main-is:             iris.hs
+  build-depends:       base >= 4.7 && < 5
+                     , attoparsec
+                     , neural
+                     , text
+  ghc-options:         -Wall -threaded -rtsopts -O2 -with-rtsopts=-N -fexcess-precision -optc-O3 -optc-ffast-math
   default-language:    Haskell2010
 
 source-repository head

src/Neural/Component.hs

@@ -5,7 +5,6 @@
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveFoldable #-}
 {-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE Arrows #-}
 
 {-|
 Module      : Neural.Component

src/Neural/Descent.hs

@@ -17,6 +17,7 @@ A special case of this is the /backpropagation algorithm/ for neural networks.
 
 module Neural.Descent
     ( Err
+    , getError
     , descent'
     , descent
     , descentM
@@ -36,6 +37,12 @@ import Utils.Statistics (mean)
 --
 type Err a b c = forall t. Component' t a b -> Component' t c Analytic
 
+-- | Computes the average error of a component for an error transformation and collection of samples.
+--
+getError :: (Functor f, Foldable f) => Component a b -> Err a b c -> f c -> Analytic
+getError (Component ws c _) err xs = let c' = convolve (err c) >>^ toList >>^ mean
+                                     in  runC c' xs $ fromDouble <$> ws
+
 -- | This function performs one step of gradient descent for the given component and error transformation.
 --
 descent' :: Component a b              -- ^ the component whose error should be decreased 
@@ -54,9 +61,9 @@ descent :: Component a b              -- ^ the component whose error should be d
            -> Double                  -- ^ the learning rate
            -> [c]                     -- ^ the mini batch of samples
            -> (Double, Component a b) -- ^ the mean error and the improved component
-descent c err eta xs = descent' c err' eta xs where
+descent c err = descent' c err' where
 
-    err' = \c' -> convolve (err c') >>^ mean
+    err' c' = convolve (err c') >>^ mean
 
 -- | This is the monadic version of 'descent': It performs one step of gradient descent on a 'mini batch'
 --   of samples and implicitly updates the state-component's weights.

src/Neural/Layer.hs

@@ -7,6 +7,8 @@ module Neural.Layer
     , linearLayer
     , layer
     , tanhLayer
+    , logisticLayer
+    , softmax
     ) where
 
 import Control.Arrow
@@ -38,3 +40,12 @@ layer f = arr (fmap f) . linearLayer
 
 tanhLayer :: (KnownNat i, KnownNat o) => Layer i o
 tanhLayer = layer tanh
+
+logisticLayer :: (KnownNat i, KnownNat o) => Layer i o
+logisticLayer = layer $ \x -> 1 / (1 + exp (- x))
+
+softmax :: (Floating a, Functor f, Foldable f) => f a -> f a
+softmax xs = let xs' = exp <$> xs
+                 s   = sum xs'
+             in  (/ s) <$> xs'
+