module Network.Network
( Network(..)
, createNetwork
, loadNetwork
, emptyNetwork
, isEmptyNetwork
, addNetworks
, predict
, apply
, saveNetwork
) where
import Network.Neuron
import Network.Layer
import System.Random
import Numeric.LinearAlgebra
import qualified Data.ByteString.Lazy as B
import System.IO
import Data.Monoid (Monoid(..))
import Data.Binary (encode, decode, Binary(..))
data Network a = Network { layers :: [Layer a] }
instance (Product a, Container Vector a, Floating (Vector a)) => Monoid (Network a) where
mempty = emptyNetwork
mappend = addNetworks
type TrainingData a = (Vector a, Vector a)
createNetwork :: (RandomGen g, Random a, Floating a, Floating (Vector a), Container Vector a)
=> RandomTransform a -> g -> [LayerDefinition a] -> Network a
createNetwork t g [] = Network []
createNetwork t g (layerDef : []) = Network []
createNetwork t g (layerDef : layerDef' : otherLayerDefs) =
Network (layer : layers restOfNetwork)
where layer = createLayer t g' layerDef layerDef'
restOfNetwork = createNetwork t g'' (layerDef' : otherLayerDefs)
(g', g'') = split g
emptyNetwork :: Network a
emptyNetwork = Network []
isEmptyNetwork :: Network a -> Bool
isEmptyNetwork n = length (layers n) == 0
addNetworks :: (Floating (Vector a), Container Vector a, Product a)
=> Network a -> Network a -> Network a
addNetworks n1 n2 = if isEmptyNetwork n1 then n2 else
if isEmptyNetwork n2 then n1 else
Network $ zipWith combineLayers (layers n1) (layers n2)
where combineLayers l1 l2 =
Layer ((weightMatrix l1) + (weightMatrix l2))
((biasVector l1) + (biasVector l2)) (neuron l1)
predict :: (Floating (Vector a), Container Vector a, Product a)
=> Vector a -> Network a -> Vector a
predict input network = foldl apply input (layers network)
apply :: (Floating (Vector a), Container Vector a, Product a)
=> Vector a -> Layer a -> Vector a
apply vector layer = mapVector sigma (weights <> vector + bias)
where sigma = activation (neuron layer)
weights = weightMatrix layer
bias = biasVector layer
saveNetwork :: (Binary (ShowableLayer a), Floating a, Floating (Vector a), Container Vector a)
=> FilePath -> Network a -> IO ()
saveNetwork file n = B.writeFile file (encode $ map layerToShowable (layers n))
loadNetwork :: (Binary (ShowableLayer a), Floating a, Floating (Vector a), Container Vector a)
=> FilePath -> [LayerDefinition a] -> IO (Network a)
loadNetwork file defs = B.readFile file >>= \sls ->
return $ Network (map showableToLayer (zip (decode sls) defs))