Ejercicio Integrador

Author

Hernán Vargas

Introducción

El archivo de base de datos es “endocrino.xlsx”, fuente: https://estadistica-dma.ulpgc.es/doctoMed, diseñado con el objetivo de estimar las prevalencias de diabetes en la población de Telde(Gran Canaria), así como para identificar los valores asociados a ella. Se tomaron muestras de sangre y se llenó un cuestionario diseñado para obtener informaciones diversas.

Actividad

a. Realizar un resumen numérico de las variables, indicando de que tipo son.

Code 
#Estas librerias serán necesarias
library(tidyverse)
library(readxl)
library(ggfx)


#Importar a R el archivo excel 'endocrino' que previamente se descargó de la dirección web.
telde<-read_excel("endocrino.xlsx",col_names = TRUE)
str(telde)
tibble [1,030 × 50] (S3: tbl_df/tbl/data.frame)
 $ ID          : num [1:1030] 22 65 116 144 204 337 458 541 551 557 ...
 $ EDAD        : num [1:1030] 51 33 40 62 33 33 68 56 55 46 ...
 $ SEXO        : num [1:1030] 1 1 1 1 1 1 1 1 1 1 ...
 $ PESO        : num [1:1030] 86.3 81.8 105 98 124 93 81 99 92 94.3 ...
 $ TALLA       : num [1:1030] 174 175 173 172 181 177 174 174 179 169 ...
 $ SEDENTARIO  : num [1:1030] 0 0 1 0 0 1 0 1 1 0 ...
 $ INSTRUCCION : chr [1:1030] "Primer grado" "Segundo grado" "Segundo grado" "Primer grado" ...
 $ TAS         : num [1:1030] 125 120 150 155 130 110 120 110 130 120 ...
 $ TAD         : num [1:1030] 80 80 100 100 90 70 70 70 80 80 ...
 $ HTA_conocida: num [1:1030] 1 0 0 0 0 0 0 0 0 0 ...
 $ HTA_OMS     : num [1:1030] 1 0 1 1 1 0 0 0 0 0 ...
 $ A_DIAB      : num [1:1030] 1 0 1 0 1 1 1 0 0 1 ...
 $ ECV_B       : num [1:1030] 1 0 0 0 0 0 0 0 0 0 ...
 $ TABACO      : num [1:1030] 0 1 1 1 0 0 0 0 0 1 ...
 $ ALCOHOL     : num [1:1030] 1 1 1 0 0 1 0 1 1 1 ...
 $ STATIN      : num [1:1030] 1 0 0 0 0 0 0 1 0 0 ...
 $ CINTURA     : num [1:1030] 104 86 116 104 130 108 100 114 105 109 ...
 $ CADERA      : num [1:1030] 102 89 107 103 122 ...
 $ OBCENT_ATP  : num [1:1030] 1 0 1 1 1 1 0 1 1 1 ...
 $ COLESTEROL  : num [1:1030] 190 217 288 225 224 163 217 306 283 218 ...
 $ HDL         : num [1:1030] 50 42 44 45 58 40 49 53 62 44 ...
 $ LDL         : num [1:1030] 123 144 NA 153 154 111 138 205 186 120 ...
 $ LDL_C       : chr [1:1030] "120 - 140" "140 - 160" NA "140 - 160" ...
 $ TG          : num [1:1030] 86 155 448 132 62 59 149 239 175 271 ...
 $ CnoHDL      : num [1:1030] 140 175 244 180 166 123 168 253 221 174 ...
 $ ApoA        : num [1:1030] 138.1 93.1 122.7 115.8 135.2 ...
 $ ApoB        : num [1:1030] 78 94 120 101 86 71 NA 150 130 99 ...
 $ LPA         : num [1:1030] 4.78 2.39 39.3 7.63 24.9 2.41 15.3 7.31 36.7 28.9 ...
 $ A1C         : num [1:1030] 6.17 5.58 5.38 5.38 5.19 ...
 $ hba1        : num [1:1030] 7.9 7.2 7.1 6.6 6.3 6 8.1 7.7 6.8 7.3 ...
 $ CREATININA  : num [1:1030] 0.9 1 1 0.9 0.8 0.9 1 1 1.2 1 ...
 $ GLUCB       : num [1:1030] 101 103 103 109 107 103 104 101 115 101 ...
 $ SOG         : num [1:1030] 122 100 90 96 69 117 166 94 162 143 ...
 $ Tol_Glucosa : chr [1:1030] "IFG" "IFG" "IFG" "IFG" ...
 $ DM          : num [1:1030] 0 0 0 0 0 0 0 0 0 0 ...
 $ conocida    : chr [1:1030] "Normal" "Normal" "Normal" "Normal" ...
 $ SM          : num [1:1030] 1 0 1 1 1 0 0 1 1 1 ...
 $ PCR         : num [1:1030] 0.34 0.32 0.58 0.32 0.32 0.34 0.34 0.34 0.34 0.49 ...
 $ INSULINEMIA : num [1:1030] 16.2 19.8 11.5 17.8 11.6 22.7 14.7 17.2 14.6 15.6 ...
 $ PAI_1       : num [1:1030] 47.8 57.2 38.5 32.4 32 71.7 46.3 56.8 71.1 31.6 ...
 $ fvw         : num [1:1030] 115 17.8 91 96.1 75 117 111 75.4 150 126 ...
 $ fibri       : num [1:1030] 2.4 2.89 2.71 2.45 3.78 3.53 3.85 3.18 3.2 2.64 ...
 $ HMC         : num [1:1030] 14 40.72 15.34 15.33 8.64 ...
 $ HOMA        : num [1:1030] 4.04 5.03 2.92 4.79 3.06 ...
 $ IR          : num [1:1030] 1 1 1 1 1 1 1 1 1 1 ...
 $ ecnos       : chr [1:1030] "ab" "bb" "bb" "bb" ...
 $ ppr         : chr [1:1030] "pp" "pp" "pp" "pp" ...
 $ fibratos    : chr [1:1030] "No" "No" "No" "No" ...
 $ CETP        : chr [1:1030] NA NA NA "B1B1" ...
 $ PON_192     : chr [1:1030] "QR" "QQ" "QR" "RR" ...

