module Main where

import Control.Monad
import System.IO
import qualified Random
import System.IO.Unsafe
import System.Environment
import Data.List

data ANN = ANN Layer Layer Layer -- ^ Red Neuronal de 3 capas
    deriving (Eq, Show)

type Layer = [Neuron] -- ^ Lista de Neuronas que conforman la capa

data Neuron = Neuron [(Float,Float)] Float -- ^ Lista de (pesos,xs) y umbral asociado
    deriving (Eq, Show) 

neurona:: Neuron -> -- ^ [(Pesos,Xs)] y Umbral
                Float
neurona (Neuron entrada umbral) =
    let entradaTupla = unzip entrada
        pesos = fst entradaTupla
        xs = snd entradaTupla
        suma = foldl' (+) (-umbral) (zipWith (*) xs pesos)
    in sigmoidal suma
    
neurona2:: [(Float,Float)] -> -- ^ [(Pesos,Xs)]
                    Float -> -- ^ Umbral
                    Float
neurona2 valores umbral =
    let entradaTupla = unzip valores
        pesos = fst entradaTupla
        xs = snd entradaTupla
        suma = foldl' (+) umbral (zipWith (*) xs pesos)
    in sigmoidal suma
    
-- ANN [] [Neuron [(4.7621,0.9993291),(4.7618,0.94501287)] 7.3061,Neuron [(6.3917,0.9993291),(6.3917,0.94501287)] 2.8441] [Neuron [(-10.3788,0.9993291),(9.7691,0.94501287)] 4.5589]
    
sigmoidal:: Float -> Float
sigmoidal x = 1 / (1 + (exp (-x)))

main:: IO()
main = do
--        nombreArchivo <- getArgs
--        archivo <- readFile (head nombreArchivo)
        pesos <- pesosIniciales 10000
        randomXs <- generarRandomXs 5000
        randomYs <- generarRandomYs 5000
        let conjunto = generar 200 0 0 randomXs randomYs []
        --print conjunto
--        let lista = parsearString archivo [[]]
--        let splitted = split lista []
        let (a,b,c) = (unzip3 (take 200 conjunto))
        --let (a,b,c) = ([0,1,0,1],[0,0,1,1],[0,1,1,0])
        let ejemplos = zipWith (ajustarEjemplos) a b
--        print ejemplos
        let nuevaRed = armarRed 2 8 1 pesos
        let entrenada = train nuevaRed ejemplos c
        let redInicializada = map (iniciarXsRed entrenada) ejemplos
        let resultados = map resultadoRed1Output (map evaluarRed redInicializada)
        print nuevaRed
        print entrenada
        print resultados
        return ()

ajustarEjemplos:: Float -> Float -> [Float]
ajustarEjemplos a b = [a,b]

train:: ANN -> [[Float]] -> [Float] -> ANN
train red ejemplosTodos esperadosTodos =
    let entrenado = entrenamiento red ejemplosTodos esperadosTodos [] 200
        squaredErrors = snd entrenado
    in if squaredErrors < 3 then fst entrenado
        else train (fst entrenado) ejemplosTodos esperadosTodos

-- ENTRENAMIENTO

entrenamiento:: ANN -> [[Float]] -> [Float] -> [Float] -> Int -> (ANN,Float)
entrenamiento red _ _ accum 0 =
    let squaredErrors = foldl' (+) 0 (map (**2) accum)  
    in (red,squaredErrors)
entrenamiento red ejemplos esperados accum epoch =
    let redInicializada = iniciarXsRed red (head ejemplos)
        redEvaluada = evaluarRed redInicializada
        redAjustada = ajustarPesos redEvaluada (head esperados)
        error = (head esperados) - (resultadoRed1Output redAjustada)
    in entrenamiento redAjustada (tail ejemplos) (tail esperados) (accum ++ [error]) (epoch-1)
    
resultadoRed1Output:: ANN -> Float
resultadoRed1Output (ANN _ _ [(Neuron ((_,xs):_) _)]) = xs

iniciarXsRed:: ANN -> [Float] -> ANN
iniciarXsRed (ANN inputLayer hiddenLayer outputLayer) valores =
    let inputNueva = zipWith ajustarXsInput inputLayer valores
    in (ANN inputNueva hiddenLayer outputLayer)
    
ajustarXsInput:: Neuron -> Float -> Neuron
ajustarXsInput (Neuron listaNeurona threshold) xsInput =
    let listaNueva = map (ajustarXs xsInput) listaNeurona
    in (Neuron listaNueva threshold)
-- FIN ENTRENAMIENTO
        
pesosIniciales :: Int -> IO [Float]
pesosIniciales n = do
    (replicateM n (Random.getStdRandom intervalo))
        where
            intervalo = Random.randomR (-0.5,0.5)

parsearString:: String -> [String] -> [String]
parsearString [] lista = (tail lista)
parsearString (x:xs) lista = if x == '\n' then parsearString xs ([]:lista)
                                else parsearString xs (((head lista) ++ [x]):(tail lista))
                                
