summaryrefslogtreecommitdiff
path: root/mnist/main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'mnist/main.hs')
-rw-r--r--mnist/main.hs152
1 files changed, 44 insertions, 108 deletions
diff --git a/mnist/main.hs b/mnist/main.hs
index d00e3c6..a91984a 100644
--- a/mnist/main.hs
+++ b/mnist/main.hs
@@ -1,6 +1,6 @@
import Neuronet
import System.Random(randomRIO)
-import Numeric.LinearAlgebra (Matrix,Vector,tr,scale,cmap,(#>),randn,toList,fromList,toLists,fromLists,Container)
+import Numeric.LinearAlgebra
import Data.List
import Data.List.Split
import Data.Tuple.Extra
@@ -34,113 +34,49 @@ testing :: (Vector Double -> Vector Double -> Bool) -> Neuronet -> Samples -> In
testing f net s = length . filter id $ map (\(x,y)->f y (asknet net x)) s
-- finally some learning and testing with MNIST
+-- MNIST files from http://yann.lecun.com/exdb/mnist/
+main :: IO ()
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"
-
+-- create Samples given two MNIST files for images and labels
+read_samples :: FilePath -> FilePath -> IO Samples
+read_samples f1 f2 = do
+ h1 <- openFile f1 ReadMode
+ h2 <- openFile f2 ReadMode
+ xs <- BS.hGetContents h1 >>= return . map (fromList.map ((/255).fromIntegral)) .
+ chunksOf (28*28) . BS.unpack.BS.drop 16
+ ys <- BS.hGetContents h2 >>= return. map (fromList.val.fromIntegral) .
+ BS.unpack . BS.drop 8
+ return $ zip xs ys
+ where zrs= take 9 $ repeat 0
+ val x= take x zrs ++ [1] ++ drop x zrs
+
+-- MNIST main function
+mainMNIST :: IO ()
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
-
- easynet<-neuronet [20,15,10]
-
- samples<-filter ((<10).uncurry (+)) <$> gensamp numtrain
- let testsmp=filter ((<10).uncurry (+))[(a,b)|a<-[0..10],b<-[0..10]]
-
- let trained=foldl' training easynet samples
- let res = map (\(a,b)->test trained (a,b) == a+b) testsmp
- let right=length $ filter (id) res
- let all = length res
-
- print $ "trained adding up to 10 with "++ show numtrain ++" random training samples"
- print $ "correct answers during testing: " ++ show right ++ "/" ++ show all ++ " (" ++ show (right*100`div`all) ++ "%)"
- print "what can I add for you?"
- str<-lines<$>getContents
- mapM_ (addit trained) str
-
- 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]
-
- 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)
-
-
- addit n x= do let w=words x
- let a=read $ w!!0 :: Int
- let b=read $ w!!1 :: Int
- putStrLn $ "I try to add " ++ show a ++ " and " ++ show b
- putStrLn $ "I think this is = " ++ show (test n (a,b) )
- putStrLn "what two numbers do you want me to add master?"
-
-
-
-
-
-
-
-showImg a | BS.null a = print "--"
- | otherwise = do mapM_ putVal $ BS.unpack $ BS.take 28 a
- putStr "\n"
- showImg $ BS.drop 28 a
-
-putVal v | v==0 = putStr " "
- | v<50 = putStr "."
- | v<128 = putStr "o"
- | v<160 = putStr "O"
- | otherwise = putStr "0"
-
-
-main2 = do
- -- 0 1 2 3 4 5 6 7 8 9
- let m=(4><10)[ 0, 100,0, 100,0, 100,0, 100,0, 100
- ,0, 0, 100,100,0, 0, 100,100,0, 0
- ,0, 0, 0, 0, 100,100,100,100,0, 0
- ,0, 0, 0, 0, 0, 0, 0, 0, 100,100]
-
- let b=vector . take 4 . repeat $ (-50)
-
- let z= repeat 0.01
- let vv x= vector $ take x z ++ [0.99] ++ take (9-x) z
- let v = vv 6
- let z= m #> v + b
- let a= cmap sigmoid z
- print m
- print v
- print z
- print a
--}
+ let ep = 1 -- number of epochs
+ let mbs = 10 -- mini-batch size
+ let lr = 3 -- learning rate
+ nt <- neuronet [28*28,30,10]
+ smpl_train <- read_samples "train-images-idx3-ubyte" "train-labels-idx1-ubyte"
+ smpl_test <- read_samples "t10k-images-idx3-ubyte" "t10k-labels-idx1-ubyte"
+ tr <- epochs ep mbs smpl_train >>= return . training (lr/fromIntegral mbs) nt
+ let passed = testing chk tr smpl_test
+ print $ show passed ++ "/10000 (" ++ show (fromIntegral passed/100)++ "%)"
+ where chk y1 y2 = val y1 == val y2
+ val x=snd . last . sort $ zip (toList x) [0..9]
+
+-- just a quick and simple network created manually, used for experimenting
+mainMANUAL :: IO ()
+mainMANUAL = do
+
+ let nt =[ ((2><2)[0.2,0.3,0.4,0.5],fromList[0.6,-0.6]) -- L1
+ ,((2><2)[-0.5,-0.4,-0.3,-0.2],fromList[0.4,0.5]) -- L2
+ ,((1><2)[0.25,0.35],fromList[0.9]) -- L3
+ ]
+
+ print nt
+ print $ wghtact nt $ fromList [0.8,0.9]
+ print $ backprop nt (fromList [0.8,0.9]) (fromList [1])
+ print $ train 0.3 nt (fromList [0.8,0.9]) (fromList [1])
+ print $ trainBatch 0.15 nt [fromList [0.8,0.9],fromList [0.8,0.9]] [fromList [1],fromList [1]]
generated by cgit v1.2.3 (git 2.25.1) at 2025-11-08 18:35:26 +0000