Soy estudiante de biotecnología de la Universidad de las Fuerzas Armadas ESPE, tengo 21 años y me interesan los temas médicos y ambientales. Me considero una persona apasionada por lo que hace y amigable con las personas que aportan de manera positiva a mis aspiraciones y vida.
Karla Gaona
Soy estudiante de Ingenieria en Biotecnología en la Universidad de las Fuerzas Armadas ESPE, tengo 21 años, actualmente vivo en Quito, aunque mi cuidad natal es Ambato. Parte importante de mi vida es el Movimiento Catolico Lazos de Amor Mariano, en cual soy misionera y participo en varias actividades.Considero que lo mas importante en mi vida, es Dios y mi familia.
Nicole Soria
70 pacientes sometidos a un estudio biomédico
La siguiente tabla corresponde a un estudio realizado en 70 pacientes ajustado a un modelo de regresión lineal múltiple para la tensión arterial diastólica en base al colesterol e índice de masa corporal y edad.
Variables
library(readxl)
pacientes <- read_excel("~/R/CLASE 1/Proyecto final/pacientes.xlsx",
skip = 2)
pacientes
## # A tibble: 70 x 6
## PACIENTE EDAD COLESTEROL IMC TAD GENERO
## <dbl> <dbl> <dbl> <chr> <chr> <chr>
## 1 1 42 292 31.64 97 Hombre
## 2 2 64 235 30.8 90 Hombre
## 3 3 47 200 25.61 80 Hombre
## 4 4 56 200 26.17 75 Mujer
## 5 5 54 300 31.96 100 Hombre
## 6 6 48 215 23.18 67 Hombre
## 7 7 57 216 21.19 , Mujer
## 8 8 52 254 26.95 70 Hombre
## 9 9 67 310 24.26 105 Hombre
## 10 10 46 237 21.87 70 Mujer
## # ... with 60 more rows
colnames(pacientes)
## [1] "PACIENTE" "EDAD" "COLESTEROL" "IMC" "TAD"
## [6] "GENERO"
colnames(pacientes)<-c("Numero de paciente","Edad","Nivel de colesterol(mg/dL)","Índice de masa corporal IMC (Kg/m2)","Tensión arterial diastólica TAD (mmHg)", "Sexo")
colnames(pacientes)
## [1] "Numero de paciente"
## [2] "Edad"
## [3] "Nivel de colesterol(mg/dL)"
## [4] "Índice de masa corporal IMC (Kg/m2)"
## [5] "Tensión arterial diastólica TAD (mmHg)"
## [6] "Sexo"
pacientes
## # A tibble: 70 x 6
## `Numero de paci~ Edad `Nivel de coles~ `Índice de masa~
## <dbl> <dbl> <dbl> <chr>
## 1 1 42 292 31.64
## 2 2 64 235 30.8
## 3 3 47 200 25.61
## 4 4 56 200 26.17
## 5 5 54 300 31.96
## 6 6 48 215 23.18
## 7 7 57 216 21.19
## 8 8 52 254 26.95
## 9 9 67 310 24.26
## 10 10 46 237 21.87
## # ... with 60 more rows, and 2 more variables: `Tensión arterial
## # diastólica TAD (mmHg)` <chr>, Sexo <chr>
View(pacientes)
str(pacientes)
## Classes 'tbl_df', 'tbl' and 'data.frame': 70 obs. of 6 variables:
## $ Numero de paciente : num 1 2 3 4 5 6 7 8 9 10 ...
## $ Edad : num 42 64 47 56 54 48 57 52 67 46 ...
## $ Nivel de colesterol(mg/dL) : num 292 235 200 200 300 215 216 254 310 237 ...
## $ Índice de masa corporal IMC (Kg/m2) : chr "31.64" "30.8" "25.61" "26.17" ...
## $ Tensión arterial diastólica TAD (mmHg): chr "97" "90" "80" "75" ...
## $ Sexo : chr "Hombre" "Hombre" "Hombre" "Mujer" ...
pacientes$`Índice de masa corporal IMC (Kg/m2)`<-as.numeric(pacientes$`Índice de masa corporal IMC (Kg/m2)`)
pacientes$`Tensión arterial diastólica TAD (mmHg)`<-as.numeric(pacientes$`Tensión arterial diastólica TAD (mmHg)`)
pacientes$Sexo<-as.factor(pacientes$Sexo)
str(pacientes)
## Classes 'tbl_df', 'tbl' and 'data.frame': 70 obs. of 6 variables:
## $ Numero de paciente : num 1 2 3 4 5 6 7 8 9 10 ...
## $ Edad : num 42 64 47 56 54 48 57 52 67 46 ...
## $ Nivel de colesterol(mg/dL) : num 292 235 200 200 300 215 216 254 310 237 ...
## $ Índice de masa corporal IMC (Kg/m2) : num 31.6 30.8 25.6 26.2 32 ...
## $ Tensión arterial diastólica TAD (mmHg): num 97 90 80 75 100 67 NA 70 105 70 ...
## $ Sexo : Factor w/ 2 levels "Hombre","Mujer": 1 1 1 2 1 1 2 1 1 2 ...
levels(pacientes$Sexo)
## [1] "Hombre" "Mujer"
levels(pacientes$Sexo)<-c("Masculino", "Femenino")
levels(pacientes$Sexo)
## [1] "Masculino" "Femenino"
str(pacientes)
## Classes 'tbl_df', 'tbl' and 'data.frame': 70 obs. of 6 variables:
## $ Numero de paciente : num 1 2 3 4 5 6 7 8 9 10 ...
## $ Edad : num 42 64 47 56 54 48 57 52 67 46 ...
## $ Nivel de colesterol(mg/dL) : num 292 235 200 200 300 215 216 254 310 237 ...
## $ Índice de masa corporal IMC (Kg/m2) : num 31.6 30.8 25.6 26.2 32 ...
## $ Tensión arterial diastólica TAD (mmHg): num 97 90 80 75 100 67 NA 70 105 70 ...
## $ Sexo : Factor w/ 2 levels "Masculino","Femenino": 1 1 1 2 1 1 2 1 1 2 ...
summary(pacientes)
## Numero de paciente Edad Nivel de colesterol(mg/dL)
## Min. : 1.00 Min. :42.00 Min. :175.0
## 1st Qu.:18.25 1st Qu.:49.00 1st Qu.:214.2
## Median :35.50 Median :56.00 Median :230.0
## Mean :35.50 Mean :55.24 Mean :236.8
## 3rd Qu.:52.75 3rd Qu.:60.00 3rd Qu.:254.0
## Max. :70.00 Max. :68.00 Max. :315.0
##
## Índice de masa corporal IMC (Kg/m2)
## Min. :19.10
## 1st Qu.:22.36
## Median :25.38
## Mean :25.47
## 3rd Qu.:27.81
## Max. :33.91
## NA's :2
## Tensión arterial diastólica TAD (mmHg) Sexo
## Min. : 65.00 Masculino:41
## 1st Qu.: 75.00 Femenino :29
## Median : 80.00
## Mean : 81.65
## 3rd Qu.: 90.00
## Max. :105.00
## NA's :1
pacientes$`Tensión arterial diastólica TAD (mmHg)`[is.na(pacientes$`Tensión arterial diastólica TAD (mmHg)`)]<-0
pacientes$`Numero de paciente`[is.na(pacientes$`Numero de paciente`)]<-0
pacientes$`Nivel de colesterol(mg/dL)`[is.na(pacientes$`Nivel de colesterol(mg/dL)`)]<-0
pacientes$`Índice de masa corporal IMC (Kg/m2)`[is.na(pacientes$`Índice de masa corporal IMC (Kg/m2)`)]<-0
View(pacientes)
boxplot(pacientes$`Índice de masa corporal IMC (Kg/m2)` ~ pacientes$Sexo, col = c("light blue", "pink"), ylab = "Índice de masa corporal")
ANÁLISIS.
El Índice de masa corporal IMC de los hombres comprendido entre el 50% y 75% de dicha población se encuentra mas disperso que aquellos valores de IMC comprendidos entre el 25% y el 50%, para las mujeres el caso es inverso.
Existe mayor concentración de valores de IMC mayores de 30(Kg/m2) que valores menores de 25 (Kg/m2), por lo tanto, se concluye que la población de pacientes posee sobrepeso.
boxplot(pacientes$`Tensión arterial diastólica TAD (mmHg)` ~ pacientes$Sexo, col = c("light blue", "pink"), ylab = "Tensión arterial diastólica")
ANÁLISIS
El valor de la tensión arterial diastólica para hombres y mujeres comprendido entre el 50% y 75% de dicha población se encuentra mas disperso que aquellos valores de TAD comprendidos entre el 25% y el 50%.
Existe mayor concentración de valores de TAD mayores de 90(mmHg) que valores menores de 70 (mmHg), por lo tanto, se concluye que la población tiene indicios de hipertensión
boxplot(pacientes$`Nivel de colesterol(mg/dL)` ~ pacientes$Sexo, col = c("light blue", "pink"), ylab = "Nivel de colesterol")
ANÁLISIS * El valor de nivel de colesterol para todos los pacientes, comprendido d entre el 50% y 75% de dicha población se encuentra mas disperso que aquellos valores entre el 25% y el 50%.
library(corrplot)
## corrplot 0.84 loaded
library(mlbench)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
correlacion1<-corrplot(cor(select(pacientes,-Sexo)))
correlacion1
## Numero de paciente Edad
## Numero de paciente 1.0000000000 -0.01691876
## Edad -0.0169187598 1.00000000
## Nivel de colesterol(mg/dL) -0.0891491211 0.33144210
## Índice de masa corporal IMC (Kg/m2) -0.0006999475 0.06297175
## Tensión arterial diastólica TAD (mmHg) -0.0013394332 0.27339412
## Nivel de colesterol(mg/dL)
## Numero de paciente -0.08914912
## Edad 0.33144210
## Nivel de colesterol(mg/dL) 1.00000000
## Índice de masa corporal IMC (Kg/m2) 0.26466284
## Tensión arterial diastólica TAD (mmHg) 0.56979915
## Índice de masa corporal IMC (Kg/m2)
## Numero de paciente -0.0006999475
## Edad 0.0629717518
## Nivel de colesterol(mg/dL) 0.2646628402
## Índice de masa corporal IMC (Kg/m2) 1.0000000000
## Tensión arterial diastólica TAD (mmHg) 0.2572102404
## Tensión arterial diastólica TAD (mmHg)
## Numero de paciente -0.001339433
## Edad 0.273394116
## Nivel de colesterol(mg/dL) 0.569799151
## Índice de masa corporal IMC (Kg/m2) 0.257210240
## Tensión arterial diastólica TAD (mmHg) 1.000000000
ANÁLISIS
Existe correlación directa entre las variables de IMC, TAD, nivel de colesterol y edad del paciente.
Visualizar la distribución de la variable indepeniente, se demuestra que las densidades máximas están entre 200 y 400 mg/mL
library(ggplot2)
pacientes %>%
ggplot(aes(pacientes$`Nivel de colesterol(mg/dL)`)) +
stat_density() +
theme_bw()
Visualizar la distribución de la variable indepeniente, se demuestra que las densidades máximas están entre 65 y 75 mmHg
library(ggplot2)
pacientes %>%
ggplot(aes(pacientes$`Tensión arterial diastólica TAD (mmHg)`)) +
stat_density() +
theme_bw()
Visualizar la distribución de la variable indepeniente, se demuestra que las densidades máximas están entre 20 y 30 Kg/m2
library(ggplot2)
pacientes %>%
ggplot(aes(pacientes$`Índice de masa corporal IMC (Kg/m2)`)) +
stat_density() +
theme_bw()
library(dplyr)
library(data.table)
pacientes %>%
select(c(`Nivel de colesterol(mg/dL)`,`Tensión arterial diastólica TAD (mmHg)`,`Índice de masa corporal IMC (Kg/m2)`, Edad)) %>%
melt(id.vars = "Edad") %>%
ggplot(aes(x = value, y =Edad, colour = variable)) +
geom_point(alpha = 0.7) +
stat_smooth(aes(colour = "black")) +
theme_minimal()
Un análisis de varianza (ANOVA) prueba la hipótesis de que las medias de dos o más poblaciones son iguales. Los ANOVA evalúan la importancia de uno o más factores al comparar las medias de la variable de respuesta en los diferentes niveles de los factores. La hipótesis nula establece que todas las medias de la población (medias de los niveles de los factores) son iguales mientras que la hipótesis alternativa establece que al menos una es diferente. En este caso, utilizando la base de datos de Pacientes sometidos a un estudio biomédico; se realizará una comparacion del Nivel de colesterol en funcion del Sexo de los Pacientes
Hipotesis nula: Las medias de la poblacion de Pacientes a quienes se les realizo un estudio biomédico son iguales.
Hipotesis alternativa: Al menos una de las medias de la poblacion de Pacientes a quienes se les realizo un estudio biomédico es diferente.
Colesterol: Es la variable respuesta.
Paciente: Es la variable factor.
colesterol <- (pacientes$`Nivel de colesterol(mg/dL)`)
paciente <- as.factor(pacientes$Sexo)
boxplot(colesterol ~ paciente, col = c("yellow", "violet"), ylab = "Índice de colesterol (mg/dL)")
tapply(colesterol, paciente, mean)
## Masculino Femenino
## 241.0000 230.7931
Petición de un ANOVA
pc = aov( lm(colesterol ~ paciente) )
Resumen de la tabla del ANOVA
summary(pc)
## Df Sum Sq Mean Sq F value Pr(>F)
## paciente 1 1770 1770 1.488 0.227
## Residuals 68 80857 1189
Elementos generados en el ANOVA:
names(pc)
## [1] "coefficients" "residuals" "effects" "rank"
## [5] "fitted.values" "assign" "qr" "df.residual"
## [9] "contrasts" "xlevels" "call" "terms"
## [13] "model"
Cuantil buscado
qf(0.05, 2-1, 70-2, lower.tail = F)
## [1] 3.981896
Valores del estadístico > 3.981896 estarán incluidos en la región de rechazo.En este caso el valor F que se obtuvo es de 1.488.
Prueba T.
Estimación de la varianza común de los datos
media <- mean(colesterol[paciente=="Femenino"])
valor_t <- pt(0.05/2, 70 - 2)
sp <- sqrt(1189) #desviación típica de la varianza muestral común
ee <- valor_t * (sp/ sqrt(41)) #error de estimación
media
## [1] 230.7931
Intervalos de confianza para las medias del Índice de colesterol de los pacientes.
Limite superior
media+ee
## [1] 233.5392
Limite Inferior
media-ee
## [1] 228.047
intervals =TukeyHSD(pc)
intervals
## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = lm(colesterol ~ paciente))
##
## $paciente
## diff lwr upr p adj
## Femenino-Masculino -10.2069 -26.90268 6.488886 0.2267087
plot(intervals)
Independencia
plot(pc$residuals)
Normalidad
summary(pc$residuals)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -66.000 -24.345 -7.793 0.000 16.207 84.207
boxplot(pc$residuals)
hist(pc$residuals)
qqnorm(pc$residuals)
qqline(pc$residuals)
Test de Shapiro-Wilk
shapiro.test(pc$residuals)
##
## Shapiro-Wilk normality test
##
## data: pc$residuals
## W = 0.9565, p-value = 0.01611
Los valores de p son menores a 0,05 entonces la dist. no es normal
Homocedasticidad
boxplot(pc$residuals~paciente, col = c("purple","green"))
desviaciones <- tapply(pc$residuals, paciente, sd)
Comparando la desviación máxima con la mínima obtenemos una orientación sobre la falta de homocedasticidad (>2 aproximadamente) para que sea homocedastica.
max(desviaciones) / min(desviaciones)
## [1] 1.362483
Prueba de Barlett
bartlett.test(pc$residuals ~ paciente)
##
## Bartlett test of homogeneity of variances
##
## data: pc$residuals by paciente
## Bartlett's K-squared = 2.9511, df = 1, p-value = 0.08582
El test de Bartlett indica que tenemos evidencia suficiente para rechazar la hipótesis nula (las varianzas son iguales).
Kruskal-Wallis
Ho: la variable respuesta es la misma en todas las poblaciones valoradas.
Ha: la variable respuesta es mayor en alguna de las poblaciones.
kruskal.test(colesterol, paciente)
##
## Kruskal-Wallis rank sum test
##
## data: colesterol and paciente
## Kruskal-Wallis chi-squared = 1.0039, df = 1, p-value = 0.3164
Bajo la Ho el estadístico de contraste H del test de Kruskal-Wallis se distribuye como una Chi-cuadrado de grados de libertad (2-1).
Cuantil buscado
qchisq(0.05, 2-1, lower.tail = F)
## [1] 3.841459
Valores del estadístico > 3.841459 estarán incluidos en la región de rechazo.
Transformacion logaritmica de los datos de la variable Nivel de Colesterol
kruskal.test(log(colesterol), paciente)
##
## Kruskal-Wallis rank sum test
##
## data: log(colesterol) and paciente
## Kruskal-Wallis chi-squared = 1.0039, df = 1, p-value = 0.3164
Se determinó que los resultados son exactamente los mismos. No se producen variaciones porque el test de Kruskal-Wallis trabaja sobre rangos, es decir, sobre ordenaciones de los valores de la variable en cada uno de los grupos. Aunque realicemos una transformación logaritmica, el orden entre los valores de la variable se mantiene y por lo tanto la transformación no afecta a los resultados del test.
PMCMR
Determinacion de los grupos que generan diferencias significativas en la variable respuesta para las distintas poblaciones.
library(PMCMR)
## Warning: package 'PMCMR' was built under R version 3.4.4
## PMCMR is superseded by PMCMRplus and will be no longer maintained. You may wish to install PMCMRplus instead.
library(PMCMRplus)
## Warning: package 'PMCMRplus' was built under R version 3.4.4
posthoc.kruskal.nemenyi.test(colesterol, paciente, method = "Chisq")
## Warning in posthoc.kruskal.nemenyi.test.default(colesterol, paciente,
## method = "Chisq"): Ties are present, p-values are not corrected.
##
## Pairwise comparisons using Tukey and Kramer (Nemenyi) test
## with Tukey-Dist approximation for independent samples
## data: colesterol and paciente
## Masculino
## Femenino 0.32
##
## P value adjustment method: none
Se rechaza la hipotesis nula, por tanto, Se concluye que al menos una de las medias de la poblacion de Pacientes a quienes se les realizo un estudio biomédico, no es igual.
library(caTools)
set.seed(70)
split <- sample.split(pacientes,SplitRatio =0.75)
train <- subset(pacientes,split==TRUE)
## Warning: Length of logical index must be 1 or 70, not 6
test <- subset(pacientes,split==FALSE)
## Warning: Length of logical index must be 1 or 70, not 6
model <- lm(Edad ~ -1 +`Nivel de colesterol(mg/dL)`+`Tensión arterial diastólica TAD (mmHg)`+`Índice de masa corporal IMC (Kg/m2)`, data = train)
summary(model)
##
## Call:
## lm(formula = Edad ~ -1 + `Nivel de colesterol(mg/dL)` + `Tensión arterial diastólica TAD (mmHg)` +
## `Índice de masa corporal IMC (Kg/m2)`, data = train)
##
## Residuals:
## Min 1Q Median 3Q Max
## -26.6796 -5.6419 0.4975 6.4708 19.7826
##
## Coefficients:
## Estimate Std. Error t value
## `Nivel de colesterol(mg/dL)` 0.16655 0.03464 4.807
## `Tensión arterial diastólica TAD (mmHg)` 0.07657 0.09404 0.814
## `Índice de masa corporal IMC (Kg/m2)` 0.39884 0.22945 1.738
## Pr(>|t|)
## `Nivel de colesterol(mg/dL)` 1.82e-05 ***
## `Tensión arterial diastólica TAD (mmHg)` 0.4199
## `Índice de masa corporal IMC (Kg/m2)` 0.0892 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8.986 on 44 degrees of freedom
## Multiple R-squared: 0.9759, Adjusted R-squared: 0.9743
## F-statistic: 594.1 on 3 and 44 DF, p-value: < 2.2e-16
Ecuación del modelo encontrado
paste("Edad=", round(model$coefficients[1],2),
round(model$coefficients[2],2),names(model$coefficients[2]),"+",
round(model$coefficients[3],2),names(model$coefficients[3])
)
## [1] "Edad= 0.17 0.08 `Tensión arterial diastólica TAD (mmHg)` + 0.4 `Índice de masa corporal IMC (Kg/m2)`"
Tras observar los resultados de la regresión lineal se pueden determinar aquellas variables que no son significativas para el modelo. En el caso de la Tensión arterial diastólida TAD, se visualiza que la probabilidad de no ser significativa es alta, por lo tanto, no es indispensable para el modelo y puede darse el estudio
considerando otra variable de acuerdo a la edad del paciente. Por otro lado, el nivel de colesterol posee una baja probabilidad, determinando asi, que es una variable significativa en el estudio.
Finalmente, el Índice de masa corporal IMC, se considera una variable medianamente significativa de acuerdo a la probabilidad obtenida en el modelo.
Visualizacion del modelo de regresión lineal trazando los residuos.
El modelo establecido para la base de datos de los pacientes a quienes se les realizo un estudio biomédico, es aceptable si: - Las variables son estadisticamente significativas - R2 (mide la calidad de un modelo) ajustado es >= 0.5 - Los residuos que se ajusten a una distribucion normal : media=0, varianza=1 - Residuos no correlacionados: no siguen un patron.
Data frame de los Residuos
res <- residuals(model)
res <- as.data.frame(res)
ggplot(res,aes(res)) + geom_histogram(fill='blue',alpha=0.5)
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Graficación del modelo considerado los residuos
plot(model)
Predicciones
test$predicted.Edad <- predict(model,test)
pl1 <-test %>%
ggplot(aes(Edad,predicted.Edad)) +
geom_point(alpha=0.5) +
stat_smooth(aes(colour='black')) +
xlab('Actual value of Edad') +
ylab('Predicted value of Edad')+
theme_bw()
ggplotly(pl1)
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
error <- test$Edad-test$predicted.Edad
rmse <- sqrt(mean(error)^2)
El modelo de regresión lineal multiple establecido para la base de datos de los pacientes a quienes se les realizo un estudio biomédico; no es aceptable, puesto que las variables no son estadisticamente significativas, ademas, los residuos no se ajustan a una distribucion normal : media=0, varianza=1; no estan correlacionados, por tanto, no siguen un patron.