#Preguntas Teóricas (50 puntos)

#1. (10 puntos) Explique el método de maxima verosimilitud y muestre que en caso de #una distribución normal, el modelo de regresión lineal entrega el mismo estimador #que el método de OLS.

El método de máxima similitud posee como función principal estimar los valores de los parámetros, en una muestra finita. La función de verosimilitud nos indica que probabilidad existe de reproducir nuestra muestra observada en función de los posibles valores que pueden tomar los datos, es decir el fin principal de este es maximizar esta función. En conclusión este método nos indica que seleccionaremos como valor estimado de los parámetro como los que tienen una mayor probabilidad de ocurrencia en base a lo observado.

En el modelo a continuación demostraremos que en el caso de una distribución normal , el modelo de regresión entrega el mismo estimar que OLS. Por esto mismo asumimos la distribución como normal.

Imagen 1

Imagen 2

Esto quiere decir que si se asume un proceso de optimización/maximización de la probabilidad de la muestra , asumiendo normalidad nos arrojan el mismo estimador al minimizar . Cabe mencionar que el MCO no asume distribución para el error.

#2. (10 puntos) Muestre que bajo los supuestos clásicos, el modelo OLS es insesgado #y explique por qué esto es importante para el modelamiento

En la estimación existen una serie de supuestos que nos logran demostrar que el estimador es insesgado. Entonces el estimador MCO de los coeficientes es insesgado bajo los siguientes supuesto:

S1.El modelo debe ser lineal en los parámetros. S2.Media debe ser nula y exogenicidad estricta. Media nula:

Imagen 3 Exogeneidad estricta:

Imagen 4 S3. no multicolinealidad perfecta

Este supuesto se refiere principalmente a que no existen relaciones lineales perfectas en las variables explicativas, y a la vez ninguna de estas variables es constante. Falta correlación. Además, cabe mencionar que no se presenta correlación perfecta, si existe esta no se pueden obtener los estimadores MCO.

S4.Homocedasticidad.

Con en supuesto nos referimos a que la varianza del error debe ser independiente a los valores de la variables explicativas , es decir Y variables dependiente nos depende de las variables explicativas. Además esta varianza del error debe ser constante.

S5.No autocorrelacion

Los términos de error no deben estar condicionadas a los valores de x , es decir estas no deben mostrar ninguna correlación , por ende si nuestras muestras son aleatorias no existe autocorrelación .

Demostración B(gorro) es insesgado:

Imagen 5

#3. (10 puntos) Suponga que el modelo verdadero es el siguiente:

#yi = α0 + α1xi + α3zi + ei (1)

#Suponga, sin embargo, que usted estima lo siguiente

#yi = β0 + β1xi + ui (2)

#Muestre que βˆ1 es sesgado y compute el sesgo

La demostración de sesgamiento de beta es la siguiente :

Imagen 6 Como podemos ver en nuestra estimación si existe sesgo y el cual es como se ve demostrado.

#4. (10 puntos) Explique de que forma saber lo anterior puede ser de utilidad y como #lo utilizarıa en el d´ıa a dıa de su modelamiento. De un ejemplo

Según lo presentado en la respuesta anterior , podemos ver que es de gran utilidad cuando nuestro beta se demuestra sesgado , identificamos la dirección de sesgamiento que presentan . De este mismo modo si nuestro modelo presenta cierta consistencias y sesgamiento , nos permite la inclusión de variables que no se pueden cuantificar de una manera fácil . Hoy en día nos encontramos en una sociedad dinámica , donde es muy importante la adaptación a los cambios , por ende al realizar nuestra modelos predictivos evidenciamos sesgamiento de nuestra variables . Los modelos se tornan más complejos cuando existe este , por esto mismo es necesario el reconocimiento y neutralización del sesgo presente en nuestros datos .

