nn.hs

type Activator = Double -> Double
type Weights = Matrix
type Bias = Vector

-- A layer can be seen as a big function from Vector -> Vector
-- When the `input` is omitted, this becomes a curried function
layer :: Weights -> Bias -> Activator -> (Vector -> Vector)
layer weights bias activator input = map activator
                                    (weights |*| input |+| bias)

type ProtoType = (Vector, Vector)
data Perceptron = Perceptron { weights :: Weights
                             , bias :: Bias
                             , activator :: Activator }

apply :: Perceptron -> Vector -> Vector
apply (Perceptron w b a) = layer w b a


-- Uses the perceptron learning rule to modify an existing network
evaluate :: (Perceptron, Int) -> ProtoType -> (Perceptron, Int)
evaluate (p, successCount) (prototype, target) =
    ( Perceptron (weights p |+| err |*| prototype)
                 (bias p |+| err)
                 (activator p)
    , success)
  where
    result = apply p prototype
    err = target |-| result
    success = case sum err of
        0 -> successCount + 1
        _ -> 0


-- Takes the # of classes, and a list of the prototyes
perceptronNet :: Int -> [ProtoType] -> (Vector -> Vector)
perceptronNet classCount prototypes =
    let initialBias    = map (const 0) $ fst $ head prototypes
        initialWeights = map (const initialBias) [1..(classCount `div` 2)]
        initial = (Perceptron initialWeights initialBias hardLim, 0)
        Just (convergent, _) = find (\(_, count) ->
                                      count == length prototypes - 1)
                        $ scanl evaluate initial (cycle prototypes)
    in apply convergent