Informe de aplicación de regresión lineal

Punto 1

Predicción de los precios de las acciones

Análisis exploratorio

Se observa que la base de datos contiene información sobre el registro de los los precios de las Acciones de Ecopetrol(x) según la variación del precio del barril de petróleo WTI(y) 1.2. Se observa que el promedio de los precio de las acciones es Us 0.263 con una desviación estándar de Us 0.0186, mientras el promedio de precio WTI por barril es Us 35,5 con una desviación estándar de Us 2.12 , también se observa que existe una relación lienal exponencial del precio del barril hasta US 0.26 de valor de acción de ahi el precio del barril es inversamente proporcional al valor de la acción tiende a decrecer.

Se transforma los valores de prec_acciones a dolar segun TRM 17/08/2022 1 USD = $4218,48

prec_acciones=c(1090, 1170, 1160, 1230, 1155, 1165, 1205, 1170, 1150, 1130, 1110, 1105, 1085, 1060, 1035, 1015, 955, 961) 
  
prec_barril=c(35.62,36.31,37.35,34.95,34.53,35.81,36.14,37.50,37.80,36.81,37.87,37.04,36.76,35.97,33.97,33.27,31.41,30.44)

ecopetrol=data.frame(precio_acciones=prec_acciones,precio_barril=prec_barril)

usd=4218.48

ecopetrol$precio_acciones=ecopetrol$precio_acciones/usd
head(ecopetrol)

##   precio_acciones precio_barril
## 1       0.2583869         35.62
## 2       0.2773511         36.31
## 3       0.2749806         37.35
## 4       0.2915742         34.95
## 5       0.2737953         34.53
## 6       0.2761658         35.81

summary(ecopetrol)

##  precio_acciones  precio_barril  
##  Min.   :0.2264   Min.   :30.44  
##  1st Qu.:0.2528   1st Qu.:34.63  
##  Median :0.2655   Median :36.05  
##  Mean   :0.2627   Mean   :35.53  
##  3rd Qu.:0.2759   3rd Qu.:36.98  
##  Max.   :0.2916   Max.   :37.87

attach(ecopetrol)

table1(~precio_acciones+precio_barril,data=ecopetrol)

	Overall (N=18)
precio_acciones
Mean (SD)	0.263 (0.0186)
Median [Min, Max]	0.265 [0.226, 0.292]
precio_barril
Mean (SD)	35.5 (2.12)
Median [Min, Max]	36.1 [30.4, 37.9]

#plot(ecopetrol$precio_barril, ecopetrol$precio_acciones,main = "Diagrama de dispersión",xlab = "Precio Barril(US)", ylab = "Precio Acciones(US) ",pch=16)

g1=ggplot(data=ecopetrol,aes(y=precio_barril,x=precio_acciones)) + geom_point() + geom_smooth()
ggplotly(g1)

modelo de regresión lineal simple

Veamos la correlación entre precio_acciones y precio_barril Se observa que a mayor precio_acciones el precio_barril aumenta y su relación es positiva de acuerdo con el coeficiente de correlación de Pearson (0,7074).
Se observa que el coeficiente $\beta_0$ no se debe interpretar por que no se observan valores de precio del barril en cero. Por otro lado el $\beta_1=0.006209$ nos indica que por cada metro cuadrado que se aumente el precio se incrementa en 0.006209 pesos.
De igual forma el area construida tiene codigos de significancia **, signfica que su relación es significante con el precio del barril
Ecuación de regresión $precio_acciones(US)$=$0.042140$+$0.006209$*$precio_barril$ , Se observa que el ajuste del modelo es de $R^2=0.5005$ es decir que el modelo explica el 50% de la variabilidad de las acciones.
Intervalo de confianza (95%) para el coeficiente $\beta_1$

El efecto que tiene precio_barril en el precio de las acciones oscila entre 0.003169096 y 0.009248904, como el cero no está incluido en el intervalo esto reafirma la significancia del precio del barril frente al precio de las acciones, pero este es minimo.

cor(precio_barril,ecopetrol$precio_acciones,use ="complete.obs" )

## [1] 0.7074373

mod_ecopetrol=lm(precio_acciones~precio_barril,data=ecopetrol)
summary(mod_ecopetrol)

## 
## Call:
## lm(formula = precio_acciones ~ precio_barril, data = ecopetrol)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -0.014199 -0.009657 -0.003779  0.007918  0.032433 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)   
## (Intercept)   0.042140   0.055192   0.764  0.45627   
## precio_barril 0.006209   0.001551   4.004  0.00102 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.01354 on 16 degrees of freedom
## Multiple R-squared:  0.5005, Adjusted R-squared:  0.4692 
## F-statistic: 16.03 on 1 and 16 DF,  p-value: 0.001024

t=qnorm(0.975)
li=0.006209 -(t* 0.001551)
ls=0.006209 +(t* 0.001551)
inter_conf=data.frame(li,ls)
inter_conf

##            li          ls
## 1 0.003169096 0.009248904

