1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
module Mind
( NeuronIndex (..)
, getNeuronIndex
, Edge (..)
, Network (..)
, createEmptyNetwork
, connectNeurons
) where
import Data.Ix
-- index different neuron types
data NeuronIndex = Input Int | Internal Int | Output Int deriving (Show, Eq)
getNeuronIndex :: NeuronIndex -> Int
getNeuronIndex (Input i) = i
getNeuronIndex (Internal i) = i
getNeuronIndex (Output i) = i
-- define incident edges
newtype Edge = Edge (NeuronIndex, Float) deriving (Show, Eq)
-- define networks
data Network = Network
{ numInput :: Int
, internalNeurons :: [[Edge]]
, 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
|