El fin principal de incorporar estas variables en nuestro modelos es poder examinar de una manera más eficaz la posible heterogeneidad en las muestras de estudio. Lo visto anteriormente se puede evidenciar si queremos estimar un modelo que nos permita ver como variable dependiente , la discriminacion salarial existente entre hombres y mujeres , donde existen ciertas variables independientes no observables y medibles . Por ende ocupamos estas para evidenciar la dirección de sesgamiento.

#5. (10 puntos) Explique las tres principales t´ecnicas de cross validation y detalle los #pros y contras de cada una. Explique por qu´e siempre es importante al menos #realizar una de ellas al estimar un modelo

Las tres principales técnicas de cross validation son The Validation Set Aproach, K-Folds cross validation y Bootstrap. No obstante, cada una de estas posee pros y contras. En primer lugar, el Validation Set Aproach lo que hace es dividir la muestra entre testeo y entrenamiento de forma aleatoria para así poder estimar el modelo y probarlo, sin embargo, tiene ciertos problemas. El primer problema es que la varianza del error varía dependeinod de qué datos se incluyen en ambos conjuntos, otro problema, que se pierden observaciones para entrenar el modelo cuando se parte el dataser. En segundo lugar, el K-Folds Cross Validation tiene como objetivo entrenar el modelo pero con k grupos de datos, este k ojala sea entre 5 y 10. Asimismo, también contiene ciertos problemas y es que al usar datos que tengan un gran parentesco entre sí, puede causar overfitting. Por último, Bootstrap estima el modelo con una sola muestra y a medida que vayan avanzando, seguirán construyendo con nuevas muestras la estimación del modelo. En suma de lo anterior, cabe destacar que el problema de esta técnica es que si se estima mal, el resultado que se entregará vendrá con un gran error. Si bien estas técnicas para el cross validation no son perfectas, es importante realizar al menos una de estas al estimar un modelo. Esto es debido a que con estas técnicas se pueden evaluar los modelos y evitar caer en overfitting o underfitting.

#Preguntas de Desarrollo (50 puntos)

Librerias:

library('readxl')  
library('dplyr')               
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library('kdensity')            
library('tidyverse')
## ── Attaching packages
## ───────────────────────────────────────
## tidyverse 1.3.2 ──
## ✔ ggplot2 3.3.6     ✔ purrr   0.3.4
## ✔ tibble  3.1.7     ✔ stringr 1.4.1
## ✔ tidyr   1.2.0     ✔ forcats 0.5.2
## ✔ readr   2.1.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
library('car')
## Loading required package: carData
## 
## Attaching package: 'car'
## 
## The following object is masked from 'package:purrr':
## 
##     some
## 
## The following object is masked from 'package:dplyr':
## 
##     recode
library('boot')
## 
## Attaching package: 'boot'
## 
## The following object is masked from 'package:car':
## 
##     logit
library('QuantPsyc')
## Loading required package: MASS
## 
## Attaching package: 'MASS'
## 
## The following object is masked from 'package:dplyr':
## 
##     select
## 
## 
## Attaching package: 'QuantPsyc'
## 
## The following object is masked from 'package:base':
## 
##     norm
library('ggplot2')  
library('Metrics')
library(readr)
library(caret)
## Loading required package: lattice
## 
## Attaching package: 'lattice'
## 
## The following object is masked from 'package:boot':
## 
##     melanoma
## 
## 
## Attaching package: 'caret'
## 
## The following objects are masked from 'package:Metrics':
## 
##     precision, recall
## 
## The following object is masked from 'package:purrr':
## 
##     lift
#install.packages("mlr3")
library(mlr3)

library(caret)
#install.packages("skimr")
library(skimr)
## 
## Attaching package: 'skimr'
## 
## The following object is masked from 'package:mlr3':
## 
##     partition
#install.packages("DataExplorer")
library(DataExplorer)
#install.packages("rsample")
library(rsample)

PARTE 1 PRACTICO:

Antes, es importante setear una semilla:

set.seed(123)


x_i <- rnorm(1000, mean=2, sd=1)

z_i <- rnorm(1000, mean=5, sd=1)