confint(object=mod_ecopetrol, level=0.95)

##                      2.5 %    97.5 %
## (Intercept)   -0.074862196 0.1591427
## precio_barril  0.002921407 0.0094964

Validación de supuestos del modelo por medio de graficos
Media cero: Se cumple por defecto.
Varianza Constante: Se observa en la grafica 1 de residuales vs ajustados que el comportamiento no es aleatorio mostrando una leve curva hacia abajo, lo que indica que no existe varianza constante y no se cumple este supuesto, se debe relaizar tranformaciones al modelo.
Normalidad: Se observa en la grafica 2 que los datos se ajustan bien a la linea de normalidad en el qqplot
Independencia: Dado que estos registros no corresponden a datos en el tiempo no se tiene un orden temporal para realizar la validación de este supuesto.

par(mfrow=c(2,2))
plot(mod_ecopetrol)

Concluya sobre la validez del modelo

El modelo explica el 50% de la variabilidad de las acciones, lo que constituye un ajuste regular, ademas no cumple con los supuestos de varianza constante lo que significa que el error incide de la predicción de los precios de las acciones, se sugire usar tranformaciones Box Cox para mejorar el ajuste del modelo.

Punto 2

Predicción del salario minimo legal mensual con base a la inflación (COL)

Los siguientes datos corresponden a la INFLACION y al SALARIO MINIMO LEGAL MENSUAL (SMLM) desde el año 1999 para Colombia.

La idea es establecer un modelo de regresión que ayude a determinar el comportamiento de estas dos variables tomando como variable dependiente SALARIO MINIMO LEGAL MENSUAL (SMLM) y como variable independiente INFLACION obtenga un modelo de regresión lineal simple y resuelva:

INFLACION=c(9.23, 8.75, 7.65, 6.99, 6.49, 5.50, 4.85, 4.48, 5.69, 7.67, 2.00, 3.17,3.73, 2.44,  1.94, 3.66, 6.77)  
  
SMLM=c(236460, 260100, 286000, 309000, 332000, 358000, 381500, 408000, 433700,461500, 496900, 515000, 535600, 566700, 589500, 616027, 644350) 

Base2 = data.frame(INFLACION, SMLM)
head(Base2)

##   INFLACION   SMLM
## 1      9.23 236460
## 2      8.75 260100
## 3      7.65 286000
## 4      6.99 309000
## 5      6.49 332000
## 6      5.50 358000

Análisis Exploratorio

Se aplica summary a las 2 variables con las que trabajaremos INFLACION y SMLM, para el caso de INFLACION (variable independiente) tenemos una media de 5.1 mientras que su mínimo es de 1.9 y su máximo de 9.2**

summary(Base2$INFLACION)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   1.940   3.660   5.500   5.354   6.990   9.230

En cuanto a SMLM (variable dependiente) tenemos una media de 437079 mientars que su minimo es de 236460 y su maximo de 644350**

summary(Base2$SMLM)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  236460  332000  433700  437079  535600  644350

g2=ggplot(data=Base2,aes(y=SMLM,x=INFLACION)) + geom_point() + geom_smooth()
ggplotly(g2)

Realizamos una grafica utilizando ggplotly, en esta grafica podemos ver que mientras mas alta sea la variable INFLACION incrementa la variable SMLM disminute, sin embargo, algunos puntos se encuentran fuera de esta tendencia**

Escriba la ecuación del modelo de regresión lineal simple

mod1= lm(formula = SMLM~INFLACION, data=Base2)
summary(mod1)

## 
## Call:
## lm(formula = SMLM ~ INFLACION, data = Base2)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -75463 -63456 -42854  17623 263207 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   648486      58947   11.00  1.4e-08 ***
## INFLACION     -39489      10151   -3.89  0.00145 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 94130 on 15 degrees of freedom
## Multiple R-squared:  0.5022, Adjusted R-squared:  0.469 
## F-statistic: 15.13 on 1 and 15 DF,  p-value: 0.00145

plantee y valide las hipótesis correspondientes a la linealidad general del modelo propuesto en a)

Hipótesis para H0 H0:β = 0 -> NO Existe relacion entre las variables

Hipótesis para H1 H1:β ≠ 0 -> Existe relacion entre las variables

Análisis: Como evidenciamos en los resultados del summary el valor que se obtuvo para p-value es de 0.00145, lo que automáticamente rechazaría ha H0 lo que sugeriría que existe una relacion lineal entre las variables

cor(Base2$SMLM,Base2$INFLACION)

## [1] -0.7086581

indique e interprete el coeficiente de correlación del modelo propuesto en a)

cor(Base2$SMLM,Base2$INFLACION)

## [1] -0.7086581

Analisis: La correlacion existente entre la variable independiente INFLACION y la variable dependiente SMLM es de -0.7086 lo que indicaria que existe una relacion negativa debil entre las variables estudiadas.**

Interprete cada uno de los coeficientes del modelo propuesto en a)