b. Seleccionar algunas variables de distintos tipos y realizar tablas y gráficos para cada variable.

Variables cuantitativas: HDL y LDL
Code 
telde|>select(HDL,LDL)|>
       stack()|>
       ggplot(aes(x=values,fill= ind))+geom_histogram(alpha=0.5,binwidth=2,
                                                      col="black")+
       scale_fill_discrete(name = "Variable")+labs(title = "Histogramas", y="frecuencias",
                                                   x="mg/dL")+
       theme(axis.title = element_text(color = 'blue',face = 'bold', size =10),
             plot.title = element_text(size = 14))

Figure 1: Estos son los histogramas de las variables seleccionadas, HDL:colesterol bueno y LDL:colesterol malo.Vemos una mayor concentración de los datos de la variable HDL entorno a sus valores centrales
Code 
telde|>arrange(HDL)|>summarise(n=n(),min=min(HDL),Q1=HDL[(length(HDL)+1)*0.25],media=mean(HDL),mediana=median(HDL),Q3=HDL[(length(HDL)+1)*0.75],max=max(HDL))|> rownames_to_column(var = "C")|>
       gather(-C,
               key= "Estadísticas", 
               value = "Value")|>mutate(Valores=round(Value,2))|>select(Estadísticas, Valores)
Table 1: variable HDL
Estadísticas Valores
n 1030.00
min 21.00
Q1 45.00
media 54.29
mediana 53.00
Q3 61.00
max 130.00
Code 
telde|>ggplot(aes(x=0,y=HDL))+
       geom_boxplot(fill= "pink")+
       labs(title = "Boxplot 1: variable HDL",y="mg/dL")+
       theme(axis.title = element_text(color = 'blue',face = 'bold', size =10),
             plot.title = element_text(size = 14))+
       stat_summary(fun.args = mean,color="red",size=0.7)

