From 683ce9f3dc564766c2b3be3d9e186c222d843332 Mon Sep 17 00:00:00 2001 From: Miguel Date: Fri, 22 Mar 2019 12:23:19 +0100 Subject: first experiments with MNIST --- mnist/Neuronet.hs | 6 ++-- mnist/main.hs | 84 +++++++++++++++++++++++++++++++++++++++++++++---------- 2 files changed, 74 insertions(+), 16 deletions(-) (limited to 'mnist') 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 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 -- cgit v1.2.3