mod1

## 
## Call:
## lm(formula = SMLM ~ INFLACION, data = Base2)
## 
## Coefficients:
## (Intercept)    INFLACION  
##      648486       -39489

Análisis: lo que podemos observar es que el coeficiente β0 es de 648486 lo que indica que si no hay inflación el SMLM sería este, mientras que por cada unidad que incrementa la variable independiente INFLACION, disminuyen en 39482 de la variable dependiente SMLM.**

Construya una gráfica de residuales y haga un análisis cualitativo de los supuestos del modelo propuesto en a)

par(mfrow = c(2, 2))
plot(mod1,pch=16)

Análisis Supuestos

- Linealidad: Tiene correlacion Lineal.

cor.test(Base2$SMLM,Base2$INFLACION)

## 
##  Pearson's product-moment correlation
## 
## data:  Base2$SMLM and Base2$INFLACION
## t = -3.89, df = 15, p-value = 0.00145
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.8871337 -0.3457958
## sample estimates:
##        cor 
## -0.7086581

- Normalidad: No se cumple el supuesto de normalidad nuestro p-value = 0.001407 por lo que es menor a 0.05

shapiro.test(mod1$residuals)

## 
##  Shapiro-Wilk normality test
## 
## data:  mod1$residuals
## W = 0.78826, p-value = 0.001407

- Homocedatidad (Varianza Constante): No se evidencia Homocedaticidad por lo que se cosidera un modelo heterocedatico el cual no tiene una varianza constante y cuya P corresponde a 0.26185

ncvTest(mod1)

## Non-constant Variance Score Test 
## Variance formula: ~ fitted.values 
## Chisquare = 1.258961, Df = 1, p = 0.26185

- Independencia: los errores no son independientes p-value = 0.0002714

lmtest::dwtest(mod1)

## 
##  Durbin-Watson test
## 
## data:  mod1
## DW = 0.68432, p-value = 0.0002714
## alternative hypothesis: true autocorrelation is greater than 0

Comente sobre la conveniencia de usar el modelo propuesto en a) para predecir el SMLM para Colombia.

RTA. El modelo nos dio como resultado un coeficiente R2 de 0.5022 lo que indicaria que la variable INFLACION explica el 50% del SMLM por lo que se considerá un coeficiente muy bajo, por lo que no es suficiente para predecir la variable SMLM, sin embargo podría ser utilizado para predecir el impacto de INFLACION sobre un salario mínimo específico.

Punto 3

Predicción de precio de viviendas

Con base en los datos de precios de vivienda de la actividad en clase realizar un informe que contenga los siguientes puntos utilizando R y RMarkdown (publicar el informe final en Rpubs presentando código, resultados e interpretaciones).

Datos_Vivienda = read_excel("C:/Mesa/Aplicación regresión lineal/Datos_Vivienda.xlsx", 
    col_types = c("text", "text", "numeric", 
        "numeric", "numeric", "numeric", 
        "numeric", "numeric", "text", "text", 
        "numeric", "numeric", "numeric"))
head(Datos_Vivienda)

## # A tibble: 6 × 13
##   Zona  piso  Estrato preci…¹ Area_…² parqu…³ Banos Habit…⁴ Tipo  Barrio corde…⁵
##   <chr> <chr>   <dbl>   <dbl>   <dbl>   <dbl> <dbl>   <dbl> <chr> <chr>    <dbl>
## 1 Zona… 2           6     880     237       2     5       4 Casa  pance    -76.5
## 2 Zona… 2           4    1200     800       3     6       7 Casa  miraf…   -76.5
## 3 Zona… 3           5     250      86      NA     2       3 Apar… multi…   -76.5
## 4 Zona… NA          6    1280     346       4     6       5 Apar… ciuda…   -76.5
## 5 Zona… 2           6    1300     600       4     7       5 Casa  pance    -76.5
## 6 Zona… 3           6     513     160       2     4       4 Casa  pance    -76.5
## # … with 2 more variables: Cordenada_latitud <dbl>, Estrato2 <dbl>, and
## #   abbreviated variable names ¹precio_millon, ²Area_contruida, ³parqueaderos,
## #   ⁴Habitaciones, ⁵cordenada_longitud
## # ℹ Use `colnames()` to see all variable names

Realice un filtro a la base de datos e incluya solo las ofertas de apartamentos, de la zona norte de la ciudad con precios inferiores a los 500 millones de pesos y áreas menores a 300 mt2. Presente los primeros 3 registros de la base y algunas tablas que comprueben la consulta. (Adicional un mapa con los puntos de la base, discutir si todos los puntos se ubican en la zona norte o se presentan valores en otras zonas, por que?).

filter1 = filter(Datos_Vivienda, Datos_Vivienda$Tipo == "Apartamento",Datos_Vivienda$Zona == "Zona Norte",Datos_Vivienda$precio_millon<500,Datos_Vivienda$Area_contruida<300)
head(filter1,3)