split:: [String] -> [(Float,Float,Float)] -> [(Float,Float,Float)]
split [] accum = accum
split (x:xs) accum = 
    let first = readNum x ""
        fstNum = read $ fst first
        second = readNum (snd first) ""
        sndNum = read $ fst second
        third = readNum (snd second) ""
        thrdNum = if (head $ fst third) == 'A' then 0
                    else 1 
    in split xs ([(fstNum,sndNum,thrdNum)]++accum)
    
readNum:: String -> String -> (String,String)
readNum [] num = ([(head num)],num)
readNum (x:xs) num = if x == ' ' then (num,xs)
                        else (if x == '\n' then (num,xs)
                                else readNum xs (num ++ [x])
                             )
                             
generar:: Int -> Int -> Int -> [Float] -> [Float] -> [(Float,Float,Float)] -> [(Float,Float,Float)]
generar total dentro fuera randomXs randomYs accum
    | total == dentro + fuera = accum
    | dentro == total `div` 2 =
        let x = head randomXs
            y = head randomYs
            isDentro = ((x-15)**2) + ((y-6)**2) <= 9
        in if isDentro then generar total dentro fuera (tail randomXs) (tail randomYs) accum
            else  generar total dentro (fuera+1) (tail randomXs) (tail randomYs) (accum ++ [(x,y,0)])
    | fuera == total `div` 2 =
        let x = head randomXs
            y = head randomYs
            isDentro = ((x-15)**2) + ((y-6)**2) <= 9
        in if isDentro then generar total (dentro+1) fuera (tail randomXs) (tail randomYs) (accum ++ [(x,y,1)])
            else  generar total dentro fuera (tail randomXs) (tail randomYs) accum
    | otherwise = 
        let x = head randomXs
            y = head randomYs
            isDentro = ((x-15)**2) + ((y-6)**2) <= 9
        in if isDentro then generar total (dentro+1) fuera (tail randomXs) (tail randomYs) (accum ++ [(x,y,1)])
            else  generar total dentro (fuera+1) (tail randomXs) (tail randomYs) (accum ++ [(x,y,0)])

generarRandomXs :: Int -> IO [Float]
generarRandomXs n = do
    (replicateM n (Random.getStdRandom intervalo))
        where
            intervalo = Random.randomR (0.0,20.0)
            
generarRandomYs :: Int -> IO [Float]
generarRandomYs n = do
    (replicateM n (Random.getStdRandom intervalo))
        where
            intervalo = Random.randomR (0.0,12.0)

-- ARMAR RED
armarRed:: Int -> Int -> Int -> [Float] -> ANN
armarRed numNeuronasInput numNeuronasHidden numNeuronasOutput randoms =
    let layerInput = armarLayerInput numNeuronasInput numNeuronasHidden randoms []
        layerHidden = armarLayerHidden numNeuronasHidden numNeuronasOutput (snd layerInput) []
        layerOutput = armarLayerOutput numNeuronasOutput (snd layerHidden) []
    in (ANN (fst layerInput) (fst layerHidden) layerOutput)

armarLayerInput:: Int -> Int -> [Float] -> Layer -> (Layer,[Float])
armarLayerInput 0 _ randoms accum = (accum,randoms)
armarLayerInput numNeuronasInput numNeuronasHidden randoms accum =
    let listaNeurona = armarListaNeuronasInput numNeuronasHidden randoms []
        newRandoms = snd listaNeurona
        neurona = [(Neuron (fst listaNeurona) 0)]
    in armarLayerInput (numNeuronasInput-1) numNeuronasHidden newRandoms (accum ++ neurona)

armarLayerHidden:: Int-> Int -> [Float] -> Layer -> (Layer,[Float])
armarLayerHidden 0 _ randoms accum = (accum,randoms)
armarLayerHidden numNeuronasHidden numNeuronasOutput randoms accum =
    let listaNeurona = armarListaNeuronasHidden numNeuronasOutput randoms []
        neurona = [(Neuron (fst listaNeurona) (head $ snd listaNeurona))]
    in armarLayerHidden (numNeuronasHidden-1) numNeuronasOutput (tail $ snd listaNeurona) (accum ++ neurona)

armarListaNeuronasHidden:: Int -> [Float] -> [(Float,Float)] -> ([(Float,Float)],[Float])
armarListaNeuronasHidden 0 randoms accum = (accum,randoms)
armarListaNeuronasHidden numElems randoms accum =
    let pesosYxs = [((head randoms),(head $ tail randoms))]
    in armarListaNeuronasHidden (numElems-1) (tail $ tail randoms) (accum ++ pesosYxs)

armarListaNeuronasInput:: Int -> [Float] -> [(Float,Float)] -> ([(Float,Float)],[Float])
armarListaNeuronasInput 0 randoms accum = (accum,randoms)
armarListaNeuronasInput numElems randoms accum =
    let pesosYxs = [((head randoms),0)]
    in armarListaNeuronasInput (numElems-1) (tail randoms) (accum ++ pesosYxs)
      
