diff options
| -rw-r--r-- | src/Mind.hs | 43 | ||||
| -rw-r--r-- | test/MindTest.hs | 36 |
2 files changed, 79 insertions, 0 deletions
diff --git a/src/Mind.hs b/src/Mind.hs index 45b90da..1ce8ab3 100644 --- a/src/Mind.hs +++ b/src/Mind.hs @@ -6,8 +6,11 @@ module Mind , Network (..) , createEmptyNetwork + , connectNeurons ) where +import Data.Ix + -- index different neuron types data NeuronIndex = Input Int | Internal Int | Output Int deriving (Show, Eq) @@ -26,5 +29,45 @@ data Network = Network , outputNeurons :: [[Edge]] } deriving (Show, Eq) +-- create a completely empty network createEmptyNetwork :: Int -> Int -> Int -> Network createEmptyNetwork i h o = Network i (replicate h []) (replicate o []) + + +-- connect two neurons together with a new edge +connectNeurons :: Network -> NeuronIndex -> NeuronIndex -> Float -> Maybe Network +-- internal sink +connectNeurons (Network i h o) source (Internal sink) weight = + if (validSource (Network i h o) source) then do + newH <- insertEdge h sink $ Edge (source, weight) + return $ Network i newH o + else Nothing +-- output sink +connectNeurons (Network i h o) source (Output sink) weight = + if (validSource (Network i h o) source) then do + newO <- insertEdge o sink $ Edge (source, weight) + return $ Network i h newO + else Nothing +-- +connectNeurons _ _ (Input _) _ = Nothing + + + +-- helpers for connectNeurons + +-- check if a given NeuronIndex can be used as a valid source +validSource :: Network -> NeuronIndex -> Bool +validSource _ (Output _) = False +validSource (Network i _ _) (Input x) = + if (inRange (0, i) x) + then True else False +validSource (Network _ h _) (Internal x) = + if (inRange (0, length h) x) + then True else False + +-- insert a new edge into a neuron list, possibly failing +insertEdge :: [[Edge]] -> Int -> Edge -> Maybe [[Edge]] +insertEdge ns i e + | (inRange (0, length ns) i) = let (front, es:back) = splitAt i ns + in Just $ front ++ [e:es] ++ back + | otherwise = Nothing diff --git a/test/MindTest.hs b/test/MindTest.hs index 5eb1734..65d5a84 100644 --- a/test/MindTest.hs +++ b/test/MindTest.hs @@ -21,4 +21,40 @@ networkTests :: TestTree networkTests = testGroup "network tests" $ [ testCase "create empty network" $ (createEmptyNetwork 3 2 1) @?= Network 3 [[], []] [[]] + , testCase "output network connection" $ + let network = Network 3 [[], []] [[]] + in (connectNeurons network (Input 0) (Output 0) (negate 1.0)) + @?= (Just $ Network 3 [[], []] [[Edge (Input 0, (negate 1.0))]]) + , testCase "internal network connection" $ + let network = Network 3 [[], []] [[]] + in (connectNeurons network (Internal 0) (Internal 1) (negate 1.0)) + @?= (Just $ Network 3 [[], [Edge (Internal 0, negate 1.0)]] [[]]) + , testCase "internal self-connection" $ + let network = Network 3 [[], []] [[]] + in (connectNeurons network (Internal 0) (Internal 0) (negate 1.0)) + @?= (Just $ Network 3 [[Edge (Internal 0, negate 1.0)], []] [[]]) + , testCase "internal source out of range" $ + let network = Network 3 [[], []] [[]] + in (connectNeurons network (Internal 5) (Internal 0) (negate 1.0)) + @?= Nothing + , testCase "internal sink out of range" $ + let network = Network 3 [[], []] [[]] + in (connectNeurons network (Internal 1) (Internal (negate 1)) (negate 1.0)) + @?= Nothing + , testCase "input source out of range" $ + let network = Network 3 [[], []] [[]] + in (connectNeurons network (Input (negate 1)) (Internal 0) (negate 1.0)) + @?= Nothing + , testCase "input sink" $ + let network = Network 3 [[], []] [[]] + in (connectNeurons network (Input 0) (Input 0) (negate 1.0)) + @?= Nothing + , testCase "output source" $ + let network = Network 3 [[], []] [[]] + in (connectNeurons network (Output 0) (Output 0) (negate 1.0)) + @?= Nothing + , testCase "output sink out of range" $ + let network = Network 3 [[], []] [[]] + in (connectNeurons network (Input 0) (Output 4) (negate 1.0)) + @?= Nothing ] |