## # A tibble: 3 × 13
##   Zona  piso  Estrato preci…¹ Area_…² parqu…³ Banos Habit…⁴ Tipo  Barrio corde…⁵
##   <chr> <chr>   <dbl>   <dbl>   <dbl>   <dbl> <dbl>   <dbl> <chr> <chr>    <dbl>
## 1 Zona… 2           3     135      56       1     1       3 Apar… torre…   -76.5
## 2 Zona… NA          3      78      54       2     1       3 Apar… chimi…   -76.5
## 3 Zona… NA          5     340     106       2     2       3 Apar… la fl…   -76.5
## # … with 2 more variables: Cordenada_latitud <dbl>, Estrato2 <dbl>, and
## #   abbreviated variable names ¹precio_millon, ²Area_contruida, ³parqueaderos,
## #   ⁴Habitaciones, ⁵cordenada_longitud
## # ℹ Use `colnames()` to see all variable names

print(filter1)

## # A tibble: 1,077 × 13
##    Zona       piso  Estrato precio_…¹ Area_…² parqu…³ Banos Habit…⁴ Tipo  Barrio
##    <chr>      <chr>   <dbl>     <dbl>   <dbl>   <dbl> <dbl>   <dbl> <chr> <chr> 
##  1 Zona Norte 2           3       135      56       1     1       3 Apar… torre…
##  2 Zona Norte NA          3        78      54       2     1       3 Apar… chimi…
##  3 Zona Norte NA          5       340     106       2     2       3 Apar… la fl…
##  4 Zona Norte 1           3       135     103       1     3       4 Apar… calim…
##  5 Zona Norte 1           3        75      54       1     2       3 Apar… calim…
##  6 Zona Norte NA          4       175      77       1     2       3 Apar… urban…
##  7 Zona Norte NA          3        99      58      NA     1       3 Apar… comfe…
##  8 Zona Norte 1           3        95      55      NA     2       3 Apar… brisa…
##  9 Zona Norte 2           3       110      57       1     2       3 Apar… puent…
## 10 Zona Norte 3           3       155      62       1     2       3 Apar… villa…
## # … with 1,067 more rows, 3 more variables: cordenada_longitud <dbl>,
## #   Cordenada_latitud <dbl>, Estrato2 <dbl>, and abbreviated variable names
## #   ¹precio_millon, ²Area_contruida, ³parqueaderos, ⁴Habitaciones
## # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names

require(leaflet)
leaflet() %>%  addCircleMarkers(lng=filter1$cordenada_longitud, lat=filter1$Cordenada_latitud,radius = 0.8,color = "blue",label = filter1$ID)%>% addTiles()

Discusión: Podemos evidenciar que con base a los filtros de tipo de vivienda “Apartamento”, Zona “Norte”, precio menor a “500M” y área construida menor a “300” la mayoría de las ubicaciones son referenciadas en la zona Norte de la ciudad, mientras que otros puntos se encuentran en zonas diferentes, esto se debe a que las coordenadas registradas no estan correctas por lo que pudo deberse a errores a la hora de registrar el inmueble

Realice un análisis exploratorio de datos enfocado en la correlación entre la variable respuesta (precio del apartamento) en función del área construida, estrato y si tiene parqueadero. Use gráficos interactivos con plotly e interprete los resultados.

summary(filter1$precio_millon)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    65.0   132.0   220.0   233.8   320.0   495.0

summary(filter1$Area_contruida)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   35.00   60.00   76.00   85.94  100.00  287.00

g3=ggplot(data=filter1,aes(y=precio_millon,x=Area_contruida)) + geom_point() + geom_smooth()
ggplotly(g3)

filtro2 = filter1
filtro2=na.omit(filtro2)
filtro2$Estrato=as.character(filtro2$Estrato)
g3=ggplot(filtro2,aes(x=Area_contruida,y=precio_millon,color=Estrato))+geom_point()+theme_bw()+geom_smooth(method = "lm")
ggplotly(g3)

Analisis: Se logra observar en la figura que la relacion area_contruida y precios_millon es muy fuerte, ya que como se esperaria, a medida que el area aumenta tambien lo hace el precio, adicional, por estrato se evidencia que entre mas alto es el estrato hay un incremento en el precio y el area_contruida

#Media de precio_millon por parqueaderos 
tapply(filtro2$precio_millon,filtro2$parqueaderos, mean, na.rm = TRUE)

##        1        2        3        4 
## 226.3506 356.6178 390.0000 400.0000

filter1$parqueaderos_SI_NO=filter1$parqueaderos!="NA"
g4=ggplot(filter1,aes(x=parqueaderos_SI_NO,y=precio_millon,fill=parqueaderos_SI_NO))+geom_boxplot()+theme_bw()
ggplotly(g4)

Analisis: Se Evidencia que a mayor precio del inmueble es más probable que el mismo cuente con un parqueadero, el precio promedio de un inmueble que cuente con parqueadero es de 260 Millones, en caso de que alguien requiera un inmueble con parqueadero su inversión debe ser de mínimo 160Millones, ya que debajo de este precio es probable que no se encuentren inmuebles con parqueadero