error <- rnorm(1000, mean=0, sd=0.1)

y = 0.5 + 0.2*x_i + 2*z_i + error

summary(y)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   4.501   9.529  11.032  10.986  12.422  17.896
plot(x_i,y)

plot(z_i,y)

m1=lm(y~x_i+z_i)
summary(m1)
## 
## Call:
## lm(formula = y ~ x_i + z_i)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.28360 -0.06277 -0.00370  0.06538  0.33787 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 0.488452   0.016538   29.53   <2e-16 ***
## x_i         0.197851   0.003134   63.12   <2e-16 ***
## z_i         2.002751   0.003079  650.55   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.09788 on 997 degrees of freedom
## Multiple R-squared:  0.9977, Adjusted R-squared:  0.9977 
## F-statistic: 2.188e+05 on 2 and 997 DF,  p-value: < 2.2e-16
coefficients(m1)
## (Intercept)         x_i         z_i 
##   0.4884515   0.1978509   2.0027507
qqnorm(m1$residuals)
qqline(m1$residuals)

Kernell REAL:

y_gorro = 1.4992 + x_i*0.2005 + 1.9998*z_i

y_obs2 <- matrix(y_gorro, nrow=1000, byrow=TRUE)


kdens_obs <- kdensity(y_obs2,
                  bw = NULL,
                  adjust = 1,
                  kernel = NULL,
                  start = NULL,
                  support = NULL,
                  na.rm = FALSE,
                  normalized = TRUE,
                  tolerance = 0.01
                  )

kdens_obs
## 
## Call:
## kdensity(x = y_obs2, bw = NULL, adjust = 1, kernel = NULL, start = NULL,     support = NULL, na.rm = FALSE, normalized = TRUE, tolerance = 0.01)
## 
## Data:      y_obs2 (1000 obs.)
## Bandwidth: 0.4625 ('nrd0')
## Support:   (-Inf, Inf)
## Kernel:    gaussian
## Start:     uniform
plot(kdens_obs)

x_i <- as.matrix(x_i)
y <- as.matrix(y)

LSE <- mean((y-x_i%*%0.2005)^2)

plot1 <- density(x_i%*%0.2005)

plot_real <- density(y)

plot(plot1, main= "kernell PREDICHO")

plot(plot_real, main= "kernell REAL")

Conclusiones:

Claramente el kernell predicho posee una desviacion respecto al real. Por lo tanto, estamos en presencia de un sesgo POSITIVO. Esto era esperable dado que faltaba la variable z_i.

  1. (10 puntos) Descargue la base de datos en R
data <- read_csv("C:/Users/matir/Downloads/real_estate.csv")
## Rows: 581 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (4): precio, N_dormitorios, N_banos, superficie
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
head(data)
## # A tibble: 6 × 4
##   precio N_dormitorios N_banos superficie
##    <dbl>         <dbl>   <dbl>      <dbl>
## 1  12.9              3       1         57
## 2  12.4              3       1         50
## 3   9.07             2       1         48
## 4  13.0              3       1         57
## 5  13.9              3       2         80
## 6  11.9              3       1         55
  1. (10 puntos) Realice un an´alisis visual de las principales variables y explique sus resultados
skim(data)
Data summary
Name data
Number of rows 581
Number of columns 4
_______________________
Column type frequency:
numeric 4
________________________
Group variables None

Variable type: numeric

