In lfpdroubi/appraiseR: R Package For Real Estate Appraisals

knitr::opts_chunk$set(cache=FALSE, warning = FALSE, message = FALSE, 
                      fig.align = "center", out.width = "60%")
knitr::knit_hooks$set(mysize = function(before, options, envir) {
  if (before) 
    return(options$size)
})
library(sf)
library(kableExtra)
library(ggplot2)
library(cowplot)
theme_set(theme_cowplot(14))
library(stargazer)

Introdução

• appraiseR (https://lfpdroubi.github.io/appraiseR/) é um pacote de software livre para utilização:
  • no ensino da Engenharia de Avaliações
  • na pesquisa de melhores práticas e novos métodos para Avaliação de Bens
  • na prática da Engenharia de Avaliações (sem garantias)
• Por que \proglang{R}?
  • \proglang{R} é uma linguagem de programação feita por estatísticos
  • \proglang{R} é uma linguagem de programação feita para estatísticos
  • Milhares de pacotes de software com métodos estatísticos já programados
  • Excelentes recursos para construção de gráficos
  • Desenvolvimento comunitário: Free software
• fortemente baseado na NBR 14.653-2 [@NBR1465302]
• implementa também alguns parâmetros da IAAO [@iaao]
• pretende integrar a comunidade de Engenheiros Avaliadores na pesquisa e divulgação de dados e análise de dados para a Engenharia de Avaliações
• Existem diversos pacotes no \proglang{R} para baixar dados de APIs
  • BETS: FGV, BCB, IBGE
  • sidrar: SIDRA/IBGE
  • ribge: IBGE, IPEA, BCB
  • rbcb: BCB
  • ecoseries: BCB, SIDRA, IPEA
• Por que não uma API para dados públicos de transações de imóveis?

Conjuntos de dados disponíveis

• Estão disponíveis vários conjuntos de dados que podem ser utilizados tanto para os testes das diversas funções do pacote, assim como testes de novos métodos estatísticos.
• P. Ex: @hochheim2015

library(appraiseR)
data(centro_2015)

knitr::kable(head(st_drop_geometry(centro_2015), 10), format = "latex", 
             format.args = list(big.mark = ".", decimal.mark = ","),
             booktabs = TRUE) %>% 
  kable_styling(font_size = 7)

Análise exploratória de dados

Gráficos na escala original

dados <- st_drop_geometry(centro_2015)
plotdf(valor~., dados)

Gráficos na escala transformada

plotdf(log(valor)~., dados)

Escolha de modelos

fits <- bestfit(valor~., data = dados)
summary(fits)

Restringindo a busca

library(car)
fit <- lm(valor ~ area_total + quartos + suites + garagens + dist_b_mar + padrao, 
          data = dados)
s <- summary(fit)
boxCox(fit)

Restringindo a busca

boxTidwell(log(valor) ~ area_total + quartos + dist_b_mar, 
           other.x = ~padrao + suites + garagens, data = dados)

logs <- fits$tab[which(fits$tab$valor == "log"), ]
logs

logs <- fits$tab[which(fits$tab$valor == "log"), ]
kable(head(logs, 9), booktabs = TRUE) %>% 
  kable_styling(font_size = 7)

Detalhe do modelo escolhido

summary(fits, fit = 37)

Gráficos na escala transformada

plotdf(log(valor)~ area_total + quartos + suites + sqrt(garagens) + 
         rsqrt(dist_b_mar) + padrao, dados)

Diagnóstico do Modelo

# Modelo adotado (37)
fit <- summary(fits, fit = 37)$fit
plot(fit, which = 1:6)

fit <- summary(fits, fit = 37)$fit
plot(fit, which = 1:6, 
     cex.caption = 3, cex.sub = 1.5, cex.axis = 2, cex.lab = 2)

Testes dos modelos

Normalidade

KS(fit)

Homoscedasticidade

library(lmtest)
bptest(fit)

plot(fit, which = c(1, 3))

Plotagem de modelos

Na escala transformada

plotModel(fits, fit = 37, interval = "both", level = .80,
          local = list(area_total = 205, quartos = 3, suites = 1, 
                       garagens = 2, dist_b_mar = 250, padrao = "medio"))

Na escala original

plotModel(fits, fit = 37, interval = "both", level = .80, func="log", ca = TRUE,
          local = list(area_total = 205, quartos = 3, suites = 1, 
                       garagens = 2, dist_b_mar = 250, padrao = "medio"))

Predição de valores

predict(fits, fit = 37, interval = "confidence", level = .80,
        newdata = data.frame(area_total = 205, quartos = 3, suites = 1, 
                       garagens = 2, dist_b_mar = 250, padrao = "medio"))

predict(fits, fit = 37, interval = "prediction", level = .80,
        newdata = data.frame(area_total = 205, quartos = 3, suites = 1, 
                       garagens = 2, dist_b_mar = 250, padrao = "medio"))

Poder de Predição

```r."} powerPlot(fit)

## Poder de Predição (2)

```r
powerPlot(fit, axis = "inverted")

Poder de Predição (3)

powerPlot(fit, axis = "inverted", func = "log")

Encolhimento

shrinkPlot(fit, func = "log")

Performance da avaliação em massa

Estatísticas

iaao_Ratio(fit, func = "log")

Gráficos

plot(iaao_Ratio(fit, func = "log"))

plot(iaao_Ratio(fit, func = "log"), cex.lab = 1.75, cex.axis = 1.75)

Simulações de dados

Dados para investigação do fenômeno do encolhimento

set.seed(1)
area <- runif(1000, 50, 600)
quartos <- rbinom(1000, 3, .33) + 1
suites <- rbinom(1000, 2, .5)
VU <- 500 - .5*area + 150*quartos + 75*suites + rnorm(1000, 0, 50)
dados <- data.frame(VU, area, quartos, suites)
amostra <- dados[sample(1:1000, 250), ]

Modelo Nulo

fit <- lm(VU ~ 1, amostra)
# Resíduos vs. valores ajustados
plot(fit, which = 1)
#Resíduos vs. valores observados
plot(amostra$VU, residuals(fit))
abline(a = 0, b = 0, col = "grey", lty = 2)

Modelo pobre (com variáveis faltantes)

fit1 <- lm(VU ~ area, amostra)
plot(fit, which = 1:6)

fit1 <- lm(VU ~ area, amostra)
plot(fit1, which = 1:6, 
     cex.caption = 3, cex.sub = 1.5, cex.axis = 2, cex.lab = 2)

Poder de predição com modelo pobre

powerPlot(fit1)
powerPlot(fit1, axis ="inverted")

Encolhimento com modelo pobre

shrinkPlot(fit1)

Poder de Predição com modelo intermediário

fit2 <- lm(VU ~ area + quartos, amostra)
powerPlot(fit2)
powerPlot(fit2, axis ="inverted")

Encolhimento com modelo intermediário

shrinkPlot(fit2)

Poder de Predição com modelo completo

fit3 <- lm(VU ~ area + quartos + suites, amostra)
powerPlot(fit3)
powerPlot(fit3, axis ="inverted")

• Mesmo com modelo completo ainda subsiste uma leve inclinação (em relação à diagonal) no 1º gráfico.

Encolhimento com modelo completo

shrinkPlot(fit3)

• Nota-se ainda algum encolhimento, ainda que pequeno.

Estatísticas dos Modelos

stargazer(fit, fit1, fit2, fit3, label = "tab:tab1", 
          title = "Estatísticas dos modelos.",
          type = "latex", header = FALSE, table.placement = "H",
          report = "vcst*", single.row = F,
          intercept.bottom = FALSE, intercept.top = TRUE,
          decimal.mark = ",", digit.separator = ".",
          digits = 2, star.cutoffs = c(0.30, 0.20, 0.10),
          notes.label = "Notas:", font.size = "tiny")

Referências

lfpdroubi/appraiseR documentation built on April 14, 2024, 10:27 p.m.