Laboratorio No. 1 - Preprocesamiento de Datos
Técnicas de Minería de Datos y Aprendizaje Automático
Laura Lucía Domínguez y Juan Camilo Ordoñez
29/05/2022
Objetivos
Objetivo principal: Analizar las diferencias en los niveles de Calcio (CaMol), Fosforo (PhoMol) y Fosfatasa Alcalina (ALP) para pacientes mayores de 65 años de edad en función del género (Sex = Male or Female).
Objetivo específico: Determinar si la variación de las condiciones analíticas entre laboratorios o la edad de los pacientes, afecta a la distribución de las 3 variables de estudio.
Descripción de variables
Variables cuantitativas
- Age ( Edad en años del paciente)
- CaMol (Calcio en milimoles por litro; (mmo/L))
- PhoMol (Fósforo en milimoles por litro; (mmo/L))
- ALP (Fosfatasa Alcalina UL/L)
Variables cualitativas
- Sex (Sexo del paciente): 1=Male; 2=Female
- Lab (Laboratorio ): 1=Metpath; 2=Deyor; 3=St. Elizabeth’s; 4=CB Rouche; 5=YOH; 6=Horizon
- AgeG (Rango de edades): 65-69; 70-74; 75-79; 80-84; 85-89 años
Solución del laboratorio
Parte 1 : Estructura y verificación de la base de datos
Calcio=read_excel("calcium.xls") # Lectura de Datos en R
str(Calcio) # Verificar la estructura de las variables## tibble [178 × 8] (S3: tbl_df/tbl/data.frame)
## $ Observacion: num [1:178] 1 2 3 4 5 6 7 8 9 10 ...
## $ Age : chr [1:178] "78" "72" "72" "NA" ...
## $ Sex : chr [1:178] "2" "2" "2" "2" ...
## $ ALP : chr [1:178] "83" "117" "132" "102" ...
## $ Lab : chr [1:178] "4" "4" "4" "4" ...
## $ CaMol : chr [1:178] "2.5299999999999998" "2.5" "2.4300000000000002" "2.48" ...
## $ PhoMol : chr [1:178] "1.0700000000000001" "1.1599999999999999" "1.1299999999999999" "0.81000000000000005" ...
## $ AgeG : chr [1:178] "75 - 79" "70 - 74" "70 - 74" "70 - 74" ...attach(Calcio)En la salida anterior se evidencia que todas la variables están siendo tomadas como caracteres, entonces se procede a cambiar su estructura, de tal forma que las variables cualitativas queden como variables de tipo factor y las variables cualitativas queden de tipo numérico.
#Se suprimen las salidas de alertas referentes a datos faltantes, pues estos se tocarán más adelante.
Calcio$Age<-suppressWarnings(as.numeric(Calcio$Age))
Calcio$ALP<-suppressWarnings(as.numeric(Calcio$ALP))
Calcio$CaMol<-suppressWarnings(as.numeric(Calcio$CaMol))
Calcio$PhoMol<-suppressWarnings(as.numeric(Calcio$PhoMol))Calcio$Sex<-as.factor(Calcio$Sex)
Calcio$Lab<-as.factor(Calcio$Lab)
Calcio$AgeG<-as.factor(Calcio$AgeG)Se vuelve a verificar la estructura de la base de datos, confirmando así que esta ha quedado correctamente especificada (las variables cualitativas tomadas como factor y las cuantitativas tomadas como númerico).
str(Calcio)## tibble [178 × 8] (S3: tbl_df/tbl/data.frame)
## $ Observacion: num [1:178] 1 2 3 4 5 6 7 8 9 10 ...
## $ Age : num [1:178] 78 72 72 NA 73 73 65 68 89 84 ...
## $ Sex : Factor w/ 9 levels "1","12","2","21",..: 3 3 3 3 6 3 3 3 9 1 ...
## $ ALP : num [1:178] 83 117 132 102 114 88 213 153 86 108 ...
## $ Lab : Factor w/ 9 levels "1","2","21","3",..: 5 5 5 5 5 6 5 5 5 5 ...
## $ CaMol : num [1:178] 2.53 2.5 2.43 2.48 2.33 2.13 2.55 2.45 2.25 2.43 ...
## $ PhoMol : num [1:178] 1.07 1.16 1.13 0.81 1.13 0.84 1.26 1.23 0.65 0.84 ...
## $ AgeG : Factor w/ 7 levels "65 - 69","70 - 74",..: 3 2 2 2 2 2 6 1 6 4 ...Parte 2 : Consistencia de la base de datos
Para verificar que cada variable ha sido correctamente digitada en la base de datos o, que dicho dato es coherente con los rangos de la variable, se medira la consistencia de la base de datos; lo anterior con los rangos o factores especificados por el mismo artículo. En el caso de las variables CaMol y PhoMol que cuentan con varios rangos de referencia, se tomará el valor mínimo y máximo de las referncias globales para establecer el rango. Finalmente, las reglas de consistencia serán:
Variables cuantitativas:
\(65\leq Age \leq 89\)
\(2.1\leq CaMol \leq 2.7\)
\(0.84\leq PhoMol \leq 1.5\)
\(30\leq ALP \leq 115\)
Variables cualitativas:
\(Sex=\left \{ 1=Male; 2=Female \right \}\)
\(Lab=\left \{ 1=Metpath; 2=Deyor; 3=St. Elizabeth's; 4=CB Rouche; 5=YOH; 6=Horizon\right \}\)
\(AgeG=\left \{ 65-69; 70-74; 75-79; 80-84; 85-89 \right \}\)
Aplicando las reglas de consistencia a la base de datos se tiene:
# Carga del archivo de reglas de validación
Rules = editrules::editfile("consistencia.txt")
# Conexión entre las reglas
plot(Rules)
# Verificación de las reglas sobres los datos
Valid_Data = editrules::violatedEdits(Rules, Calcio)
summary(Valid_Data)## Edit violations, 178 observations, 0 completely missing (0%):
##
## editname freq rel
## num8 34 19.1%
## num4 15 8.4%
## dat11 8 4.5%
## num5 7 3.9%
## num6 5 2.8%
## num2 3 1.7%
## dat10 3 1.7%
## mix13 3 1.7%
## num3 2 1.1%
## dat9 2 1.1%
## num7 1 0.6%
## mix9 1 0.6%
##
## Edit violations per record:
##
## errors freq rel
## 0 105 59%
## 1 54 30.3%
## 2 14 7.9%
## 3 2 1.1%
## 6 1 0.6%
## 7 2 1.1%Del resumen estadístico de la verificación de las reglas sobre los datos se puede extraer que:
Tres pacientes presentan una edad mayor de 89 años (uno de ellos tiene una edad de 771 años).
Dos pacientes presentan una medición del calcio menor a 2.1 (cercano a 1, violando el límie inferior del rango coherente según las referencias). Quince pacientes presentan una medición del calcio mayor a 2.7 (estos quince individuos tienen una medición cerca a 25 (mmo/L), medida incoherente según las referencias)
Siete pacientes tienen una medición de Fósforo menor de 0.84 (mediciones cercanas a 0.09, siendo estas muy bajas). Por otro lado, seis pacientes presentan mediciones de Fósforo en su cuerpo mayores a 1.5 (cercanas a 8.9, siendo estas muy altas e incoherentes con los rangos degún las referencias).
Para la variable que mide Fosfatasa Alcalina, se encontró una medición menor a 30, igual a 9. Así mismo, se encontraron 34 pacientes com mediciones mayores a 115 y cercanas a 219 (siendo estas muy grandes y violando el límite superior coherente según los estudios de referencia).
Para la variable Sexo, se encontraron que ocho mediciones estaban decodficadas de forma diferetne a 1 y 2. Para la varaible Laboratorio se encontró que 3 pacientes tenían decodificaciones diferentes a los 6 laboratorios asginados originalmente. Finalmente, se encontró que un total de tres pacientes no estaban categorizados correctamente según los rangos de edades datos.
Parte 3: Visualización e identifiación de datos faltantes
Relizando la identificación de los datos faltantes en R se tiene:
visdat::vis_miss(Calcio) # Una función que visualiza los datos faltantes en la hoja de calculo## Warning: `gather_()` was deprecated in tidyr 1.2.0.
## Please use `gather()` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was generated.
De la salida anterior se evidencia que un total del 0.4% de nuestros datos son faltantes. Las variables que tienen estos datos faltantes son Age, ALP CaMol y PhoMol.
# Una función (Desarrollo propio: Evalua e identifica los datos faltantes por variable e individuo)
miss<-function(Datos,plot=T){
n=nrow(Datos);p=ncol(Datos)
names.obs<-rownames(Datos)
nobs.comp=sum(complete.cases(Datos)) # Cuenta los registros completos
Obs.comp=which(complete.cases(Datos)) # Identifica los registros completos
nobs.miss = sum(!complete.cases(Datos)) # Identifica los registros con datos faltantes.
Obs.miss=which(!complete.cases(Datos)) # Identifica los registros con datos faltantes.
Datos.NA<-is.na(Datos)
Var_Num<- sort(colSums(Datos.NA),decreasing=T)
Var_per<-round(Var_Num/n,3)
Obs_Num<-rowSums(Datos.NA)
names(Obs_Num)<-names.obs
Obs_Num<-sort(Obs_Num,decreasing=T)
Obs_per<-round(Obs_Num/p,3)
lista<-list(n.row = n, n.col = p,n.comp = nobs.comp,Obs.comp = Obs.comp,n.miss = nobs.miss,Obs.miss = Obs.miss, Var.n = Var_Num , Var.p = Var_per, Obs.n= Obs_Num, Obs.per= Obs_per)
if(plot){
#windows(height=10,width=15)
par(mfrow=c(1,2))
coord<-barplot(Var_per,plot=F)
barplot(Var_per,xaxt="n",horiz=T,yaxt="n",xlim=c(-0.2,1), ylim=c(0,max(coord)+1),main= "% datos faltantes por variable")
axis(2,at=coord,labels=names(Var_per), cex.axis=0.5,pos=0,las=2)
axis(1,seq(0,1,0.2),seq(0,1,0.2),pos=0)
coord<-barplot(Obs_per,plot=F)
barplot(Obs_per,xaxt="n",horiz=T,yaxt="n",xlim=c(-0.2,1), ylim=c(0,max(coord)+1),main= "% datos faltantes por registro")
axis(2,at=coord,labels=names(Obs_per),cex.axis=0.5,pos=0,las=2)
axis(1,seq(0,1,0.2),seq(0,1,0.2))
}
return(invisible(lista))
}
Summary.NA = miss(Calcio) # Asignamos el resultado a un objeto lista para consultarlo
Los datos faltantes pertenecen a los registros: 4, 14, 22 ,42, 85 y 105.
Parte 4: Correción datos faltantes e inconsistencia en la base de datos
Como primera medida, se proceden a solucionar las inconsistencias obvias, esto es, mediante la declaración de niveles correctos para las variables tipo Factor:
level_Sex=c("f"="2","F"="2","M"="1", "m"="1","12"="2","21"="1","22"="2")
level_AgeG=c("85-89"="85 - 89")Se corrigen los datos faltantes remplazando los encontrados en los registros del enlace:
Calcio[4,2]=73;Calcio[14,2]=76;Calcio[22,4]=64
level_Lab=c("43"="4","21"="2")
Valid_Data=as.data.frame(Valid_Data);Name=colnames(Valid_Data)
OBS=c();for(i in 1:16){OBS[[i]]=which(Valid_Data[,Name[i]]==TRUE)} #Encontrar filas que violan todas las reglas
OBS=unlist(OBS);OBS=OBS[!duplicated(OBS)] #Lista de registros con violación a las reglas
#Se comparan los datos que violan las reglas vs lo datos originales, y se corrigen aquellos erroneos
or=order(OBS);OBS=OBS[or]; Va=Valid_Data[c(OBS),] #Extrae las filas de los registros son incoherencias
Calcio[53,2]=69;Calcio[11,2]=71;Calcio[123,2]=73;Calcio[25,6]=2.53;Calcio[26,6]=2.0;Calcio[27,6]=2.23;Calcio[28,6]=2.43;Calcio[29,6]=2.5;Calcio[30,6]=2.33;Calcio[31,6]=2.4;Calcio[32,6]=2.5;Calcio[33,6]=2.35;Calcio[34,6]=2.25;Calcio[35,6]=2.5;Calcio[36,6]=2.45;Calcio[37,6]=2.33;Calcio[32,7]=3.21;Calcio[176,7]=1.26;Calcio[132,7]=0.84;Calcio[108,7]=0.9;Calcio[60,4]=97Modificación del formato y transformación de variables
Calcio = transform(Calcio,
Sex=factor(dplyr::recode(Sex,!!!level_Sex)),
AgeG=factor(dplyr::recode(AgeG, !!!level_AgeG),levels=c("65 - 69","70 - 74","75 - 79","80 - 84","85 - 89"),ordered=TRUE),
Lab=factor(dplyr::recode(Lab, !!!level_Lab))
)
summary(Calcio[,c(2,4,6,7)]) | Age | ALP | CaMol | PhoMol | |
|---|---|---|---|---|
| Min. :65.00 | Min. : 42.00 | Min. :1.050 | Min. :0.520 | |
| 1st Qu.:69.00 | 1st Qu.: 71.25 | 1st Qu.:2.250 | 1st Qu.:0.970 | |
| Median :72.00 | Median : 85.00 | Median :2.350 | Median :1.130 | |
| Mean :72.32 | Mean : 92.37 | Mean :2.355 | Mean :1.114 | |
| 3rd Qu.:75.00 | 3rd Qu.:108.75 | 3rd Qu.:2.450 | 3rd Qu.:1.230 | |
| Max. :89.00 | Max. :219.00 | Max. :3.200 | Max. :3.210 | |
| NA’s :1 | NA | NA’s :1 | NA’s :1 |
En total se corrgieron 3 datos atípicos y 21 por mala digitación.
Parte 5: Diagnóstico de datos atípicos:
Enfoque univariado
id.out.uni=function(x,method=c("Standarized","Tukey","Cook")){
id.out=NULL
if(method=="Standarized"){id.out=which(abs(scale(x))>3)}
else if(method=="Tukey"){id.out=which(x%in%(boxplot.stats(x)$out))}
else if(method=="Cook"){model=lm(x~1);CD=cooks.distance(model)
id.out=unname(which(CD>4*mean(CD)))}
return(id.out)
}par(mfrow=c(1,4))
Boxplot=lapply(Calcio[,-c(1,3,5,8)],boxplot,col="blue")
### Identificar los Datos Atipicos
### Identificar los Datos Atipicos
out_Tukey = lapply(Calcio[,-c(1,3,5,8)],id.out.uni,method="Tukey");out_Tukey=unlist(out_Tukey)
out_Cook = lapply(Calcio[,-c(1,3,5,8)],id.out.uni,method="Cook");out_Cook=unlist(out_Cook)
# Se extraen los valores atípicos que conisiden de acuerdo a los métodos de Tukey y distancias Cook
At1= (out_Cook[order(out_Cook)] %in% out_Tukey[order(out_Tukey)]);At1=out_Cook[which(At1==TRUE)]Los registros que se pueden considerar atípicos de acuerdo al enfoque univariado y combinando los métodos de Tukey y distancias Cooks son:
At1## Age1 Age2 Age5 Age6 Age8 ALP5 ALP6 CaMol1 CaMol3 CaMol4
## 9 10 38 59 107 89 94 21 50 147
## PhoMol3
## 78Enfoque multivariado
####### Identificación multivariada de outliers
Calcio.cor = cor(na.omit(Calcio[,-c(1,3,5,8)]),method="pearson")
corrplot::corrplot(Calcio.cor , method = "ellipse",addCoef.col = "black",type="upper")
pairs(Calcio[,-c(1,3,5,8)],lower.panel = panel.smooth, pch = 15)
## Visualización de outliers multivariados
out.mult=function(Datos){
n= nrow(Datos); p= ncol(Datos)
Distance=mahalanobis(Datos,center=colMeans(Datos),cov=cov(Datos))
Limit= qchisq(0.01, lower.tail=FALSE,df=p)
id.dist= which(Distance>Limit)
Score_LOF = DMwR2::lofactor(Datos, k=5)
id.LOF <- order(Score_LOF, decreasing=TRUE)[1:ceiling(0.01*n)]
plot(Distance,pch=20,ylim=c(0,max(Distance)#*1.2))
))
text(id.dist,Distance[id.dist],id.dist, col="red",pos=2,cex=0.8)
abline(h=Limit,col="red",lwd=2,lty=2)
plot(Score_LOF,pch=20,ylim=c(0,max(Score_LOF)#*1.2))
))
text(id.LOF,Score_LOF[id.LOF],id.LOF, col="red",pos=2,cex=0.8)
return(list(Out_dist=id.dist,Out_LOF=id.LOF))
}id_Out_mult=out.mult(na.omit(Calcio[,-c(1,3,5,8)]))
Y con base en los gráficos anteriores, desde el enfoque multivariado los resgistros a considerarse atípicos son:
## [1] 7 9 21 32 80 94 149Finalmente, con base en el análisis Univariado y multivariado de datos atípicos se deciden amputar los siguientes tres registros:
| Registro | ColNumb | |
|---|---|---|
| ALP | 7 | 4 |
| CaMol | 21 | 6 |
| PhoMo | 32 | 7 |
| CaMol2 | 146 | 6 |
Finalmente se aíslan los registros que se consideraron anteriormente:
for(i in 1:4){Calcio[Registro[,1][i],Registro[,2][i]]=NA}Parte 6: Imputación de datos faltantes
Para la amputación de datos faltantes se tiene 3 opciones inicialmente:
Valor medio o Mediana: Consiste en remplazar el NA por la media o mediana de la varaible, dado que este método subestima la varianza y es poco robusto no se tomará en cuenta.
Amputación por regresión: Se predice el NA en función de los facores completos, el problema de este método es que si la asociación de las variables es poca es equivalente a remplazar la media.
Dado que los dos métodos anteriores no convencen, se procederá a realizar la amputación de datos faltantes por el método de las distancias (K vecinos cercanos).
## Imputación por vecindad (KNN)
Datos=Calcio
Datos_ImputKNN<-DMwR2::knnImputation(Datos,k=5,scale=T,meth = "weighAvg")
windows(height=10,width=15); visdat::vis_miss(Datos_ImputKNN)
par(mfrow=c(1,4))
Boxplot=lapply(Calcio[,-c(1,3,5,8)],boxplot,col="blue")
Terminando el proceso de imputación, se obtiene una base de datos limpia (sin datos faltantes) y con algunas correciones de datos atípicos que se consideraron influyentes.
Parte 7: txt
Genere un resumen de los cambios realizados en la hoja de datos. ReporteCambios.txt
Parte 8: Visualziación de datos
Exportando datos limpios de R a excel en formato CSV
## Datos limpios de R a excel
clean_calcium=Datos_ImputKNN
write.csv(clean_calcium,"clean_calcium.csv")Distribución de los pacientes por edad, género y laboratorio.
ii
Las diferencias de las variables clínicas: ALP, CaMol, PhoMol entre los grupos de edad (AgeG) , Sexo (Sex) y Laboratorio (Lab).
iii
La estructura de correlación entre las variables cuantitativas: Age, ALP, CaMol, PhoMol.