Memory Leak - Artificial Neural Network
|
View:
New views
7 Messages
—
Rating Filter:
Alert me
|
 |
Memory Leak - Artificial Neural Network
by Hector Guilarte
::
Rate this Message:
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 [Parte2New.hs] 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 _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@... http://www.haskell.org/mailman/listinfo/haskell-cafe |
|
|
Re: Memory Leak - Artificial Neural Network
by Hector Guilarte
::
Rate this Message:
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@...> wrote: Hello everyone, _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@... http://www.haskell.org/mailman/listinfo/haskell-cafe |
|
|
Re: Memory Leak - Artificial Neural Network
by shelby-3
::
Rate this Message:
> 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. I suggested an idea for fix to Haskell in general for these: http://www.haskell.org/pipermail/haskell-cafe/2009-November/068633.html Maybe you might want to vote for my Proposal at the bug tracker for Haskell: http://hackage.haskell.org/trac/ghc/ticket/3630 (note Hackage has been down and this page is still giving errors, even though the page intially came up when hackage came back up) _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@... http://www.haskell.org/mailman/listinfo/haskell-cafe |
|
|
Re: Memory Leak - Artificial Neural Network
by Hector Guilarte
::
Rate this Message:
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:
let nuevaRed = armarRed 2 8 1 pesos 8 is the number of hidden layers... From: Hector Guilarte <hectorg87@...>
Date: Thu, 5 Nov 2009 06:27:25 -0430 To: <haskell-cafe@...> Subject: Re: Memory Leak - Artificial Neural Network Once again, Thanks in advance Hector Guilarte On Thu, Nov 5, 2009 at 6:24 AM, Hector Guilarte <hectorg87@...> wrote: Hello everyone, _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@... http://www.haskell.org/mailman/listinfo/haskell-cafe |
|
|
Re: Memory Leak - Artificial Neural Network
by Luke Palmer-2
::
Rate this Message:
On Thu, Nov 5, 2009 at 3:54 AM, Hector Guilarte <hectorg87@...> wrote:
> 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) Well, I don't speak spanish (portuguese?), which makes this especially hard to read. But just from your introductory paragraph, maybe I can give you a few hints. They probably won't be able to fix your program, just treat them as things to keep in mind in the future. When I write in Haskell, my functions are usually *not* tail recursive. Tail recursion is good when you are reducing to a flat, strict domain (Int, Bool, ...), but when you are building up inductive, lazy structures, the relevant term is *corecursion* (IIRC), which is a whole different thing. Take eg. a tail recursive map function on lists: map f = go [] where go accum [] = accum go accum (x:xs) = go (accum ++ [f x]) xs map f [1,2,3] will reduce like this before anything else: map f [1,2,3] go [] [1,2,3] go ([] ++ [1]) [2,3] go (([] ++ [1]) ++ [2]) [3] go ((([] ++ [1]) ++ [2]) ++ [3]) [] (([] ++ [1]) ++ [2]) ++ [3] If the tail recursion has saved any stack space, it has paid for it in heap space. (Additionally, the way ++ is used here and in the code I quoted causes quadratic time behavior, becuase ++ is linear in the length of its left argument). The corecursive way to write map is the canonical example: map f (x:xs) = f x : map f xs Notice how the recursive call to map is "under" the (:) constructor? The new structure goes on the outside of the recursive call, not passed as an argument. IOW, we can generate some of the output without looking at all of the input. And this has very good behavior: map f [1,2,3] f 1 : map f [2,3] -- and when you get around to evaluating the tail.... ... : f 2 : map f [3] -- ditto ... : f 3 : map f [] -- ditto ... : [] I used ...s to emphasize that we could have forgotten about of the head of the list by now, only processing its tail, so it can be garbage collected. map has constant space complexity, in some sense. The art of programming corecursively is one of the joys of Haskell, but if you are used to either imperative programming or strict functional programming (basically... any other language at all), it takes time to get the hang of. Luke _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@... http://www.haskell.org/mailman/listinfo/haskell-cafe |
|
|
Re: Memory Leak - Artificial Neural Network
by Hector Guilarte
::
Rate this Message:
Hi Luke,
The code is mainly in Spanish with son parts in English... Thanks for the explanation, I got the idea very well, but now I got some questions about that. How does the Prelude functions for managing lists work? I mean, what does zip, unzip, foldl, foldr, map and zipWith do? Tail recursion or corecursion? I know, thanks to the profiling I did, that my main memory leak is in the function "entrenamiento" (which means training in Spanish), and I hardly believe it is in when I use of those functions I mentioned before, so if they are tail recursive and I change them to my own corecursive version, maybe I'll get rid of the problem, won't I? Thanks, Hector Guilarte -----Original Message----- From: Luke Palmer <lrpalmer@...> Date: Thu, 5 Nov 2009 04:24:44 To: Hector Guilarte<hectorg87@...> Cc: <haskell-cafe@...> Subject: Re: [Haskell-cafe] Memory Leak - Artificial Neural Network On Thu, Nov 5, 2009 at 3:54 AM, Hector Guilarte <hectorg87@...> wrote: > 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) hard to read. But just from your introductory paragraph, maybe I can give you a few hints. They probably won't be able to fix your program, just treat them as things to keep in mind in the future. When I write in Haskell, my functions are usually *not* tail recursive. Tail recursion is good when you are reducing to a flat, strict domain (Int, Bool, ...), but when you are building up inductive, lazy structures, the relevant term is *corecursion* (IIRC), which is a whole different thing. Take eg. a tail recursive map function on lists: map f = go [] where go accum [] = accum go accum (x:xs) = go (accum ++ [f x]) xs map f [1,2,3] will reduce like this before anything else: map f [1,2,3] go [] [1,2,3] go ([] ++ [1]) [2,3] go (([] ++ [1]) ++ [2]) [3] go ((([] ++ [1]) ++ [2]) ++ [3]) [] (([] ++ [1]) ++ [2]) ++ [3] If the tail recursion has saved any stack space, it has paid for it in heap space. (Additionally, the way ++ is used here and in the code I quoted causes quadratic time behavior, becuase ++ is linear in the length of its left argument). The corecursive way to write map is the canonical example: map f (x:xs) = f x : map f xs Notice how the recursive call to map is "under" the (:) constructor? The new structure goes on the outside of the recursive call, not passed as an argument. IOW, we can generate some of the output without looking at all of the input. And this has very good behavior: map f [1,2,3] f 1 : map f [2,3] -- and when you get around to evaluating the tail.... ... : f 2 : map f [3] -- ditto ... : f 3 : map f [] -- ditto ... : [] I used ...s to emphasize that we could have forgotten about of the head of the list by now, only processing its tail, so it can be garbage collected. map has constant space complexity, in some sense. The art of programming corecursively is one of the joys of Haskell, but if you are used to either imperative programming or strict functional programming (basically... any other language at all), it takes time to get the hang of. Luke _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@... http://www.haskell.org/mailman/listinfo/haskell-cafe |
|
|
Re: Memory Leak - Artificial Neural Network
by wren ng thornton
::
Rate this Message:
Hector Guilarte wrote:
> Hi Luke, > > The code is mainly in Spanish with son parts in English... > > Thanks for the explanation, I got the idea very well, but now I got some questions about that. > > How does the Prelude functions for managing lists work? I mean, what does zip, unzip, foldl, foldr, map and zipWith do? Tail recursion or corecursion? I know, thanks to the profiling I did, that my main memory leak is in the function "entrenamiento" (which means training in Spanish), and I hardly believe it is in when I use of those functions I mentioned before, so if they are tail recursive and I change them to my own corecursive version, maybe I'll get rid of the problem, won't I? Don't worry about the Prelude definitions, by and large they're the "right" definitions. If you're curious then just search for Prelude.hs on your system, or check it out online[1]. As a more general high-level suggestion, the most efficient way to implement feedforward ANNs is to treat them as matrix multiplication problems and use matrices/arrays rather than lists. For a three layer network of N, M, and O nodes we thus: * start with an N-wide vector of inputs * multiply by the N*M matrix of weights, to get an M-vector * map sigmoid or other activation function * multiply by the M*O matrix of weights for the next layer to get an O-vector * apply some interpretation (e.g. winner-take-all) to the output There are various libraries for optimized matrix multiplication, but even just using an unboxed array for the matrices will make it much faster to traverse through things. [1] http://haskell.org/ghc/docs/latest/html/libraries/base/Prelude.html See the "Source Code" link at the top of the page. -- Live well, ~wren _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@... http://www.haskell.org/mailman/listinfo/haskell-cafe |
| Free embeddable forum powered by Nabble | Forum Help |
