SITUACION_PROBLEMA_1
Avril Lobato A00833113
2023-11-10
Evidencia 1: Estadística multivariante
Importación de librerías
library(caret)## Loading required package: ggplot2## Loading required package: latticelibrary(ggplot2)
library(lattice)
library(rpart)
library(rpart.plot)
library(party)## Loading required package: grid## Loading required package: mvtnorm## Loading required package: modeltools## Loading required package: stats4## Loading required package: strucchange## Loading required package: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric## Loading required package: sandwichlibrary(gmodels)
library(grid)
library(mvtnorm)
library(modeltools)
library(stats4)
library(dplyr)##
## Attaching package: 'dplyr'## The following object is masked from 'package:party':
##
## where## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(strucchange)
library(zoo)
library(readr)
library(ggplot2)Limpieza de base de datos
Se carga base de datos y se realia transformación de tipos de datos
bd <- read.csv("Datos bienes y raices CDMXF (1).csv", stringsAsFactors = TRUE)
bd$Estacionamiento <- as.numeric(bd$Estacionamiento)
bd$Precio <- as.numeric(bd$Precio)Se eliminan duplicados
bd <- unique(bd)
dim(bd) #5 registros duplicados## [1] 653 23Se elimina outliers por medio del rango intercuartil de la variable precio y eliminación de nulos
conteorango <- sum(bd$Precio >= 0 & bd$Precio < 100, na.rm = TRUE)
conteorango## [1] 1bd$Precio <- replace(bd$Precio, bd$Precio >= 0 & bd$Precio < 100, NA)
bd$Precio[is.na(bd$Precio)] <- median(bd$Precio, na.rm = TRUE)
#Eliminar valores extremos adicionales usando el rango intercuartil
q1 <- quantile(bd$Precio, 0.25, na.rm=TRUE)
q3 <- quantile(bd$Precio, 0.75, na.rm=TRUE)
rangointq <- q3 - q1
limite_inferior <- q1 - 1.5 * rangointq
limite_superior <- q3 + 1.5 * rangointq
bd <- subset(bd, Precio >= limite_inferior & Precio <= limite_superior)
summary(bd$Precio)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 116.0 823.8 1728.0 2993.1 4250.0 12500.0Se reemplazan variantes de valores para solamente tener “Si” y “No”
# Cambiar los valores
bd$Cocina_equip <- gsub("Sí|Si ", "Si", bd$Cocina_equip)
bd$Gimnasio <- gsub("Sí|Si ", "Si", bd$Gimnasio)
bd$Amueblado <- gsub("Sí|Si ", "Si", bd$Amueblado)
bd$Alberca <- gsub("Sí|Si ", "Si", bd$Alberca)
bd$Alberca <- gsub("si|si ", "Si", bd$Alberca)
bd$Terraza <- gsub("Sí|Si ", "Si", bd$Terraza)
bd$Elevador <- gsub("Sí|Si ", "Si", bd$Elevador)
bd$Elevador <- gsub("si|si ", "Si", bd$Elevador)
bd$Cocina_equip <- gsub("No ", "No", bd$Cocina_equip)
bd$Gimnasio <- gsub("No ", "No", bd$Gimnasio)
bd$Amueblado <- gsub("No ", "No", bd$Amueblado)
bd$Alberca <- gsub("No ", "No", bd$Alberca)
bd$Terraza <- gsub("No ", "No", bd$Terraza)
bd$Elevador <- gsub("No ", "No", bd$Elevador)
unique(bd$Gimnasio)## [1] "Si" "No"Se convierten los datos a factores
#Conversión a factores
for (i in colnames(bd)) {
if (is.character(bd[[i]])) {
bd[[i]] <- as.factor(bd[[i]])
}
}
# Visualizar los datos
summary(bd)## Alcaldia Colonia X1
## Iztapalapa : 92 Santa Fe : 22 Min. :0.350
## Tlahuac : 80 San Angel : 13 1st Qu.:1.020
## Alvaro Obregon : 79 San Jer\xf3nimo L\xedndice: 11 Median :1.400
## Gustavo A. Madero : 79 Lomas Estrella : 10 Mean :1.383
## Coyoacan : 45 Miguel Hidalgo : 10 3rd Qu.:1.550
## Venustiano Carranza: 33 Tepalcates : 9 Max. :2.800
## (Other) :192 (Other) :525
## X2 X3 X4 X5
## Min. :3.810 Min. :31.70 Min. : 6.07 Min. :18.46
## 1st Qu.:4.980 1st Qu.:40.21 1st Qu.:16.35 1st Qu.:24.42
## Median :5.620 Median :42.85 Median :18.21 Median :26.78
## Mean :5.355 Mean :42.56 Mean :17.46 Mean :26.61
## 3rd Qu.:5.680 3rd Qu.:46.56 3rd Qu.:20.05 3rd Qu.:28.25
## Max. :6.780 Max. :51.23 Max. :23.46 Max. :32.20
##
## X6 X7 X8 X9
## Min. :0.480 Min. : 0.030 Min. :0.02000 Min. : 3.170
## 1st Qu.:2.280 1st Qu.: 0.280 1st Qu.:0.03000 1st Qu.: 6.980
## Median :3.190 Median : 0.300 Median :0.05000 Median : 8.250
## Mean :3.476 Mean : 1.077 Mean :0.08055 Mean : 7.997
## 3rd Qu.:4.540 3rd Qu.: 0.710 3rd Qu.:0.10000 3rd Qu.: 9.560
## Max. :8.530 Max. :10.210 Max. :0.23000 Max. :13.060
##
## X10 Cocina_equip Gimnasio Amueblado Alberca Terraza Elevador
## Min. :15.15 No: 61 No:453 No:587 No:520 No:335 No:292
## 1st Qu.:36.60 Si:539 Si:147 Si: 13 Si: 80 Si:265 Si:308
## Median :43.86
## Mean :41.04
## 3rd Qu.:50.08
## Max. :63.97
##
## m2_construido Banos Recamaras Estacionamiento
## Min. : 34.00 Min. :1.000 Min. :1.000 Min. :1.000
## 1st Qu.: 57.00 1st Qu.:1.000 1st Qu.:2.000 1st Qu.:2.000
## Median : 70.00 Median :1.000 Median :2.000 Median :2.000
## Mean : 88.24 Mean :1.562 Mean :2.262 Mean :2.297
## 3rd Qu.:100.25 3rd Qu.:2.000 3rd Qu.:3.000 3rd Qu.:3.000
## Max. :450.00 Max. :5.000 Max. :5.000 Max. :7.000
##
## Precio
## Min. : 116.0
## 1st Qu.: 823.8
## Median : 1728.0
## Mean : 2993.1
## 3rd Qu.: 4250.0
## Max. :12500.0
## Observaciones:
- La variable de precio está en dolares
- Existen varias variables con valores de texto como lo son: estacionamieto, elevador, Cocina_equip, Gimnasio, Amueblado, Alcaldia y Colonia. Cada una de estas se debe de tratar de una manera diferente.
- Las variables categóricas son: Cocina_equip, Gimnasio, Amueblado, Alberca, - Terraza, Estacionamiento y Elevador; dichas variables se deberán de transformar en factores para ser analizadas.
- Se analizó el caso de las variables podemos ver que en la base de datos se enlistan 16 Alcaldías y 313 colonias; por ende, se cambia la variable colonia a factor para su análisis.
Significado de cada una de las X
- X1 Población de 15 años o más analfabeta (porcentaje)
- X2 Población de 6 a 14 años que no asiste a la escuela (porcentaje)
- X3 Población de 15 a 24 años que no asiste a la escuela (porcentaje)
- X4 Población de 15 años o más con educación básica incompleta (porcentaje)
- X5 Población sin derechohabiencia a servicios de salud (porcentaje)
- X6 Viviendas con hacinamiento (porcentaje)
- X7 Viviendas que no disponen de agua entubada de la red pública (porcentaje)
- X8 Viviendas que no disponen de energía eléctrica (porcentaje)
- X9 Viviendas que no disponen de celular (porcentaje)
- X10 Viviendas que no disponen de computadora (computadora, laptop o tablet)(porcentaje)
##Clusterizacion##
Se seleccionan variables X
# Seleccionar solo las variables numéricas
datos_clusters <- bd[sapply(bd, is.numeric)]Se excluyen variables categóricas
columnas_a_excluir <- c("Precio", "m2_construido", "Banos", "Recamaras", "Estacionamiento")Se genera merge
datos_clusters <- datos_clusters[, !names(datos_clusters) %in% columnas_a_excluir]Se escala la bd anterior
Se genera método de k-means y su gráfica
set.seed(123)
wcss <- vector()
max_k <- 10 #se puede modificar
for (k in 1:max_k) {
kmeans_model <- kmeans(dfc_scaled, centers = k, nstart = 25)
wcss[k] <- kmeans_model$tot.withinss
}
# Graficar el método del codo
par(mar = c(4, 4, 1, 1))
plot(1:max_k, wcss, type = "b", xlab = "Numero de Clusters", ylab = "WCSS", main = "Metodo del Codo", pch = 19, frame = FALSE)
Se realiza análisis de conglomerados k-means con 5 grupos/clusters
k <- 5
indices_centroides_iniciales <- sample(1:nrow(dfc_scaled),k)
centroides_iniciales <- dfc_scaled[indices_centroides_iniciales, ]
resultado_kmeans <- kmeans(dfc_scaled, centers = centroides_iniciales)
print(resultado_kmeans)## K-means clustering with 5 clusters of sizes 205, 91, 132, 90, 82
##
## Cluster means:
## X1 X2 X3 X4 X5 X6
## 1 -0.01229747 -0.1670383 -0.2039899 0.09587836 -0.4141441 -0.1649009
## 2 0.64762161 -1.3830533 0.9327452 0.73317336 0.1590626 1.2306895
## 3 1.16542516 0.1099135 1.0324527 1.01598968 1.4941049 0.9152052
## 4 -0.87491379 1.4820834 -0.1918941 -0.64352157 -0.3583660 -0.9416883
## 5 -1.60373738 0.1488367 -1.9765264 -1.98253094 -1.1529764 -1.3932097
## X7 X8 X9 X10
## 1 -0.1503282 -0.5822788 -0.06552285 -0.1250894
## 2 0.2532510 0.6063286 1.04756593 1.2348923
## 3 0.6274710 1.5423629 0.68370493 0.8541518
## 4 -0.4007392 -0.7049406 -0.32094289 -0.5444220
## 5 -0.4754661 -0.9262925 -1.74707933 -1.8351457
##
## Clustering vector:
## 1 2 4 5 6 8 9 10 11 12 13 14 15 17 18 19 20 21 22 23
## 3 2 2 2 2 1 3 4 3 1 1 3 5 1 5 4 4 5 3 4
## 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 42 43 44 45
## 1 3 4 4 3 3 1 2 2 1 1 2 1 1 2 1 3 1 1 1
## 46 47 49 50 51 53 54 55 56 57 58 61 62 63 64 65 66 67 68 69
## 1 1 4 3 3 1 5 1 2 5 5 3 2 1 2 5 3 1 3 1
## 70 71 72 73 74 75 76 77 78 82 83 84 85 86 87 88 89 90 91 92
## 1 3 4 1 1 1 1 4 2 3 1 1 3 5 4 1 2 1 1 3
## 94 96 97 98 99 100 101 102 103 104 105 106 107 108 110 111 112 113 115 116
## 4 1 3 3 1 5 3 5 3 1 1 3 4 5 3 3 1 4 5 1
## 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136
## 3 1 2 1 1 1 2 1 3 1 3 3 4 1 4 4 2 5 5 5
## 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156
## 3 2 4 5 1 3 5 2 3 1 1 4 1 4 3 1 1 3 2 2
## 157 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177
## 5 4 2 4 5 3 1 1 3 1 3 2 1 3 1 2 4 1 4 4
## 178 179 180 181 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198
## 2 1 2 5 1 2 1 3 2 1 2 1 1 3 1 3 4 3 1 1
## 199 200 201 202 203 204 207 208 209 210 212 213 214 216 217 218 219 221 222 223
## 3 1 5 3 1 2 2 1 1 4 1 4 1 1 4 2 4 1 1 2
## 224 225 226 227 228 229 230 231 232 233 234 235 237 238 239 240 241 242 243 244
## 3 5 5 4 5 4 3 1 3 1 1 2 5 1 4 1 1 1 1 2
## 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 262 263 264 265
## 4 3 1 2 2 3 2 1 1 3 2 2 3 5 1 3 1 2 1 4
## 266 267 268 270 271 272 273 274 275 276 277 278 279 280 281 283 284 285 286 287
## 1 1 1 4 1 1 5 1 1 1 4 1 5 5 2 3 2 1 1 3
## 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307
## 5 5 3 1 5 2 4 4 5 3 2 2 3 1 4 4 4 3 5 1
## 308 309 310 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328
## 3 3 2 3 5 2 1 1 5 3 3 1 4 1 3 1 3 1 1 3
## 329 330 332 333 334 335 336 337 338 339 340 341 342 343 345 346 347 348 349 350
## 4 1 1 1 4 1 2 1 5 4 4 5 5 4 2 5 2 4 2 3
## 351 352 353 354 355 356 358 359 360 361 362 363 364 365 366 367 368 369 370 371
## 1 1 1 1 5 2 3 1 3 4 2 4 2 2 2 1 1 4 4 3
## 372 373 374 375 377 378 379 380 381 382 383 384 385 386 387 388 389 390 393 394
## 4 1 5 4 5 3 3 3 5 5 1 2 1 3 5 1 2 1 1 1
## 395 396 397 398 399 400 401 402 403 404 405 407 408 409 410 411 413 414 415 416
## 3 4 4 2 3 2 4 4 1 1 5 1 1 4 3 3 3 3 3 1
## 417 418 419 420 421 422 424 425 426 427 428 429 431 432 433 434 435 436 437 438
## 1 5 3 2 4 4 5 3 3 3 5 3 3 5 3 5 4 3 1 1
## 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458
## 4 1 3 1 5 1 1 2 3 3 4 3 5 2 4 4 1 4 1 3
## 459 460 461 462 463 464 465 466 467 469 470 471 472 473 474 475 476 477 478 479
## 1 5 3 4 3 1 1 4 3 1 1 3 1 3 1 1 2 3 4 5
## 480 481 482 483 484 485 486 487 488 489 491 492 493 495 496 497 498 499 500 502
## 2 2 1 5 1 1 3 1 3 1 5 5 3 2 5 1 2 2 1 2
## 503 504 505 506 507 509 510 511 512 513 514 515 516 517 518 519 520 522 523 525
## 5 1 2 3 1 1 1 4 1 3 5 3 5 2 2 5 1 3 3 1
## 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545
## 4 3 1 4 5 3 4 2 4 4 2 3 4 1 2 3 2 4 1 3
## 546 547 548 549 551 552 553 556 557 558 559 560 561 562 563 564 565 566 569 570
## 1 4 2 2 3 1 1 1 5 1 1 5 2 1 4 5 1 2 1 5
## 571 572 574 575 576 577 578 579 580 581 582 583 584 586 587 588 589 590 591 592
## 3 1 2 1 1 1 1 3 3 3 1 5 3 2 5 4 5 1 2 5
## 593 594 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613
## 4 1 3 5 1 1 1 1 3 1 1 1 2 3 3 5 1 1 3 4
## 615 616 617 618 620 621 622 624 625 626 627 628 629 630 631 632 634 635 636 637
## 5 1 5 5 1 2 1 2 3 3 2 1 1 1 1 1 2 1 2 5
## 638 639 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658
## 2 4 3 4 3 5 4 1 4 4 4 1 3 3 1 5 5 3 3 4
##
## Within cluster sum of squares by cluster:
## [1] 348.5061 299.1237 489.8702 153.6554 185.7432
## (between_SS / total_SS = 75.3 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"bd$Cluster <- resultado_kmeans$clusterSe crea matriz de calor para visualizar los centroides de los grupos del análisis de conglomerados k-means. Con base a eso, se determinan etiquetas de cada cluster: - cluster1 = “Zona Mixta”, - cluster2 = “Zona Economica”, - cluster3 = “Zona Marginada”, - cluster4 = “Zona Residencial”, - cluster5 = “Zona Premium”
centros <- resultado_kmeans$centers
# Transponer la matriz para que las filas representen variables y las columnas representen centros de clústeres
centros_transpuestos <- t(centros)
heatmap(centros_transpuestos, col = colorRampPalette(c("red", "green"))(20), scale = "none")
Se convierte cada cluster en variable
#Clusters a variables
cluster1 <- bd %>%
filter(Cluster == 1) %>%
select(Cocina_equip, Gimnasio, Amueblado, Alberca, Terraza, Elevador, m2_construido, Banos, Recamaras, Estacionamiento, Precio, Cluster)
cluster2 <- bd %>%
filter( Cluster == 2) %>%
select(Cocina_equip, Gimnasio, Amueblado, Alberca, Terraza, Elevador, m2_construido, Banos, Recamaras, Estacionamiento, Precio, Cluster)
cluster3 <- bd %>%
filter( Cluster == 3) %>%
select(Cocina_equip, Gimnasio, Amueblado, Alberca, Terraza, Elevador, m2_construido, Banos, Recamaras, Estacionamiento, Precio, Cluster)
cluster4 <- bd %>%
filter( Cluster == 4) %>%
select(Cocina_equip, Gimnasio, Amueblado, Alberca, Terraza, Elevador, m2_construido, Banos, Recamaras, Estacionamiento, Precio, Cluster)
cluster5 <- bd %>%
filter( Cluster == 5) %>%
select(Cocina_equip, Gimnasio, Amueblado, Alberca, Terraza, Elevador, m2_construido, Banos, Recamaras, Estacionamiento, Precio, Cluster)##Árboles de decisión##
###Arbol 1###
Se genera arbol de decision para el cluster 1
cluster1$Cluster <- NULL
#ARBOL CLUSTER 1
set.seed(123)
# Paso 1: Dividir el conjunto de datos en entrenamiento (50%) y temporal (50%)
trainIndex1 <- createDataPartition(cluster1$Precio, p = 0.5, list = FALSE, times = 1)
train <- cluster1[trainIndex1, ]
temp <- cluster1[-trainIndex1, ]
# Paso 2: Dividir el conjunto temporal en validación (50% de temp) y prueba (50% de temp)
trainIndex2 <- createDataPartition(cluster1$Precio, p = 0.5, list = FALSE, times = 1)
validation <- temp[trainIndex2, ]
test <- temp[-trainIndex2, ]
# Construir el árbol de decisión
tree <- rpart(Precio ~ ., data = train, method = "anova", control = rpart.control(cp = 0.0))
rpart.plot(tree)
rpart.plot(tree,digits = 4,fallen.leaves = TRUE,type = 3,extra = 101)
# Visualizar la curva de complejidad de costo
plotcp(tree)
Validacion Cruzada Arbol 1
Se entrena el modelo con validación cruzada y se genera árbol podado
#### Imputar valores faltantes
preproc <- preProcess(validation, method = "medianImpute")
validation_clean <- predict(preproc, cluster1)
# Definir el método de control de entrenamiento para la validación cruzada k-fold 10 pliegues o subconjuntos. El modelo se entrena 10 veces
ctrl <- trainControl(method = "cv", number = 10)
#Entrenar el modelo con validación cruzada
tree_model_cv <- train(Precio ~ ., data = validation_clean,
method = "rpart",
trControl = ctrl,
tuneLength = 10)## Warning in nominalTrainWorkflow(x = x, y = y, wts = weights, info = trainInfo,
## : There were missing values in resampled performance measures.# Ver los resultados
print(tree_model_cv)## CART
##
## 205 samples
## 10 predictor
##
## No pre-processing
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 185, 184, 185, 185, 185, 183, ...
## Resampling results across tuning parameters:
##
## cp RMSE Rsquared MAE
## 0.003608460 1968.573 0.7099683 1234.724
## 0.003692738 1969.835 0.7097674 1239.933
## 0.005315913 1988.867 0.7060580 1236.410
## 0.009337947 1978.756 0.7038307 1265.994
## 0.011321102 1976.867 0.7062888 1263.683
## 0.016164531 2018.379 0.6937190 1296.222
## 0.018711081 2061.550 0.6793739 1315.024
## 0.021412593 2058.870 0.6814553 1355.202
## 0.124210799 2577.552 0.5339962 1869.551
## 0.630959235 3180.049 0.4695315 2523.803
##
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was cp = 0.00360846.# Elegir un valor de cp basado en la gráfica y podar el árbol
pruned_tree <- prune(tree, cp = 0.0026)
# Visualizar el árbol podado
rpart.plot(pruned_tree)
# Elegir un valor de cp basado en la gráfica y podar el árbol
pruned_tree <- prune(tree, cp = 0.005)
# Visualizar el árbol podado
rpart.plot(pruned_tree)
rpart.plot(pruned_tree,digits = 4,fallen.leaves = TRUE,type = 3,extra = 101)
Se realiza análisis de error y/o evaluación de modelo
# Realizar predicciones en el conjunto de prueba con el árbol podado
predictions1 <- predict(pruned_tree, newdata = test)
# Calcular e imprimir las métricas de evaluación para el modelo podado
postResample(pred = predictions1, obs = test$Precio)## RMSE Rsquared MAE
## 1780.6426214 0.7796483 1181.8337687###Arbol 2###
Se genera arbol de decision para el cluster 2 y su curva de complejidad
cluster2$Cluster <- NULL
#ARBOL CLUSTER 2
set.seed(123)
# Paso 1: Dividir el conjunto de datos en entrenamiento (50%) y temporal (50%)
trainIndexc2 <- createDataPartition(cluster2$Precio, p = 0.5, list = FALSE, times = 1)
train2 <- cluster2[trainIndexc2, ]
temp2 <- cluster2[-trainIndexc2, ]
# Paso 2: Dividir el conjunto temporal en validación (50% de temp) y prueba (50% de temp)
trainIndexc2 <- createDataPartition(cluster2$Precio, p = 0.5, list = FALSE, times = 1)
validation2 <- temp2[trainIndexc2, ]
test2 <- temp2[-trainIndexc2, ]
# Construir el árbol de decisión
tree2 <- rpart(Precio ~ ., data = train2, method = "anova", control = rpart.control(cp = 0.0))
rpart.plot(tree2)
rpart.plot(tree2,digits = 4,fallen.leaves = TRUE,type = 3,extra = 101)
# Visualizar la curva de complejidad de costo
plotcp(tree2)
Validación Cruzada Arbol 2
Se entrena el modelo con validación cruzada y se genera árbol podado junto con análisis de error de modelo
#### Imputar valores faltantes
preproc2 <- preProcess(validation2, method = "medianImpute")
validation_clean2 <- predict(preproc2, cluster2)
# Definir el método de control de entrenamiento para la validación cruzada k-fold 10 pliegues o subconjuntos. El modelo se entrena 10 veces
ctrl2 <- trainControl(method = "cv", number = 10)
#convertir a factores
# Entrenar el modelo con validación cruzada
tree_model_cv2 <- train(Precio ~ ., data = validation_clean2,
method = "rpart",
trControl = ctrl,
tuneLength = 10)## Warning in nominalTrainWorkflow(x = x, y = y, wts = weights, info = trainInfo,
## : There were missing values in resampled performance measures.# Ver los resultados
print(tree_model_cv2)## CART
##
## 91 samples
## 10 predictors
##
## No pre-processing
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 80, 82, 83, 81, 82, 81, ...
## Resampling results across tuning parameters:
##
## cp RMSE Rsquared MAE
## 0.00000000 737.2043 0.1532078 509.2189
## 0.01604080 735.7325 0.1654455 504.0341
## 0.03208161 743.5254 0.1696093 514.4819
## 0.04812241 739.1747 0.1640186 504.4722
## 0.06416321 711.0589 0.1640186 493.3611
## 0.08020401 711.0589 0.1640186 493.3611
## 0.09624482 730.7579 0.1345626 510.6359
## 0.11228562 721.0586 0.1418700 514.2956
## 0.12832642 711.7599 0.1474244 507.0132
## 0.14436723 738.4366 0.0460703 525.0279
##
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was cp = 0.08020401.# Elegir un valor de cp basado en la gráfica y podar el árbol
pruned_tree2 <- prune(tree2, cp = 0.0026)
# Visualizar el árbol podado
rpart.plot(pruned_tree2)
# Elegir un valor de cp basado en la gráfica y podar el árbol
pruned_tree2 <- prune(tree2, cp = 0.005)
# Visualizar el árbol podado
rpart.plot(pruned_tree2)
rpart.plot(pruned_tree2,digits = 4,fallen.leaves = TRUE,type = 3,extra = 101)
# Realizar predicciones en el conjunto de prueba con el árbol podado
predictions2 <- predict(pruned_tree2, newdata = test)
# Calcular e imprimir las métricas de evaluación para el modelo podado
postResample(pred = predictions2, obs = test2$Precio)## RMSE Rsquared MAE
## NA 0.1568795 NA###Arbol 3###
Se genera arbol de decision para el cluster 3 y su curva de complejidad
cluster3$Cluster <- NULL
#ARBOL CLUSTER 3
set.seed(123)
# Paso 1: Dividir el conjunto de datos en entrenamiento (50%) y temporal (50%)
trainIndexc3 <- createDataPartition(cluster3$Precio, p = 0.5, list = FALSE, times = 1)
train3 <- cluster3[trainIndexc3, ]
temp3 <- cluster3[-trainIndexc3, ]
# Paso 2: Dividir el conjunto temporal en validación (50% de temp) y prueba (50% de temp)
trainIndexc3 <- createDataPartition(cluster3$Precio, p = 0.5, list = FALSE, times = 1)
validation3 <- temp3[trainIndexc3, ]
test3 <- temp3[-trainIndexc3, ]
# Construir el árbol de decisión
tree3 <- rpart(Precio ~ ., data = train3, method = "anova", control = rpart.control(cp = 0.0))
rpart.plot(tree3)
rpart.plot(tree3,digits = 4,fallen.leaves = TRUE,type = 3,extra = 101)
# Visualizar la curva de complejidad de costo
plotcp(tree3)
Validación Cruzada Arbol 3
Se entrena el modelo con validación cruzada y se genera árbol podado junto con análisis de error de modelo
#### Imputar valores faltantes
preproc3 <- preProcess(validation3, method = "medianImpute")
validation_clean3 <- predict(preproc3, cluster3)
# Definir el método de control de entrenamiento para la validación cruzada k-fold 10 pliegues o subconjuntos. El modelo se entrena 10 veces
ctrl3 <- trainControl(method = "cv", number = 10)
#convertir a factores
# Entrenar el modelo con validación cruzada
tree_model_cv3 <- train(Precio ~ ., data = validation_clean3,
method = "rpart",
trControl = ctrl,
tuneLength = 10)## Warning in nominalTrainWorkflow(x = x, y = y, wts = weights, info = trainInfo,
## : There were missing values in resampled performance measures.# Ver los resultados
print(tree_model_cv3)## CART
##
## 132 samples
## 10 predictor
##
## No pre-processing
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 119, 119, 118, 119, 119, 119, ...
## Resampling results across tuning parameters:
##
## cp RMSE Rsquared MAE
## 0.0000000000 899.6444 0.7842331 594.9948
## 0.0002700762 896.7100 0.7878015 591.2929
## 0.0002936850 895.0033 0.7899250 589.9053
## 0.0003103346 895.0033 0.7899250 589.9053
## 0.0003550067 894.5138 0.7903115 588.3246
## 0.0009200305 886.7699 0.7957676 577.1581
## 0.0023527258 886.7394 0.7974596 584.4370
## 0.0127825796 898.8997 0.7859079 600.3619
## 0.0857525313 981.6731 0.7830664 672.0426
## 0.7001881662 1510.2018 0.6797223 1044.4741
##
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was cp = 0.002352726.# Elegir un valor de cp basado en la gráfica y podar el árbol
pruned_tree3 <- prune(tree3, cp = 0.0026)
# Visualizar el árbol podado
rpart.plot(pruned_tree3)
# Elegir un valor de cp basado en la gráfica y podar el árbol
pruned_tree3 <- prune(tree3, cp = 0.005)
# Visualizar el árbol podado
rpart.plot(pruned_tree3)
rpart.plot(pruned_tree3,digits = 4,fallen.leaves = TRUE,type = 3,extra = 101)
# Realizar predicciones en el conjunto de prueba con el árbol podado
predictions3 <- predict(pruned_tree3, newdata = test)
# Calcular e imprimir las métricas de evaluación para el modelo podado
postResample(pred = predictions3, obs = test3$Precio)## RMSE Rsquared MAE
## NA 0.006732611 NA###Arbol 4###
Se genera arbol de decision para el cluster 4 y su curva de complejidad. Cabe destacar que, no se realiza podada de árbol para obtener mayor precision en la prediccion
cluster4$Cluster <- NULL
#ARBOL CLUSTER 4
set.seed(123)
# Paso 1: Dividir el conjunto de datos en entrenamiento (50%) y temporal (50%)
trainIndexc4 <- createDataPartition(cluster4$Precio, p = 0.5, list = FALSE, times = 1)
train4 <- cluster4[trainIndexc4, ]
temp4 <- cluster4[-trainIndexc4, ]
# Paso 2: Dividir el conjunto temporal en validación (50% de temp) y prueba (50% de temp)
trainIndexc4 <- createDataPartition(cluster4$Precio, p = 0.5, list = FALSE, times = 1)
validation4 <- temp4[trainIndexc4, ]
test4 <- temp4[-trainIndexc4, ]
# Construir el árbol de decisión
tree4 <- rpart(Precio ~ ., data = train4, method = "anova", control = rpart.control(cp = 0.0))
rpart.plot(tree4)
rpart.plot(tree4,digits = 4,fallen.leaves = TRUE,type = 3,extra = 101)
# Visualizar la curva de complejidad de costo
plotcp(tree4)
#ERROR
# Realizar predicciones en el conjunto de prueba con el árbol podado
predictions4 <- predict(tree4, newdata = test)
# Calcular e imprimir las métricas de evaluación para el modelo podado
postResample(pred = predictions4, obs = test4$Precio)## RMSE Rsquared MAE
## NA 0.06356008 NA###Arbol 5###
Se genera arbol de decision para el cluster 5 y su curva de complejidad
cluster5$Cluster <- NULL
#ARBOL CLUSTER 5
set.seed(123)
# Paso 1: Dividir el conjunto de datos en entrenamiento (50%) y temporal (50%)
trainIndexc5 <- createDataPartition(cluster5$Precio, p = 0.5, list = FALSE, times = 1)
train5 <- cluster5[trainIndexc5, ]
temp5 <- cluster5[-trainIndexc5, ]
# Paso 2: Dividir el conjunto temporal en validación (50% de temp) y prueba (50% de temp)
trainIndexc5 <- createDataPartition(cluster5$Precio, p = 0.5, list = FALSE, times = 1)
validation5 <- temp5[trainIndexc5, ]
test5 <- temp5[-trainIndexc5, ]
# Construir el árbol de decisión
tree5 <- rpart(Precio ~ ., data = train5, method = "anova", control = rpart.control(cp = 0.0))
rpart.plot(tree5)
rpart.plot(tree5,digits = 4,fallen.leaves = TRUE,type = 3,extra = 101)
# Visualizar la curva de complejidad de costo
plotcp(tree5)
Validación Cruzada Arbol 5
Se entrena el modelo con validación cruzada y se genera árbol podado junto con análisis de error de modelo
# Imputar valores faltantes
preproc5 <- preProcess(validation5, method = "medianImpute")
validation_clean5 <- predict(preproc5, cluster5)
# Definir el método de control de entrenamiento para la validación cruzada k-fold 10 pliegues o subconjuntos. El modelo se entrena 10 veces
ctrl5 <- trainControl(method = "cv", number = 10)
#convertir a factores
# Entrenar el modelo con validación cruzada
tree_model_cv5 <- train(Precio ~ ., data = validation_clean5,
method = "rpart",
trControl = ctrl,
tuneLength = 10)## Warning in nominalTrainWorkflow(x = x, y = y, wts = weights, info = trainInfo,
## : There were missing values in resampled performance measures.# Ver los resultados
print(tree_model_cv5)## CART
##
## 82 samples
## 10 predictors
##
## No pre-processing
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 74, 74, 73, 74, 74, 74, ...
## Resampling results across tuning parameters:
##
## cp RMSE Rsquared MAE
## 0.00000000 1999.552 0.6317392 1442.161
## 0.05291429 2098.932 0.5852149 1552.446
## 0.10582859 2388.378 0.4601879 1806.913
## 0.15874288 2545.185 0.3885035 1915.309
## 0.21165717 2545.185 0.3885035 1915.309
## 0.26457147 2545.185 0.3885035 1915.309
## 0.31748576 2545.185 0.3885035 1915.309
## 0.37040005 2545.185 0.3885035 1915.309
## 0.42331434 2545.185 0.3885035 1915.309
## 0.47622864 3022.621 0.1176967 2318.497
##
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was cp = 0.# Elegir un valor de cp basado en la gráfica y podar el árbol
pruned_tree5 <- prune(tree5, cp = 0.0026)
# Visualizar el árbol podado
rpart.plot(pruned_tree5)
# Elegir un valor de cp basado en la gráfica y podar el árbol
pruned_tree5 <- prune(tree5, cp = 0.005)
# Visualizar el árbol podado
rpart.plot(pruned_tree5)
rpart.plot(pruned_tree5,digits = 4,fallen.leaves = TRUE,type = 3,extra = 101)
# Realizar predicciones en el conjunto de prueba con el árbol podado
predictions5 <- predict(pruned_tree5, newdata = test)
# Calcular e imprimir las métricas de evaluación para el modelo podado
postResample(pred = predictions5, obs = test5$Precio)## RMSE Rsquared MAE
## NA 0.0402678 NA##Predicciones##
Se agrega nueva fila a la bd con la cual se genera prediccion de precio con cada modelado y arbol de cluster
#Cargar la fila del archivo "PREDICT"
fila_prediccion1 <- read.csv("PREDICT_SP.csv")
fila_prediccion2 <- read.csv("PREDICT_SP.csv")
fila_prediccion3 <- read.csv("PREDICT_SP.csv")
fila_prediccion4 <- read.csv("PREDICT_SP.csv")
fila_prediccion5 <- read.csv("PREDICT_SP.csv")
# Realizar la predicción
prediccion1 <- predict(pruned_tree, newdata = fila_prediccion1)
prediccion2 <- predict(pruned_tree2, newdata = fila_prediccion2)
prediccion3 <- predict(pruned_tree3, newdata = fila_prediccion3)
prediccion4 <- predict(tree4, newdata = fila_prediccion4)
prediccion5 <- predict(pruned_tree5, newdata = fila_prediccion5)
# Obtener el valor del cluster
cluster1 <- as.character(prediccion1[1])
prediccion1## 1
## 651.3548cluster2 <- as.character(prediccion2[1])
prediccion2## 1
## 1301.75cluster3 <- as.character(prediccion3[1])
prediccion3## 1
## 6423.571cluster4 <- as.character(prediccion4[1])
prediccion4## 1
## 5829.9cluster5 <- as.character(prediccion5[1])
prediccion5## 1
## 9287.125##Etiquetado##
Se genera datframe que muestra el etiquetado de cada cluster y su prediccion de precio segun la fila agregada
# Cambiar el nombre de los cluster
clusters <- c(
cluster1 = "Zona Mixta",
cluster2 = "Zona Economica",
cluster3 = "Zona Marginada",
cluster4 = "Zona Residencial",
cluster5 = "Zona Premium"
)
predicciones <- c(
prediccion1,
prediccion2,
prediccion3,
prediccion4,
prediccion5
)
df_prediccion <- data.frame(
Predicciones = predicciones,
Clasificacion = clusters
)
# Visualizar el DataFrame
df_prediccion## Predicciones Clasificacion
## cluster1 651.3548 Zona Mixta
## cluster2 1301.7500 Zona Economica
## cluster3 6423.5714 Zona Marginada
## cluster4 5829.9000 Zona Residencial
## cluster5 9287.1250 Zona Premium