skim_variable n_missing complete_rate mean sd p0 p25 p50 p75 p100 hist
precio 0 1 12.66 5.05 4.71 9.86 11.51 13.89 51.59 ▇▂▁▁▁
N_dormitorios 0 1 2.57 0.87 1.00 2.00 3.00 3.00 6.00 ▆▇▁▁▁
N_banos 0 1 1.61 0.70 1.00 1.00 2.00 2.00 4.00 ▇▆▁▂▁
superficie 0 1 68.37 31.44 21.00 50.00 60.00 78.00 350.00 ▇▂▁▁▁ 
summary(data)
##      precio      N_dormitorios      N_banos        superficie    
##  Min.   : 4.71   Min.   :1.000   Min.   :1.000   Min.   : 21.00  
##  1st Qu.: 9.86   1st Qu.:2.000   1st Qu.:1.000   1st Qu.: 50.00  
##  Median :11.51   Median :3.000   Median :2.000   Median : 60.00  
##  Mean   :12.66   Mean   :2.573   Mean   :1.614   Mean   : 68.37  
##  3rd Qu.:13.89   3rd Qu.:3.000   3rd Qu.:2.000   3rd Qu.: 78.00  
##  Max.   :51.59   Max.   :6.000   Max.   :4.000   Max.   :350.00
data %>% map_dbl(.f = function(x){sum(is.na(x))})
##        precio N_dormitorios       N_banos    superficie 
##             0             0             0             0
plot_missing(
  data    = data, 
  title   = "Porcentaje de valores ausentes",
  ggtheme = theme_bw(),
  theme_config = list(legend.position = "none")
)

Luego de ejecutar este comando, concluimos que NO hay datos faltantes en la base.

ggplot(data=data, aes(x=precio)) + geom_boxplot() + theme_classic()

ggplot(data=data, aes(x=N_dormitorios)) + geom_boxplot() + theme_classic()

ggplot(data=data, aes(x=N_banos)) + geom_boxplot() + theme_classic()

ggplot(data=data, aes(x=superficie)) + geom_boxplot() + theme_classic()

Si bien los datos se encuentran bastante homogeoneos, encontramos una serie de outliers en ciertas variables: - Precio => consideraremos datos atípicos aquellos que sean mayores a 50 UF. - Superficie => creemos que una superficie mayor a 300 metros resulta ser algo poco común en departamentos.

data <- data %>%
  filter(precio < 40) %>%
  filter(superficie < 300)
hist(data$precio)

hist(data$N_dormitorios)

hist(data$N_banos)

hist(data$superficie)

Plot Density para variables continuas:

plot_density(
  data    = data,
  ncol    = 3,
  title   = "Distribución variables continuas",
  ggtheme = theme_bw(),
  theme_config = list(
                  plot.title = element_text(size = 16, face = "bold"),
                  strip.text = element_text(colour = "black", size = 12, face = 2)
                 )
  )

Matriz de correlación:

plot_correlation(
  data = data,
  type = "continuous",
  title = "Matriz de correlación variables continuas",
  theme_config = list(legend.position = "none",
                      plot.title = element_text(size = 16, face = "bold"),
                      axis.title = element_blank(),
                      axis.text.x = element_text(angle = -45, hjust = +0.1)
                     )
)

  1. (10 puntos) Estime tres modelos diferentes utilzidando el m´etodo de OLS y compare los ECM
modelo1 <- lm(precio~superficie, data=data, na.action= na.exclude)

summary(modelo1)
## 
## Call:
## lm(formula = precio ~ superficie, data = data, na.action = na.exclude)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -7.9403 -1.6548 -0.1599  1.5367 16.4244 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 4.231329   0.305255   13.86   <2e-16 ***
## superficie  0.122732   0.004159   29.51   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.854 on 577 degrees of freedom
## Multiple R-squared:  0.6014, Adjusted R-squared:  0.6007 
## F-statistic: 870.6 on 1 and 577 DF,  p-value: < 2.2e-16
mse1 <- mse(data$precio, predict(modelo1, data))
mse1
## [1] 8.115692
modelo2 <- lm(precio~superficie + N_dormitorios, data=data, na.action= na.exclude)

summary(modelo2)
## 
## Call:
## lm(formula = precio ~ superficie + N_dormitorios, data = data, 
##     na.action = na.exclude)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -7.9094 -1.6582 -0.1568  1.5208 16.4230 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)    4.273099   0.376999  11.335   <2e-16 ***
## superficie     0.123522   0.005897  20.946   <2e-16 ***
## N_dormitorios -0.037137   0.196384  -0.189     0.85    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.856 on 576 degrees of freedom
## Multiple R-squared:  0.6014, Adjusted R-squared:  0.6001 
## F-statistic: 434.6 on 2 and 576 DF,  p-value: < 2.2e-16
mse2 <- mse(data$precio, predict(modelo2, data))

