module AI.Instinct.Brain
(
Brain(..),
Pattern,
NetInit(..),
buildNet,
runNet,
runNetList,
activation,
netInput,
netInputFrom,
listPat,
patError
)
where
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as U
import AI.Instinct.Activation
import AI.Instinct.ConnMatrix
import Text.Printf
data Brain =
Brain {
brainAct :: Activation,
brainConns :: ConnMatrix,
brainInputs :: Int,
brainOutputs :: Int
}
instance Show Brain where
show (Brain actF cm il ol) =
printf "Neural network: %i input(s), %i output(s), %s\n%s\n"
il ol (show actF) (replicate 72 '-') ++
show cm
data NetInit =
InitMLP {
mlpActFunc :: Activation,
mlpLayers :: [Int]
}
deriving (Read, Show)
type Pattern = U.Vector Double
activation :: Brain -> Pattern -> V.Vector Double
activation (Brain actF cm il _) inP = av
where
af = actFunc actF
actOf :: Int -> Double
actOf dk
| dk < il = inP U.! dk
| otherwise = af $ cmFold dk (\s sk w -> s + w * actOf sk) 0 cm
av :: V.Vector Double
av = V.generate (cmSize cm) actOf
buildNet :: NetInit -> IO Brain
buildNet (InitMLP actF ls) = do
let il = head ls
ol = last ls
cm <- buildLayered ls
let b = Brain { brainAct = actF,
brainConns = cm,
brainInputs = il,
brainOutputs = ol }
return b
listPat :: [Double] -> Pattern
listPat = U.fromList
netInput :: Brain -> Pattern -> V.Vector Double
netInput b@(Brain _ cm il _) inP = iv
where
av = activation b inP
iv = V.generate (cmSize cm) inputOf
inputOf :: Int -> Double
inputOf dk
| dk < il = inP U.! dk
| otherwise = cmFold dk (\s sk w -> s + w * (av V.! sk)) 0 cm
netInputFrom :: Brain -> V.Vector Double -> Pattern -> V.Vector Double
netInputFrom (Brain _ cm il _) av inP = iv
where
iv = V.generate (cmSize cm) inputOf
inputOf :: Int -> Double
inputOf dk
| dk < il = inP U.! dk
| otherwise = cmFold dk (\s sk w -> s + w * (av V.! sk)) 0 cm
patError :: Pattern -> Pattern -> Double
patError p1 p2 = U.sum (U.zipWith (\x y -> let e = x y in e*e) p1 p2)
runNet :: Brain -> Pattern -> Pattern
runNet b@(Brain _ cm _ ol) inP =
V.convert .
V.drop (cmSize cm ol) $
activation b inP
runNetList :: Brain -> [Double] -> [Double]
runNetList b = U.toList . runNet b . U.fromList