Estime un modelo de regresión lineal múltiple con las variables del punto anterior e interprete los coeficientes si son estadísticamente significativos. Las interpretaciones deber están contextualizadas y discutir si los resultados son lógicos. Adicionalmente interprete el coeficiente R2 y discuta el ajuste del modelo e implicaciones (que podrían hacer para mejorarlo).

mod_vivienda = lm(formula = precio_millon ~ Area_contruida + Estrato + parqueaderos, data = filter1)
mod_vivienda

## 
## Call:
## lm(formula = precio_millon ~ Area_contruida + Estrato + parqueaderos, 
##     data = filter1)
## 
## Coefficients:
##    (Intercept)  Area_contruida         Estrato    parqueaderos  
##      -172.2131          0.7657         69.7759         42.9483

summary(mod_vivienda)

## 
## Call:
## lm(formula = precio_millon ~ Area_contruida + Estrato + parqueaderos, 
##     data = filter1)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -184.798  -37.957    0.529   31.854  231.856 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)    -172.21312   10.87566 -15.835  < 2e-16 ***
## Area_contruida    0.76566    0.08161   9.382  < 2e-16 ***
## Estrato          69.77587    2.89836  24.074  < 2e-16 ***
## parqueaderos     42.94832    5.24414   8.190 1.12e-15 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 56.62 on 751 degrees of freedom
##   (322 observations deleted due to missingness)
## Multiple R-squared:  0.7096, Adjusted R-squared:  0.7084 
## F-statistic: 611.6 on 3 and 751 DF,  p-value: < 2.2e-16

Realice la validación de supuestos del modelo e interprete los resultados (no es necesario corregir en caso de presentar problemas solo realizar sugerencias de que se podría hacer).

mod_vivienda$coefficients

##    (Intercept) Area_contruida        Estrato   parqueaderos 
##   -172.2131187      0.7656607     69.7758734     42.9483159

par(mfrow = c(2, 2))
plot(mod_vivienda,pch=16)

Análisis Supuestos

- Linealidad: Tiene correlacion Lineal.

cor.test(filter1$precio_millon,filter1$Area_contruida)

## 
##  Pearson's product-moment correlation
## 
## data:  filter1$precio_millon and filter1$Area_contruida
## t = 31.583, df = 1075, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.6614370 0.7235121
## sample estimates:
##       cor 
## 0.6937608

cor.test(filter1$precio_millon,filter1$Estrato)

## 
##  Pearson's product-moment correlation
## 
## data:  filter1$precio_millon and filter1$Estrato
## t = 47.519, df = 1075, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.8028225 0.8414486
## sample estimates:
##       cor 
## 0.8230851

cor.test(filter1$precio_millon,filter1$parqueaderos)

## 
##  Pearson's product-moment correlation
## 
## data:  filter1$precio_millon and filter1$parqueaderos
## t = 17.663, df = 753, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.4887773 0.5898250
## sample estimates:
##       cor 
## 0.5412523

- Normalidad: No se cumple el supuesto de normalidad nuestro p-value = 0.002832 por lo que es menor a 0.05

shapiro.test(mod_vivienda$residuals)

## 
##  Shapiro-Wilk normality test
## 
## data:  mod_vivienda$residuals
## W = 0.99366, p-value = 0.002832

- Homocedatidad (Varianza Constante): No se evidencia Homocedaticidad por lo que se cosidera un modelo heterocedatico el cual no tiene una varianza constante y cuya P corresponde a 2.22e-16

library(car)
ncvTest(mod_vivienda)

## Non-constant Variance Score Test 
## Variance formula: ~ fitted.values 
## Chisquare = 84.67655, Df = 1, p = < 2.22e-16

- Multicolinealidad: No se evidencia factor de Multicolinealidad lo que significa que no hay factores de iflacion de varianza

VIF(mod_vivienda)

## Area_contruida        Estrato   parqueaderos 
##       1.679942       1.477094       1.389209

Con el modelo identificado predecir el precio de un apartamento con 100 mt2, de estrato 4 y con parqueadero. ¿Si este apartamento lo están ofreciendo en 450 millones cual seria su opinión con base en el resultado del modelo considera que es una buena oferta?

mod_vivienda$coefficients

##    (Intercept) Area_contruida        Estrato   parqueaderos 
##   -172.2131187      0.7656607     69.7758734     42.9483159

prediccion=predict(mod_vivienda,list(Area_contruida=100,Estrato=4,parqueaderos=1))
prediccion

##        1 
## 226.4048

RTA. Con base a los datos obtenidos en el modelo se identifica que un apartamento en venta por 450 millones NO sería una buena oferta, ya que el modelo registra un precio medio para un inmueble con estas características de 226.4048 Millones

