Voice recognition (fixes #58)

horde-ad.cabal

@@ -196,14 +196,18 @@ library testLibrary
     exposed-modules:  TestMnistCNN
                       TestMnistFCNN
                       TestMnistRNN
+                      TestSpeechRNN
                       TestSimpleDescent
                       TestSingleGradient
   }
 
     -- Other library packages from which modules are imported.
     build-depends:
         base
+      , bytestring
+      , cereal
       , deepseq
+      , directory
       , HUnit-approx
       , hmatrix
       , horde-ad

src/HordeAd/Core/Optimizer.hs

@@ -5,6 +5,7 @@ module HordeAd.Core.Optimizer
   , sgd
   , sgdAdam, sgdAdamArgs
   , StateAdam, initialStateAdam
+  , mapDomains
   ) where
 
 import Prelude

src/HordeAd/Core/OptimizerTools.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE TypeFamilies #-}
 -- | Tools for implementing (and debugging the use of) gradient descent schemes.
 module HordeAd.Core.OptimizerTools
-  ( updateWithGradient
+  ( mapDomains, updateWithGradient
   , gradientIsNil, minimumGradient, maximumGradient
   , ArgsAdam(..), defaultArgsAdam
   , StateAdam(..), initialStateAdam
@@ -22,6 +22,7 @@ import           Numeric.LinearAlgebra.Devel
   (MatrixOrder (..), liftMatrix, liftMatrix2, matrixFromVector, orderOf)
 
 import HordeAd.Internal.Delta (Domains, isTensorDummy)
+import HordeAd.Internal.OrthotopeOrphanInstances (liftVT)
 
 {-
 60% of heap allocation in matrix- and vector-based MNIST
@@ -144,18 +145,23 @@ data StateAdam r = StateAdam
   , vAdam :: Domains r
   }
 
--- The arguments are just sample params0, for dimensions.
+mapDomains :: (Numeric r1, Numeric r2)
+           => (Vector r1 -> Vector r2) -> Domains r1 -> Domains r2
+mapDomains f (params0, params1, params2, paramsX) =
+  ( f params0
+  , V.map f params1
+  , V.map (liftMatrix f) params2
+  , V.map (liftVT f) paramsX )
+
+-- The arguments are just sample params, for dimensions.
 zeroParameters :: Numeric r
                => Domains r -> Domains r
-zeroParameters (params0, params1, params2, paramsX) =
+zeroParameters domains =
   let zeroVector v = runST $ do
         vThawed <- V.thaw v
         VM.set vThawed 0
         V.unsafeFreeze vThawed
-  in ( zeroVector params0
-     , V.map zeroVector params1
-     , V.map (liftMatrix zeroVector) params2
-     , V.map (\a -> OT.constant (OT.shapeL a) 0) paramsX )  -- fast allright
+  in mapDomains zeroVector domains
 
 initialStateAdam :: Numeric r
                  => Domains r -> StateAdam r

src/HordeAd/Internal/OrthotopeOrphanInstances.hs

@@ -15,9 +15,9 @@ import           Numeric.LinearAlgebra (Matrix, Numeric, Vector)
 import qualified Numeric.LinearAlgebra as HM
 import qualified Numeric.LinearAlgebra.Devel
 
-liftVT :: Numeric r
-       => (Vector r -> Vector r)
-       -> OT.Array r -> OT.Array r
+liftVT :: (Numeric r1, Numeric r2)
+       => (Vector r1 -> Vector r2)
+       -> OT.Array r1 -> OT.Array r2
 liftVT op t = OT.fromVector (OT.shapeL t) $ op $ OT.toVector t
 
 liftVT2 :: Numeric r

test/ExtremelyLongTest.hs

@@ -24,6 +24,7 @@ import qualified TestMnistFCNN
 import qualified TestMnistRNN
 import qualified TestSimpleDescent
 import qualified TestSingleGradient
+import qualified TestSpeechRNN
 #endif
 
 main :: IO ()
@@ -46,5 +47,6 @@ tests = testGroup "Tests" $
   ++ TestSimpleDescent.testTrees
   ++ TestMnistFCNN.testTrees
   ++ TestMnistRNN.testTrees
+  ++ TestSpeechRNN.testTrees
   ++ TestMnistCNN.testTrees
 #endif

test/ShortTestForCI.hs

@@ -21,6 +21,7 @@ import qualified TestMnistFCNN
 import qualified TestMnistRNN
 import qualified TestSimpleDescent
 import qualified TestSingleGradient
+import qualified TestSpeechRNN
 #endif
 
 main :: IO ()
@@ -41,6 +42,7 @@ tests = testGroup "Short tests for CI" $
   ++ TestSimpleDescent.testTrees
   ++ TestMnistFCNN.shortTestForCITrees
   ++ TestMnistRNN.shortTestForCITrees
+  ++ TestSpeechRNN.shortTestForCITrees
   ++ TestMnistCNN.shortTestForCITrees
 #else
   []