Redes neuronales en pocas palabras.
Redes neuronales de una sola capa
Ya hemos hablado acerca del comportamiento general de una red neuronal, y las partes que la componen. Pensemos ahora nuestra red neuronal como una familia de algoritmos que nos permite modelar comportamientos inteligetntes. Dependiendo del número de características que se tengan en nuestro conjunto de datos, la red neuronal puede ser una “caja negra”. En un principio, se pueden mostrar las ecuaciones que cosntruyen la red neuronal, pero en cierta medida, la cantidad de información se vuelve demasiado densa para ser intuida fácilmente.
Recordemos
En el capitulo 2 vimos el desarrollo de una compuerta lógica del tipo \(AND\), que se comporta de la siguiente forma:
x1 <- c(0, 0, 1, 1)
x2 <- c(0, 1, 0, 1)
logic <- data.frame(x1, x2)
logic$AND <- as.numeric(x1 & x2)
knitr::kable(logic)| x1 | x2 | AND |
|---|---|---|
| 0 | 0 | 0 |
| 0 | 1 | 0 |
| 1 | 0 | 0 |
| 1 | 1 | 1 |
## [1] TRUE## [1] FALSE## [1] FALSE¿Qué esta pasando dentro de esta red?
| \(x_1\) | \(x_2\) | \(-20+15x_1+17x_2\) | \(\frac{1}{e^{-(-20+15x_1+17x_2)}}\) |
| 1 | 1 | -20+15+17 | 1 |
| 1 | 0 | -20+15 | 0 |
| 0 | 1 | -20+17 | 0 |
| 0 | 0 | -20 | 0 |
AND (\(\wedge\))
Establecimos que la puerta lógica \(AND\) es justamente el operador binario (\(\wedge\)), obteniendo cálculos similares al los del análisis de la regresión logistica.
Luego empleamos la función sigmoide, que está dada por:
\(g(z) = \frac{1}{1+e^{-z}}\)
Donde \(z\) es una función de la forma \(z = \theta_0 + \theta_1 x_1 + \theta_2 x_2\) y donde previamente, se escogieron los pesos de \(\theta_0 =20, \theta_1 = 15, \theta_2 = 17\) .
La red
Teniendo en cuenta todos estos datos, logramos construir una red neuronal simple, de una sola capa, con entradas \((0,1)\),función de activación dada por la sigmoide y salida \(0\).
## [1] 0 0 0 1
Construyendo una red neurona simple usando R
Antes de comenzar con las matemáticas, vamos a desglosar la visualización presentada en la Figura 5-1, un diagrama de una red neuronal más sencilla que se puede hacer.
Análisis
1.Hay una capa de entrada y una capa de salida. 2.Los números en las líneas indican los mejores pesos (computacionalmente hablando) para usar en el modelo. 3. El número que acompaña al “1” en el círculo ubicado en la parte superior es el peso del nodo de sesgo.
Entonces, en cierto sentido, esto es sólo una forma diferente de representar un análisis de regresión logística en la forma más simple de una red neuronal. El resultado final es un esquema de clasificación para los datos que tienen etiquetas 1 o 0.
En R
En R, hay solo una librería de redes neuronales que tiene la funcionalidad para visualizarlas. En la práctica, la mayoría del tiempo graficar redes neuronales es más complicado de lo que parece, como se verá después.
Código
El código mostrado en la Figura 5-1 muestra una tabla similar a los datos de binary.data en la función neuralnet() (función del paquete del mismo nombre). El resultado que se obtiene será una ecuación que tiene los pesos θ_0=−11.86048, θ_1=7.75382, θ_2=7.75519
Detalles del funcionamiento
Se toman dos entradas Var1 y Var2 y se introduce en la ecuación: z=−11.86048 + 7.75382Var1 + 7.75519Var2. Entonces pasamos la ecuación a través de la función sigmoide g(z)=1/(1+e^(−z)) y obtenemos la salida.
-Entonces, el proceso entero será de la siguiente manera: \[AND = \frac{1}{1+ e^{-(-11.86048 + 7.75382 Var_1 + 7.75519 Var_2)}}\]
Verificación
Se puede verificar la salida de la función neuralnet() usando la función prediction()
## Data Error: 0;## $rep1
## Var1 Var2 AND
## 1 0 0 7.064116e-06
## 2 1 0 1.619615e-02
## 3 0 1 1.621788e-02
## 4 1 1 9.746310e-01
##
## $data
## Var1 Var2 AND
## 1 0 0 0
## 2 1 0 0
## 3 0 1 0
## 4 1 1 1En la primera tabla están las variables de entrada y lo que la red neuronal cree que es la respuesta. Hasta ahora, se ha realizado con éxito una red neuronal con una sola capa. Es decir, todas las entradas pasaron por un solo punto de procesamiento, como se muestra en la Figura 5-1.
Multiples salidas de cálculos
set.seed(123)
AND <- c(rep(0, 7), 1)
OR <- c(0, rep(1, 7))
binary.data <- data.frame(expand.grid(c(0, 1), c(0, 1), c(0,1)), AND, OR)
net <- neuralnet(AND + OR ~ Var1 + Var2 + Var3, binary.data,hidden = 0, err.fct = "ce", linear.output = FALSE)
plot(net, rep = "best")
Nodos ocultos de cálculos
Mostraremos como el añadir una capa oculta de cálculos, puede incrementar la presición del modelo.
Gráfica resultante del código:
Matemáticamente se ve de la siguiente manera:
\(H_{1} = 8.57 - 3.5\cdot Var_{1}-3.5\cdot Var_{2}-3.6\cdot Var_{3}\)Esto, al pasarlo por un nodo de regresión logística:
\(g(H_{1}) = \frac{1}{1 + e^{(8.57 - 3.5\cdot Var_{1}-3.5\cdot Var_{2}-3.6\cdot Var_{3})}}\)Evaluando en otro nodo de regresión logística, en la formula anterior:
\(AND=g(5.72 - 13.79\cdot g(H_{1}))\)
set.seed(123)
net2 <- neuralnet(AND ~ Var1 + Var2 + Var3, binary.data, hidden = 2,
err.fct = "ce", linear.output = FALSE)
plot(net2, rep = "best")
Matemáticamente, esto puede ser representado como dos ecuaciones de regresión logística que son introducidas en una ecuación de regresión logística final para obtener nuestra salida
- \(H_{1} = 13.64 + 13.97\cdot Var_{1} + 14.9\cdot Var_{2}+14.27\cdot Var_{3}\)
- \(H_{2} = -7.95 + 3.24\cdot Var_{1} + 3.15\cdot Var_{2}+3.29\cdot Var_{3}\)
- \(H_{3} = -5.83 + 1.94\cdot g(H_{1}) + 14.09\cdot g(H_{2})\)
- \(AND = g(H_{3})\)
set.seed(123)
net <- neuralnet(AND + OR ~ Var1 + Var2 + Var3, binary.data,
hidden = 6, err.fct = "ce", linear.output = FALSE)
plot(net, rep = "best")
Redes neuronales con múltiples capas
library(neuralnet)
x1 <- c(0, 0, 1, 1)
x2 <- c(0, 1, 0, 1)
logic <- data.frame(x1, x2)
logic$AND <- as.numeric(x1 & x2)
logic$OR <- as.numeric(x1 | x2)
logic## x1 x2 AND OR
## 1 0 0 0 0
## 2 0 1 0 1
## 3 1 0 0 1
## 4 1 1 1 1plot(x = logic$x1, y = logic$x2, pch = logic$AND, cex = 2,
main = "Clasificación simple de dos tipos",
xlab = "x", ylab = "y", xlim = c(-0.5, 1.5), ylim = c(-0.5,
1.5))
plot(x = logic$x1, y = logic$x2, pch = logic$OR, cex = 2,
main = "Clasificación simple de dos tipos",
xlab = "x", ylab = "y", xlim = c(-0.5, 1.5), ylim = c(-0.5,
1.5))
x1 <- c(0, 0, 1, 1)
x2 <- c(0, 1, 0, 1)
logic <- data.frame(x1, x2)
logic$AND <- as.numeric(x1 & x2)
logic$OR <- as.numeric(x1 | x2)
logic$XOR <- as.numeric(xor(x1, x2))
logic$XNOR <- as.numeric(x1 == x2)
logic## x1 x2 AND OR XOR XNOR
## 1 0 0 0 0 0 1
## 2 0 1 0 1 1 0
## 3 1 0 0 1 1 0
## 4 1 1 1 1 0 1plot(x = logic$x1, y = logic$x2, pch = logic$XOR, cex = 2, main = "Clasificación de dos tipos no lineal",
xlab = "x", ylab = "y", xlim = c(-0.5, 1.5), ylim = c(-0.5,
1.5))
plot(x = logic$x1, y = logic$x2, pch = logic$XNOR, cex = 2, main = "Clasificación de dos tipos no lineal",
xlab = "x", ylab = "y", xlim = c(-0.5, 1.5), ylim = c(-0.5,
1.5))
logic$XOR <- as.numeric(xor(x1, x2))
set.seed(123)
net.xor <- neuralnet(XOR ~ x1 + x2, logic, hidden = 0, err.fct = "ce",
linear.output = FALSE)
prediction(net.xor)## Data Error: 0;## $rep1
## x1 x2 XOR
## 1 0 0 0.4870313
## 2 1 0 0.4970851
## 3 0 1 0.4980805
## 4 1 1 0.5081364
##
## $data
## x1 x2 XOR
## 1 0 0 0
## 2 1 0 1
## 3 0 1 1
## 4 1 1 0
set.seed(123)
and.net <- neuralnet(AND ~ x1 + x2, logic, hidden = 2, err.fct = "ce",
linear.output = FALSE)
and.result <- data.frame(prediction(and.net)$rep1)## Data Error: 0;or.net <- neuralnet(OR ~ x1 + x2, logic, hidden = 2, err.fct = "ce",
linear.output = FALSE)
or.result <- data.frame(prediction(or.net)$rep1)## Data Error: 0;## [1] 0 1 1 0xor.data <- data.frame(and.result$AND, or.result$OR,
as.numeric(xor(round(and.result$AND),
round(or.result$OR))))
names(xor.data) <- c("AND", "OR", "XOR")
xor.net <- neuralnet(XOR ~ AND + OR, data = xor.data, hidden = 0,
err.fct = "ce", linear.output = FALSE)
prediction(xor.net)## Data Error: 0;## $rep1
## AND OR XOR
## 1 0.0001754982 0.01115157 0.013427053
## 2 0.0021855081 0.99537740 0.993710673
## 3 0.0080918285 0.99566428 0.993306664
## 4 0.9853433841 0.99806092 0.003024048
##
## $data
## AND OR XOR
## 1 0.0001754982 0.01115157 0
## 2 0.0021855081 0.99537740 1
## 3 0.0080918285 0.99566428 1
## 4 0.9853433841 0.99806092 0
Redes neuronales para regresión
Se puede utilizar redes neuronales para problemas estándar de aprendizaje automático como regresión y clasificación. Veremos un ejemplo utilizando la libreria mlbench y la base de datos Boston Housing
Base de datos Boston Housing
Esta base de datos contiene 506 secciones censales del Boston del censo de 1970. La base de datos Boston Housing contiene los datos originales de Harrison y Rubinfeld (1979).
Esta información esta incluida en la biblioteca mlbench. Los datos tienen las siguientes caracteristicas, siendo medv la variable objetivo o independiente.
Caracteristicas Boston Housing
| crim | Crime per cápita por ciudad. |
| zn | Proporción de terrenos residenciales divididos en zonas para lotes de más de 25,000 pies cuadrados. |
| indus | Proporción de acres de negocios no minoristas por ciudad. |
| chas | Variable ficticia de Charles River ( =1 si el tramo limita el río, 0 de lo contrario). |
| nox | Voncentración de óxidos nítricos (parte por 10 millones). |
| rm | Número promedio de habitaciones por vivienda. |
| age | Proporción de unidades ocupadas por sus propietarios construidas antes de 1940 |
| dis | Distancias desproporcionadas a cinco centro de empleo de Boston |
| rad | Índice de accesibilidad a las autopistas radiales. |
| tax | Tasa de impuestos a la propiedad de valor complejo por USD 10,00 |
| ptratio | Colegios por localidad. |
| b | \(1000(B-0.63)^2\), donde B es la proporción de afrodescendientes por ciudad. |
| Istat | Porcentaje de población de estatus bajo. |
| medv | Valor medio de las viviendas ocupadas por sus propietarios en USD 1000. |
Boston Housing
## crim zn indus chas nox rm age dis rad tax ptratio b lstat
## 1 0.00632 18 2.31 0 0.538 6.575 65.2 4.0900 1 296 15.3 396.90 4.98
## 2 0.02731 0 7.07 0 0.469 6.421 78.9 4.9671 2 242 17.8 396.90 9.14
## 3 0.02729 0 7.07 0 0.469 7.185 61.1 4.9671 2 242 17.8 392.83 4.03
## 4 0.03237 0 2.18 0 0.458 6.998 45.8 6.0622 3 222 18.7 394.63 2.94
## 5 0.06905 0 2.18 0 0.458 7.147 54.2 6.0622 3 222 18.7 396.90 5.33
## 6 0.02985 0 2.18 0 0.458 6.430 58.7 6.0622 3 222 18.7 394.12 5.21
## medv
## 1 24.0
## 2 21.6
## 3 34.7
## 4 33.4
## 5 36.2
## 6 28.7lm.fit <- lm(medv ~ ., data = BostonHousing)
lm.predict <- predict(lm.fit)
plot(BostonHousing$medv, lm.predict, main = "Predicción de la regresión lineal vs
actual",
xlab = "Actual", ylab = "Predicción")
## # weights: 31
## initial value 283985.903126
## final value 277329.140000
## convergednnet.predict1 <- predict(nnet.fit1)
plot(BostonHousing$medv, nnet.predict1, main = "Predicción red neuronal vs
actual",
xlab = "Actual", ylab = "Predicción")
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 5.00 17.02 21.20 22.53 25.00 50.00## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.1000 0.3405 0.4240 0.4507 0.5000 1.0000set.seed(1234)
nnet.fit2 <- nnet(medv/50 ~ ., data = BostonHousing, size = 2,
maxit = 1000, trace = FALSE)
nnet.predict2 <- predict(nnet.fit2) * 50
plot(BostonHousing$medv, nnet.predict2, main = "Neural network predictions vs
actual with normalized response inputs",
xlab = "Actual", ylab = "Prediction")
## [1] 21.89483## [1] 16.12609mygrid <- expand.grid(.decay = c(0.5, 0.1), .size = c(4, 5, 6))
nnetfit <- train(medv/50 ~ ., data = BostonHousing, method = "nnet",
maxit = 1000, tuneGrid = mygrid, trace = F)
print(nnetfit)## Neural Network
##
## 506 samples
## 13 predictor
##
## No pre-processing
## Resampling: Bootstrapped (25 reps)
## Summary of sample sizes: 506, 506, 506, 506, 506, 506, ...
## Resampling results across tuning parameters:
##
## decay size RMSE Rsquared MAE
## 0.1 4 0.08236667 0.8033466 0.05731807
## 0.1 5 0.08292114 0.8010850 0.05779031
## 0.1 6 0.08282244 0.8010013 0.05725517
## 0.5 4 0.09069138 0.7717789 0.06374459
## 0.5 5 0.09018424 0.7723917 0.06340960
## 0.5 6 0.08909644 0.7771297 0.06258204
##
## RMSE was used to select the optimal model using the smallest value.
## The final values used for the model were size = 4 and decay = 0.1.La mejor estimación de error de este caso es de tamaño 6, lo que significa 6 nodos en una capa oculta de la red, y una caída del parámetro de 0.1. La raíz del error cuadrático medio (RMSE) da el mismo error que ha visto anteriormente, pero habiendo tomando la raíz cuadrada. Entonces, para comparar con los resultados vistos anteriormente, el mejor error aquí es como sigue:
## [1] 0.006672444Redes neuronales para clasificación
iris.df <- iris
smp_size <- floor(0.75 * nrow(iris.df))
set.seed(123)
train_ind <- sample(seq_len(nrow(iris.df)), size = smp_size)
train <- iris.df[train_ind, ]
test <- iris.df[-train_ind, ]
iris.nnet <- nnet(Species ~ ., data = train, size = 4, decay = 0.0001,
maxit = 500, trace = FALSE)
predictions <- predict(iris.nnet, test[, 1:4], type = "class")
table(predictions, test$Species)##
## predictions setosa versicolor virginica
## setosa 12 0 0
## versicolor 0 16 0
## virginica 0 1 9Redes neuronales con caret.
Regresión.
library(car)
library(caret)
trainIndex <- createDataPartition(Prestige$income, p = 0.7, list = F)
prestige.train <- Prestige[trainIndex, ]
prestige.test <- Prestige[-trainIndex, ]
my.grid <- expand.grid(.decay = c(0.5, 0.1), .size = c(5, 6,
7))
prestige.fit <- train(income ~ prestige + education, data = prestige.train,
method = "nnet", maxit = 1000, tuneGrid = my.grid, trace = F,
linout = 1)
prestige.predict <- predict(prestige.fit, newdata = prestige.test)
summary(prestige.test$income)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 611 4504 5962 7196 8077 25879## [1] 3658.62prestige.fit <- train(income ~ prestige + education, data = prestige.train,
method = "neuralnet")
prestige.predict <- predict(prestige.fit, newdata = prestige.test)
sqrt(mean((prestige.predict - prestige.test$income)^2))## [1] 5067.804Clasificación
## Warning: package 'e1071' was built under R version 4.0.4iris.caret <- train(Species ~ ., data = train, method = "nnet",
trace = FALSE)
predictions <- predict(iris.caret, test[, 1:4])
table(predictions, test$Species)##
## predictions setosa versicolor virginica
## setosa 12 0 0
## versicolor 0 16 0
## virginica 0 1 9iris.caret.m <- train(Species ~ ., data = train, method = "multinom",
trace = FALSE)
predictions.m <- predict(iris.caret.m, test[, 1:4])
table(predictions.m, test$Species)##
## predictions.m setosa versicolor virginica
## setosa 12 0 0
## versicolor 0 16 0
## virginica 0 1 9