first experiments with MNIST

2 files changed, 74 insertions, 16 deletions

diff --git a/mnist/Neuronet.hs b/mnist/Neuronet.hs
index 7a3a159..517f3b8 100644
--- a/mnist/Neuronet.hs
+++ b/mnist/Neuronet.hs
@@ -3,7 +3,8 @@
      N E U R O T I C U S
         
      A small and straight forward neural network coded in Haskell
-     from scratch. It uses the beatuiful backpropagation for learning.
+     from scratch. It uses gradient descent and the beatuiful 
+     backpropagation for learning.
      
      Michal Idziorek <m.i@gmx.at> 
      March 2019
@@ -11,7 +12,8 @@
 -}
 
 module Neuronet
-    ( neuronet      -- initalize neuronet
+    ( Neuronet      -- the neuronet
+     ,neuronet      -- initalize neuronet
      ,train         -- train with one sample
      ,trainBatch    -- train with batch
      ,asknet        -- ask the neuroal net
diff --git a/mnist/main.hs b/mnist/main.hs
index 97c76df..d00e3c6 100644
--- a/mnist/main.hs
+++ b/mnist/main.hs
@@ -2,8 +2,77 @@ import Neuronet
 import System.Random(randomRIO)
 import Numeric.LinearAlgebra (Matrix,Vector,tr,scale,cmap,(#>),randn,toList,fromList,toLists,fromLists,Container)
 import Data.List
+import Data.List.Split
+import Data.Tuple.Extra
+import System.Random.Shuffle
+import qualified Data.ByteString as BS
+import System.IO
 
-main = do
+-- a single data-sample with input and expected output
+type Sample = (Vector Double,Vector Double)
+
+-- a list of samples
+type Samples =[Sample]
+
+-- split samples into random batches of n elements
+batches :: Int -> Samples -> IO [Samples]
+batches n x = do s<-shuffleM x
+                 return . filter ((==n).length) $ chunksOf n s
+
+-- get multiple epochs, with the given number of samples each.
+epochs :: Int -> Int -> Samples -> IO [[Samples]]
+epochs 0 _ _ = return []
+epochs e n s = (:) <$> batches n s <*> epochs (e-1) n s
+
+-- train for multiple epochs
+training :: Double -> Neuronet -> [[Samples]] -> Neuronet
+training r net s = foldl' f net (concat s)
+    where f a v = trainBatch r a (fst.unzip $ v) (snd.unzip $ v)
+
+-- test with given samples and return number of correct answers
+testing :: (Vector Double -> Vector Double -> Bool) -> Neuronet -> Samples -> Int
+testing f net s = length . filter id $ map (\(x,y)->f y (asknet net x)) s
+
+-- finally some learning and testing with MNIST
+main = mainMNIST
+
+-- Paths to the unpacked files from http://yann.lecun.com/exdb/mnist/
+train_img="train-images-idx3-ubyte"
+train_lbl="train-labels-idx1-ubyte"
+test_img="t10k-images-idx3-ubyte"
+test_lbl="t10k-labels-idx1-ubyte"
+
+mainMNIST =do
+        nt <- neuronet [28*28,10,10]
+        h1 <- openFile train_img ReadMode
+        h2 <- openFile train_lbl ReadMode
+        xs <- BS.hGetContents h1 >>= return. map (fromList.map fromIntegral) . chunksOf (28*28) . BS.unpack.BS.drop 16
+        ys <- BS.hGetContents h2 >>= return. map (fromList.val.fromIntegral) . BS.unpack. BS.drop 8
+        tr <- epochs 1 100 (zip xs ys) >>= return . training (1/100) nt
+
+        print "bye"
+    where  zrs= take 9 $ repeat 0
+           val x= take x zrs ++ [1::Double] ++ drop x zrs
+
+main2 = do
+
+        easynet<-neuronet [20,10,10]
+        samples<-(map ( \(a,b) -> (fromList (val a++val b),fromList $ val $ a+b)) . filter ((<10).uncurry (+))) <$> gensamp 4000
+        tstsmpl<-(map ( \(a,b) -> (fromList (val a++val b),fromList $ val $ a+b)) . filter ((<10).uncurry (+))) <$> gensamp 1000
+        trained <- epochs 200 100 samples >>= return . training (3/100) easynet
+        print $ testing tst trained tstsmpl
+
+    where  zrs= take 9 $ repeat 0.01
+           val x= take x zrs ++ [0.99] ++ drop x zrs
+           getVal x=snd . last . sort $ zip x [0..9]
+           tst y1 y2 = getVal (toList y1) == getVal (toList y2)
+
+gensamp :: Int -> IO [(Int,Int)]
+gensamp  0 = return []
+gensamp n = (\a b r->(a,b):r) <$> randomRIO (0,9) <*> randomRIO (0,9) <*> gensamp (n-1)
+
+{-
+main3 = do
 
     let numtrain=300000
 
@@ -30,9 +99,6 @@ main = do
            training net (s1,s2) = train 0.25 net (fromList $ val s1++val s2) (fromList $ val $ s1+s2)
            test net (s1,s2) = getVal . toList $ asknet net (fromList $ val s1++val s2)
 
-           gensamp :: Int -> IO [(Int,Int)]
-           gensamp  0 = return []
-           gensamp n = (\a b r->(a,b):r) <$> randomRIO (0,9) <*> randomRIO (0,9) <*> gensamp (n-1)
 
            addit n x=   do  let w=words x
                             let a=read $ w!!0 :: Int
@@ -42,18 +108,8 @@ main = do
                             putStrLn "what two numbers do you want me to add master?"
 
                             
-{-
-
 
-train_img="train-images-idx3-ubyte"
-train_lbl="train-labels-idx1-ubyte"
-sel=3333
 
-main1 = do
-        h <- openFile train_img ReadMode
-        h2 <- openFile train_lbl ReadMode
-        BS.hGetContents h>>= showImg . BS.take (28*28) . BS.drop (28*28*sel) . BS.drop 16
-        BS.hGetContents h2>>= print. BS.unpack . BS.take 1 . BS.drop (sel) . BS.drop 8