By the way, there is a line where I'm using unsafePerformIO to print the sum of the squared erros, feel free to delete it, I was checking convergence on smaller training sets before I realized the huge memory leak...<br>
<br>Once again, Thanks in advance<br><br>Hector Guilarte<br><br><br><div class="gmail_quote">On Thu, Nov 5, 2009 at 6:24 AM, Hector Guilarte <span dir="ltr"><<a href="mailto:hectorg87@gmail.com">hectorg87@gmail.com</a>></span> wrote:<br>
<blockquote class="gmail_quote" style="border-left: 1px solid rgb(204, 204, 204); margin: 0pt 0pt 0pt 0.8ex; padding-left: 1ex;">Hello everyone,<br><br>I just implemented an Artificial Neural Network but I'm having a serious memory leak. I was very careful of using tail recursion all over my code, but for some reason (a.k.a lazyness) my program is misusing incredible ammounts of RAM. I read the whole chapter 25 of Real World Haskell trying to find a solution with no luck. Maybe somebody can take a look at the code to help me out with this problem, I would really appreciate it.<br>
<br>Thanks A LOT in advance,<br><br>Hector Guilarte<br><br>Ps: The file is also attached<br><br>Ps2: The code is written in Spanglish, sorry for that, I'm working on that bad habbit...<br><br>module Main where<br><br>
import Control.Monad<br>import System.IO<br>import qualified Random<br>import System.IO.Unsafe<br>import System.Environment<br>import Data.List<br><br>data ANN = ANN Layer Layer Layer -- ^ Red Neuronal de 3 capas<br> deriving (Eq, Show)<br>
<br>type Layer = [Neuron] -- ^ Lista de Neuronas que conforman la capa<br><br>data Neuron = Neuron [(Float,Float)] Float -- ^ Lista de (pesos,xs) y umbral asociado<br> deriving (Eq, Show) <br><br>neurona:: Neuron -> -- ^ [(Pesos,Xs)] y Umbral<br>
Float<br>neurona (Neuron entrada umbral) =<br> let entradaTupla = unzip entrada<br> pesos = fst entradaTupla<br> xs = snd entradaTupla<br> suma = foldl' (+) (-umbral) (zipWith (*) xs pesos)<br>
in sigmoidal suma<br> <br>neurona2:: [(Float,Float)] -> -- ^ [(Pesos,Xs)]<br> Float -> -- ^ Umbral<br> Float<br>neurona2 valores umbral =<br> let entradaTupla = unzip valores<br>
pesos = fst entradaTupla<br> xs = snd entradaTupla<br> suma = foldl' (+) umbral (zipWith (*) xs pesos)<br> in sigmoidal suma<br> <br>-- 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]<br>
<br>sigmoidal:: Float -> Float<br>sigmoidal x = 1 / (1 + (exp (-x)))<br><br>main:: IO()<br>main = do<br>-- nombreArchivo <- getArgs<br>-- archivo <- readFile (head nombreArchivo)<br> pesos <- pesosIniciales 10000<br>
randomXs <- generarRandomXs 5000<br> randomYs <- generarRandomYs 5000<br> let conjunto = generar 200 0 0 randomXs randomYs []<br> --print conjunto<br>-- let lista = parsearString archivo [[]]<br>
-- let splitted = split lista []<br> let (a,b,c) = (unzip3 (take 200 conjunto))<br> --let (a,b,c) = ([0,1,0,1],[0,0,1,1],[0,1,1,0])<br> let ejemplos = zipWith (ajustarEjemplos) a b<br>-- print ejemplos<br>
let nuevaRed = armarRed 2 8 1 pesos<br> let entrenada = train nuevaRed ejemplos c<br> let redInicializada = map (iniciarXsRed entrenada) ejemplos<br> let resultados = map resultadoRed1Output (map evaluarRed redInicializada)<br>
print nuevaRed<br> print entrenada<br> print resultados<br> return ()<br><br>ajustarEjemplos:: Float -> Float -> [Float]<br>ajustarEjemplos a b = [a,b]<br><br>train:: ANN -> [[Float]] -> [Float] -> ANN<br>
train red ejemplosTodos esperadosTodos =<br> let entrenado = entrenamiento red ejemplosTodos esperadosTodos [] 200<br> squaredErrors = snd entrenado<br> in if squaredErrors < 3 then fst entrenado<br> else train (fst entrenado) ejemplosTodos esperadosTodos<br>
<br>-- ENTRENAMIENTO<br><br>entrenamiento:: ANN -> [[Float]] -> [Float] -> [Float] -> Int -> (ANN,Float)<br>entrenamiento red _ _ accum 0 =<br> let squaredErrors = foldl' (+) 0 (map (**2) accum) <br>
in (red,squaredErrors)<br>entrenamiento red ejemplos esperados accum epoch =<br> let redInicializada = iniciarXsRed red (head ejemplos)<br> redEvaluada = evaluarRed redInicializada<br> redAjustada = ajustarPesos redEvaluada (head esperados)<br>
error = (head esperados) - (resultadoRed1Output redAjustada)<br> in entrenamiento redAjustada (tail ejemplos) (tail esperados) (accum ++ [error]) (epoch-1)<br> <br>resultadoRed1Output:: ANN -> Float<br>resultadoRed1Output (ANN _ _ [(Neuron ((_,xs):_) _)]) = xs<br>
<br>iniciarXsRed:: ANN -> [Float] -> ANN<br>iniciarXsRed (ANN inputLayer hiddenLayer outputLayer) valores =<br> let inputNueva = zipWith ajustarXsInput inputLayer valores<br> in (ANN inputNueva hiddenLayer outputLayer)<br>
<br>ajustarXsInput:: Neuron -> Float -> Neuron<br>ajustarXsInput (Neuron listaNeurona threshold) xsInput =<br> let listaNueva = map (ajustarXs xsInput) listaNeurona<br> in (Neuron listaNueva threshold)<br>
-- FIN ENTRENAMIENTO<br> <br>pesosIniciales :: Int -> IO [Float]<br>pesosIniciales n = do<br> (replicateM n (Random.getStdRandom intervalo))<br> where<br> intervalo = Random.randomR (-0.5,0.5)<br>
<br>parsearString:: String -> [String] -> [String]<br>parsearString [] lista = (tail lista)<br>parsearString (x:xs) lista = if x == '\n' then parsearString xs ([]:lista)<br> else parsearString xs (((head lista) ++ [x]):(tail lista))<br>
<br>split:: [String] -> [(Float,Float,Float)] -> [(Float,Float,Float)]<br>split [] accum = accum<br>split (x:xs) accum = <br> let first = readNum x ""<br> fstNum = read $ fst first<br>
second = readNum (snd first) ""<br> sndNum = read $ fst second<br> third = readNum (snd second) ""<br> thrdNum = if (head $ fst third) == 'A' then 0<br> else 1 <br>
in split xs ([(fstNum,sndNum,thrdNum)]++accum)<br> <br>readNum:: String -> String -> (String,String)<br>readNum [] num = ([(head num)],num)<br>readNum (x:xs) num = if x == ' ' then (num,xs)<br> else (if x == '\n' then (num,xs)<br>
else readNum xs (num ++ [x])<br> )<br> <br>generar:: Int -> Int -> Int -> [Float] -> [Float] -> [(Float,Float,Float)] -> [(Float,Float,Float)]<br>
generar total dentro fuera randomXs randomYs accum<br> | total == dentro + fuera = accum<br> | dentro == total `div` 2 =<br> let x = head randomXs<br> y = head randomYs<br> isDentro = ((x-15)**2) + ((y-6)**2) <= 9<br>
in if isDentro then generar total dentro fuera (tail randomXs) (tail randomYs) accum<br> else generar total dentro (fuera+1) (tail randomXs) (tail randomYs) (accum ++ [(x,y,0)])<br> | fuera == total `div` 2 =<br>
let x = head randomXs<br> y = head randomYs<br> isDentro = ((x-15)**2) + ((y-6)**2) <= 9<br> in if isDentro then generar total (dentro+1) fuera (tail randomXs) (tail randomYs) (accum ++ [(x,y,1)])<br>
else generar total dentro fuera (tail randomXs) (tail randomYs) accum<br> | otherwise = <br> let x = head randomXs<br> y = head randomYs<br> isDentro = ((x-15)**2) + ((y-6)**2) <= 9<br>
in if isDentro then generar total (dentro+1) fuera (tail randomXs) (tail randomYs) (accum ++ [(x,y,1)])<br> else generar total dentro (fuera+1) (tail randomXs) (tail randomYs) (accum ++ [(x,y,0)])<br>
<br>
generarRandomXs :: Int -> IO [Float]<br>generarRandomXs n = do<br> (replicateM n (Random.getStdRandom intervalo))<br> where<br> intervalo = Random.randomR (0.0,20.0)<br> <br>generarRandomYs :: Int -> IO [Float]<br>
generarRandomYs n = do<br> (replicateM n (Random.getStdRandom intervalo))<br> where<br> intervalo = Random.randomR (0.0,12.0)<br><br>-- ARMAR RED<br>armarRed:: Int -> Int -> Int -> [Float] -> ANN<br>
armarRed numNeuronasInput numNeuronasHidden numNeuronasOutput randoms =<br> let layerInput = armarLayerInput numNeuronasInput numNeuronasHidden randoms []<br> layerHidden = armarLayerHidden numNeuronasHidden numNeuronasOutput (snd layerInput) []<br>
layerOutput = armarLayerOutput numNeuronasOutput (snd layerHidden) []<br> in (ANN (fst layerInput) (fst layerHidden) layerOutput)<br><br>armarLayerInput:: Int -> Int -> [Float] -> Layer -> (Layer,[Float])<br>
armarLayerInput 0 _ randoms accum = (accum,randoms)<br>armarLayerInput numNeuronasInput numNeuronasHidden randoms accum =<br> let listaNeurona = armarListaNeuronasInput numNeuronasHidden randoms []<br> newRandoms = snd listaNeurona<br>
neurona = [(Neuron (fst listaNeurona) 0)]<br> in armarLayerInput (numNeuronasInput-1) numNeuronasHidden newRandoms (accum ++ neurona)<br><br>armarLayerHidden:: Int-> Int -> [Float] -> Layer -> (Layer,[Float])<br>
armarLayerHidden 0 _ randoms accum = (accum,randoms)<br>armarLayerHidden numNeuronasHidden numNeuronasOutput randoms accum =<br> let listaNeurona = armarListaNeuronasHidden numNeuronasOutput randoms []<br> neurona = [(Neuron (fst listaNeurona) (head $ snd listaNeurona))]<br>
in armarLayerHidden (numNeuronasHidden-1) numNeuronasOutput (tail $ snd listaNeurona) (accum ++ neurona)<br><br>armarListaNeuronasHidden:: Int -> [Float] -> [(Float,Float)] -> ([(Float,Float)],[Float])<br>armarListaNeuronasHidden 0 randoms accum = (accum,randoms)<br>
armarListaNeuronasHidden numElems randoms accum =<br> let pesosYxs = [((head randoms),(head $ tail randoms))]<br> in armarListaNeuronasHidden (numElems-1) (tail $ tail randoms) (accum ++ pesosYxs)<br><br>armarListaNeuronasInput:: Int -> [Float] -> [(Float,Float)] -> ([(Float,Float)],[Float])<br>
armarListaNeuronasInput 0 randoms accum = (accum,randoms)<br>armarListaNeuronasInput numElems randoms accum =<br> let pesosYxs = [((head randoms),0)]<br> in armarListaNeuronasInput (numElems-1) (tail randoms) (accum ++ pesosYxs)<br>
<br>armarLayerOutput:: Int -> [Float] -> Layer -> Layer<br>armarLayerOutput 0 _ accum = accum<br>armarLayerOutput numNeuronasHidden randoms accum =<br> let neurona = [(Neuron [(0,(head randoms))] (head $ tail randoms))]<br>
in armarLayerOutput (numNeuronasHidden-1) (tail $ tail randoms) (accum ++ neurona)<br> <br>-- FIN ARMAR RED<br><br>-- EVALUAR RED<br><br>evaluarRed:: ANN -> ANN<br>evaluarRed (ANN inputLayer hiddenLayer outputLayer) =<br>
let newHidden = ajustarLayer inputLayer hiddenLayer [] 0<br> newOutput = ajustarLayer newHidden outputLayer [] 0<br> in (ANN inputLayer newHidden newOutput)<br> <br>ajustarLayer:: Layer -> Layer -> Layer -> Int -> Layer<br>
ajustarLayer _ [] accum numNeurona = accum<br>ajustarLayer leftLayer ((Neuron listaNeurona threshold):rightLayer) accum numNeurona =<br> let valorLayer = evaluarLayer leftLayer threshold numNeurona <br> listaNeuronaNew = map (ajustarXs valorLayer) listaNeurona<br>
in ajustarLayer leftLayer rightLayer (accum ++ [(Neuron listaNeuronaNew threshold)]) (numNeurona+1)<br> <br>ajustarXs:: Float -> (Float,Float) -> (Float,Float)<br>ajustarXs xs (peso,_) = (peso,xs)<br> <br>
evaluarLayer:: Layer -> Float -> Int -> Float<br>evaluarLayer layer threshold numNeurona =<br> let listaTuplas = extraerTuplaLayer layer numNeurona []<br> valor = neurona2 listaTuplas threshold<br> in valor<br>
<br>extraerTuplaLayer:: Layer -> Int -> [(Float,Float)] -> [(Float,Float)]<br>extraerTuplaLayer [] _ accum = accum<br>extraerTuplaLayer ((Neuron tupla _):resto) numNeurona accum = extraerTuplaLayer resto numNeurona (accum ++ [(tupla !! numNeurona)])<br>
<br>-- FIN EVALUAR RED<br><br>-- AJUSTAR RED<br><br>ajustarPesos:: ANN -> Float -> ANN<br>ajustarPesos salida@(ANN inputLayer hiddenLayer outputLayer) esperado = <br> let outputNuevo = map (ajustarPesoOutput esperado) outputLayer<br>
gradientes = snd $ unzip outputNuevo<br> hiddenNuevo = map (ajustarPesoHidden gradientes) hiddenLayer<br> gradientes2 = snd $ unzip hiddenNuevo<br> inputNuevo = map (ajustarPesoInput gradientes2) inputLayer<br>
in (ANN inputNuevo (fst $ unzip hiddenNuevo) (fst $ unzip outputNuevo))<br> <br>ajustarPesoOutput:: Float -> Neuron -> (Neuron,Float)<br>ajustarPesoOutput esperado (Neuron [(peso,obtenido)] threshold) =<br> let error = esperado-obtenido<br>
gradiente = obtenido*(1-obtenido)*error<br> deltaTheta = tasaAprendizaje*(-1)*gradiente<br> thresholdNuevo = threshold + deltaTheta <br> in ((Neuron [(peso,obtenido)] thresholdNuevo),gradiente)<br>
<br>ajustarPesoHidden:: [Float] -> Neuron -> (Neuron,Float)<br>ajustarPesoHidden gradientes (Neuron listaNeurona threshold) =<br> let (pesosViejos,xsViejos) = unzip listaNeurona<br> pesosAjustados = zipWith ajustarPesosHidden listaNeurona gradientes<br>
sumatoriaGradientes = foldl' (+) 0 (zipWith (*) gradientes pesosViejos)<br> gradiente = (head xsViejos)*(1-(head xsViejos))*sumatoriaGradientes<br> thresholdNuevo = tasaAprendizaje*(-1)*gradiente<br>
in ((Neuron pesosAjustados thresholdNuevo),gradiente)<br> <br>ajustarPesoInput:: [Float] -> Neuron -> Neuron<br>ajustarPesoInput gradientes (Neuron listaNeurona threshold) =<br> let (pesosViejos,xsViejos) = unzip listaNeurona<br>
pesosAjustados = zipWith (+) pesosViejos (map (*tasaAprendizaje) (zipWith (*) gradientes xsViejos))<br> listaNeuronaNueva = zip pesosAjustados xsViejos<br> in (Neuron listaNeuronaNueva threshold)<br><br>
<br>ajustarPesosHidden:: (Float,Float) -> Float -> (Float,Float)<br>ajustarPesosHidden (pesoViejo,xs) gradiente =<br> let deltaW = tasaAprendizaje*xs*gradiente<br> pesoNuevo = pesoViejo + deltaW<br> in (pesoNuevo,xs)<br>
<br>-- FIN AJUSTAR RED<br><br>tasaAprendizaje = 0.1<br>
</blockquote></div><br>