Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

We’re showing branches in this repository, but you can also compare across forks.

base fork: alpmestan/hnn
base: master
...
head fork: yoki/hnn
compare: master
  • 3 commits
  • 2 files changed
  • 0 commit comments
  • 1 contributor
Showing with 51 additions and 10 deletions.
  1. +40 −0 AI/HNN/FF/Network-no-comment.hs
  2. +11 −10 AI/HNN/FF/Network.hs
40 AI/HNN/FF/Network-no-comment.hs
View
@@ -0,0 +1,40 @@
+module Quantum.AI.Neural.Network (Network, Vec, qCreateNetwork, qComputeNetworkWith, qComputeNetworkWithS, qSigmoid, tanh) where
+
+import qualified Data.Vector as V
+import qualified Data.Vector.Unboxed as U
+
+import Quantum.Base
+import BlackHole.Base
+import AI.Neural.Internal.Matrix
+
+data Network a = Network
+ { matrices :: !(V.Vector (Matrix a))
+ , thresholds :: !(V.Vector (Vec a))
+ , nInputs :: {-# UNPACK #-} !Int
+ , arch :: ![Int]
+ }
+
+qCreateNetwork :: (Variate a, U.Unbox a) => Int -> [Int] -> IO (Network a)
+qCreateNetwork nI as = withSystemRandom . asGenST $ \gen -> do
+ (vs, ts) <- go nI as V.empty V.empty gen
+ return $! Network vs ts nI as
+ where go _ [] ms ts _ = return $! (ms, ts)
+ go !k (!a:archs) ms ts g = do
+ m <- randomMatrix a k g
+ let !m' = Matrix m a k
+ t <- randomMatrix a 1 g
+ go a archs (ms `V.snoc` m') (ts `V.snoc` t) g
+
+ randomMatrix n m g = uniformVector g (n*m)
+
+qComputeLayerWith :: (U.Unbox a, Num a) => Vec a -> (Matrix a, Vec a, a -> a) -> Vec a
+qComputeLayerWith input (m, thresholds, f) = U.map f $! U.zipWith (-) (m `apply` input) thresholds
+
+qComputeNetworkWith :: (U.Unbox a, Num a) => Network a -> (a -> a) -> Vec a -> Vec a
+qComputeNetworkWith (Network{..}) activation input = V.foldl' qComputeLayerWith input $ V.zip3 matrices thresholds (V.replicate (length arch) activation)
+
+qComputeNetworkWithS :: (U.Unbox a, Num a) => Network a -> [a -> a] -> Vec a -> Vec a
+qComputeNetworkWithS (Network{..}) activations input = V.foldl' qComputeLayerWith input $ V.zip3 matrices thresholds (V.fromList activations)
+
+sigmoid :: Floating a => a -> a
+sigmoid !x = 1 / (1 + exp (-x))
21 AI/HNN/FF/Network.hs
View
@@ -35,8 +35,9 @@ import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as U
import System.Random.MWC
-
-import AI.HNN.Internal.Matrix
+import Quantum.Base
+import BlackHole.Base`
+import AI.Neural.Internal.Matrix
-- | Our feed-forward neural network type
data Network a = Network
@@ -50,8 +51,8 @@ data Network a = Network
-- the net will have n1 neurons on the first layer, n2 neurons on the second, and so on
--
-- > createNetwork n l
-createNetwork :: (Variate a, U.Unbox a) => Int -> [Int] -> IO (Network a)
-createNetwork nI as = withSystemRandom . asGenST $ \gen -> do
+qCreateNetwork :: (Variate a, U.Unbox a) => Int -> [Int] -> IO (Network a)
+qCreateNetwork nI as = withSystemRandom . asGenST $ \gen -> do
(vs, ts) <- go nI as V.empty V.empty gen
return $! Network vs ts nI as
where go _ [] ms ts _ = return $! (ms, ts)
@@ -64,8 +65,8 @@ createNetwork nI as = withSystemRandom . asGenST $ \gen -> do
randomMatrix n m g = uniformVector g (n*m)
-- Helper function that computes the output of a given layer
-computeLayerWith :: (U.Unbox a, Num a) => Vec a -> (Matrix a, Vec a, a -> a) -> Vec a
-computeLayerWith input (m, thresholds, f) = U.map f $! U.zipWith (-) (m `apply` input) thresholds
+qComputeLayerWith :: (U.Unbox a, Num a) => Vec a -> (Matrix a, Vec a, a -> a) -> Vec a
+qComputeLayerWith input (m, thresholds, f) = U.map f $! U.zipWith (-) (m `apply` input) thresholds
{-# INLINE computeLayerWith #-}
-- | Computes the output of the given 'Network' assuming all neurons have the given function
@@ -74,8 +75,8 @@ computeLayerWith input (m, thresholds, f) = U.map f $! U.zipWith (-) (m `apply`
-- Example:
--
-- > computeNetworkWith n sigmoid (U.fromList [0.5, 0.5])
-computeNetworkWith :: (U.Unbox a, Num a) => Network a -> (a -> a) -> Vec a -> Vec a
-computeNetworkWith (Network{..}) activation input = V.foldl' computeLayerWith input $ V.zip3 matrices thresholds (V.replicate (length arch) activation)
+qComputeNetworkWith :: (U.Unbox a, Num a) => Network a -> (a -> a) -> Vec a -> Vec a
+qComputeNetworkWith (Network{..}) activation input = V.foldl' qComputeLayerWith input $ V.zip3 matrices thresholds (V.replicate (length arch) activation)
{-# INLINE computeNetworkWith #-}
-- | Computes the output of the given 'Network', just like 'computeNetworkWith', but accepting
@@ -84,8 +85,8 @@ computeNetworkWith (Network{..}) activation input = V.foldl' computeLayerWith in
-- > computeNetworkWith n f input == computeNetworkWithS n (repeat f) input
--
-- (or, to be more accurate, we can replace @repeat f@ by a list containing a copy of @f@ per layer)
-computeNetworkWithS :: (U.Unbox a, Num a) => Network a -> [a -> a] -> Vec a -> Vec a
-computeNetworkWithS (Network{..}) activations input = V.foldl' computeLayerWith input $ V.zip3 matrices thresholds (V.fromList activations)
+qComputeNetworkWithS :: (U.Unbox a, Num a) => Network a -> [a -> a] -> Vec a -> Vec a
+qComputeNetworkWithS (Network{..}) activations input = V.foldl' qComputeLayerWith input $ V.zip3 matrices thresholds (V.fromList activations)
sigmoid :: Floating a => a -> a
sigmoid !x = 1 / (1 + exp (-x))

No commit comments for this range

Something went wrong with that request. Please try again.