<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> <html><head> <meta content="text/html; charset=utf-8" http-equiv="Content-Type"> </head>There's one more thing I forgot to mention, there's a line in the main function that calls the function that builds the initial neural network, in that call you can specify how many input, Hidden and Output Neurons you want, please leave the input in 2 and the output in 1, but feel free to play with the hidden Neurons value, the best performance I got was for 6 Neurons... The line I'm talking about it the one that says:<br/>        let nuevaRed = armarRed 2 8 1 pesos<br/><br/>8 is the number of hidden layers...<hr/><div><b>From: </b> Hector Guilarte &lt;hectorg87@gmail.com&gt;
</div><div><b>Date: </b>Thu, 5 Nov 2009 06:27:25 -0430</div><div><b>To: </b>&lt;haskell-cafe@haskell.org&gt;</div><div><b>Subject: </b>Re: Memory Leak - Artificial Neural Network</div><div><br/></div>By the way, there is a line where I&#39;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">&lt;<a href="mailto:hectorg87@gmail.com">hectorg87@gmail.com</a>&gt;</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&#39;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&#39;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 -&gt; -- ^ [(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&#39; (+) (-umbral) (zipWith (*) xs pesos)<br>

    in sigmoidal suma<br>    <br>neurona2:: [(Float,Float)] -&gt; -- ^ [(Pesos,Xs)]<br>                    Float -&gt; -- ^ Umbral<br>                    Float<br>neurona2 valores umbral =<br>    let entradaTupla = unzip valores<br>

        pesos = fst entradaTupla<br>        xs = snd entradaTupla<br>        suma = foldl&#39; (+) 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 -&gt; Float<br>sigmoidal x = 1 / (1 + (exp (-x)))<br><br>main:: IO()<br>main = do<br>--        nombreArchivo &lt;- getArgs<br>--        archivo &lt;- readFile (head nombreArchivo)<br>        pesos &lt;- pesosIniciales 10000<br>

        randomXs &lt;- generarRandomXs 5000<br>        randomYs &lt;- 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 -&gt; Float -&gt; [Float]<br>ajustarEjemplos a b = [a,b]<br><br>train:: ANN -&gt; [[Float]] -&gt; [Float] -&gt; ANN<br>

train red ejemplosTodos esperadosTodos =<br>    let entrenado = entrenamiento red ejemplosTodos esperadosTodos [] 200<br>        squaredErrors = snd entrenado<br>    in if squaredErrors &lt; 3 then fst entrenado<br>        else train (fst entrenado) ejemplosTodos esperadosTodos<br>

<br>-- ENTRENAMIENTO<br><br>entrenamiento:: ANN -&gt; [[Float]] -&gt; [Float] -&gt; [Float] -&gt; Int -&gt; (ANN,Float)<br>entrenamiento red__ accum 0 =<br>    let squaredErrors = foldl&#39; (+) 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 -&gt; Float<br>resultadoRed1Output (ANN__ [(Neuron ((_,xs):_)_)]) = xs<br>

<br>iniciarXsRed:: ANN -&gt; [Float] -&gt; 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 -&gt; Float -&gt; 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 -&gt; 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 -&gt; [String] -&gt; [String]<br>parsearString [] lista = (tail lista)<br>parsearString (x:xs) lista = if x == &#39;\n&#39; then parsearString xs ([]:lista)<br>                                else parsearString xs (((head lista) ++ [x]):(tail lista))<br>

                                <br>split:: [String] -&gt; [(Float,Float,Float)] -&gt; [(Float,Float,Float)]<br>split [] accum = accum<br>split (x:xs) accum = <br>    let first = readNum x &quot;&quot;<br>        fstNum = read $ fst first<br>

        second = readNum (snd first) &quot;&quot;<br>        sndNum = read $ fst second<br>        third = readNum (snd second) &quot;&quot;<br>        thrdNum = if (head $ fst third) == &#39;A&#39; then 0<br>                    else 1 <br>

    in split xs ([(fstNum,sndNum,thrdNum)]++accum)<br>    <br>readNum:: String -&gt; String -&gt; (String,String)<br>readNum [] num = ([(head num)],num)<br>readNum (x:xs) num = if x == &#39; &#39; then (num,xs)<br>                        else (if x == &#39;\n&#39; then (num,xs)<br>

                                else readNum xs (num ++ [x])<br>                             )<br>                             <br>generar:: Int -&gt; Int -&gt; Int -&gt; [Float] -&gt; [Float] -&gt; [(Float,Float,Float)] -&gt; [(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) &lt;= 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) &lt;= 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) &lt;= 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 -&gt; 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 -&gt; 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 -&gt; Int -&gt; Int -&gt; [Float] -&gt; 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 -&gt; Int -&gt; [Float] -&gt; Layer -&gt; (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-&gt; Int -&gt; [Float] -&gt; Layer -&gt; (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 -&gt; [Float] -&gt; [(Float,Float)] -&gt; ([(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 -&gt; [Float] -&gt; [(Float,Float)] -&gt; ([(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 -&gt; [Float] -&gt; Layer -&gt; 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 -&gt; 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 -&gt; Layer -&gt; Layer -&gt; Int -&gt; 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 -&gt; (Float,Float) -&gt; (Float,Float)<br>ajustarXs xs (peso,_) = (peso,xs)<br>    <br>

evaluarLayer:: Layer -&gt; Float -&gt; Int -&gt; Float<br>evaluarLayer layer threshold numNeurona =<br>    let listaTuplas = extraerTuplaLayer layer numNeurona []<br>        valor = neurona2 listaTuplas threshold<br>    in valor<br>

        <br>extraerTuplaLayer:: Layer -&gt; Int -&gt; [(Float,Float)] -&gt; [(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 -&gt; Float -&gt; 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 -&gt; Neuron -&gt; (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] -&gt; Neuron -&gt; (Neuron,Float)<br>ajustarPesoHidden gradientes (Neuron listaNeurona threshold) =<br>    let (pesosViejos,xsViejos) = unzip listaNeurona<br>        pesosAjustados = zipWith ajustarPesosHidden listaNeurona gradientes<br>

        sumatoriaGradientes = foldl&#39; (+) 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] -&gt; Neuron -&gt; 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) -&gt; Float -&gt; (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>

</html>