Relatório - Regressão usando Redes Neurais
Júlia Maria
Como um dos objetivos principais este relatório ira demonstrar como criar um modelo de rede neural e depois comparar o resultado com um modelo de regressão.
O banco de dados utilizado foi obtido pelo site Kaggle,< https://www.kaggle.com/c/house-prices-advanced-regression-techniques>.
suppressMessages(suppressWarnings(library(keras)))
suppressMessages(suppressWarnings(library(tidyverse)))
suppressMessages(suppressWarnings(library(MASS)))
suppressMessages(suppressWarnings(library(gridExtra)))
train <- read_csv("/opt/datasets/houseprices/train.csv", na = "")Início
Antes de inciar a crição dos modelos, vamos começar com um breve analise descritiva.
Começando com a análise da variável resposta SalePrice.
train %>%
select_at(.vars = vars(ends_with("Price"))) %>%
select_if(is.numeric) %>%
gather(var,value) %>%
ggplot(aes(x = value)) +
geom_histogram(bins = 25,
fill = "ivory3",
colour = "pink") +
theme_light() +
facet_wrap(~var, scales = "free")
Tem-se que a variável resposta é bastante assimétrica à direita.Vamos tentar corrigir aplicando a transformação log.
train %>%
select_at(.vars = vars(ends_with("Price"))) %>%
select_if(is.numeric) %>%
gather(var,value) %>%
ggplot(aes(x = log(value))) +
geom_histogram(bins = 25,
fill = "ivory3",
colour = "pink") +
theme_light() +
facet_wrap(~var, scales = "free")
Após a transformação a variável resposta apresentou uma grande melhora. Como temos uma grande quantidade de variaveis, para a exibição dos graficos sera pre selecionado uma palavra e todas as que se referem a ela, serão analizadas.
Análise das variáveis relacionadas a vendas.
train %>%
select_at(.vars = vars(ends_with("Sold"))) %>%
select_if(is.numeric) %>%
gather(var,value) %>%
ggplot(aes(x = value)) +
geom_histogram(bins = 10,
fill = "ivory3",
colour = "pink") +
theme_light() +
facet_wrap(~var, scales = "free")
A variável MoSoldapresenta um comportamento proximo ao normal e a variável YrSoldpossuis informações por anos.
Análise das variáveis relacionadas a área.
train %>%
select_at(.vars = vars(ends_with("Area"))) %>%
select_if(is.numeric) %>%
gather(var,value) %>%
ggplot(aes(x = value)) +
geom_histogram(bins = 25,
fill = "ivory3",
colour = "pink") +
theme_light() +
facet_wrap(~var, scales = "free")
As variáveis relacionadas com a área aparentam possuir fortes assimetrias.
Para seleção das variáveis de nossa base de dados, sera selecionado apenas as variáveis quantitativas e aplicado a transformação log.
set.seed(100)
train_num <- train %>%
select_if(is.numeric) %>%
mutate_at(vars(ends_with("Area")), function(x){log(x+1)}) %>%
mutate_at(vars(ends_with("Sold")), function(x){log(x+1)}) %>%
mutate_at(vars(ends_with("Price")), function(x){log(x+1)}) %>%
mutate_at(-1, scale) %>%
mutate(Flag = sample(c("Test", "Train"),
n(),
replace = TRUE,
prob = c(.2,.8)))Separando a base de dados.
train_all <- train_num %>%
filter(Flag=="Train") %>%
dplyr::select(-Id, -Flag, -TotalBsmtSF) %>%
as.data.frame()
test<- train_num %>%
filter(Flag=="Test") %>%
dplyr::select(-Id, -Flag, - TotalBsmtSF) %>%
as.data.frame()Construindo o modelo linear simpples:
modelo <- lm(SalePrice ~. , data=train_all )
summary(modelo)##
## Call:
## lm(formula = SalePrice ~ ., data = train_all)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.4432 -0.1706 0.0126 0.1892 1.6053
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.003646 0.010625 -0.343 0.731581
## MSSubClass -0.029016 0.014822 -1.958 0.050524 .
## LotArea 0.106289 0.014681 7.240 8.32e-13 ***
## OverallQual 0.275891 0.018999 14.521 < 2e-16 ***
## OverallCond 0.145724 0.013157 11.076 < 2e-16 ***
## YearBuilt 0.214969 0.021308 10.089 < 2e-16 ***
## YearRemodAdd 0.050505 0.016090 3.139 0.001740 **
## BsmtFinSF1 0.122274 0.024808 4.929 9.52e-07 ***
## BsmtFinSF2 0.035048 0.012713 2.757 0.005930 **
## BsmtUnfSF 0.069603 0.021815 3.191 0.001459 **
## `1stFlrSF` -0.154595 0.041676 -3.709 0.000218 ***
## `2ndFlrSF` -0.161762 0.041230 -3.923 9.26e-05 ***
## LowQualFinSF -0.010467 0.011313 -0.925 0.355033
## GrLivArea 0.484446 0.049801 9.728 < 2e-16 ***
## BsmtFullBath 0.069334 0.015926 4.353 1.46e-05 ***
## BsmtHalfBath -0.004703 0.011631 -0.404 0.686063
## FullBath 0.040461 0.018298 2.211 0.027223 *
## HalfBath 0.001871 0.015525 0.121 0.904082
## BedroomAbvGr -0.034111 0.016441 -2.075 0.038238 *
## KitchenAbvGr -0.043520 0.013809 -3.152 0.001667 **
## TotRmsAbvGrd 0.047195 0.023969 1.969 0.049199 *
## Fireplaces 0.051945 0.013472 3.856 0.000122 ***
## GarageCars 0.135730 0.020626 6.581 7.18e-11 ***
## GarageArea -0.008589 0.016893 -0.508 0.611260
## WoodDeckSF 0.032710 0.011660 2.805 0.005113 **
## OpenPorchSF -0.011998 0.011494 -1.044 0.296784
## EnclosedPorch 0.012983 0.011987 1.083 0.278998
## `3SsnPorch` 0.014473 0.011297 1.281 0.200425
## ScreenPorch 0.045322 0.010714 4.230 2.52e-05 ***
## PoolArea -0.025883 0.011308 -2.289 0.022267 *
## MiscVal -0.003328 0.010805 -0.308 0.758132
## MoSold 0.013870 0.010943 1.268 0.205229
## YrSold -0.016876 0.010734 -1.572 0.116204
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.3598 on 1121 degrees of freedom
## Multiple R-squared: 0.873, Adjusted R-squared: 0.8693
## F-statistic: 240.7 on 32 and 1121 DF, p-value: < 2.2e-16Como muitas variáveis não foram significativas para o modelo, sera utilizado o critério de seleção AIC.
modelo2 <- stepAIC(modelo)summary(modelo2)##
## Call:
## lm(formula = SalePrice ~ MSSubClass + LotArea + OverallQual +
## OverallCond + YearBuilt + YearRemodAdd + BsmtFinSF1 + BsmtFinSF2 +
## BsmtUnfSF + `1stFlrSF` + `2ndFlrSF` + GrLivArea + BsmtFullBath +
## FullBath + BedroomAbvGr + KitchenAbvGr + TotRmsAbvGrd + Fireplaces +
## GarageCars + WoodDeckSF + ScreenPorch + PoolArea + YrSold,
## data = train_all)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.4951 -0.1647 0.0119 0.1944 1.6128
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.003607 0.010612 -0.340 0.734004
## MSSubClass -0.031651 0.014673 -2.157 0.031207 *
## LotArea 0.104403 0.014549 7.176 1.30e-12 ***
## OverallQual 0.278228 0.018802 14.798 < 2e-16 ***
## OverallCond 0.143943 0.012848 11.204 < 2e-16 ***
## YearBuilt 0.209942 0.018769 11.185 < 2e-16 ***
## YearRemodAdd 0.050607 0.015848 3.193 0.001445 **
## BsmtFinSF1 0.117732 0.024447 4.816 1.66e-06 ***
## BsmtFinSF2 0.032954 0.012560 2.624 0.008816 **
## BsmtUnfSF 0.066961 0.021699 3.086 0.002079 **
## `1stFlrSF` -0.147996 0.039245 -3.771 0.000171 ***
## `2ndFlrSF` -0.154866 0.038073 -4.068 5.08e-05 ***
## GrLivArea 0.479278 0.046080 10.401 < 2e-16 ***
## BsmtFullBath 0.071603 0.015158 4.724 2.61e-06 ***
## FullBath 0.041406 0.016649 2.487 0.013026 *
## BedroomAbvGr -0.032488 0.016278 -1.996 0.046196 *
## KitchenAbvGr -0.040554 0.013536 -2.996 0.002796 **
## TotRmsAbvGrd 0.039502 0.023510 1.680 0.093190 .
## Fireplaces 0.053132 0.013384 3.970 7.65e-05 ***
## GarageCars 0.131896 0.015024 8.779 < 2e-16 ***
## WoodDeckSF 0.032166 0.011528 2.790 0.005354 **
## ScreenPorch 0.042811 0.010539 4.062 5.20e-05 ***
## PoolArea -0.027236 0.011055 -2.464 0.013899 *
## YrSold -0.017651 0.010580 -1.668 0.095531 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.3595 on 1130 degrees of freedom
## Multiple R-squared: 0.8722, Adjusted R-squared: 0.8696
## F-statistic: 335.2 on 23 and 1130 DF, p-value: < 2.2e-16Após a seleção final, iremos realizar a análise de residuos,
Através dos gráficos da análise de residuo, pode-se notar que o modelo esta bem ajustado. Para confirmar, utiliza-se o gráfico de envelope.
Com o gráfico de envelope, pode-se verificar que o modelo não apresentou um otimo ajuste.
Análisando o erro quadratico médio, tem-se:
EQM<-lms$sigma
EQM## [1] 0.3594616Construindo o modelo utilizando uma rede neural
#Variáveis preditoras na base de treino
x_train <- train_num %>%
filter(Flag == "Train") %>%
dplyr::select(-Id, -Flag, -SalePrice) %>%
as.matrix()
#Variável resposta na base de treino
y_train <- train_num %>%
filter(Flag == "Train") %>%
dplyr::select(SalePrice) %>%
as.matrix()
#Variáveis preditoras na base de teste
x_test <- train_num %>%
filter(Flag == "Test") %>%
dplyr::select(-Id, -Flag, -SalePrice) %>%
as.matrix()
#Variável resposta na base de teste
y_test<- train_num %>%
filter(Flag == "Test") %>%
dplyr::select(SalePrice) %>%
as.matrix()Para construção da rede neural, será utilizada 3 camadas, sendo a primeira com 32 neurônios, a segunda com 16 e a última camada com apenas 1 neurônio, que representa a previsão do preço.
model <- keras_model_sequential() %>%
layer_dense(units = 32, activation = "relu",
input_shape = ncol(train_num) - 3, kernel_initializer='normal') %>%
layer_dense(units =16, activation = "relu", kernel_initializer='normal') %>%
layer_dense(units = 1)
model %>% compile(
optimizer = optimizer_adam(),
loss = 'mse',
metrics = list("mean_absolute_error")
)Na criação do modelo tem que utilizar um critério de parada, e para este problema o escolhido foi o número de iterações igual a 50.
history <- model %>% fit(
x_train, y_train,
epochs = 50,
validation_split = 0.2,
verbose = 1,
shuffle = TRUE,
callbacks = list(
callback_early_stopping(monitor = "val_mean_absolute_error", min_delta = 0.01,
patience = 25,
verbose = 0,
mode = "auto",
restore_best_weights = TRUE)
))
plot(history)
O valor do erro quadratico médio foi:
evaluate(model, x_test, y_test)## $loss
## [1] 0.08720855
##
## $mean_absolute_error
## [1] 0.2139383