[Haskell-cafe] Re: Memory Leak - Artificial Neural Network

Hector Guilarte hectorg87 at gmail.com
Thu Nov 5 05:57:25 EST 2009


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...

Once again, Thanks in advance

Hector Guilarte


On Thu, Nov 5, 2009 at 6:24 AM, Hector Guilarte <hectorg87 at gmail.com> wrote:

> Hello everyone,
>
> 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.
>
> Thanks A LOT in advance,
>
> Hector Guilarte
>
> Ps: The file is also attached
>
> Ps2: The code is written in Spanglish, sorry for that, I'm working on that
> bad habbit...
>
> 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
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20091105/16ba4ab2/attachment-0001.html


More information about the Haskell-Cafe mailing list