Red Neuronal
MFLM
2022-12-07
## Red Neuronal
Creacion de una red neuronal predictiva de valores de parcelas, en funcion de variables calificativas (atributos propios de los terrenos).
library(readxl)#carga de base de datos para entrenamiento
variables <- read_excel("C:/Users/Marcelo/Desktop/red neuronal/variables.xlsx")
View(variables)
train <- data.frame(variables)
library(readxl)#carga de base de datos predictiva
prueba <- read_excel("C:/Users/Marcelo/Desktop/red neuronal/prueba.xlsx")
View(prueba)
test <- data.frame(prueba)
head(train)#muestra las 6 primeras filas de la base de entrenamiento## Vmtrs2 Superficie Pua Ubc S2calles Ubz
## 1 869.00 3.5 2 2 3 2.0
## 2 780.00 3.5 2 3 3 2.0
## 3 781.00 3.0 2 3 3 2.0
## 4 875.00 3.0 2 3 3 1.5
## 5 832.00 2.5 2 3 3 2.0
## 6 795.88 2.5 2 3 3 2.0#install.packages("ggplot2", dependencies = TRUE) # Se instala una sola vez
library(ggplot2) #se genera los graficos ## Warning: package 'ggplot2' was built under R version 4.2.2library(gridExtra)## Warning: package 'gridExtra' was built under R version 4.2.2plot1 <- ggplot(train, aes(x=Vmtrs2, y=Superficie)) + geom_point()
plot2 <- ggplot(train, aes(x=Vmtrs2, y=Pua)) + geom_point()
plot3 <- ggplot(train, aes(x=Vmtrs2, y=Ubc)) + geom_point()
plot4 <- ggplot(train, aes(x=Vmtrs2, y=S2calles)) + geom_point()
plot5 <- ggplot(train, aes(x=Vmtrs2, y=Ubz)) + geom_point()
grid.arrange(plot1, plot2, plot3, plot4, plot5, ncol=5)
maxs <- apply(train, 2, max) # Máximo valor de las variables
mins <- apply(train, 2, min) # Mínimo valor de las variables
scaled <- as.data.frame(scale(train, center=mins, scale=maxs-mins))
head(cbind(train, scaled))## Vmtrs2 Superficie Pua Ubc S2calles Ubz Vmtrs2 Superficie Pua Ubc S2calles
## 1 869.00 3.5 2 2 3 2.0 0.6705172 0.5 0.4 0.5 1
## 2 780.00 3.5 2 3 3 2.0 0.4513054 0.5 0.4 1.0 1
## 3 781.00 3.0 2 3 3 2.0 0.4537685 0.4 0.4 1.0 1
## 4 875.00 3.0 2 3 3 1.5 0.6852956 0.4 0.4 1.0 1
## 5 832.00 2.5 2 3 3 2.0 0.5793842 0.3 0.4 1.0 1
## 6 795.88 2.5 2 3 3 2.0 0.4904187 0.3 0.4 1.0 1
## Ubz
## 1 0.50
## 2 0.50
## 3 0.50
## 4 0.25
## 5 0.50
## 6 0.50#Ahora bien, la primera red neuronal a considerar se llamará mod1 y tendrá una capa con un solo nodo
library(neuralnet)## Warning: package 'neuralnet' was built under R version 4.2.2mod1 <- neuralnet(Vmtrs2 ~ Superficie+Pua+Ubc+S2calles+Ubz, data=scaled, hidden=c(5), threshold=0.01)
plot(mod1, rep="best")#graficamos
names(mod1)#El objeto mod1 tiene varios elementos en su interior, éstos se pueden ver usando## [1] "call" "response" "covariate"
## [4] "model.list" "err.fct" "act.fct"
## [7] "linear.output" "data" "exclude"
## [10] "net.result" "weights" "generalized.weights"
## [13] "startweights" "result.matrix"mod1$act.fct # Activation function## function (x)
## {
## 1/(1 + exp(-x))
## }
## <bytecode: 0x00000284a4f91e00>
## <environment: 0x00000284a4f964d0>
## attr(,"type")
## [1] "logistic"unlist(mod1$weights) # Obtener en formas de vector los weigths=pesos## [1] -0.5376765 0.2360377 -4.7494243 -1.4455928 0.8569947 2.3898437
## [7] -0.4451088 -0.5117994 -0.2311957 1.1020616 -1.2608481 -3.3855569
## [13] 0.4668909 -3.1759956 4.6023147 -0.4546833 -0.9218018 -1.9450280
## [19] -3.4640429 -5.5260675 32.3551982 37.7614811 -5.9486397 33.2513963
## [25] 1.3827100 0.7952630 -0.9255436 1.0791331 -0.4815025 -0.3569747
## [31] -0.4086564 2.1697402 3.4343641 0.3987192 0.6453046 -0.4809443myprediction <- compute(x=mod1, covariate=test)
myprediction## $neurons
## $neurons[[1]]
## Superficie Pua Ubc S2calles Ubz
## [1,] 1 4.0 2.0 2.0 3 2.0
## [2,] 1 3.5 2.0 1.0 1 3.5
## [3,] 1 2.0 1.0 3.0 3 3.0
## [4,] 1 2.5 2.0 3.0 3 2.0
## [5,] 1 3.0 2.0 3.0 3 1.5
## [6,] 1 3.0 2.0 3.0 1 2.0
## [7,] 1 1.5 2.5 3.5 3 2.0
## [8,] 1 3.0 3.5 3.0 3 3.5
## [9,] 1 4.0 3.0 2.0 1 1.5
## [10,] 1 5.0 4.0 4.5 3 2.0
## [11,] 1 1.5 3.0 5.0 3 2.5
## [12,] 1 3.0 2.0 2.0 3 3.0
## [13,] 1 3.0 2.5 1.0 3 4.0
## [14,] 1 2.5 3.0 1.0 1 1.5
## [15,] 1 1.0 4.0 3.5 3 1.0
##
## $neurons[[2]]
## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] 1 9.632928e-03 1.232051e-05 2.498299e-05 1 0.9377593
## [2,] 1 1.923926e-01 4.100306e-07 6.581826e-05 1 0.8406755
## [3,] 1 6.430694e-01 4.404261e-06 1.304197e-05 1 0.9410141
## [4,] 1 1.605782e-03 7.991461e-05 1.855062e-03 1 0.9307793
## [5,] 1 5.475874e-04 3.361579e-04 1.003293e-03 1 0.9598765
## [6,] 1 3.259280e-04 7.697494e-04 2.394044e-03 1 0.9812817
## [7,] 1 5.736127e-05 2.060389e-04 2.615035e-01 1 0.8676404
## [8,] 1 5.253966e-05 2.725344e-07 2.003477e-02 1 0.7450867
## [9,] 1 4.591846e-06 6.610937e-04 3.996913e-02 1 0.9492342
## [10,] 1 2.486807e-08 7.312483e-05 3.317024e-03 1 0.9873140
## [11,] 1 2.016262e-06 1.764099e-04 4.033441e-01 1 0.9457151
## [12,] 1 7.733766e-02 6.959480e-07 8.555011e-05 1 0.8263887
## [13,] 1 2.653474e-01 6.973096e-09 1.924446e-04 1 0.4161415
## [14,] 1 1.367828e-05 4.732960e-04 8.849148e-01 1 0.6584524
## [15,] 1 3.762874e-09 5.526952e-03 9.999171e-01 1 0.6109441
##
##
## $net.result
## [,1]
## [1,] -0.193408511
## [2,] 0.249799686
## [3,] 1.179386801
## [4,] -0.206506528
## [5,] -0.222256218
## [6,] -0.230988266
## [7,] -0.075539919
## [8,] -0.113593751
## [9,] -0.201663670
## [10,] -0.236621054
## [11,] -0.056756768
## [12,] 0.007040426
## [13,] 0.612318912
## [14,] 0.274456947
## [15,] 0.360485878yhat_red <- myprediction$net.result * (max(train$Vmtrs2)- min(train$Vmtrs2))+min(train$Vmtrs2)
yhat_red #Resultado predictivo## [,1]
## [1,] 518.2461
## [2,] 698.1887
## [3,] 1075.6010
## [4,] 512.9283
## [5,] 506.5340
## [6,] 502.9888
## [7,] 566.1008
## [8,] 550.6509
## [9,] 514.8946
## [10,] 500.7019
## [11,] 573.7268
## [12,] 599.6284
## [13,] 845.3715
## [14,] 708.1995
## [15,] 743.1273#comparacion de grafico de base de datos de entrenamiento con el resultado segun sus variables
plot7 <- plot(train$Vmtrs2)
plot8 <- plot(yhat_red)