armarLayerOutput:: Int -> [Float] -> Layer -> Layer
armarLayerOutput 0 _ accum = accum
armarLayerOutput numNeuronasHidden randoms accum =
    let neurona = [(Neuron [(0,(head randoms))] (head $ tail randoms))]
    in armarLayerOutput (numNeuronasHidden-1) (tail $ tail randoms) (accum ++ neurona)
    
-- FIN ARMAR RED

-- EVALUAR RED

evaluarRed:: ANN -> ANN
evaluarRed (ANN inputLayer hiddenLayer outputLayer) =
    let newHidden = ajustarLayer inputLayer hiddenLayer [] 0
        newOutput = ajustarLayer newHidden outputLayer [] 0
    in (ANN inputLayer newHidden newOutput)
    
ajustarLayer:: Layer -> Layer -> Layer -> Int -> Layer
ajustarLayer _ [] accum numNeurona = accum
ajustarLayer leftLayer ((Neuron listaNeurona threshold):rightLayer) accum numNeurona =
    let valorLayer = evaluarLayer leftLayer threshold numNeurona 
        listaNeuronaNew = map (ajustarXs valorLayer) listaNeurona
    in ajustarLayer leftLayer rightLayer (accum ++ [(Neuron listaNeuronaNew threshold)]) (numNeurona+1)
    
ajustarXs:: Float -> (Float,Float) -> (Float,Float)
ajustarXs xs (peso,_) = (peso,xs)
    
evaluarLayer:: Layer -> Float -> Int -> Float
evaluarLayer layer threshold numNeurona =
    let listaTuplas = extraerTuplaLayer layer numNeurona []
        valor = neurona2 listaTuplas threshold
    in valor
        
extraerTuplaLayer:: Layer -> Int -> [(Float,Float)] -> [(Float,Float)]
extraerTuplaLayer [] _ accum = accum
extraerTuplaLayer ((Neuron tupla _):resto) numNeurona accum = extraerTuplaLayer resto numNeurona (accum ++ [(tupla !! numNeurona)])

-- FIN EVALUAR RED

-- AJUSTAR RED

ajustarPesos:: ANN -> Float -> ANN
ajustarPesos salida@(ANN inputLayer hiddenLayer outputLayer) esperado = 
    let outputNuevo = map (ajustarPesoOutput esperado) outputLayer
        gradientes = snd $ unzip outputNuevo
        hiddenNuevo = map (ajustarPesoHidden gradientes) hiddenLayer
        gradientes2 = snd $ unzip hiddenNuevo
        inputNuevo = map (ajustarPesoInput gradientes2) inputLayer
    in (ANN inputNuevo (fst $ unzip hiddenNuevo) (fst $ unzip outputNuevo))
    
ajustarPesoOutput:: Float -> Neuron -> (Neuron,Float)
ajustarPesoOutput esperado (Neuron [(peso,obtenido)] threshold) =
    let error = esperado-obtenido
        gradiente = obtenido*(1-obtenido)*error
        deltaTheta = tasaAprendizaje*(-1)*gradiente
        thresholdNuevo = threshold + deltaTheta 
    in ((Neuron [(peso,obtenido)] thresholdNuevo),gradiente)
    
ajustarPesoHidden:: [Float] -> Neuron -> (Neuron,Float)
ajustarPesoHidden gradientes (Neuron listaNeurona threshold) =
    let (pesosViejos,xsViejos) = unzip listaNeurona
        pesosAjustados = zipWith ajustarPesosHidden listaNeurona gradientes
        sumatoriaGradientes = foldl' (+) 0 (zipWith (*) gradientes pesosViejos)
        gradiente = (head xsViejos)*(1-(head xsViejos))*sumatoriaGradientes
        thresholdNuevo = tasaAprendizaje*(-1)*gradiente
    in ((Neuron pesosAjustados thresholdNuevo),gradiente)
    
ajustarPesoInput:: [Float] -> Neuron -> Neuron
ajustarPesoInput gradientes (Neuron listaNeurona threshold) =
    let (pesosViejos,xsViejos) = unzip listaNeurona
        pesosAjustados = zipWith (+) pesosViejos (map (*tasaAprendizaje) (zipWith (*) gradientes xsViejos))
        listaNeuronaNueva = zip pesosAjustados xsViejos
    in (Neuron listaNeuronaNueva threshold)

    
ajustarPesosHidden:: (Float,Float) -> Float -> (Float,Float)
ajustarPesosHidden (pesoViejo,xs) gradiente =
    let deltaW = tasaAprendizaje*xs*gradiente
        pesoNuevo = pesoViejo + deltaW
    in (pesoNuevo,xs)
   
-- FIN AJUSTAR RED

tasaAprendizaje = 0.1