module AI.HNN.Neuron where
import Data.Array.Vector
import Data.List
data Neuron = Neuron {
threshold :: Double
, weights :: UArr Double
, func :: Double -> Double
}
instance Show Neuron where
show n = "Threshold : " ++ show (threshold n) ++ "\nWeights : " ++ show (weights n)
createNeuronU :: Double -> UArr Double -> (Double -> Double) -> Neuron
createNeuronU t ws f = Neuron { threshold = t, weights = ws, func = f }
createNeuronHeavysideU :: Double -> UArr Double -> Neuron
createNeuronHeavysideU t ws = createNeuronU t ws heavyside
createNeuronSigmoidU :: Double -> UArr Double -> Neuron
createNeuronSigmoidU t ws = createNeuronU t ws sigmoid
createNeuron :: Double -> [Double] -> (Double -> Double) -> Neuron
createNeuron t ws f = createNeuronU t (toU ws) f
createNeuronHeavyside :: Double -> [Double] -> Neuron
createNeuronHeavyside t ws = createNeuronU t (toU ws) heavyside
createNeuronSigmoid :: Double -> [Double] -> Neuron
createNeuronSigmoid t ws = createNeuronU t (toU ws) sigmoid
heavyside :: Double -> Double
heavyside x | x >= 0 = 1.0
heavyside _ = 0.0
sigmoid :: Double -> Double
sigmoid x = 1.0 / (1 + exp (x))
computeU :: Neuron -> UArr Double -> Double
computeU n inputs | lengthU inputs == lengthU (weights n)
= func n $ sumU (zipWithU (*) (weights n) inputs) threshold n
computeU n inputs = error $ "Number of inputs != Number of weights\n" ++ show n ++ "\nInput : " ++ show inputs
compute :: Neuron -> [Double] -> Double
compute n = computeU n . toU
learnSampleU :: Double -> Neuron -> (UArr Double, Double) -> Neuron
learnSampleU alpha n (xs, y) = Neuron {
threshold = threshold n
, weights = map_weights (weights n) (xs, y)
, func = func n
}
where map_weights ws (xs, y) = let s = computeU n xs in
zipWithU (\w_i x_i -> w_i + alpha*(ys)*x_i) ws xs
learnSample :: Double -> Neuron -> ([Double], Double) -> Neuron
learnSample alpha n (xs, y) = learnSampleU alpha n (toU xs, y)
learnSamplesU :: Double -> Neuron -> [(UArr Double, Double)] -> Neuron
learnSamplesU alpha = foldl' (learnSampleU alpha)
learnSamples :: Double -> Neuron -> [([Double], Double)] -> Neuron
learnSamples alpha n samples = learnSamplesU alpha n $ map (\(xs, y) -> (toU xs, y)) samples