Figura 2:Boxplot 1, vemos que el 50 % de 
los datos se encuentran aprox. entre 65 
y 45 mg/dL, hay simetría con respecto a
la mediana y esta casi coincide con la
media, también se observa algunos valores
atípicos.
Variable cualitativa: Alcohol
Code 
telde|>select(ALCOHOL)|>
       mutate(ALCOHOL=factor(ALCOHOL,levels=c(0,1),labels=c("no","si")))|>count(ALCOHOL)
Table 2: Cantidad de casos
ALCOHOL n
no 685
si 345
Code 
telde|>mutate(ALCOHOL=factor(ALCOHOL,levels=c(0,1),labels=c("no","si")))|>
       ggplot(aes(ALCOHOL))+geom_bar(width=0.5)+labs(title = "Gráfico de barras",y="casos",x="consumo de alcohol")+ theme(axis.title = element_text(color = 'blue',face = 'bold', size =10),
             plot.title = element_text(size = 14))

Figura 3: vemos en el gráfico de barras 
que los casos que no consumen alcohol son
casi el doble.

c. Realizar un análisis descriptivo bivariado, con variables del mismo tipo y de distinto tipo

Distintos tipos de variables: SEDENTARIO(cualitativa), LDL(cuantitativa).
Code 
telde|>select(SEDENTARIO,LDL)|>mutate(SEDENTARIO=factor(SEDENTARIO,levels=c(0,1),
                                                        labels=c("si","no")))|>
       group_by(SEDENTARIO)|>summarise(LDL_media=mean(LDL,na.rm=TRUE),LDL_mediana=median(LDL,na.rm=TRUE))
Table 3: medidas de tendencia central variable LDL
SEDENTARIO LDL_media LDL_mediana
si 133.4767 130
no 134.4901 132
Code 
telde|>select(SEDENTARIO,LDL)|>mutate(SEDENTARIO=factor(SEDENTARIO,levels=c(0,1),
                                                        labels=c("si","no")))|>
       ggplot(aes(x=SEDENTARIO,y= LDL))+geom_boxplot(fill= "cyan")+
              labs(title = "Boxplot 2:LDL",y="mg/dL")+
              theme(axis.title = element_text(color = 'blue',face = 'bold', size =10),
                    plot.title = element_text(size = 14))+
              stat_summary(fun.args = mean,color="red",size=0.7)+
              geom_point()

Figura 4: Boxplot 2, vemos que hay 
simetría con respecto a la mediana
y esta casi coincide con la media 
en ambos casos, también se observa
algunos valores atípicos.Podriamos
intuir que no hay efecto del seden-
-tarismo en las cantidades de LDL 
en la sangre para estos casos.
Igual tipo de variables: SEDENTARIO(cualitativa), A_DIAB(cualitativa).
Code 
library(knitr)
telde|>select(SEDENTARIO,A_DIAB)|>
       mutate(SEDENTARIO=factor(SEDENTARIO,levels=c(0,1),labels=c("Sedentario_si","Sedentario_no")))|>
       mutate(A_DIAB=factor(A_DIAB,levels=c(0,1),labels=c("Dia_si","Dia_no")))|>
       table()|>kable(caption = "Tabla 4: tabla de contingencia")