Con las predicciones del modelo sugiera potenciales ofertas para una persona interesada en un apartamento en la zona norte con mas de 100 mt2 de área, de estrato 4, que tenga parqueadero y tenga encuentra que la persona tiene un crédito preaprobado de máximo 400 millones de pesos. Realice un análisis y presente en un mapa al menos 5 ofertas potenciales que debe discutir.

precio_ejemplo=mod_vivienda$fitted.values
precio_real=filter1$precio_millon
area=filter1$Area_contruida
estrato=filter1$Estrato
parqueadero=filter1$parqueaderos_SI_NO

potenciales=precio_ejemplo-precio_real
target=potenciales>0&precio_real<=400&area>100&estrato=="4"&parqueadero==TRUE
table(target)

## target
## FALSE  TRUE 
##  1063     8

filter1$potenciales=potenciales

Apt_recomendados=filter1[target,]
Apt_recomendados

## # A tibble: 14 × 15
##    Zona       piso  Estrato precio_…¹ Area_…² parqu…³ Banos Habit…⁴ Tipo  Barrio
##    <chr>      <chr>   <dbl>     <dbl>   <dbl>   <dbl> <dbl>   <dbl> <chr> <chr> 
##  1 <NA>       <NA>       NA        NA      NA      NA    NA      NA <NA>  <NA>  
##  2 <NA>       <NA>       NA        NA      NA      NA    NA      NA <NA>  <NA>  
##  3 <NA>       <NA>       NA        NA      NA      NA    NA      NA <NA>  <NA>  
##  4 Zona Norte NA          4       350     130       1     2       3 Apar… la fl…
##  5 Zona Norte 1           4       290     108       1     2       3 Apar… la fl…
##  6 Zona Norte 4           4       185     104       1     3       3 Apar… san v…
##  7 Zona Norte NA          4       265     125       2     3       4 Apar… la fl…
##  8 <NA>       <NA>       NA        NA      NA      NA    NA      NA <NA>  <NA>  
##  9 Zona Norte 4           4       250     118       1     2       3 Apar… versa…
## 10 Zona Norte 7           4       315     125       1     3       4 Apar… cente…
## 11 <NA>       <NA>       NA        NA      NA      NA    NA      NA <NA>  <NA>  
## 12 Zona Norte 10          4       245     103       1     2       2 Apar… versa…
## 13 <NA>       <NA>       NA        NA      NA      NA    NA      NA <NA>  <NA>  
## 14 Zona Norte NA          4       310     120       1     3       2 Apar… san p…
## # … with 5 more variables: cordenada_longitud <dbl>, Cordenada_latitud <dbl>,
## #   Estrato2 <dbl>, parqueaderos_SI_NO <lgl>, potenciales <dbl>, and
## #   abbreviated variable names ¹precio_millon, ²Area_contruida, ³parqueaderos,
## #   ⁴Habitaciones
## # ℹ Use `colnames()` to see all variable names

leaflet() %>%  addCircleMarkers(lng=Apt_recomendados$cordenada_longitud, lat=Apt_recomendados$Cordenada_latitud,radius = 10,color = "blue",label = Apt_recomendados$ID)%>% addTiles()

Analisis: Se identificaron 8 Apartamentos que corresponden a las características buscadas, se recomienda a los compradores visitar los barrios la flora y versalles donde podra encontrar 4 opciones 2 en cada barrio que son acordes a los intereses

Punto 4

Modelo de regresión lineal múltiple BD Arboles para predecir el peso de los arboles

Cargar Datos

data_arboles_RM =read_excel("C:/Mesa/data_arboles_RM.xlsx", 
    col_types = c("text", "text", "numeric", 
        "numeric", "numeric"))
head(data_arboles_RM)

## # A tibble: 6 × 5
##   finca   mg          peso diametro altura
##   <chr>   <chr>      <dbl>    <dbl>  <dbl>
## 1 FINCA_1 GENOTIPO_1 13.7       4.7    5  
## 2 FINCA_1 GENOTIPO_1 14.6       5.3    5.6
## 3 FINCA_1 GENOTIPO_1 15.9       4.8    5.8
## 4 FINCA_1 GENOTIPO_1  8.99      3.2    4.3
## 5 FINCA_1 GENOTIPO_1  6.99      2.2    3.3
## 6 FINCA_1 GENOTIPO_2 19.3       6.3    7.9

data_arboles_RM=data_arboles_RM[, 3:5]
attach(data_arboles_RM)
names(data_arboles_RM)

## [1] "peso"     "diametro" "altura"

Analizar la relación entre variables

round(cor(x = data_arboles_RM, method = "pearson"), 3)

##           peso diametro altura
## peso     1.000    0.908  0.858
## diametro 0.908    1.000  0.936
## altura   0.858    0.936  1.000

multi.hist(x = data_arboles_RM, dcol = c("blue", "red"), dlty = c("dotted", "solid"),
           main = "")

Del análisis preliminar se pueden extraer las siguientes conclusiones:

Las variables que tienen una mayor relación lineal con la peso son: diametro (r= 0.908), altura (r= 0.858)

