Ejercicio Integrador-Marlene-Roman
Marlene Elizabeth Román de Del Puerto
2023-06-05
EJERCICIO INTEGRADOR El archivo de la base de datos “endocrino.xlsx”, se muestran parte de las variables medidas en un estudio transversal realizado, diseñado originalmente con el objetivo de estimar las prevalencias de diabetes mellitus (DM) en la población de Telde (Gran Canaria), así como para identificar los factores asociados con aquella. En el estudio se incluyeron 1030 sujetos con edades comprendidas entre los 30 y 82 años, que respondieron a un cuestionario diseñado para obtener información sobre la edad, sexo, historia personal y familiar de diabetes mellitus y estilos de vida. Se realizaron mediciones antropométricas y de presión arterial. Se tomaron muestras de sangre sobre las que se obtuvieron diversas mediciones (glucemia, lípidos, marcadores de inflamación, hemostasia, etc). Página para descargar datos https://estadistica-dma.ulpgc.es/doctoMed Aclaración: TAS: Presión arterial Sistólica; TAD: Presión arterial Diastólica; HTA_conocida: Padece de Hipertensión arterial; A_DIAB: Padece Diabetes tipo A; STATIN: Consume Estanina (medicamento para bajar colesterol y triglicéridos); OBCENT_ATP: Obesidad Central. CINTURA Y CADERA: perímetro en cm.
rm(list=ls(all=TRUE))
library(readxl)## Warning: package 'readxl' was built under R version 4.2.3telde<-read_excel("C:/Users/HP/OneDrive/Escritorio/Maestria/endocrino(1).xlsx")
telde## # A tibble: 1,030 × 50
## ID EDAD SEXO PESO TALLA SEDENTARIO INSTRUCCION TAS TAD HTA_conocida
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <chr> <dbl> <dbl> <dbl>
## 1 22 51 1 86.3 174 0 Primer gra… 125 80 1
## 2 65 33 1 81.8 175 0 Segundo gr… 120 80 0
## 3 116 40 1 105 173 1 Segundo gr… 150 100 0
## 4 144 62 1 98 172 0 Primer gra… 155 100 0
## 5 204 33 1 124 181 0 Segundo gr… 130 90 0
## 6 337 33 1 93 177 1 Segundo gr… 110 70 0
## 7 458 68 1 81 174 0 Primer gra… 120 70 0
## 8 541 56 1 99 174 1 Tercer gra… 110 70 0
## 9 551 55 1 92 179 1 Primer gra… 130 80 0
## 10 557 46 1 94.3 169 0 Primer gra… 120 80 0
## # ℹ 1,020 more rows
## # ℹ 40 more variables: HTA_OMS <dbl>, A_DIAB <dbl>, ECV_B <dbl>, TABACO <dbl>,
## # ALCOHOL <dbl>, STATIN <dbl>, CINTURA <dbl>, CADERA <dbl>, OBCENT_ATP <dbl>,
## # COLESTEROL <dbl>, HDL <dbl>, LDL <dbl>, LDL_C <chr>, TG <dbl>,
## # CnoHDL <dbl>, ApoA <dbl>, ApoB <dbl>, LPA <dbl>, A1C <dbl>, hba1 <dbl>,
## # CREATININA <dbl>, GLUCB <dbl>, SOG <dbl>, Tol_Glucosa <chr>, DM <dbl>,
## # conocida <chr>, SM <dbl>, PCR <dbl>, INSULINEMIA <dbl>, PAI_1 <dbl>, …- Realizar un resumen numérico de las variables, indicando de que tipo son. ##Las variables a utilizar en el trabajo son: #TAS: Presión arterial Sistólica;Variable Cuantitativa continua #TAD:Presión arterial Diastólica;Variable Cuantitativa continua #HTA_conocida:Padecimiento de Hipertensión;Variable cualitativa nominal #A_DIAB:Padecimiento diabetes tipo I;Variable cualitativa nominal #STATIN:Consume Estanina, medicamento para bajar colesterol y triglicéridos:Variable cualitativa nominal #OBCENT_ATP:Presenta obesidad Central;Variable cualitativa nominal #CINTURA:Perimetro de la cintura en cm:Variable Cuantitativa continua #CADERA: Perimetro de la cadera en cm:Variable Cuantitat
telde <-telde[,c("TAS","TAD","HTA_conocida","A_DIAB","STATIN","OBCENT_ATP","CINTURA","CADERA")]
str(telde)## tibble [1,030 × 8] (S3: tbl_df/tbl/data.frame)
## $ 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 ...
## $ A_DIAB : num [1:1030] 1 0 1 0 1 1 1 0 0 1 ...
## $ STATIN : num [1:1030] 1 0 0 0 0 0 0 1 0 0 ...
## $ OBCENT_ATP : num [1:1030] 1 0 1 1 1 1 0 1 1 1 ...
## $ CINTURA : num [1:1030] 104 86 116 104 130 108 100 114 105 109 ...
## $ CADERA : num [1:1030] 102 89 107 103 122 ...summary(telde)## TAS TAD HTA_conocida A_DIAB
## Min. : 70.0 Min. : 50.00 Min. :0.0000 Min. :0.0000
## 1st Qu.:110.0 1st Qu.: 70.00 1st Qu.:0.0000 1st Qu.:0.0000
## Median :120.0 Median : 70.00 Median :0.0000 Median :0.0000
## Mean :118.7 Mean : 73.34 Mean :0.2029 Mean :0.4019
## 3rd Qu.:130.0 3rd Qu.: 80.00 3rd Qu.:0.0000 3rd Qu.:1.0000
## Max. :190.0 Max. :120.00 Max. :1.0000 Max. :1.0000
##
## STATIN OBCENT_ATP CINTURA CADERA
## Min. :0.0000 Min. :0.0000 Min. : 61.00 Min. : 75.0
## 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.: 88.00 1st Qu.: 97.0
## Median :0.0000 Median :1.0000 Median : 97.00 Median :103.0
## Mean :0.1476 Mean :0.5738 Mean : 96.81 Mean :104.3
## 3rd Qu.:0.0000 3rd Qu.:1.0000 3rd Qu.:105.00 3rd Qu.:110.0
## Max. :1.0000 Max. :1.0000 Max. :145.00 Max. :150.0
## NA's :1 NA's :1Conforme a los resultados obtenidos a través de “str” y “summary” a la base telde, se verifican que existen variables cualitativas declaras como numérica, por lo que requieren ser declaradas como factor a fin de subsanarlas
Declararemos como factor algunas de las variables cualitativas y que figuran como numéricas y que serían de interés para la parte b):
telde$HTA_conocida <- factor(telde$HTA_conocida,labels=c("No padece","Sí padece"))
telde$A_DIAB <- factor(telde$A_DIAB,labels=c("No padece","Sí padece"))
telde$STATIN <- factor(telde$STATIN,labels=c("No consume","Sí consume"))
telde$OBCENT_ATP <- factor(telde$OBCENT_ATP,labels=c("No","Sí"))
summary(telde)## TAS TAD HTA_conocida A_DIAB
## Min. : 70.0 Min. : 50.00 No padece:821 No padece:616
## 1st Qu.:110.0 1st Qu.: 70.00 Sí padece:209 Sí padece:414
## Median :120.0 Median : 70.00
## Mean :118.7 Mean : 73.34
## 3rd Qu.:130.0 3rd Qu.: 80.00
## Max. :190.0 Max. :120.00
##
## STATIN OBCENT_ATP CINTURA CADERA
## No consume:878 No:439 Min. : 61.00 Min. : 75.0
## Sí consume:152 Sí:591 1st Qu.: 88.00 1st Qu.: 97.0
## Median : 97.00 Median :103.0
## Mean : 96.81 Mean :104.3
## 3rd Qu.:105.00 3rd Qu.:110.0
## Max. :145.00 Max. :150.0
## NA's :1 NA's :1#b) Seleccionar algunas variables de distinto tipo y realizar tablas y Gráficos, #para cada variable (Análisis Univariado) ##Las variables a utilizar en el trabajo son: #TAS: Presión arterial Sistólica;Variable Cuantitativa continua #TAD:Presión arterial Diastólica;Variable Cuantitativa continua #HTA_conocida:Padecimiento de Hipertensión;Variable cualitativa nominal #A_DIAB:Padecimiento diabetes tipo I;Variable cualitativa nominal #STATIN:Consume Estanina, medicamento para bajar colesterol y triglicéridos:Variable cualitativa nominal #OBCENT_ATP:Presenta obesidad Central;Variable cualitativa nominal #CINTURA:Perimetro de la cintura en cm:Variable Cuantitativa continua #CADERA: Perimetro de la cadera en cm:Variable Cuantitativa continua ## VARIABLES CUALITATIVAS #Variable Hipertensión Arterial
tabla_HTA<-xtabs(~ HTA_conocida, data = telde);tabla_HTA## HTA_conocida
## No padece Sí padece
## 821 209prop.table(tabla_HTA)*100## HTA_conocida
## No padece Sí padece
## 79.70874 20.29126barplot(tabla_HTA,
xlab = "Hipertensión arterial",
ylab = "Frecuencia",
main = "Distribución de pacientes según padecimiento o no de hipertensión",
col = "blueviolet")
#Variable Diabetes Tipo I
tabla_A_DIAB<-xtabs(~ A_DIAB, data = telde);tabla_A_DIAB## A_DIAB
## No padece Sí padece
## 616 414prop.table(tabla_A_DIAB)*100## A_DIAB
## No padece Sí padece
## 59.80583 40.19417barplot(tabla_A_DIAB,
xlab = "Diabetes Tipo I",
ylab = "Frecuencia",
main = "Distribución de pacientes según padecimiento o no de Diabetes Tipo I",
col = "blue")
#Variable Consume EStatina
tabla_STATIN<-xtabs(~ STATIN, data = telde);tabla_STATIN## STATIN
## No consume Sí consume
## 878 152prop.table(tabla_STATIN)*100## STATIN
## No consume Sí consume
## 85.24272 14.75728barplot(tabla_STATIN,
xlab = "Consume Estanina",
ylab = "Frecuencia",
main = "Distribución de pacientes según consume o no Estanina",
col = "pink")
#Variable Obesidad Central
tabla_OBCENT_ATP<-xtabs(~OBCENT_ATP, data = telde);tabla_OBCENT_ATP## OBCENT_ATP
## No Sí
## 439 591prop.table(tabla_OBCENT_ATP)*100## OBCENT_ATP
## No Sí
## 42.62136 57.37864barplot(tabla_OBCENT_ATP,
xlab = "Obesidad Central",
ylab = "Frecuencia",
main = "Distribución de pacientes según padecimiento o no de Obesidad Central",
col = "red")
#VARIABLES CUANTITATIVAS
#Variable:TAS: PresiÓn arterial Sistólica
boxplot(telde$TAS,las=1,
ylab="Presion arterial SistÓlica",
main="Distribucion de la Presion Arterial Sistolica",
col = "green",
pch = 18)
#Variable:TAD:PresiÓn arterial DiastÓlica
summary(telde$TAD)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 50.00 70.00 70.00 73.34 80.00 120.00boxplot(telde$TAD,las=1,
ylab="Presion arterial Diastolica",
main="Distribucion de la Presion Arterial Diastólica",
col = "violet",
pch = 16)
#Variable:Perímetro de la cintura en cm
summary(telde$CINTURA)## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 61.00 88.00 97.00 96.81 105.00 145.00 1boxplot(telde$CINTURA,las=1,
ylab="Perimetro de cintura",
main="Distribucion del perimetro de cintura en cm",
col = "navyblue",
pch = 16)
#Variable:Perímetro de la cadera en cm
summary(telde$CADERA)## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 75.0 97.0 103.0 104.3 110.0 150.0 1boxplot(telde$CADERA,las=1,
ylab="Perimetro de cadera",
main="Distribucion del perimetro de cadera en cm",
col = "orange",
pch = 16)
#c) Realizar un análisis descriptivo Bivariado, con variables del mismo
tipo y de distinto tipo. #Variables:Padece obesidad y Perimetro de
cintura y cadera
boxplot(telde$CINTURA ~telde$OBCENT_ATP,las=1,
ylab="Perimetro de cintura",
xlab = "Presenta obesidad central",
main="Distribucion del perimetro de cintura segun\npadecimiento de obesidad",
col = "aquamarine2",
pch = 16)
boxplot(telde$CADERA ~telde$OBCENT_ATP,las=1,
ylab="Perimetro de cadera en cm",
xlab = "Presenta Obesidad Central",
main="Distribucion del perimetro de cadera segun\npadecimiento de obesidad",
col = "red3",
pch = 16)
#Variables:Padece HTA y Padece Diabetes
tabla_hta_diab<-xtabs(~HTA_conocida+A_DIAB,data = telde)
tabla_hta_diab## A_DIAB
## HTA_conocida No padece Sí padece
## No padece 487 334
## Sí padece 129 80#Variables:Padece obesidad y consume Estanina
tabla_obe_sta<-xtabs(~OBCENT_ATP+STATIN,data = telde)
tabla_obe_sta## STATIN
## OBCENT_ATP No consume Sí consume
## No 402 37
## Sí 476 115plot_obe_sta<-barplot(tabla_obe_sta,xlab = "Padece obesidad",
beside = T,col=c("pink","yellow"),ylim = c(0,600),
main="Distribucion del consumo de Estanina segun\npadecimiento de obesidad")
legend(4.5,500,legend=c("No padece","si padece"),fill=c("pink","yellow"),
title="Padece obesidad",title.adj=0.5)
text(plot_obe_sta,tabla_obe_sta+30,tabla_obe_sta)
#Variables:Padece obesidad y padece diabetes
tabla_obe_dia<-xtabs(~OBCENT_ATP+A_DIAB,data=telde)
tabla_obe_dia## A_DIAB
## OBCENT_ATP No padece Sí padece
## No 270 169
## Sí 346 245plot_obe_dia<-barplot(tabla_obe_dia,xlab = "Padece obesidad",
beside = T,col=c("blue","yellow"),ylim = c(0,500),
main="Padecimiento de Obesidad y\ndiabetes")
legend(3,470,legend=c("Sí","No"),fill=c("blue","yellow"),
title="Padece obesidad",title.adj=0.5)
text(tabla_obe_dia,tabla_obe_dia+0.5,tabla_obe_dia)
#Variables:Padece obesidad y Presión arterial Diastólica y Presion
Arterial Sistolica
boxplot(telde$TAD ~telde$OBCENT_ATP,las=1,
ylab="Presion arterial Diastolica",
xlab = "Presenta obesidad central",
main="Distribucion de la Presion arterial Diastolica segun\npadecimiento de obesidad",
col = "red",
pch = 16)
boxplot(telde$TAS~telde$OBCENT_ATP,las=1,
ylab="Presion arterial Sistolica",
xlab = "Presenta Obesidad Central",
main="Distribucion de la Presion arterial Sistolica segun\npadecimiento de obesidad",
col = "blue",
pch = 16)
#d) Seleccionar el análisis Inferencial que corresponda para una
variable cuantitativa y una cualitativa.
#El analisis inferencial se realiza con las variables CADERA en centimetro como variable cuantitativa y #la variable obesidad(padece o no obesidad) pare ver si existe diferencia significativa entre el promedio #en cm de la variable CADERA segun padece o no obesidad
#Primero analizamos la normalidad de las variables #\(H_0\)> El perimetro de la CADERA tiene distribucion normal segun padecimiento de obesidad #\(H_1\)> El perimetro de la CADERA no tiene distribucion normal segun padecimiento de obesidad #Para demostrar la normalidad utilizamos la prueba K-S
si_obesidad<-telde[telde$OBCENT_ATP=="Sí","CADERA"]
si_obesidad## # A tibble: 591 × 1
## CADERA
## <dbl>
## 1 102.
## 2 107
## 3 103
## 4 122
## 5 106
## 6 109
## 7 105
## 8 111
## 9 105
## 10 116
## # ℹ 581 more rowsno_obesidad<-telde[telde$OBCENT_ATP=="No","CADERA"]
no_obesidad## # A tibble: 439 × 1
## CADERA
## <dbl>
## 1 89
## 2 106
## 3 105
## 4 104
## 5 100
## 6 95
## 7 97
## 8 102
## 9 102
## 10 100
## # ℹ 429 more rowsks.test(si_obesidad$CADERA,"pnorm",mean(si_obesidad$CADERA),sd(si_obesidad$CADERA))## Warning in ks.test.default(si_obesidad$CADERA, "pnorm",
## mean(si_obesidad$CADERA), : ties should not be present for the
## Kolmogorov-Smirnov test##
## Asymptotic one-sample Kolmogorov-Smirnov test
##
## data: si_obesidad$CADERA
## D = 0.11989, p-value = 8.372e-08
## alternative hypothesis: two-sidedks.test(no_obesidad$CADERA,"pnorm",mean(no_obesidad$CADERA,na.rm = T),sd(no_obesidad$CADERA,na.rm = T))## Warning in ks.test.default(no_obesidad$CADERA, "pnorm",
## mean(no_obesidad$CADERA, : ties should not be present for the
## Kolmogorov-Smirnov test##
## Asymptotic one-sample Kolmogorov-Smirnov test
##
## data: no_obesidad$CADERA
## D = 0.056948, p-value = 0.1167
## alternative hypothesis: two-sided#En la prueba k-s los p-valores son menores a 0.05, por lo que rechazamos la hipotesis de normalidad, #es decir el perimetro de la cadera no tiene distribucion normal segun padecimiento de obesidad #Teniendo en cuenta este resultado, comparar los gurpos mediante sus valores promedios puede ser muy #poco adecuado y como no sigue una distribución normal, el test de la t de Student puede no ser válido.
#En este caso resulta conveniente realizar la comparación mediante un test no parametrico, en este caso #podemos utilizar el test de Wilcoxon-Man Whitney para muestras independientes, pero antes es necesario #probar la homocedasticidad de Varianzas #Para ello utilizaremos el test de levene
#Establecimiento de la hipótesis
#\(H_0\): La varianza del perimetro de la cadera entre los pacientes que padecen y no padecen obesidad son iguales #\(H_1\):La varianza del perimetro de la cadera entre los pacientes que padecen y no padecen obesidad no son iguales.
#Se observa que el p-valor(0.1167)es mayor a 0.05, no podemos rechazar la Ho, por lo que existe evidencia de que las varianzas #del perimetro de cadera de los grupos son homocedasticos
#Procedemos a realizar el test de Wilcoxon-Man Whitney para muestras independientes
#Segun el gráfico de cajas, donde se observa que perimetro de cadera es mayor en personas obesas, se establece la siguiente #hipotesis siguiente:
#\(H_0\)> La mediana del perimetro de la cadera es igual para el grupo que padece y no padece obesidad #\(H_1\)> La mediana del perimetro de la cadera es diferente para el grupo que padece y no padece obesidad
wilcox.test(CADERA~OBCENT_ATP,data = telde)##
## Wilcoxon rank sum test with continuity correction
##
## data: CADERA by OBCENT_ATP
## W = 20985, p-value < 2.2e-16
## alternative hypothesis: true location shift is not equal to 0#Como el p-valor es menor que el nivel de significancia, podemos decir que existe evidencia significativa para concluir que la #mediana del perimetro de cadera entre los pacientes que padecen y no padecen obesidad son diferentes.
#e) Seleccionar con R, una submuestra de tamaño n=100, con algunas de las variables del archivo original.
set.seed(1234)
telde$ID<-1:nrow(telde)
muestra<-sample(1:nrow(telde),100,replace = F)
muestra## [1] 1018 1004 623 905 645 934 400 900 98 103 726 602 326 79 974
## [16] 884 270 382 184 574 4 1023 661 552 212 952 195 996 511 479
## [31] 605 634 901 578 510 687 424 379 980 816 108 131 343 41 627
## [46] 740 840 928 298 811 258 629 1017 182 305 358 696 307 902 976
## [61] 221 736 561 313 136 794 145 959 123 776 234 608 495 534 803
## [76] 297 208 989 854 569 522 918 248 365 665 643 595 434 757 760
## [91] 218 727 838 508 276 169 71 573 864 1030telde_m100<-subset(telde,ID%in%muestra,select=c("CADERA","OBCENT_ATP"))
telde_m100## # A tibble: 100 × 2
## CADERA OBCENT_ATP
## <dbl> <fct>
## 1 103 Sí
## 2 102 No
## 3 112 Sí
## 4 104 Sí
## 5 100 Sí
## 6 96 Sí
## 7 111 Sí
## 8 103 No
## 9 100 Sí
## 10 80 No
## # ℹ 90 more rows