Tabla 4: tabla de contingencia
Dia_si Dia_no
Sedentario_si 303 214
Sedentario_no 313 200
Code 
telde|>mutate(SEDENTARIO=factor(SEDENTARIO,levels=c(0,1),labels=c("si","no")))|>
       mutate(A_DIAB=factor(A_DIAB,levels=c(0,1),labels=c("si","no")))|>
       ggplot(aes(A_DIAB,SEDENTARIO))+ geom_count()+ labs(title = "Gráfico Tabla de cantidades")+
       theme(axis.title = element_text(color = 'blue',face = 'bold', size =10),
                    plot.title = element_text(size = 14))

Figura 5: vemos que la situación 
que tiene la menor cantidad de 
casos es cuando no es sedentario
y no padece diabetes tipo A.

d. Seleccionar el análisis de inferencia que corresponde para una variable cuantitativa y una cualitativa.

Se seleccionan las variables LDL e INSTRUCCION para realizar un análisis de varianza ANOVA
Code 
telde1<-telde|>select(INSTRUCCION,y=LDL)|>na.omit()|>
       mutate(INSTRUCCION=factor(INSTRUCCION,levels=c("Primer grado","Segundo grado","Tercer grado","Sin estudios")))|>group_by(INSTRUCCION)|>
       summarise(n=n(),media=mean(y),varianza=var(y),sd=sqrt(varianza),"cv(%)"=round(sd/mean(y)*100,2),"(Y-Ῡ)²"=sum((y-mean(y))^2))
telde1
INSTRUCCION n media varianza sd cv(%) (Y-Ῡ)²
Primer grado 355 136.6704 1046.2837 32.34631 23.67 370384.44
Segundo grado 502 133.0578 1033.8310 32.15324 24.16 517949.32
Tercer grado 150 129.9733 947.3147 30.77848 23.68 141149.89
Sin estudios 13 142.3077 949.3974 30.81229 21.65 11392.77
Code 
telde2<-telde|>select(INSTRUCCION,y=LDL)|>na.omit()|>
       summarise(N=length(y),media_total=mean(y),varianza_total=var(y),SCT=varianza_total*(N-1),
                 SCE=sum((telde1$media-media_total)^2*telde1$n),SCD=sum(telde1$`(Y-Ῡ)²`))
telde2
N media_total varianza_total SCT SCE SCD
1020 133.9794 1027.657 1047183 6306.141 1040876
Code 
nn=length(telde1$n)
telde3<-telde2|>summarise("CMᵗ"=SCE/(nn-1),"CMₑₑ"=SCD/(N-nn),"estadístico_ε"=CMᵗ/CMₑₑ,
                  pvalue=pf(estadístico_ε,nn-1,N-nn,lower.tail = FALSE))
telde3
CMᵗ CMₑₑ estadístico_ε pvalue
2102.047 1024.485 2.051809 0.1049999
Code 
telde|>select(INSTRUCCION,y=LDL)|>na.omit()|>
       mutate(INSTRUCCION=factor(INSTRUCCION,levels=c("Primer grado","Segundo grado","Tercer grado","Sin estudios")))|>group_by(INSTRUCCION)|>
       ggplot(aes(x=INSTRUCCION,y=y))+geom_boxplot()+
              labs(title = "Boxplot 3:LDL por INSTRUCCION",y="mg/dL")+
              theme(axis.title = element_text(color = 'blue',face = 'bold', size =10),
                    plot.title = element_text(size = 14))+
              stat_summary(fun.args = mean,color="red",size=0.7)+
              geom_point(shape=21)+scale_y_continuous(n.breaks = 15)

Boxplot 3: vemos que en todos los casos menos en la variable Tercer grado,los datos son bastantes simétricos. En la variable Tercer grado se observa un pequeño sesgo positivo.El 50% de los datos de las variables Primer, Segundo y Tercer grado se distribuye entre los valores de 110 y 160 mg/dL,pero en la variable Sin estudios varía su rango interquartil en 120 y 170, pero hay que tener en cuenta que esta variable solo tiene 13 muestras. La variable Segundo grado es la que presenta valores atípicos mayores. No se observa diferencias significativas en las varianzas por el tamaño de las cajas.
Code 
α=0.05
N=telde2$N

