git.iko.soy/grenade
on master help sign in
Use ExceptT in mnist
2cb93c6Huw Campbell
main/feedforward.hs+1−2
compare with master
unifiedsplit
@@ -8,7 +8,6 @@
8
8
9import Control.Monad
9import Control.Monad
10import Control.Monad.Random
10import Control.Monad.Random
11−
12import GHC.TypeLits
11import GHC.TypeLits
13
12
14import qualified Numeric.LinearAlgebra.Static as SA
13import qualified Numeric.LinearAlgebra.Static as SA
@@ -51,7 +50,7 @@ netTest rate n = do
51 where
50 where
52 inCircle :: KnownNat n => SA.R n -> (SA.R n, Double) -> Bool
51 inCircle :: KnownNat n => SA.R n -> (SA.R n, Double) -> Bool
53 v `inCircle` (o, r) = SA.norm_2 (v - o) <= r
52 v `inCircle` (o, r) = SA.norm_2 (v - o) <= r
54− trainEach !nt !(i, o) = train rate nt i o
53+ trainEach !network (i,o) = train rate network i o
55
54
56 render n' | n' <= 0.2 = ' '
55 render n' | n' <= 0.2 = ' '
57 | n' <= 0.4 = '.'
56 | n' <= 0.4 = '.'
main/mnist.hs+35−29
@@ -9,6 +9,8 @@
9import Control.Applicative
9import Control.Applicative
10import Control.Monad
10import Control.Monad
11import Control.Monad.Random
11import Control.Monad.Random
12+import Control.Monad.Trans.Class
13+import Control.Monad.Trans.Except
12
14
13import qualified Data.Attoparsec.Text as A
15import qualified Data.Attoparsec.Text as A
14import qualified Data.Text as T
16import qualified Data.Text as T
@@ -35,35 +37,23 @@ randomMnist :: MonadRandom m
35 '[ 'D2 28 28, 'D3 24 24 10, 'D3 12 12 10, 'D3 12 12 10, 'D3 8 8 16, 'D3 4 4 16, 'D1 256, 'D1 256, 'D1 80, 'D1 80, 'D1 10, 'D1 10])
37 '[ 'D2 28 28, 'D3 24 24 10, 'D3 12 12 10, 'D3 12 12 10, 'D3 8 8 16, 'D3 4 4 16, 'D1 256, 'D1 256, 'D1 80, 'D1 80, 'D1 10, 'D1 10])
36randomMnist = randomNetwork
38randomMnist = randomNetwork
37
39
38−
39−convTest :: Int -> FilePath -> FilePath -> LearningParameters -> IO ()
40+convTest :: Int -> FilePath -> FilePath -> LearningParameters -> ExceptT String IO ()
40convTest iterations trainFile validateFile rate = do
41convTest iterations trainFile validateFile rate = do
41− net0 <- evalRandIO randomMnist
42+ net0 <- lift randomMnist
42− fT <- T.readFile trainFile
43+ trainData <- readMNIST trainFile
43− fV <- T.readFile validateFile
44+ validateData <- readMNIST validateFile
44− let trainRows = traverse (A.parseOnly p) (T.lines fT)
45− let validateRows = traverse (A.parseOnly p) (T.lines fV)
46− case (trainRows, validateRows) of
47− (Right tr', Right vr') -> foldM_ (runIteration tr' vr') net0 [1..iterations]
45+ lift $ foldM_ (runIteration trainData validateData) net0 [1..iterations]
48− err -> print err
46+
49−
50− where
47+ where
51− trainEach !rate' !nt !(i, o) = train rate' nt i o
48+ trainEach rate' !network (i, o) = train rate' network i o
52−
49+
53− p :: A.Parser (S' ('D2 28 28), S' ('D1 10))
50+ runIteration trainRows validateRows net i = do
54− p = do
51+ let trained' = foldl (trainEach ( rate { learningRate = learningRate rate * 0.9 ^ i} )) net trainRows
55− lab <- A.decimal
56− pixels <- many (A.char ',' >> A.double)
57− let lab' = replicate lab 0 ++ [1] ++ replicate (9 - lab) 0
58− return (S2D' $ SA.fromList pixels, S1D' $ SA.fromList lab')
59−
60− runIteration trainRows validateRows net i = do
61− let trained' = foldl (trainEach rate) net trainRows
62− let res = fmap (\(rowP,rowL) -> (rowL,) $ runNet trained' rowP) validateRows
52+ let res = fmap (\(rowP,rowL) -> (rowL,) $ runNet trained' rowP) validateRows
63− let res' = fmap (\(S1D' label, S1D' prediction) -> (maxIndex (SA.extract label), maxIndex (SA.extract prediction))) res
53+ let res' = fmap (\(S1D' label, S1D' prediction) -> (maxIndex (SA.extract label), maxIndex (SA.extract prediction))) res
64− print trained'
54+ print trained'
65− putStrLn $ "Iteration " ++ show i ++ ": " ++ show (length (filter ((==) <$> fst <*> snd) res')) ++ " of " ++ show (length res')
55+ putStrLn $ "Iteration " ++ show i ++ ": " ++ show (length (filter ((==) <$> fst <*> snd) res')) ++ " of " ++ show (length res')
66− return trained'
56+ return trained'
67
57
68data MnistOpts = MnistOpts FilePath FilePath Int LearningParameters
58data MnistOpts = MnistOpts FilePath FilePath Int LearningParameters
69
59
@@ -81,4 +71,20 @@ main :: IO ()
81main = do
71main = do
82 MnistOpts mnist vali iter rate <- execParser (info (mnist' <**> helper) idm)
72 MnistOpts mnist vali iter rate <- execParser (info (mnist' <**> helper) idm)
83 putStrLn "Training convolutional neural network..."
73 putStrLn "Training convolutional neural network..."
74+
84− convTest iter mnist vali rate
75+ res <- runExceptT $ convTest iter mnist vali rate
76+ case res of
77+ Right () -> pure ()
78+ Left err -> putStrLn err
79+
80+readMNIST :: FilePath -> ExceptT String IO [(S' ('D2 28 28), S' ('D1 10))]
81+readMNIST mnist = ExceptT $ do
82+ mnistdata <- T.readFile mnist
83+ return $ traverse (A.parseOnly parseMNIST) (T.lines mnistdata)
84+
85+parseMNIST :: A.Parser (S' ('D2 28 28), S' ('D1 10))
86+parseMNIST = do
87+ lab <- A.decimal
88+ pixels <- many (A.char ',' >> A.double)
89+ let lab' = replicate lab 0 ++ [1] ++ replicate (9 - lab) 0
90+ return (S2D' $ SA.fromList pixels, S1D' $ SA.fromList lab')