Tambien se oberva que diametro y altura están fuerte mente correlacionados (r= 0.936), por lo que se sugiere dejar una de las dos

Graficamente Peso, diametro y altura muestran una distribución de normalidad

ggpairs(data_arboles_RM, lower = list(continuous = "smooth"),
        diag = list(continuous = "barDiag"), axisLabels = "none")

Generar el modelo

Se realiza el metodo mixto con todas las variables, como predictoras y realizando la selección con los mejores predictores con el calculo del $R^2$ ajustado para ver el porcentaje de explicación del mismo y lo valores de p-value si son significativos tando del modelo, como las variables predictoras y finalmente se relaiza la selección de los mejores predictores con la medición Akaike(AIC).
El modelo con las dos variables predictorias tiene un $R^2$ alto (0,8253), lo que significa que es capaz de explicarlo en un 82,53% de la variablidad observada del peso, el p-value de las variables diametro y altura son significativos.
Validación del modelo
Media cero: Se cumple por defecto.
Varianza Constante: Se observa en la grafica 1 de residuales vs ajustados que el comportamiento es aleatorio mostrando una leve curva hacia abajo.
Normalidad: Se observa en la grafica 2 que los datos se ajustan bien a la linea de normalidad en el qqplot
Independencia: Dado que estos registros no corresponden a datos en el tiempo no se tiene un orden temporal para realizar la validación de este supuesto.

modelo_arboles = lm(peso ~ diametro + altura, data = data_arboles_RM )
summary(modelo_arboles)

## 
## Call:
## lm(formula = peso ~ diametro + altura, data = data_arboles_RM)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -6.3083 -2.5121  0.1608  2.0088 11.7446 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  -9.1205     1.4305  -6.376 8.44e-09 ***
## diametro      4.7395     0.7128   6.649 2.49e-09 ***
## altura        0.3132     0.5751   0.544    0.587    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.449 on 87 degrees of freedom
## Multiple R-squared:  0.8253, Adjusted R-squared:  0.8213 
## F-statistic: 205.5 on 2 and 87 DF,  p-value: < 2.2e-16

par(mfrow=c(2,2))
plot(modelo_arboles)

Selección de los mejores predictores

En este caso se van a emplear la estrategia de stepwise mixto. El valor matemático empleado para determinar la calidad del modelo va a ser Akaike(AIC).

step(object = modelo_arboles, direction = "both", trace = 1)

## Start:  AIC=225.79
## peso ~ diametro + altura
## 
##            Df Sum of Sq    RSS    AIC
## - altura    1      3.53 1038.2 224.09
## <none>                  1034.7 225.79
## - diametro  1    525.74 1560.5 260.76
## 
## Step:  AIC=224.09
## peso ~ diametro
## 
##            Df Sum of Sq    RSS    AIC
## <none>                  1038.2 224.09
## + altura    1       3.5 1034.7 225.79
## - diametro  1    4884.0 5922.2 378.80

## 
## Call:
## lm(formula = peso ~ diametro, data = data_arboles_RM)
## 
## Coefficients:
## (Intercept)     diametro  
##      -9.020        5.103

El mejor modelo resultante del proceso de selección ha sido como predictora el diametro:

Validación del modelo
Media cero: Se cumple por defecto.
Varianza Constante: Se observa en la grafica 1 de residuales vs ajustados que el comportamiento es aleatorio mostrando una leve curva hacia abajo, se sugiere una tranformación exponencial $Z$=$Log(y)$ $X=X$.
Normalidad: Se observa en la grafica 2 que los datos se ajustan bien a la linea de normalidad en el qqplot
Independencia: Dado que estos registros no corresponden a datos en el tiempo no se tiene un orden temporal para realizar la validación de este supuesto.
Validación del modelo ajustado
Media cero: Se cumple por defecto.
Varianza Constante: Se observa en la grafica 1 de residuales vs ajustados que el comportamiento es aleatorio no con alguna tendencia en particular que indique problemas. Se valida grafiamente.
Normalidad: Se observa en la grafica 2 que los datos se ajustan bien a la linea de normalidad en el qqplot. Es decir se valida graficamente. + Independencia: Dado que estos registros no corresponden a datos en el tiempo no se tiene un orden temporal para realizar la validación de este supuesto.

Ademas el modelo mejora en ajuste pasando de $R^2$=0.8247 a $R^2$=0.8865, lo que significa que el modelo explica la variabilidad observada del peso en un 88,65%

modelo_arboles_res = (lm(formula = peso ~diametro, data = data_arboles_RM))
summary(modelo_arboles_res)

## 
## Call:
## lm(formula = peso ~ diametro, data = data_arboles_RM)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -6.3775 -2.6594  0.0237  1.8758 11.9876 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  -9.0203     1.4129  -6.384 7.86e-09 ***
## diametro      5.1026     0.2508  20.346  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.435 on 88 degrees of freedom
## Multiple R-squared:  0.8247, Adjusted R-squared:  0.8227 
## F-statistic:   414 on 1 and 88 DF,  p-value: < 2.2e-16