εα=qf(α,nn-1,N-1,lower.tail = FALSE)
tibble(ε= rf(5000,nn-1,N-1)) |> 
  ggplot(aes(ε)) +
  as_reference(geom_density(adjust = 2, fill = "white",colour="red"), id = "density") +
  with_blend(annotate("rect", xmin = εα, xmax = Inf, ymin = -Inf, ymax = Inf,
           fill = "red"), bg_layer = "density", blend_type = "atop")+
       geom_text(x=1,y=0.2,size=4,fontface="bold",label=paste0("Nivel de Confianza"))+
       geom_text(x=1,y=0.15,size=4,fontface="bold",label=paste0("<------ ",
                                                                (1-α)*100," %"," ------>"))+
       geom_vline(xintercept=0,linetype="dashed",colour="gray")+
       geom_text(x=εα,y=0.12,size=4,label=paste0(round(εα,2)))+
       geom_segment(aes(x=εα,y=0,xend=εα,yend=0.1))+
       geom_segment(aes(x=telde3$estadístico_ε,y=0,xend=telde3$estadístico_ε,yend=0.03))+
       geom_text(x=telde3$estadístico_ε,y=0.05,size=4,
                 label=paste0("ε= ",round(telde3$estadístico_ε,2)))+
       labs(title = "Distribución F")+ xlim(-0.1,5)

Code 
contraste<-c("Ho","Ha")
hipotesis<-c("μ1=μ2=μ3=μ4","μᵢ≠μ para al menos uno")
α<-c(α)
Resultado=NULL
if(telde3$pvalue<α){Resultado="se rechaza Ho"}else{Resultado="no se rechaza Ho"}
#hipotesis<-c("t1=t2=t3=0","tᵢ≠0 para al menos uno")
prueba<-tibble(contraste,"hipótesis"=hipotesis,α=α,"Decisión"=Resultado)
prueba
contraste hipótesis α Decisión
Ho μ1=μ2=μ3=μ4 0.05 no se rechaza Ho
Ha μᵢ≠μ para al menos uno 0.05 no se rechaza Ho

Comprobación

base_anova<-telde|>select(INSTRUCCION,y=LDL)|>na.omit()|>
       mutate(INSTRUCCION=factor(INSTRUCCION,levels=c("Primer grado","Segundo grado",
                                                      "Tercer grado","Sin estudios")))|>
       group_by(INSTRUCCION)
summary(aov(base_anova$y~base_anova$INSTRUCCION))
                         Df  Sum Sq Mean Sq F value Pr(>F)
base_anova$INSTRUCCION    3    6306    2102   2.052  0.105
Residuals              1016 1040876    1024
Conclusión:

A un nivel de significancia del 5% no se rechaza la Hipótesis nula, no hay evidencia estadísticamente significativa con estos datos para afirmar que las medias poblacionales de la ciudad de Telde son diferentes para al menos unos de los niveles.

e. Seleccionar con R una muestra de tamaño n=100, con algunas de las variables del archivo original.

1a=c(sample(1:50,4))
2telde|>select(a[1],a[2],a[3],a[4])|>slice_sample(n=100,replace = FALSE)|>
3head(10)
1
Se genera 4 números en forma aleatoria, que serán para seleccionar 4 variables para un nuevo marco de datos.
2
Usamos la base de datos ‘telde’, seleccionamos las variables y luego 100 casos de forma nuevamente aleatoria.
3
Se listan los primeros 10 casos de los 100 seleccionados al azar.
fibri TAS HMC HDL
3.29 130 21.22 50
2.76 130 17.25 52
3.20 120 11.40 62
4.43 120 4.57 54
2.42 110 9.40 66
3.95 110 5.87 56
2.46 140 13.67 50
4.33 110 7.25 60
3.18 115 10.54 57
2.42 120 8.17 42