mse2
## [1] 8.115188
modelo3 <- lm(precio~superficie + N_dormitorios + N_banos, data=data, na.action= na.exclude)

summary(modelo3)
## 
## Call:
## lm(formula = precio ~ superficie + N_dormitorios + N_banos, data = data, 
##     na.action = na.exclude)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -8.1096 -1.7472 -0.1087  1.3828 16.2376 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)    3.829400   0.386144   9.917  < 2e-16 ***
## superficie     0.105517   0.007207  14.642  < 2e-16 ***
## N_dormitorios -0.032486   0.193574  -0.168    0.867    
## N_banos        1.025738   0.242696   4.226 2.76e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.815 on 575 degrees of freedom
## Multiple R-squared:  0.6135, Adjusted R-squared:  0.6114 
## F-statistic: 304.2 on 3 and 575 DF,  p-value: < 2.2e-16
mse3 <- mse(data$precio, predict(modelo3, data))

mse3
## [1] 7.87068
mses <- c(mse1,mse2,mse3)
print(paste("El menor ECM de los tres modelos es del Modelo 3, siendo:", round(min(mses),3)))
## [1] "El menor ECM de los tres modelos es del Modelo 3, siendo: 7.871"

El modelo 3 posee el menor Error Cuadratico Medio.

  1. (10 puntos) Separe la muestra entre entrenamiento y testeo y estime los mismos modelos. Compare sus ECM utilizando ahora el test sample. ¿Qu´e modelo elige en este caso?

Division muestra entre entrenamiento (train) y testeo (test):

## 80% tamaño de test:
test_size <- floor(0.8 * nrow(data))

## ponemos semilla para hacer particion reproducible:
set.seed(123)
train_ind <- sample(seq_len(nrow(data)), size = test_size)

train <- data[train_ind, ]
test <- data[-train_ind, ]
modelo1_train <- train(precio ~ superficie, 
      data = train, 
      method = "lm")

predicciones_modelo1 <- predict(modelo1_train, newdata = test,
                            type = "raw")



mse1_test <- mse(data$precio, predict(modelo1_train, test))
## Warning in actual - predicted: longitud de objeto mayor no es múltiplo de la
## longitud de uno menor
mse1_test
## [1] 35.72565
modelo2_train <- train(precio ~ superficie + N_dormitorios, 
      data = train, 
      method = "lm")


predicciones_modelo2 <- predict(modelo2_train, newdata = test,
                            type = "raw")



mse2_test <- mse(data$precio, predict(modelo2_train, test))
## Warning in actual - predicted: longitud de objeto mayor no es múltiplo de la
## longitud de uno menor
mse2_test
## [1] 35.72573
modelo3_train <- train(precio ~ superficie + N_dormitorios + N_banos, 
      data = train, 
      method = "lm")


predicciones_modelo3 <- predict(modelo3_train, newdata = test,
                            type = "raw")



mse3_test <- mse(data$precio, predict(modelo3_train, test))
## Warning in actual - predicted: longitud de objeto mayor no es múltiplo de la
## longitud de uno menor
mse3_test
## [1] 35.74254
mses_test <- c(mse1_test,mse2_test,mse3_test)
print(paste("El menor ECM de los tres modelos, una vez implementados en la muestra de prueba, es el del Modelo 2, con un valor de:", round(min(mses_test),3)))
## [1] "El menor ECM de los tres modelos, una vez implementados en la muestra de prueba, es el del Modelo 2, con un valor de: 35.726"

Como conclusión, nuestros resultados cambian al testear el modelo en la muestra de prueba. Antes de evaluarlos, el menor ECM pertenecía al Modelo 3. Luego del testeo, el menor ECM pasa a ser el del Modelo 2.