Mínería de datos -Técnicas de pre procesamiento de datos
Alvaro Cesar Tauma Salvador
Curso: Minería de datos
Pre procesamiento de datos (Atípicos y Faltantes)
Aplicación . Encuesta Nacional de Hogares - ENAHO
Se ha recopilado la base de datos de la ENAHO 2017 – tercer trimestre del Portal del INEI que se encuentran en el formato .sav. Los módulos que se descargan: Módulo 100 (Información de la vivienda y el hogar), Módulo 300 (Información de la salud), Módulo 400 (Información de la educación) y Módulo 500 (Información del empleo e ingreso). Los cuatro archivos constituyen tablas relacionadas que son fusionadas para obtener la Base de Datos Integrada
Archivo: IMD_PD_Clase_02_PreProcesamiento_01_Datos01.csv
Las variables son:
Y = Ingresos mensual del hogar (soles).
X1 = Total gasto mensual servicios de la vivienda (soles)
X2 = Gasto por servicios de salud (soles)
X3 = Número de horas trabajó a la semana en su ocupación principal
X4 = Tiempo trabajando en la ocupación principal (años)
X5 = Número de horas trabajadas a la semana en su ocupación secundaria
X6 = Gasto en alimentación y transporte (soles)
Aplique las técnicas de pre procesamiento para la detección y manejo de los datos atípicos
Aplique los métodos de detección de datos atípicos basados en medidas estadística
# Lectura de archivo de datos
Datos=read.table("IMD_PD_Clase_02_PreProcesamiento_01_Datos01.csv",header=TRUE,sep=";")
head(Datos)## X1 X2 X3 X4 X5 X6 Y
## 1 212 240 19.5 64 2 46 NA
## 2 461 18 12.7 79 8 67 NA
## 3 80 120 17.5 70 10 39 NA
## 4 139 6 10.0 50 25 58 NA
## 5 405 600 2.0 36 40 64 NA
## 6 227 40 1.2 48 8 55 NAattach(Datos)
str(Datos) ## 'data.frame': 1872 obs. of 7 variables:
## $ X1: num 212 461 80 139 405 227 133 225 168 164 ...
## $ X2: num 240 18 120 6 600 40 5 170 248 13 ...
## $ X3: num 19.5 12.7 17.5 10 2 1.2 4 26 4 17 ...
## $ X4: int 64 79 70 50 36 48 92 75 23 48 ...
## $ X5: int 2 8 10 25 40 8 10 1 15 4 ...
## $ X6: int 46 67 39 58 64 55 44 44 47 36 ...
## $ Y : num NA NA NA NA NA NA NA NA NA NA ...summary(Datos) ## X1 X2 X3 X4
## Min. : 3.0 Min. : 0.5 Min. : 0.20 Min. : 2.00
## 1st Qu.: 71.0 1st Qu.: 7.0 1st Qu.: 3.00 1st Qu.:28.00
## Median :124.0 Median : 20.0 Median : 8.00 Median :40.00
## Mean :164.4 Mean : 101.9 Mean : 12.83 Mean :41.07
## 3rd Qu.:219.0 3rd Qu.: 70.0 3rd Qu.: 15.50 3rd Qu.:51.00
## Max. :960.0 Max. :5043.0 Max. :365.00 Max. :98.00
##
## X5 X6 Y
## Min. : 1.00 Min. :20.00 Min. : 5
## 1st Qu.: 4.00 1st Qu.:41.00 1st Qu.: 220
## Median :10.00 Median :49.50 Median : 640
## Mean :14.29 Mean :50.08 Mean :1431
## 3rd Qu.:21.00 3rd Qu.:59.00 3rd Qu.:2200
## Max. :68.00 Max. :91.00 Max. :7250
## NA's :458Detección y manejo de los datos atípicos
Método del Z-scores
Datos_A=Datos
Var_A <- c(1,2,3)
for (i in 1:3) {
k=Var_A[i]
XI=Datos_A[,k]
cat("Id Atípicas: Variable X",i,"\n")
Atipicos_XI <- abs(scale(XI))> 3
Atipicos_Ind <- which(Atipicos_XI)#me entrega solo indices TRUE;
print(Atipicos_Ind)
#print(Datos_A[Atipicos_Ind,])
Datos_A <- Datos_A[-Atipicos_Ind, ]
} ## Id Atípicas: Variable X 1
## [1] 37 288 308 317 320 357 446 562 699 701 702 713 774 781 790
## [16] 854 895 900 1128 1145 1179 1462 1569 1576 1595 1606 1760 1842
## Id Atípicas: Variable X 2
## [1] 63 74 112 328 447 459 482 532 555 760 770 775 827 879 995
## [16] 1139 1173 1255 1331 1472 1687 1734 1813
## Id Atípicas: Variable X 3
## [1] 26 57 92 124 265 316 372 430 472 499 507 514 649 651 662
## [16] 705 746 921 923 960 961 962 1028 1054 1094 1178 1179 1188 1189 1247
## [31] 1295 1471 1543 1606 1727 1745 1776 1794 1801 1806 1818 1821boxplot(Datos_A)
Datos_Sin_A=Datos_A
boxplot(Datos_Sin_A) 
dim(Datos_Sin_A)[1] ## [1] 1779nrow(Datos_A)## [1] 1779"Se eliminaron=1872-1779=93 observaciones"## [1] "Se eliminaron=1872-1779=93 observaciones"Método del diagrama de cajas
Datos_A=Datos
Var_A<- c(1,2,3)
for (i in 1:3)
{
k=Var_A[i]
XI=Datos_A[, k]
cat("Id Atípicas: Variable X",i,"\n")
Atipicos <- boxplot.stats(XI)$out
Atipicos_Ind <- which(XI %in% c(Atipicos)); print(Atipicos_Ind)
# print(Datos_A[Atipicos_Ind,])
Datos_A <- Datos_A[-Atipicos_Ind, ]
# Verificar la prueba con D. Cajas
# boxplot(XI, ylab="X1", main="Diagrama de cajas X1" )
# mtext(paste("Atípicos: ", paste(Atipicos, collapse = ", ")))
} ## Id Atípicas: Variable X 1
## [1] 2 26 37 50 119 124 178 272 288 308 313 315 317 320 329
## [16] 357 395 397 427 446 448 484 534 558 562 563 610 697 699 700
## [31] 701 702 713 714 715 716 717 718 772 774 781 790 840 854 895
## [46] 900 901 910 1084 1127 1128 1145 1167 1179 1222 1305 1366 1449 1451 1453
## [61] 1460 1462 1466 1489 1541 1569 1576 1590 1593 1595 1597 1600 1606 1705 1709
## [76] 1710 1760 1786 1804 1814 1815 1842 1846 1848 1849 1868 1870 1872
## Id Atípicas: Variable X 2
## [1] 1 4 7 8 15 33 35 45 59 60 68 70 71 82 87
## [16] 93 95 97 109 120 126 146 150 169 171 198 203 209 217 218
## [31] 229 243 250 253 262 264 268 273 299 306 318 320 321 327 330
## [46] 336 343 356 358 360 364 369 377 394 422 429 431 433 434 438
## [61] 445 447 459 467 478 479 486 494 499 505 515 516 536 537 560
## [76] 568 570 577 591 614 618 640 658 659 662 666 679 684 692 693
## [91] 698 704 722 728 737 743 744 748 754 779 784 787 799 803 804
## [106] 807 809 811 823 824 832 840 851 870 889 896 909 922 923 928
## [121] 936 943 949 965 983 989 1012 1015 1027 1031 1037 1039 1045 1056 1061
## [136] 1064 1092 1093 1107 1111 1114 1118 1128 1134 1140 1156 1179 1186 1187 1190
## [151] 1193 1195 1220 1221 1226 1253 1257 1287 1296 1298 1314 1319 1321 1360 1374
## [166] 1383 1409 1425 1430 1456 1457 1459 1466 1468 1470 1487 1493 1499 1506 1514
## [181] 1516 1517 1520 1524 1526 1534 1542 1546 1549 1553 1558 1559 1561 1562 1579
## [196] 1582 1585 1591 1593 1614 1615 1616 1637 1638 1640 1645 1646 1653 1666 1684
## [211] 1702 1707 1712 1730 1732 1733 1734 1736 1738 1745 1746 1748 1756 1758 1759
## [226] 1762 1764 1770 1772 1773 1783 1784
## Id Atípicas: Variable X 3
## [1] 17 30 38 46 70 76 102 140 151 183 224 232 233 270 313
## [16] 315 340 351 367 373 393 400 424 436 463 523 554 558 559 570
## [31] 600 628 630 635 640 655 771 782 789 790 791 817 822 823 824
## [46] 852 886 907 917 939 956 980 1016 1017 1020 1025 1026 1039 1067 1076
## [61] 1080 1120 1121 1166 1195 1197 1203 1275 1280 1302 1339 1369 1394 1412 1447
## [76] 1475 1489 1500 1503 1522 1525 1527 1528 1537 1540 1541 1542 1544 1551boxplot(Datos_A) 
Datos_Sin_A=Datos_A
dim(Datos_Sin_A)## [1] 1463 7#Se eliminaron=1872-1463=409 observacionesMétodo de filtro de Hampel (mad:mediana en valor absoluto)
Datos_A=Datos
Var_A<- c(1,2,3)
for (i in 1:3){
k=Var_A[i]
XI=Datos_A[, k]
cat("Id Atípicas: Variable X",i,"\n")
LI <- median(XI) - 3 * mad(XI); LS <- median(XI) + 3.2 * mad(XI)
Atipicos_Ind <- which(XI < LI | XI > LS); print(Atipicos_Ind)
# print(Datos_A[Atipicos_Ind,])
Datos_A <- Datos_A[-Atipicos_Ind, ]
} ## Id Atípicas: Variable X 1
## [1] 2 26 37 50 119 124 178 272 288 308 313 315 317 320 329
## [16] 357 395 397 427 446 448 484 534 558 562 563 610 697 699 700
## [31] 701 702 713 714 715 716 717 718 772 774 781 790 840 854 895
## [46] 900 901 910 1084 1127 1128 1145 1167 1169 1177 1179 1182 1222 1305 1366
## [61] 1449 1451 1453 1460 1462 1466 1489 1541 1569 1576 1590 1593 1595 1597 1600
## [76] 1606 1705 1709 1710 1760 1786 1804 1814 1815 1842 1846 1848 1849 1868 1870
## [91] 1872
## Id Atípicas: Variable X 2
## [1] 1 2 4 7 8 10 15 22 33 35 45 59 60 64 68
## [16] 70 71 80 82 87 89 93 95 97 109 115 120 126 133 146
## [31] 150 152 157 159 169 171 190 192 198 199 200 203 204 209 217
## [46] 218 224 227 229 243 244 250 253 254 257 262 264 265 268 273
## [61] 276 278 281 294 299 301 306 310 315 318 320 321 323 327 330
## [76] 336 339 343 356 358 360 364 369 377 379 383 394 398 403 422
## [91] 429 431 433 434 438 439 445 447 457 459 467 478 479 486 487
## [106] 491 494 499 505 513 515 516 536 537 541 560 563 568 570 573
## [121] 577 580 584 586 591 599 614 618 633 639 640 658 659 662 666
## [136] 674 675 679 684 692 693 698 704 722 728 733 736 737 743 744
## [151] 748 754 779 784 787 799 803 804 807 809 811 823 824 828 832
## [166] 837 840 851 870 872 873 889 896 909 922 923 928 936 937 938
## [181] 943 948 949 952 963 965 967 983 985 989 996 1012 1015 1027 1031
## [196] 1037 1039 1040 1045 1056 1061 1064 1066 1071 1091 1092 1093 1098 1107 1111
## [211] 1114 1115 1117 1129 1130 1131 1137 1147 1148 1153 1158 1176 1183 1184 1187
## [226] 1190 1192 1194 1206 1217 1218 1223 1232 1238 1249 1250 1254 1282 1284 1288
## [241] 1293 1295 1301 1308 1311 1316 1318 1325 1344 1357 1362 1371 1380 1396 1406
## [256] 1410 1422 1427 1444 1446 1453 1454 1456 1458 1460 1463 1465 1466 1467 1474
## [271] 1484 1489 1490 1496 1500 1503 1511 1513 1514 1517 1521 1523 1531 1536 1539
## [286] 1543 1546 1548 1550 1553 1555 1556 1558 1559 1576 1579 1582 1588 1590 1606
## [301] 1610 1611 1612 1613 1626 1634 1635 1637 1642 1643 1647 1648 1650 1660 1663
## [316] 1664 1665 1681 1699 1704 1709 1713 1716 1722 1727 1728 1729 1730 1731 1733
## [331] 1735 1742 1743 1745 1747 1753 1755 1756 1759 1760 1761 1764 1766 1767 1769
## [346] 1770 1780 1781
## Id Atípicas: Variable X 3
## [1] 27 35 43 65 70 95 129 140 167 203 210 211 282 284 307
## [16] 316 332 338 357 363 397 423 449 476 506 510 521 534 549 577
## [31] 579 584 588 602 714 725 732 733 734 763 764 765 789 821 842
## [46] 851 871 887 908 938 939 942 947 948 961 987 996 1037 1038 1078
## [61] 1106 1108 1113 1183 1239 1266 1291 1308 1339 1364 1378 1389 1391 1407 1410
## [76] 1412 1423 1425 1432boxplot(Datos_A) 
Datos_Sin_A=Datos_A
dim(Datos_Sin_A)[1]## [1] 1354Métodos de detección de datos atípicos basados en pruebas estadísticas
Prueba de Grubbs’s
# install.packages("outliers")
library(outliers)
# 5. Prueba de Grubbs’s
Datos_A=Datos
Var_A<- c(1,2,3)
for (i in 1:3)
{
k=Var_A[i]
XI=Datos_A[, k]
cat("Id Atípicas: Variable X",i,"\n")
# Por defecto la prueba el valor atípico más alto (opposite=menor)
Prueba <- grubbs.test(XI); print(Prueba)
Atipico_Ind1 <- which.max(XI)
Dato_Atipico <-Datos[Atipico_Ind1, ]; print(Dato_Atipico)
Prueba <- grubbs.test(XI, opposite = TRUE); print(Prueba)
Atipico_Ind2 <- which.min(XI)
Dato_Atipico <-Datos[Atipico_Ind2, ]; print(Dato_Atipico)
# Eliminar los valores atípicos el mayor y el menor
Atipicos_Ind <-c(Atipico_Ind1, Atipico_Ind2); print(Atipicos_Ind)
# print(Datos_A[Atipicos_Ind,])
Datos_A <- Datos_A[-Atipicos_Ind, ]
}## Id Atípicas: Variable X 1
##
## Grubbs test for one outlier
##
## data: XI
## G = 5.89043, U = 0.98145, p-value = 3.064e-06
## alternative hypothesis: highest value 960 is an outlier
##
## X1 X2 X3 X4 X5 X6 Y
## 1595 960 33 10 24 5 61 100
##
## Grubbs test for one outlier
##
## data: XI
## G = 1.19526, U = 0.99924, p-value = 1
## alternative hypothesis: lowest value 3 is an outlier
##
## X1 X2 X3 X4 X5 X6 Y
## 751 3 23 16 48 30 64 420
## [1] 1595 751
## Id Atípicas: Variable X 2
##
## Grubbs test for one outlier
##
## data: XI
## G = 14.41347, U = 0.88879, p-value < 2.2e-16
## alternative hypothesis: highest value 5043 is an outlier
##
## X1 X2 X3 X4 X5 X6 Y
## 64 127 5043 3.7 65 12 64 NA
##
## Grubbs test for one outlier
##
## data: XI
## G = 0.29607, U = 0.99995, p-value = 1
## alternative hypothesis: lowest value 0.5 is an outlier
##
## X1 X2 X3 X4 X5 X6 Y
## 252 104 0.5 12.5 40 11 42 NA
## [1] 64 252
## Id Atípicas: Variable X 3
##
## Grubbs test for one outlier
##
## data: XI
## G = 18.94193, U = 0.80772, p-value < 2.2e-16
## alternative hypothesis: highest value 365 is an outlier
##
## X1 X2 X3 X4 X5 X6 Y
## 37 578 370 365 72 1 45 NA
##
## Grubbs test for one outlier
##
## data: XI
## G = 0.67966, U = 0.99975, p-value = 1
## alternative hypothesis: lowest value 0.2 is an outlier
##
## X1 X2 X3 X4 X5 X6 Y
## 1054 107 13.5 2 21 1 51 600
## [1] 37 1054Prueba de Dixon’s
# 6. Prueba de Dixon’s (Para conjunto entre 5 a 30 observaciones)
# Se extrae una muestra de 30 datos
Datos_S <- Datos[1:30, ]
Var_A<- c(1,2,3)
for (i in 1:3)
{
k=Var_A[i]
XI=Datos_S[, k]
cat("Id Atípicas: Variable X",i,"\n")
Prueba <- dixon.test(XI); print(Prueba)
Atipico_Ind1 <- which.max(XI)
Dato_Atipico <-Datos_S[Atipico_Ind1, ]; print(Dato_Atipico)
Prueba <- dixon.test(XI, opposite = TRUE); print(Prueba)
Atipico_Ind2 <- which.min(XI)
Dato_Atipico <-Datos_S[Atipico_Ind2, ]; print(Dato_Atipico)
# Eliminar los valores atípicos el mayor y el menor
Atipicos_Ind <-c(Atipico_Ind1, Atipico_Ind2); print(Atipicos_Ind)
print(Datos_S[Atipicos_Ind,])
Datos_S <- Datos_S[-Atipicos_Ind, ]; Atipicos_Ind
}## Id Atípicas: Variable X 1
##
## Dixon test for outliers
##
## data: XI
## Q = 0.14106, p-value = 0.7111
## alternative hypothesis: highest value 461 is an outlier
##
## X1 X2 X3 X4 X5 X6 Y
## 2 461 18 12.7 79 8 67 NA
##
## Dixon test for outliers
##
## data: XI
## Q = 0.10966, p-value = 0.4817
## alternative hypothesis: lowest value 22 is an outlier
##
## X1 X2 X3 X4 X5 X6 Y
## 22 22 1.5 2.2 49 31 59 NA
## [1] 2 22
## X1 X2 X3 X4 X5 X6 Y
## 2 461 18.0 12.7 79 8 67 NA
## 22 22 1.5 2.2 49 31 59 NA
## Id Atípicas: Variable X 2
##
## Dixon test for outliers
##
## data: XI
## Q = 0.60302, p-value < 2.2e-16
## alternative hypothesis: highest value 600 is an outlier
##
## X1 X2 X3 X4 X5 X6 Y
## 5 405 600 2 36 40 64 NA
##
## Dixon test for outliers
##
## data: XI
## Q = 0.0062893, p-value < 2.2e-16
## alternative hypothesis: lowest value 1.5 is an outlier
##
## X1 X2 X3 X4 X5 X6 Y
## 28 72 1.5 19 84 17 59 NA
## [1] 4 26
## X1 X2 X3 X4 X5 X6 Y
## 5 405 600.0 2 36 40 64 NA
## 28 72 1.5 19 84 17 59 NA
## Id Atípicas: Variable X 3
##
## Dixon test for outliers
##
## data: XI
## Q = 0.67568, p-value < 2.2e-16
## alternative hypothesis: highest value 76 is an outlier
##
## X1 X2 X3 X4 X5 X6 Y
## 26 454 13 76 28 20 57 NA
##
## Dixon test for outliers
##
## data: XI
## Q = 0.032258, p-value = 0.05806
## alternative hypothesis: lowest value 1.2 is an outlier
##
## X1 X2 X3 X4 X5 X6 Y
## 6 227 40 1.2 48 8 55 NA
## [1] 23 4
## X1 X2 X3 X4 X5 X6 Y
## 26 454 13 76.0 28 20 57 NA
## 6 227 40 1.2 48 8 55 NAPrueba de Rosner
# 7. Prueba de Rosner
#install.packages("EnvStats")
library(EnvStats) ##
## Attaching package: 'EnvStats'## The following objects are masked from 'package:stats':
##
## predict, predict.lmDatos_A=Datos
Var_A<- c(1,2,3)
for (i in 1:3)
{
k=Var_A[i]
XI=Datos_A[, k]
cat("Id Atípicas: Variable X",i,"\n")
Prueba <- rosnerTest(XI, k = 20); print(Prueba)
Atipicos_Ind <- Prueba$all.stats[,5]; print(Atipicos_Ind)
# print(Datos_A[Atipicos_Ind,])
Datos_A <- Datos_A[-Atipicos_Ind, ]
}## Id Atípicas: Variable X 1## Warning in rosnerTest(XI, k = 20): The true Type I error may be larger than assumed.
## Although the help file for 'rosnerTest' has a table with information
## on the estimated Type I error level,
## simulations were not run for k > 10 or k > floor(n/2).##
## Results of Outlier Test
## -------------------------
##
## Test Method: Rosner's Test for Outliers
##
## Hypothesized Distribution: Normal
##
## Data: XI
##
## Sample Size: 1872
##
## Test Statistics: R.1 = 5.890426
## R.2 = 5.454300
## R.3 = 5.469583
## R.4 = 5.485033
## R.5 = 4.995836
## R.6 = 4.907758
## R.7 = 4.894604
## R.8 = 4.888711
## R.9 = 4.584443
## R.10 = 4.414635
## R.11 = 4.351949
## R.12 = 4.375451
## R.13 = 4.383333
## R.14 = 4.383232
## R.15 = 4.399187
## R.16 = 4.066112
## R.17 = 4.077297
## R.18 = 3.916599
## R.19 = 3.859965
## R.20 = 3.810598
##
## Test Statistic Parameter: k = 20
##
## Alternative Hypothesis: Up to 20 observations are not
## from the same Distribution.
##
## Type I Error: 5%
##
## Number of Outliers Detected: 15
##
## i Mean.i SD.i Value Obs.Num R.i+1 lambda.i+1 Outlier
## 1 0 164.4327 135.0611 960 1595 5.890426 4.190522 TRUE
## 2 1 164.0075 133.8380 894 854 5.454300 4.190396 TRUE
## 3 2 163.6171 132.8041 890 1179 5.469583 4.190271 TRUE
## 4 3 163.2285 131.7716 886 900 5.485033 4.190146 TRUE
## 5 4 162.8415 130.7406 816 562 4.995836 4.190021 TRUE
## 6 5 162.4917 129.8981 800 1606 4.907758 4.189895 TRUE
## 7 6 162.1501 129.0911 794 357 4.894604 4.189770 TRUE
## 8 7 161.8113 128.2933 789 308 4.888711 4.189644 TRUE
## 9 8 161.4748 127.5019 746 699 4.584443 4.189519 TRUE
## 10 9 161.1610 126.8143 721 895 4.414635 4.189393 TRUE
## 11 10 160.8604 126.1824 710 317 4.351949 4.189267 TRUE
## 12 11 160.5653 125.5721 710 701 4.375451 4.189141 TRUE
## 13 12 160.2699 124.9575 708 702 4.383333 4.189015 TRUE
## 14 13 159.9753 124.3431 705 713 4.383232 4.188889 TRUE
## 15 14 159.6819 123.7315 704 320 4.399187 4.188763 TRUE
## 16 15 159.3888 123.1179 660 774 4.066112 4.188637 FALSE
## 17 16 159.1191 122.6010 659 1145 4.077297 4.188511 FALSE
## 18 17 158.8496 122.0831 637 1462 3.916599 4.188385 FALSE
## 19 18 158.5917 121.6095 628 446 3.859965 4.188258 FALSE
## 20 19 158.3384 121.1520 620 1576 3.810598 4.188132 FALSE
##
##
## [1] 1595 854 1179 900 562 1606 357 308 699 895 317 701 702 713 320
## [16] 774 1145 1462 446 1576
## Id Atípicas: Variable X 2## Warning in rosnerTest(XI, k = 20): The true Type I error may be larger than assumed.
## Although the help file for 'rosnerTest' has a table with information
## on the estimated Type I error level,
## simulations were not run for k > 10 or k > floor(n/2).##
## Results of Outlier Test
## -------------------------
##
## Test Method: Rosner's Test for Outliers
##
## Hypothesized Distribution: Normal
##
## Data: XI
##
## Sample Size: 1852
##
## Test Statistics: R.1 = 14.536236
## R.2 = 14.287063
## R.3 = 14.949721
## R.4 = 15.101890
## R.5 = 15.116992
## R.6 = 15.992918
## R.7 = 16.108820
## R.8 = 14.084690
## R.9 = 13.512983
## R.10 = 13.135452
## R.11 = 11.501748
## R.12 = 11.152295
## R.13 = 11.470458
## R.14 = 11.742867
## R.15 = 9.484788
## R.16 = 9.468497
## R.17 = 9.597913
## R.18 = 9.810075
## R.19 = 10.031775
## R.20 = 8.479644
##
## Test Statistic Parameter: k = 20
##
## Alternative Hypothesis: Up to 20 observations are not
## from the same Distribution.
##
## Type I Error: 5%
##
## Number of Outliers Detected: 20
##
## i Mean.i SD.i Value Obs.Num R.i+1 lambda.i+1 Outlier
## 1 0 100.32954 340.0241 5043 64 14.536236 4.188005 TRUE
## 2 1 97.65927 320.1036 4671 883 14.287063 4.187879 TRUE
## 3 2 95.18719 301.9998 4610 557 14.949721 4.187752 TRUE
## 4 3 92.74543 283.2264 4370 1741 15.101890 4.187625 TRUE
## 5 4 90.43090 265.2359 4100 1178 15.116992 4.187498 TRUE
## 6 5 88.26004 248.3437 4060 1477 15.992918 4.187372 TRUE
## 7 6 86.10850 230.5502 3800 484 16.108820 4.187245 TRUE
## 8 7 84.09556 213.7714 3095 778 14.084690 4.187118 TRUE
## 9 8 82.46274 201.9937 2812 461 13.512983 4.186990 TRUE
## 10 9 80.98171 191.7725 2600 534 13.135452 4.186863 TRUE
## 11 10 79.61417 182.6145 2180 831 11.501748 4.186736 TRUE
## 12 11 78.47328 175.9751 2041 449 11.152295 4.186609 TRUE
## 13 12 77.40668 169.9665 2027 1820 11.470458 4.186481 TRUE
## 14 13 76.34655 163.8146 2000 75 11.742867 4.186354 TRUE
## 15 14 75.29995 157.5892 1570 1693 9.484788 4.186226 TRUE
## 16 15 74.48628 153.7217 1530 762 9.468497 4.186099 TRUE
## 17 16 73.69352 149.9604 1513 1260 9.597913 4.185971 TRUE
## 18 17 72.90916 146.1855 1507 1144 9.810075 4.185843 TRUE
## 19 18 72.12721 142.3350 1500 773 10.031775 4.185715 TRUE
## 20 19 71.34823 138.4081 1245 999 8.479644 4.185587 TRUE
##
##
## [1] 64 883 557 1741 1178 1477 484 778 461 534 831 449 1820 75 1693
## [16] 762 1260 1144 773 999
## Id Atípicas: Variable X 3## Warning in rosnerTest(XI, k = 20): The true Type I error may be larger than assumed.
## Although the help file for 'rosnerTest' has a table with information
## on the estimated Type I error level,
## simulations were not run for k > 10 or k > floor(n/2).##
## Results of Outlier Test
## -------------------------
##
## Test Method: Rosner's Test for Outliers
##
## Hypothesized Distribution: Normal
##
## Data: XI
##
## Sample Size: 1832
##
## Test Statistics: R.1 = 19.619815
## R.2 = 10.684568
## R.3 = 8.288896
## R.4 = 8.444917
## R.5 = 7.702992
## R.6 = 7.573833
## R.7 = 7.628456
## R.8 = 7.120683
## R.9 = 7.080820
## R.10 = 7.109797
## R.11 = 7.139076
## R.12 = 6.796095
## R.13 = 6.848216
## R.14 = 6.611559
## R.15 = 6.678923
## R.16 = 6.372910
## R.17 = 6.368047
## R.18 = 5.961998
## R.19 = 5.958327
## R.20 = 5.945795
##
## Test Statistic Parameter: k = 20
##
## Alternative Hypothesis: Up to 20 observations are not
## from the same Distribution.
##
## Type I Error: 5%
##
## Number of Outliers Detected: 20
##
## i Mean.i SD.i Value Obs.Num R.i+1 lambda.i+1 Outlier
## 1 0 12.61932 17.96045 365.0 37 19.619815 4.185459 TRUE
## 2 1 12.42687 15.96444 183.0 1805 10.684568 4.185331 TRUE
## 3 2 12.33366 15.46241 140.5 968 8.288896 4.185203 TRUE
## 4 3 12.26359 15.17320 140.4 1186 8.444917 4.185075 TRUE
## 5 4 12.19349 14.87818 126.8 476 7.702992 4.184947 TRUE
## 6 5 12.13076 14.63846 123.0 709 7.573833 4.184818 TRUE
## 7 6 12.07004 14.41051 122.0 927 7.628456 4.184690 TRUE
## 8 7 12.00981 14.18266 113.0 1786 7.120683 4.184561 TRUE
## 9 8 11.95444 13.98786 111.0 653 7.080820 4.184433 TRUE
## 10 9 11.90011 13.79785 110.0 1100 7.109797 4.184304 TRUE
## 11 10 11.84627 13.60873 109.0 655 7.139076 4.184175 TRUE
## 12 11 11.79292 13.42051 103.0 1615 6.796095 4.184047 TRUE
## 13 12 11.74280 13.25268 102.5 966 6.848216 4.183918 TRUE
## 14 13 11.69291 13.08422 98.2 58 6.611559 4.183789 TRUE
## 15 14 11.64532 12.92943 98.0 1829 6.678923 4.183660 TRUE
## 16 15 11.59780 12.77316 93.0 1034 6.372910 4.183530 TRUE
## 17 16 11.55297 12.63292 92.0 1755 6.368047 4.183401 TRUE
## 18 17 11.50865 12.49436 86.0 503 5.961998 4.183272 TRUE
## 19 18 11.46759 12.37468 85.2 666 5.958327 4.183143 TRUE
## 20 19 11.42692 12.25624 84.3 1737 5.945795 4.183013 TRUE
##
##
## [1] 37 1805 968 1186 476 709 927 1786 653 1100 655 1615 966 58 1829
## [16] 1034 1755 503 666 1737boxplot(Datos_A)
Datos_Sin_A=Datos_A
dim(Datos_Sin_A)[1]## [1] 1812Imputación de datos faltantes con el programa R
#install.packages("VIM")
library("VIM")## Loading required package: colorspace## Loading required package: grid## The legacy packages maptools, rgdal, and rgeos, underpinning this package
## will retire shortly. Please refer to R-spatial evolution reports on
## https://r-spatial.org/r/2023/05/15/evolution4.html for details.
## This package is now running under evolution status 0## VIM is ready to use.## Suggestions and bug-reports can be submitted at: https://github.com/statistikat/VIM/issues##
## Attaching package: 'VIM'## The following object is masked from 'package:datasets':
##
## sleep# Lectura de archivo de datos
Datos=read.table("IMD_PD_Clase_02_PreProcesamiento_01_Datos01.csv",header=TRUE,sep=";")
attach(Datos)## The following objects are masked from Datos (pos = 8):
##
## X1, X2, X3, X4, X5, X6, Ystr(Datos)## 'data.frame': 1872 obs. of 7 variables:
## $ X1: num 212 461 80 139 405 227 133 225 168 164 ...
## $ X2: num 240 18 120 6 600 40 5 170 248 13 ...
## $ X3: num 19.5 12.7 17.5 10 2 1.2 4 26 4 17 ...
## $ X4: int 64 79 70 50 36 48 92 75 23 48 ...
## $ X5: int 2 8 10 25 40 8 10 1 15 4 ...
## $ X6: int 46 67 39 58 64 55 44 44 47 36 ...
## $ Y : num NA NA NA NA NA NA NA NA NA NA ...dim(Datos)[1]## [1] 1872summary(Datos)## X1 X2 X3 X4
## Min. : 3.0 Min. : 0.5 Min. : 0.20 Min. : 2.00
## 1st Qu.: 71.0 1st Qu.: 7.0 1st Qu.: 3.00 1st Qu.:28.00
## Median :124.0 Median : 20.0 Median : 8.00 Median :40.00
## Mean :164.4 Mean : 101.9 Mean : 12.83 Mean :41.07
## 3rd Qu.:219.0 3rd Qu.: 70.0 3rd Qu.: 15.50 3rd Qu.:51.00
## Max. :960.0 Max. :5043.0 Max. :365.00 Max. :98.00
##
## X5 X6 Y
## Min. : 1.00 Min. :20.00 Min. : 5
## 1st Qu.: 4.00 1st Qu.:41.00 1st Qu.: 220
## Median :10.00 Median :49.50 Median : 640
## Mean :14.29 Mean :50.08 Mean :1431
## 3rd Qu.:21.00 3rd Qu.:59.00 3rd Qu.:2200
## Max. :68.00 Max. :91.00 Max. :7250
## NA's :458# Renombrar los nombres de las variables si es necesario
# names(Datos)=c("X1","X2","X3","X4","X5","X6","Y")
# Distribución y gráfico de missing por variable y combinaciones de variables
countNA(Datos)# Contar número de missing por variable## [1] 458R1<-aggr(Datos, numbers=TRUE, prop=c(TRUE,FALSE))# Gráfico distribución de missing
summary(R1)# Tabla de frecuencias de missing##
## Missings per variable:
## Variable Count
## X1 0
## X2 0
## X3 0
## X4 0
## X5 0
## X6 0
## Y 458
##
## Missings in combinations of variables:
## Combinations Count Percent
## 0:0:0:0:0:0:0 1414 75.53419
## 0:0:0:0:0:0:1 458 24.46581R2<-histMiss(Datos)# Histograma por variable (continua) de datos faltantes
R3<-barMiss(Datos)# Barras por variable (categórica) de datos faltantes
R4<-marginmatrix(Datos) 
R5<-matrixplot(Datos)
# Medidas estadísticas de base de datos con datos completos y datos faltantes
apply(Datos, 2, mean)## X1 X2 X3 X4 X5 X6 Y
## 164.43269 101.91629 12.83125 41.06731 14.29487 50.07853 NAsummary(Datos$Y, na.rm=TRUE); sd(Datos$Y, na.rm=TRUE)## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 5 220 640 1431 2200 7250 458## [1] 1667.921n=dim(Datos)[1]; n_F=countNA(Datos); n_C=n-n_F; n_F; n_C; n## [1] 458## [1] 1414## [1] 1872f=c(n_F,n_C); fr=round(prop.table(f)*100,1); cbind(f, fr); n## f fr
## [1,] 458 24.5
## [2,] 1414 75.5## [1] 1872hist(Datos$Y, breaks=10, freq=NULL, main=" ", xlab="Ingreso de los hogares", ylab="Número de hogares")
# Método de eliminación de datos
Datos_C<-Datos[is.na(Datos$Y)!=1,]# Datos_C=BD sólo con datos completos
Datos_F<-Datos[is.na(Datos$Y)!=0,]# Datos_F=BD sólo con datos faltantes
# También: Datos_C=na.omit(datos) o Datos_C=na.exclude(Datos)apply(Datos_C, 2, mean)## X1 X2 X3 X4 X5 X6 Y
## 162.39604 101.60566 12.75438 39.20156 14.10184 50.31259 1431.48373apply(Datos_C, 2, sd)## X1 X2 X3 X4 X5 X6 Y
## 137.08039 349.71161 17.44087 18.55680 13.19201 13.69622 1667.92116summary(Datos_C$Y); sd(Datos_C$Y)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 5 220 640 1431 2200 7250## [1] 1667.921As=(3*(mean(Datos_C$Y)-median(Datos_C$Y)))/sd(Datos_C$Y); As## [1] 1.423599hist(Datos$Y, breaks=10, freq=NULL, main=" ", xlab="Ingreso de los hogares", ylab="Número de hogares")
round(cor(Datos_C), 4)## X1 X2 X3 X4 X5 X6 Y
## X1 1.0000 0.1126 0.2047 0.1423 -0.0483 0.0163 0.4548
## X2 0.1126 1.0000 0.0399 0.0242 0.0431 0.0337 0.0618
## X3 0.2047 0.0399 1.0000 0.1481 -0.0479 -0.1634 0.2680
## X4 0.1423 0.0242 0.1481 1.0000 -0.1578 -0.1705 0.2043
## X5 -0.0483 0.0431 -0.0479 -0.1578 1.0000 0.5133 -0.0675
## X6 0.0163 0.0337 -0.1634 -0.1705 0.5133 1.0000 -0.1323
## Y 0.4548 0.0618 0.2680 0.2043 -0.0675 -0.1323 1.0000# Cálculo del intervalo de confianza del 95% para la media del ingreso
n=dim(Datos_C)[1]; Alfa=0.05
LI= mean(Datos_C$Y)- qt(1-Alfa/2, n-1)*sd(Datos_C$Y)/sqrt(n); LI## [1] 1344.473LS= mean(Datos_C$Y)+ qt(1-Alfa/2, n-1)*sd(Datos_C$Y)/sqrt(n); LS## [1] 1518.494R=LS-LI; R## [1] 174.0208# Cálculo del intervalo de confianza del 95% para la desviación estándar ingreso
n=dim(Datos_C)[1]; Alfa=0.05
LI= sqrt((n-1)*var(Datos_C$Y)/qchisq(1-Alfa/2,n-1)); LI## [1] 1608.634LS= sqrt((n-1)*var(Datos_C$Y)/qchisq(Alfa/2,n-1)); LS## [1] 1731.779R=LS-LI; R## [1] 123.1449Método de imputación por la media
# Método de imputación por la media
Datos_M=Datos# BD resultante por la imputación de la media
Promedio=mean(Datos$Y,na.rm=TRUE)
Datos_M[is.na(Datos_M$Y), 7] <- Promedio# Imputar los datos faltantes por la media
summary(Datos_M$Y); sd(Datos_M$Y)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 5 300 1431 1431 1500 7250## [1] 1449.472Método de imputación por la mediana
# Método de imputación por la mediana
Datos_M=Datos# BD resultante por la imputación de la mediana
Mediana=median(Datos$Y,na.rm=TRUE)
Datos_M[is.na(Datos_M$Y), 7] <- Mediana# Imputar los datos faltantes por la mediana
summary(Datos_M$Y); sd(Datos_M$Y)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 5 300 640 1238 1500 7250## [1] 1488.891Método de imputación HotDeck
# Método de imputación HotDeck (reemplazo aleatorio)
set.seed(5000)# Para tener los mismos resultados
Imp_HD<- hotdeck(Datos, variable=c("Y"), domain_var=c("X1","X3","X4","X5","X6"), impNA=TRUE, imp_var=TRUE)
Datos_Imp_HD<-Imp_HD# BD resultante por la imputación de HotDeck (aleatorio)
summary(Imp_HD$Y); sd(Imp_HD$Y)## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 5 220 640 1431 2200 7250 458## [1] NAMétodo de imputación por k vecino más cercano
# Método de imputación por k vecino más cercano
# Método de imputación por k=9 vecino más cercano (con la media)
# Datos_S=Datos[, c("X1","X2","X3","X4" ,"X5","X6","Y")]# BD selecciona variables donantes
Imp_Knn<-kNN(Datos, metric=NULL, k=9, numFun=mean, imp_var=FALSE)
Datos_Imp_Knn<-Imp_Knn# BD resultante por la imputación de k vecino más cercano
summary(Imp_Knn$Y); sd(Imp_Knn$Y)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 5.0 295.2 882.9 1423.3 2092.4 7250.0## [1] 1507.447Método de imputación por k=9 vecino más cercano (con la mediana)
# Método de imputación por k=9 vecino más cercano (con la mediana)
Imp_Knn<-kNN(Datos, metric=NULL, k=9, numFun=median, imp_var=FALSE)
Datos_Imp_Knn<-Imp_Knn# BD resultante por la imputación de k vecino más cercano
summary(Imp_Knn$Y); sd(Imp_Knn$Y)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 5 250 600 1317 1933 7250## [1] 1538.567Método de Imputación por regresión
# Método de Imputación por regresión
Imp_Reg<-regressionImp(data=Datos, family="AUTO", Y~X1+X2+X3+X4+X5+X6, imp_var=FALSE)
summary(Imp_Reg)## X1 X2 X3 X4
## Min. : 3.0 Min. : 0.5 Min. : 0.20 Min. : 2.00
## 1st Qu.: 71.0 1st Qu.: 7.0 1st Qu.: 3.00 1st Qu.:28.00
## Median :124.0 Median : 20.0 Median : 8.00 Median :40.00
## Mean :164.4 Mean : 101.9 Mean : 12.83 Mean :41.07
## 3rd Qu.:219.0 3rd Qu.: 70.0 3rd Qu.: 15.50 3rd Qu.:51.00
## Max. :960.0 Max. :5043.0 Max. :365.00 Max. :98.00
## X5 X6 Y
## Min. : 1.00 Min. :20.00 Min. : 5
## 1st Qu.: 4.00 1st Qu.:41.00 1st Qu.: 300
## Median :10.00 Median :49.50 Median :1000
## Mean :14.29 Mean :50.08 Mean :1465
## 3rd Qu.:21.00 3rd Qu.:59.00 3rd Qu.:2062
## Max. :68.00 Max. :91.00 Max. :8926Datos_Imp_Reg<-Imp_Reg# BD resultante por la imputación regresión
# Ajuste a una regresión con datos completos
Reg_Com<-lm(Datos_Imp_Reg$Y ~ X1+X2+X3+X4+X5+X6)
summary(Reg_Com)##
## Call:
## lm(formula = Datos_Imp_Reg$Y ~ X1 + X2 + X3 + X4 + X5 + X6)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4939.0 -711.8 0.0 148.8 5936.5
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 682.30520 141.23201 4.831 1.47e-06 ***
## X1 5.00025 0.22227 22.497 < 2e-16 ***
## X2 0.04419 0.08490 0.520 0.6028
## X3 14.38244 1.61304 8.916 < 2e-16 ***
## X4 9.83553 1.51420 6.496 1.06e-10 ***
## X5 4.41351 2.60704 1.693 0.0906 .
## X6 -13.88475 2.54347 -5.459 5.43e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1246 on 1865 degrees of freedom
## Multiple R-squared: 0.3201, Adjusted R-squared: 0.3179
## F-statistic: 146.4 on 6 and 1865 DF, p-value: < 2.2e-16Comparación de los métodos de imputación usando el ECM y Coef. Correlación
El ECM entre valores imputados y observados para cada uno de los métodos
Simular una muestra de datos faltantes del 10% con la BD con datos completos
Datos_A=Datos_C# BD que contendrá una muestra aleatoria de 10% missing
set.seed(5000)
indice <- sample(2, nrow(Datos_A), replace = TRUE, prob = c(0.90, 0.10))
Datos_A$Y[indice == 2] <-NA
n=dim(Datos_A)[1]; n_F=countNA(Datos_A); n_C=n-n_F
f=c(n_F,n_C); fr=round(prop.table(f)*100,1); cbind(f, fr); n## f fr
## [1,] 126 8.9
## [2,] 1288 91.1## [1] 1414# Método de imputación por la media
Datos_M=Datos_A
Promedio=mean(Datos_M$Y,na.rm=TRUE)
Datos_M[is.na(Datos_M$Y), 7] <- Promedio
ECM<-sum((Datos_M$Y-Datos_C$Y)^2);sqrt(ECM/n_F)## [1] 1504.549cor(Datos_M$Y, Datos_C$Y)## [1] 0.9630815# Método de imputación por la mediana
Datos_M=Datos_A
Mediana=median(Datos_M$Y,na.rm=TRUE)
Datos_M[is.na(Datos_M$Y), 7] <- Mediana
ECM<-sum((Datos_M$Y-Datos_C$Y)^2);sqrt(ECM/n_F)## [1] 1619.906cor(Datos_M$Y, Datos_C$Y)## [1] 0.9577189# Método de imputación HotDeck (aleatorio)
Imp_HD<- hotdeck(Datos_A, variable=c("Y"), domain_var=c("X1","X2","X3","X4","X5","X6"), impNA=TRUE, imp_var=TRUE)
Datos_Imp_HD<-Imp_HD
ECM<-sum((Datos_Imp_HD$Y-Datos_C$Y)^2);sqrt(ECM/n_F)## [1] NAcor(Datos_Imp_HD$Y, Datos_C$Y)## [1] NA# Método de imputación por k vecino más cercano (con la media)
Datos_S=Datos_A[, c("X1","X2","X3","X4","X5","X6","Y")]
Imp_Knn<-kNN(Datos_S, metric=NULL, k=9, numFun=mean, imp_var=FALSE)
Datos_Imp_Knn<-Imp_Knn
ECM<-sum((Datos_Imp_Knn$Y-Datos_C$Y)^2);sqrt(ECM/n_F)## [1] 1336.699cor(Datos_Imp_Knn$Y, Datos_C$Y)## [1] 0.9710811# Método de imputación por k vecino más cercano (con la mediana)
Imp_Knn<-kNN(Datos_S, metric=NULL, k=9, numFun=median, imp_var=FALSE)
Datos_Imp_Knn<-Imp_Knn
ECM<-sum((Datos_Imp_Knn$Y-Datos_C$Y)^2);sqrt(ECM/n)## [1] 430.0776cor(Datos_Imp_Knn$Y, Datos_C$Y)## [1] 0.9664493# Método de Imputación por regresión
Datos_S=Datos_A[, c("X1","X2","X3","X4","X5","X6","Y")]
Imp_Reg<-regressionImp(data=Datos_S, family="AUTO", Y~X1+X2+X3+X4+X5+X6, imp_var=FALSE)
summary(Imp_Reg)## X1 X2 X3 X4
## Min. : 3.0 Min. : 0.50 Min. : 0.200 Min. : 2.0
## 1st Qu.: 66.0 1st Qu.: 6.00 1st Qu.: 3.125 1st Qu.:25.0
## Median :119.0 Median : 20.00 Median : 8.000 Median :40.0
## Mean :162.4 Mean : 101.61 Mean : 12.754 Mean :39.2
## 3rd Qu.:215.8 3rd Qu.: 67.75 3rd Qu.: 15.700 3rd Qu.:48.0
## Max. :960.0 Max. :4671.00 Max. :200.000 Max. :98.0
## X5 X6 Y
## Min. : 1.0 Min. :20.00 Min. : 5
## 1st Qu.: 3.0 1st Qu.:40.00 1st Qu.: 250
## Median :10.0 Median :50.00 Median : 719
## Mean :14.1 Mean :50.31 Mean :1451
## 3rd Qu.:21.0 3rd Qu.:60.00 3rd Qu.:2200
## Max. :63.0 Max. :89.00 Max. :7250Datos_Imp_Reg<-Imp_Reg# BD resultante por la imputación regresión
ECM<-sum((Datos_Imp_Reg$Y-Datos_C$Y)^2);sqrt(ECM/n_F)## [1] 1377.288cor(Datos_Imp_Reg$Y, Datos_C$Y)## [1] 0.9692279