New version
Thomas Bereknyei
tomberek at gmail.com
Thu Jan 28 10:49:59 EST 2010
{-# LANGUAGE GeneralizedNewtypeDeriving,MultiParamTypeClasses #-}
{-Implementation:
PROs: Room for generalization
CONS: Can't have different types of Neurons in a Net, (I think)
-}
import Data.Graph.Inductive
import Data.List (unzip3)
import Data.Maybe (fromJust)
--for viewing
import Data.GraphViz
import System.Process
-- end for viewing
class Show a => Neuron a where
afunc :: a-> a
--eval :: (Graph gr) => gr a b -> Node -> a
eval :: (Graph gr)=>gr a a -> Context a a -> Context a a
class Graph gr => Net gr where
view :: (Show a,Show b) =>gr a b -> IO ProcessHandle
step :: Neuron a => gr a a -> gr a a
--Implementation of standard Neural Network where step simply maps
eval over all the Neurons
--data NN gr a b
-- where NN :: gr a a -> NN gr a a
--data NN gr a b = NN (gr a b)
newtype NN gr a b = NN (gr a b)
deriving (Graph,DynGraph)
instance (DynGraph gr) => Net (NN gr) where
view (NN g) = do
writeFile "./temp.dot" $ graphviz' g
runCommand "dotty temp.dot"
step g= gmap (eval g) g
--Implementation of the standard sigmoid neuron with standard weighted sum
newtype NSig a= NSig a
deriving (Eq,Show,Read,Ord,Enum,Num,Real,Fractional,RealFrac,RealFloat,Floating)
instance (RealFloat a) => Neuron (NSig a) where
afunc x = 1.0 / (1 + exp x)
eval g c@(i,n,a,o)= (i,n,afunc . sum $ zipWith (*) az ws,o)
where (ns,_,ws)=unzip3 $ inn g n
az=map (fromJust . lab g) ns
--Examples to work with
-- t has 4 layers of 10,10,2,1 NSig Neurons
nz=zip [1..23] $ (take 10 [-1,-0.9..]) ++ repeat 0 :: [(Int,NSig Double)]
ez= let
a2layer=[(x,y) | x<-[1..10],y<-[11..20]
, or [x+10==y,x*2==y,x*3==y] ]
a3layer=a2layer++[(x,y) | x<-[11..20],y<-[21,22]
, or [ and [y==22,x>15] , and [y==21,x<=15] ]
]
a4layer=a3layer++[(21,23),(22,23)]
zipit (x,y) z=(x,y,z)
in
zipWith zipit a4layer [-1,-0.9..] :: [(Int,Int,NSig Double)]
t=mkGraph nz ez :: Gr (NSig Double) (NSig Double)
-------------- next part --------------
A non-text attachment was scrubbed...
Name: nn5.hs
Type: application/octet-stream
Size: 2176 bytes
Desc: not available
Url : http://projects.haskell.org/pipermail/hnn/attachments/20100128/2b902a00/attachment.obj
More information about the Hnn
mailing list