Laboratorio_1
Diana Carolina Echavarria Cardenas y Oscar Fernando PeƱafiel Acosta
2022-06-20
Universidad del Valle - Escuela de Estadistica
Programa Academico de:
Esp. en Estadistica Aplicada, Maestria en Analitica e Int Negocios
Asignatura : Tecnicas de Mineria de Datos y Aprendizaje Automatico
Estudiantes: Diana Carolina Echavarria
Oscar Fernando PeƱafiel 0. Configuracion inicial-Librerias requeridas
wd="C:\\Users\\Carolina\\OneDrive\\Carolina\\Maestria\\Tercer Semestre\\Mineria de Datos\\Laboratorios\\Laboratorio 1\\Solucion" # Establecer el dir de trabajo
setwd(wd)
library("easypackages")## Error in get(genname, envir = envir) :
## objeto 'testthat_print' no encontradolib_req<-c("lubridate","dplyr","visdat","missMDA","mice","DMwR2","corrplot","editrules","readxl")# Listado de librerias requeridas por el script
easypackages::packages(lib_req) # Verificacion, instalacion y carga de librerias.Punto1.
Lea la hoja de datos y adecue el formato de cada variable,
verificando que dispone de una hoja de datos tecnicamente correcta.
Base<- read_excel("calcium.xls")
View(Base)
str(Base)## tibble [178 x 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" ...## Modificacion del formato y transformacion de variables
Base1 = transform(Base,
Age=as.numeric(Age),
ALP=as.numeric(ALP),
CaMol=as.numeric(CaMol),
PhoMol=as.numeric(PhoMol))
str(Base1)## 'data.frame': 178 obs. of 8 variables:
## $ Observacion: num 1 2 3 4 5 6 7 8 9 10 ...
## $ Age : num 78 72 72 NA 73 73 65 68 89 84 ...
## $ Sex : chr "2" "2" "2" "2" ...
## $ ALP : num 83 117 132 102 114 88 213 153 86 108 ...
## $ Lab : chr "4" "4" "4" "4" ...
## $ CaMol : num 2.53 2.5 2.43 2.48 2.33 2.13 2.55 2.45 2.25 2.43 ...
## $ PhoMol : num 1.07 1.16 1.13 0.81 1.13 0.84 1.26 1.23 0.65 0.84 ...
## $ AgeG : chr "75 - 79" "70 - 74" "70 - 74" "70 - 74" ...#Validacion variables categoricas.
#Nota: Al ser pocos datos, se revisa uno a uno y se modifica el valor de la categoria
table(Base1$Sex)##
## 1 12 2 21 22 f F m M
## 87 1 83 1 1 1 1 1 2level_Sex=c("1" ="Male",
"12" ="Female",
"2" ="Female",
"21" ="Male",
"22" ="Female",
"F" ="Female",
"m" ="Male",
"f" ="Female",
"M" ="Male")
table(Base1$Lab)##
## 1 2 21 3 4 43 5 6 NA
## 88 41 1 16 13 1 11 6 1level_Lab=c("1" ="Metpath",
"2" ="Deyor",
"21" ="Deyor",
"3" ="St. Elizabets",
"4" ="CB Rouche",
"43" ="CB Rouche",
"5" ="YOH",
"6" ="Horizon")
table(Base1$AgeG)##
## 65 - 69 70 - 74 75 - 79 80 - 84 85-89 85 - 89 NA
## 55 70 38 9 1 4 1level_AgeG=c("65 - 69" ="65-69",
"70 - 74" ="70-74",
"75 - 79" ="75-79",
"80 - 84" ="80-84",
"85 - 89" ="85-89",
"85-89" ="85-89")
Base1 = transform(Base1,
Sex =factor(dplyr::recode(Sex,!!!level_Sex)),
Lab =factor(dplyr::recode(Lab, !!!level_Lab), levels=c("Metpath","Deyor","St. Elizabets","CB Rouche","YOH","Horizon"),ordered = T),
AgeG=factor(dplyr::recode(AgeG,!!!level_AgeG),levels=c("65-69","70-74","75-79","80-84","85-89"),ordered=T))
str(Base1)## 'data.frame': 178 obs. of 8 variables:
## $ Observacion: num 1 2 3 4 5 6 7 8 9 10 ...
## $ Age : num 78 72 72 NA 73 73 65 68 89 84 ...
## $ Sex : Factor w/ 2 levels "Female","Male": 1 1 1 1 1 1 1 1 2 2 ...
## $ ALP : num 83 117 132 102 114 88 213 153 86 108 ...
## $ Lab : Ord.factor w/ 6 levels "Metpath"<"Deyor"<..: 4 4 4 4 4 4 4 4 4 4 ...
## $ CaMol : num 2.53 2.5 2.43 2.48 2.33 2.13 2.55 2.45 2.25 2.43 ...
## $ PhoMol : num 1.07 1.16 1.13 0.81 1.13 0.84 1.26 1.23 0.65 0.84 ...
## $ AgeG : Ord.factor w/ 5 levels "65-69"<"70-74"<..: 3 2 2 2 2 2 5 1 5 4 ...summary(Base1) ## Observacion Age Sex ALP
## Min. : 1.00 Min. : 65.00 Female:87 Min. : 9.00
## 1st Qu.: 45.25 1st Qu.: 69.00 Male :91 1st Qu.: 71.00
## Median : 89.50 Median : 72.00 Median : 85.00
## Mean : 89.50 Mean : 83.65 Mean : 92.03
## 3rd Qu.:133.75 3rd Qu.: 75.50 3rd Qu.:109.00
## Max. :178.00 Max. :771.00 Max. :219.00
## NA's :3 NA's :1
## Lab CaMol PhoMol AgeG
## Metpath :88 Min. : 1.050 Min. :0.09 65-69:55
## Deyor :42 1st Qu.: 2.280 1st Qu.:0.97 70-74:70
## St. Elizabets:16 Median : 2.350 Median :1.13 75-79:38
## CB Rouche :14 Mean : 3.921 Mean :1.16 80-84: 9
## YOH :11 3rd Qu.: 2.480 3rd Qu.:1.23 85-89: 5
## Horizon : 6 Max. :25.300 Max. :8.84 NA's : 1
## NA's : 1 NA's :1 NA's :1Punto 2.
Construya el archivo: consistencia.txt, en el cual incluya las ecuaciones (reglas de validacion) que usted considera necesarias para verificar la consistencia de los datos en el conjunto de variables. Aplique estas reglas sobre la hoja de datos y genere un pequeno reporte de sus resultados,verificando que dispone de una hoja de datos tecnicamente correcta.
# Carga del archivo de reglas de validacion
Rules = editrules::editfile("consistencia.txt")
# ConexiĆĀ³n entre las reglas
windows()
plot(Rules)
# Verificacion de las reglas sobres los datos
#editrules::violatedEdits(Rules, Base1)
Valid_Data = editrules::violatedEdits(Rules, Base1)
summary(Valid_Data)## Edit violations, 178 observations, 0 completely missing (0%):
##
## editname freq rel
## mix5 2 1.1%
## mix10 2 1.1%
## dat11 1 0.6%
## dat12 1 0.6%
## mix3 1 0.6%
##
## Edit violations per record:
##
## errors freq rel
## 0 168 94.4%
## 1 6 3.4%
## 3 3 1.7%
## 5 1 0.6%# Visualizacion del diagnostico
windows()
plot(Valid_Data)
# Extraer las posiciones para correccion del dato
Inconsistencias=function(Valid_Data){
Reglas_inc=which(apply(Valid_Data,2,any))
Lab_Reglas_inc=colnames(Valid_Data)[Reglas_inc]
Registros_inc=unname(which(apply(Valid_Data,1,any)))
id_reg_inc= lapply(Reglas_inc,function(j){
unname(which(Valid_Data[,j]))})
return(list(Lab_Reglas_inc=Lab_Reglas_inc,id_reg_inc=id_reg_inc))
}
Inconsistencias(Valid_Data)## $Lab_Reglas_inc
## [1] "dat11" "dat12" "mix3" "mix5" "mix10"
##
## $id_reg_inc
## $id_reg_inc$dat11
## [1] 79
##
## $id_reg_inc$dat12
## [1] 170
##
## $id_reg_inc$mix3
## [1] 53
##
## $id_reg_inc$mix5
## [1] 11 123
##
## $id_reg_inc$mix10
## [1] 7 35#$Lab_Reglas_inc
#[1] ""dat11" "dat12" "mix3" "mix5" "mix10"
#$id_reg_inc
#$id_reg_inc$dat11
#[1] 79"
#Se debe corregir el rango
Base1[79,8]<-"80-84"
#$id_reg_inc$dat12
#[1] 170
Base1[170,5]<-NA
#Es un NA y no hay informaciĆĀ³n en la base de datos
#$id_reg_inc$mix3
#[1] 53
Base1[53,2]<-69
#$id_reg_inc$mix5
#[1] 11 123
Base1[11,2]<-71
Base1[123,2]<-73
#$id_reg_inc$mix10
#[1] 7 35"
Base1[7,8]<-"65-69"
Base1[35,8]<-"80-84"
#Verificacion de los ajustes de las reglas de calidad
#editrules::violatedEdits(Rules, Base1)
Valid_Data = editrules::violatedEdits(Rules, Base1)
summary(Valid_Data)## Edit violations, 178 observations, 0 completely missing (0%):
##
## editname freq rel
## dat12 1 0.6%
##
## Edit violations per record:
##
## errors freq rel
## 0 174 97.8%
## 1 1 0.6%
## 3 3 1.7%Inconsistencias(Valid_Data)## $Lab_Reglas_inc
## [1] "dat12"
##
## $id_reg_inc
## $id_reg_inc$dat12
## [1] 170Punto 3.
Visualice e identifique los registros que presentan datos faltantes.
#is.na(Base1)
x11()
visdat::vis_miss(Base1) 
# Una funcion (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,0.03), ylim=c(0,max(coord)+1),main= "% datos faltantes por variable")
axis(2,at=coord,labels=names(Var_per), cex.axis=0.7,pos=0,las=2)
axis(1,seq(0,01,0.02),seq(0,01,0.02),pos=0)
coord<-barplot(Obs_per,plot=F)
barplot(Obs_per,xaxt="n",horiz=T,yaxt="n",xlim=c(-0,0.15), ylim=c(0,max(coord)+1),main= "% datos faltantes por registro")
axis(2,at=coord,labels=names(Obs_per),cex.axis=0.7,pos=0,las=2)
axis(1,seq(0,01,0.02),seq(0,01,0.02))
}
return(invisible(lista))
}
Summary.NA = miss(Base1)
Summary.NA$Obs.miss
## [1] 4 14 22 42 85 105 170Punto 4.
Con los resultados de los puntos 2 y 3, usted dispone de un listado de los registros inconsistentes y de los datos faltantes. Es necesario corregirlo
#Los datos inconsistentes se ajustaron durante la validacion previa
#Correccion de datos faltantes
Summary.NA$Obs.miss## [1] 4 14 22 42 85 105 170Base1[4,2]<-73
Base1[14,2]<-76
Base1[22,4]<-64
#No se tiene informacion en la base de datos
Base1[42,7]## [1] NABase1[85,6]## [1] NABase1[105,2]## [1] NABase1[170,5]## [1] <NA>
## Levels: Metpath < Deyor < St. Elizabets < CB Rouche < YOH < HorizonPunto 5
Sobre el conjunto de variables cuantitativas, realice un diagnostico de datos atipicos Utilice los dos enfoques, univariado y multivariado.Para cada dato atipico identificado, decida si debe ser retenido o aislado del anĆĀ”lisis de datos. #Validacion de datos atipicos, enfoque univariado:
x11()
boxplot(Base1)
# 5.1 Identificacion y visualizacion de outliers Univariados. ####
#Inicialmente se dejan los valores atipicos hasta realizar el analisis multivariado
#Age
x11()
par(mfrow=c(3,1))
with(Base1,{
hist(Age,freq=F,col="blue",breaks=13)
boxplot(Age,horizontal=T,col="blue")
hist(scale(Age),freq=F,col="blue",breaks=13)
}
)
#No son datos atipicos, las edades se encuentran en los rangos
#de estudio
x11()
par(mfrow=c(3,1))
with(Base1,{
hist(ALP,freq=F,col="green",breaks=13)
boxplot(ALP,horizontal=T,col="green")
hist(scale(ALP),freq=F,col="green",breaks=13)
}
)
#Validar datos atipicos:
which(Base1$ALP%in%boxplot.stats(Base1$ALP)$out)## [1] 7 60 74 80 94 100#El rango normal esta entre 30 y 115, se corrige la observacion 60
#los demas valores, pese a ser atipicos se dejan el estudio.
Base1[7,4] #*Se quitarĆĀ”## [1] 213Base1[60,4]<-97
Base1[74,4]## [1] 168Base1[80,4]#*Se quitarĆĀ”## [1] 193Base1[94,4]#*Se quitarĆĀ”## [1] 219Base1[100,4]## [1] 171#CaMol
x11()
par(mfrow=c(3,1))
with(Base1,{
hist(CaMol,freq=F,col="red",breaks=13)
boxplot(CaMol,horizontal=T,col="red")
hist(scale(CaMol),freq=F,col="red",breaks=13)
}
)
#Validar datos atipicos:
which(Base1$CaMol%in%boxplot.stats(Base1$CaMol)$out)## [1] 21 25 26 27 28 29 30 31 32 33 34 35 36 37 148 149#En este caso se revisaron los valores atipicos y se corrigieron, la observacion
#148, pese a presentar valores atipicos se deja en el estudio.
Base1[21,6]<-2.2
Base1[25,6]<-2.53
Base1[26,6]<-2
Base1[27,6]<-2.23
Base1[28,6]<-2.43
Base1[29,6]<-2.5
Base1[30,6]<-2.33
Base1[31,6]<-2.4
Base1[32,6]<-2.5
Base1[33,6]<-2.5
Base1[34,6]<-2.35
Base1[35,6]<-2.25
Base1[36,6]<-2.45
Base1[37,6]<-2.33
Base1[148,6]## [1] 1.9Base1[149,6]<-2.05
#PhoMol
x11()
par(mfrow=c(3,1))
with(Base1,{
hist(PhoMol,freq=F,col="red",breaks=13)
boxplot(PhoMol,horizontal=T,col="red")
hist(scale(PhoMol),freq=F,col="red",breaks=13)
}
)
#Validar datos atipicos:
which(Base1$PhoMol%in%boxplot.stats(Base1$PhoMol)$out)## [1] 23 32 108 132 176#En este caso se revisaron los valores atipicos y se corrigieron, la observacion
#23, pese a presentar valores atipicos se deja en el estudio.
Base1[23,7] #Se quitara## [1] 0.52Base1[32,7]<-1.23
Base1[108,7]<-0.9
Base1[132,7]<-0.84
Base1[176,7]<-1.26
##Criterio Distancia Cooks
mean(Base1$ALP, na.rm=TRUE)## [1] 92.36517model=lm(ALP~1,data=Base1);CD=cooks.distance(model)
id_ALP=unname(which(CD>4*mean(CD)))
windows()
labels=1:nrow(Base1);labels[-id_ALP]="."
plot(CD,pch=20);abline(h=4*mean(CD),col="red",ylab="Cooks_Distance")
text(id_ALP,CD[id_ALP],id_ALP, col="red",pos=3,cex=0.8)
mean(Base1$CaMol, na.rm = TRUE)## [1] 2.354915model=lm(CaMol~1,data=Base1, set.seed(123));CD=cooks.distance(model)
id_CaMol=unname(which(CD>4*mean(CD)))
windows()
labels=1:nrow(Base1);labels[-id_CaMol]="."
plot(CD,pch=20);abline(h=4*mean(CD),col="red",ylab="Cooks_Distance")
text(id_CaMol,CD[id_CaMol],id_CaMol, col="red",pos=3,cex=0.8)
mean(Base1$PhoMol,na.rm = TRUE )## [1] 1.102712model=lm(PhoMol~1,data=Base1);CD=cooks.distance(model)
id_PhoMol=unname(which(CD>4*mean(CD)))
windows()
labels=1:nrow(Base1);labels[-id_PhoMol]="."
plot(CD,pch=20);abline(h=4*mean(CD),col="red",ylab="Cooks_Distance")
text(id_PhoMol,CD[id_PhoMol],id_PhoMol, col="red",pos=3,cex=0.8)
#Funcion Valores atipicos 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)
}
# Miremos como funciona la funcion
id.out.uni(Base1$ALP,method="Standarized")## [1] 7 80 94id.out.uni(Base1$ALP,method="Tukey")## [1] 7 74 80 94 100id.out.uni(Base1$ALP,method="Cook")## [1] 7 17 74 80 89 94 100 105id.out.uni(Base1$CaMol,method="Standarized")## [1] 148id.out.uni(Base1$CaMol,method="Tukey")## [1] 148id.out.uni(Base1$CaMol,method="Cook")## [1] 20 26 48 50 89 98 147 148 176id.out.uni(Base1$PhoMol,method="Standarized")## [1] 23id.out.uni(Base1$PhoMol,method="Tukey")## [1] 23id.out.uni(Base1$PhoMol,method="Cook")## [1] 9 13 23 78 92# 5.2 Identificacion y visualizacion de outliers Multivariados.####
str(Base1)## 'data.frame': 178 obs. of 8 variables:
## $ Observacion: num 1 2 3 4 5 6 7 8 9 10 ...
## $ Age : num 78 72 72 73 73 73 65 68 89 84 ...
## $ Sex : Factor w/ 2 levels "Female","Male": 1 1 1 1 1 1 1 1 2 2 ...
## $ ALP : num 83 117 132 102 114 88 213 153 86 108 ...
## $ Lab : Ord.factor w/ 6 levels "Metpath"<"Deyor"<..: 4 4 4 4 4 4 4 4 4 4 ...
## $ CaMol : num 2.53 2.5 2.43 2.48 2.33 2.13 2.55 2.45 2.25 2.43 ...
## $ PhoMol : num 1.07 1.16 1.13 0.81 1.13 0.84 1.26 1.23 0.65 0.84 ...
## $ AgeG : Ord.factor w/ 5 levels "65-69"<"70-74"<..: 3 2 2 2 2 2 1 1 5 4 ...delete.na <- function(df, n=0) {
df[rowSums(is.na(df)) <= n,]
}
Base1.1<-delete.na(Base1)
Base.cor = cor(Base1[,-c(1,3,5,8)],method="pearson",use = "pairwise.complete.obs")
windows(height=10,width=15)
corrplot::corrplot(Base.cor , method = "ellipse",addCoef.col = "black",type="upper")
windows(height=10,width=15)
pairs(Base1[,-c(1,3,5,8)],lower.panel = panel.smooth, pch = 15)
## Visualizacion 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=F,df=p)
id.dist= which(Distance>Limit)
Score_LOF = DMwR2::lofactor(Datos, k=5)
id.LOF <- order(Score_LOF, decreasing=T)[1:ceiling(0.01*n)]
windows()
par(mfrow=c(2,1))
plot(Distance,pch=20,ylim=c(0,max(Distance)*1.2))
text(id.dist,Distance[id.dist],id.dist, col="red",pos=3,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=3,cex=0.8)
return(list(Out_dist=id.dist,Out_LOF=id.LOF))
}
id_Out_mult=out.mult(Base1[-c(42,85,105,170),c(2,4,6,7)])
id_Out_mult$Out_dist
## 7 9 23 79 80 94 148
## 7 9 23 78 79 92 145#Seleccion de datos atipicos que se cambiaran por NA
Base1[7,4]<-NA# #*Se quitara
Base1[80,4]<-NA#*Se quitara
Base1[94,4]<-NA#*Se quitara
Base1[100,4]<-NA#*Se quitara
Base1[74,4]<-NA#*Se quitara
Base1[148,6]<-NA#*Se quitara
Base1[23,7]<-NA#*Se quitara
Base1[79,7]<-NA#*Se quitara
Base1[93,7]<-NA#*Se quitara por decision del analisa al revisar la dispersion
Base.cor = cor(Base1[,-c(1,3,5,8)],method="pearson",use = "pairwise.complete.obs")
windows(height=10,width=15)
corrplot::corrplot(Base.cor , method = "ellipse",addCoef.col = "black",type="upper")
windows(height=10,width=15)
pairs(Base1[,-c(1,3,5,8)],lower.panel = panel.smooth, pch = 15)
Punto 6
Ahora usted tiene una hoja de datos con unos pocos datos faltantes. Algunos de ellos son originalmente ausentes y otros se convirtieron en ausentes por ser datos atipicos aislables. Sugiera el metodo adecuado para realizar la imputacion de estos datos y ejecutelo.
Summary.NA = miss(Base1)
Summary.NA$Obs.miss
## [1] 7 23 42 74 79 80 85 93 94 100 105 148 170Base1[c(Summary.NA$Obs.miss),]## Observacion Age Sex ALP Lab CaMol PhoMol AgeG
## 7 7 65 Female NA CB Rouche 2.55 1.26 65-69
## 23 23 68 Male 82 YOH 2.15 NA 65-69
## 42 42 75 Female 88 Deyor 2.28 NA 75-79
## 74 74 73 Male NA Deyor 2.55 1.13 70-74
## 79 79 82 Female 115 Metpath 2.33 NA 80-84
## 80 80 79 Female NA Metpath 2.28 1.23 75-79
## 85 85 78 Female 115 Metpath NA 1.19 75-79
## 93 93 72 Female 73 Metpath 2.45 NA 70-74
## 94 94 70 Female NA Metpath 2.25 1.16 70-74
## 100 100 69 Female NA Metpath 2.33 1.07 65-69
## 105 105 NA Female 163 Metpath 2.25 1.36 65-69
## 148 148 68 Male 107 Metpath NA 1.32 65-69
## 170 170 72 Female 89 <NA> 2.30 1.36 70-74#Imputacion por regresion
imputM = mice::mice(Base1[,-c(1)], maxit = 1, method = "mean",seed = 2018,print=F)
Datos_ImputM = mice::complete(imputM)
#Imputacion por KNN
Datos_ImputKNN<-DMwR2::knnImputation(Base1[,c(2,4,6,7)],k=5,scale=T,meth = "weighAvg")
windows(height=10,width=15); visdat::vis_miss(Datos_ImputKNN)
# Imputacion por la media.
#Edad
Base1F<- subset(Base1, Sex=="Female")
Base1M<- subset(Base1, Sex=="Male")
Datos_ImputProm_Edad<-tapply(Base1F$Age,Base1F$AgeG, mean, na.rm=T)
#Variable Edad
Datos_ImputProm_Edad## 65-69 70-74 75-79 80-84 85-89
## 67.20000 71.89130 76.53333 81.20000 NADatos_ImputKNN[105,]## Age ALP CaMol PhoMol
## 105 70.71545 163 2.25 1.36Datos_ImputM[105,]## Age Sex ALP Lab CaMol PhoMol AgeG
## 105 72.32203 Female 163 Metpath 2.25 1.36 65-69#Imputamos la edad
Base1[105,2]<-67
#Imputacion por regresion
imputM = mice::mice(Base1[,-c(1)], maxit = 1, method = "mean",seed = 2018,print=F)
Datos_ImputM = mice::complete(imputM)
#Imputacion por KNN
Datos_ImputKNN<-DMwR2::knnImputation(Base1[,c(2,4,6,7)],k=5,scale=T,meth = "weighAvg")
# Imputacion por la media.
#ALP
Datos_ImputProm_ALPF<-tapply(Base1F$ALP,Base1F$AgeG, mean, na.rm=T)
Datos_ImputProm_ALPM<-tapply(Base1M$ALP,Base1M$AgeG, mean, na.rm=T)
####Variable ALP###
Datos_ImputProm_ALPF #103.47368 ## 65-69 70-74 75-79 80-84 85-89
## 103.47368 92.55556 96.14286 71.80000 NADatos_ImputKNN[7,] #108.7911## Age ALP CaMol PhoMol
## 7 65 108.7911 2.55 1.26Datos_ImputM[7,]#89.46243## Age Sex ALP Lab CaMol PhoMol AgeG
## 7 65 Female 89.46243 CB Rouche 2.55 1.26 65-69###Por comparacion, se define realizar la imputacion a traves de KNN
Base1<-data.frame(Datos_ImputKNN,Base1)
Base1<-Base1[,c(5,1,7,2,9,3,4,12)]#Se dejan las variables imputadas+cualitativas
windows(height=10,width=15); visdat::vis_miss(Datos_ImputKNN)Punto 7
Exportamos el archivo clean_calcium.csv
write.table(Base1, file="clean_calcium.csv", sep="|",dec=",", row.names = FALSE)Punto 8
Utilice sus habilidades de analista para resumir los datos en algunas tablas resumen y/o tableros grƔficos, en los cuales se pueda evidenciar:
# library
library(ggplot2)
library(dplyr)
library(hrbrthemes)i. La distribuciĆ³n de los pacientes por edad, laboratorio y gĆ©nero.
#Rango de Edad
ggplot(data = Base1, aes(x = AgeG, fill = as.factor(AgeG))) +
geom_bar(show.legend = FALSE) +
scale_fill_manual(values=c("#b2182b","#b2182b","#b2182b","#b2182b","#b2182b","#b2182b"))+
scale_y_continuous(breaks = seq(0, 70, by = 5))+
xlab("Rango de edad") +
ylab("Cantidad de pacientes") +
ggtitle("Distribucion de pacientes por rango de edad") +
labs(fill = "Rango de edad")
#Laboratorio
ggplot(data = Base1, aes(x = Lab, fill = as.factor(Lab))) +
geom_bar(show.legend = FALSE) +
scale_fill_manual(values=c("#b2182b","#b2182b","#b2182b","#b2182b","#b2182b","#b2182b"))+
scale_y_continuous(breaks = seq(0, 80, by = 10))+
xlab("Laboratorio") +
ylab("Cantidad de pacientes") +
ggtitle("Distribucion de pacientes por Laboratorio") +
labs(fill = "Laboratorio")
#Sexo
ggplot(data = Base1, aes(x = Sex, fill = as.factor(Sex))) +
geom_bar() +
scale_fill_manual(values=c("#b2182b", "#2166ac"))+
xlab("Sexo") +
ylab("Cantidad") +
ggtitle("Distribucion de pacientes por sexo") +
labs(fill = "Sexo")
ii. Las diferencias de las variables clinicas: ALP, CaMol, PhoMol entre los grupos de edad (AgeG) , Sexo (Sex) y Laboratorio (Lab).
##Rango de Edad#
#ALP
ggplot(Base1, aes(x=ALP, y=AgeG, fill=AgeG)) +
geom_boxplot()+
scale_fill_manual(values=c("#e41a1c", "#377eb8","#4daf4a","#984ea3","#ff7f00"))+
xlab("ALP") +
ylab("Rango de Edad") +
ggtitle("Diferencias en la Fosfatasa alcalina por Rango de Edad") +
labs(fill = "Rango de edad")
#CaMol
ggplot(Base1, aes(x=CaMol, y=AgeG, fill=AgeG)) +
geom_boxplot()+
scale_fill_manual(values=c("#e41a1c", "#377eb8","#4daf4a","#984ea3","#ff7f00"))+
xlab("CaMol") +
ylab("Rango de Edad") +
ggtitle("Diferencias en el calcio por Rango de Edad") +
labs(fill = "Rango de edad")
#PhoMol
ggplot(Base1, aes(x=PhoMol, y=AgeG, fill=AgeG)) +
geom_boxplot()+
scale_fill_manual(values=c("#e41a1c", "#377eb8","#4daf4a","#984ea3","#ff7f00"))+
xlab("PhoMol") +
ylab("Rango de Edad") +
ggtitle("Diferencias en el fosforo por Rango de Edad") +
labs(fill = "Rango de edad")
#SEX
#ALP
ggplot(Base1, aes(x=ALP, y=Sex, fill=Sex)) +
geom_boxplot()+
scale_fill_manual(values=c("#b2182b", "#2166ac"))+
xlab("ALP") +
ylab("Sexo") +
ggtitle("Diferencias en la Fosfatasa alcalina por Sexo") +
labs(fill = "Sexo")
#CaMol
ggplot(Base1, aes(x=CaMol, y=Sex, fill=Sex)) +
geom_boxplot()+
scale_fill_manual(values=c("#b2182b", "#2166ac"))+
xlab("CaMol") +
ylab("Sexo") +
ggtitle("Diferencias en el calcio por Sexo") +
labs(fill = "Sexo")
#PhoMol
ggplot(Base1, aes(x=PhoMol, y=Sex, fill=Sex)) +
geom_boxplot()+
scale_fill_manual(values=c("#b2182b", "#2166ac"))+
xlab("PhoMol") +
ylab("Sexo") +
ggtitle("Diferencias en el fosforo por Sexo") +
labs(fill = "Sexo")
#LAB
#ALP
ggplot(Base1, aes(x=ALP, y=Lab, fill=Lab)) +
geom_boxplot()+
scale_fill_manual(values=c("#e41a1c", "#377eb8","#4daf4a","#984ea3","#ff7f00","#ffff33"))+
xlab("ALP") +
ylab("Laboratorio") +
ggtitle("Diferencias en la Fosfatasa alcalina por Laboratorio") +
labs(fill = "Lab")
#CaMol
ggplot(Base1, aes(x=CaMol, y=Lab, fill=Lab)) +
geom_boxplot()+
scale_fill_manual(values=c("#e41a1c", "#377eb8","#4daf4a","#984ea3","#ff7f00","#ffff33"))+
xlab("CaMol") +
ylab("Laboratorio") +
ggtitle("Diferencias en el calcio por Laboratorio") +
labs(fill = "Lab")
#PhoMol
ggplot(Base1, aes(x=PhoMol, y=Lab, fill=Lab)) +
geom_boxplot()+
scale_fill_manual(values=c("#e41a1c", "#377eb8","#4daf4a","#984ea3","#ff7f00","#ffff33"))+
xlab("PhoMol") +
ylab("Laboratorio") +
ggtitle("Diferencias en el fosforo por Laboratorio") +
labs(fill = "Lab")
iii. La estructura de correlacion entre las variables cuantitativas: Age, ALP, CaMol,PhoMol.
Base.cor = cor(Base1[,-c(1,3,5,8)],method="pearson")
windows(height=10,width=15)
corrplot::corrplot(Base.cor , method = "ellipse",addCoef.col = "black",type="upper")
windows(height=10,width=15)
pairs(Base1[,-c(1,3,5,8)],lower.panel = panel.smooth, pch = 15)