par(mfrow=c(2,2))
plot(modelo_arboles_res)

modelo_arboles_res_ajustado = (lm(formula = log(peso) ~diametro, data = data_arboles_RM))
summary(modelo_arboles_res_ajustado)

## 
## Call:
## lm(formula = log(peso) ~ diametro, data = data_arboles_RM)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.27395 -0.10180 -0.00328  0.10073  0.33742 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  1.32798    0.05977   22.22   <2e-16 ***
## diametro     0.27818    0.01061   26.22   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.1453 on 88 degrees of freedom
## Multiple R-squared:  0.8865, Adjusted R-squared:  0.8852 
## F-statistic: 687.6 on 1 and 88 DF,  p-value: < 2.2e-16

par(mfrow=c(2,2))
plot(modelo_arboles_res_ajustado)

Validación cruzada del modelo final de arboles

Ecuación de regresión $peso$=$log(1,327)+0,278*altura +\varepsilon$
El modelo ajustado haciendo la validación cruzada con la técnica MAE se obtiene un 11,42% de probabilidad de error de predicción, lo que constituye un buen modelo predictivo y el RMSE 14,17% la proporción del error versus el promedio del peso observado

validar_modelo=function(datos,n,numModelo){
  var_predict=array(NA,n)
  for (i in 1:n) {
    datos_training=datos[-i,]
    datos_test=datos[i,]
    if(numModelo==1)
    {       
    mod=lm(log(peso)~diametro,data=datos_training)
    var_predict[i]=exp(predict(mod,list(diametro=(datos_test$diametro))))
    }
    if(numModelo==2){
      mod=lm(precio_acciones~precio_barril,data=datos_training)
      var_predict[i]=predict(mod,list(precio_barril=(datos_test$precio_barril)))
    }
    if(numModelo==3){
      mod=lm(SMLM~INFLACION,data=datos_training)
      var_predict[i]=predict(mod,list(INFLACION=(datos_test$INFLACION)))
    }
    if(numModelo==4){
      mod=lm(precio_millon ~ Area_contruida + Estrato + parqueaderos,data=datos_training)
      var_predict[i]=predict(mod,list(Area_contruida=(datos_test$Area_contruida),Estrato=(datos_test$Estrato),parqueaderos=(datos_test$parqueaderos)))
    }
    if(numModelo==5){
      mod=lm(peso ~ diametro + altura,data=datos_training)
      var_predict[i]=predict(mod,list(diametro=(datos_test$diametro),altura=(datos_test$altura)))
    }
  }
  return(var_predict)
 }

## Modelo arboles ajustado
peso_predict=validar_modelo(data_arboles_RM,90,1)
res=data.frame(data_arboles_RM,peso_predict)
head(res)

##    peso diametro altura peso_predict
## 1 13.73      4.7    5.0    13.952728
## 2 14.58      5.3    5.6    16.506467
## 3 15.88      4.8    5.8    14.323356
## 4  8.99      3.2    4.3     9.198522
## 5  6.99      2.2    3.3     6.956406
## 6 19.34      6.3    7.9    21.809526

MAE=mean(abs(res$peso-res$peso_predict))
print(paste("MAE= ",MAE/mean(res$peso)*100))

## [1] "MAE=  11.4391613821492"

RMSE=sqrt(mean((res$peso-res$peso_predict)^2))
#rmse(res$peso,res$peso_predict)

## Predicción del error

print(paste("RMSE",RMSE/mean(res$peso)*100))

## [1] "RMSE 14.1764162463181"

Resumen

Descriptivas			Modelo		Validación		Supuestos
Variables	Grafico	Cor	R2	P-value	RMSE	MAE	Cumple
Ecopetrol(precio_acciones)
precio_barril	relación alta	0,70	0,50	**	5,3%	4,3%	No cumple supuesto 2
SALARIO MINIMO LEGAL MENSUAL (SMLM)
INFLACION	relación baja	-0,70	0,50	**	24,4%	17,1%	No Cumple
Viviendas(precio_millon )
Area_contruida	relación alta	0,69	0,70	***	24,3%	18,7%	Cumple
Estrato	relación alta	0,82	0,70	***	24,3%	18,7%	Cumple
parqueaderos	relación baja	0,54	0,70	***	24,3%	18,7%	Cumple
Arboles(peso)
diametro	relación alta	0,90	0,82	***	18,9%	15,7%	No cumple supuesto 2
altura	relación alta	0,85	0,82		18,9%	15,7%	No cumple supuesto 2
Arboles Ajustado Log(peso)
diametro	relación alta	0,90	0,82	***	14,1%	11,4%	cumple
P-Value Signif. codes: 0 ‘’ 0.001 ’’ 0.01 ’’ 0.05 ‘.’ 0.1 ’ ’ 1

Aplicación regresión lineal

Miguel Velandia Feria y David Barrera

2022-08-16