Pruecto Final_R_Pacientes
Anaguano;Balseka; Quinga
3 de octubre de 2018
Me llamos Alexis Anaguano soy estudiante de Biotecnología en la “Universidad de las Fuerzas Armadas-ESPE”, soy de Quito,tengo 21 años, para mi la estadistica es una parte fundamental para la carrera por lo cual el manejo de datos es indispensable en las investigaciones que realizare.
Yo soy Karol Balseca,tengo 21 años, y me gustan los gatos y el medio ambiente, estudio en la “Universidad de las Fuerzas Armadas-ESPE”, soy de latacunga, y estoy cursando la carrera de Biotecnologia la cual me ha parecido muy interesante, me gusta investigar por lo cual es necesario tener muchos conocimientos de estadistica y biologia, ya que me permitiran en un futuro lograr poder mejorar o buscar soluciones para remediar el medio ambiente.
Mi nombre es Joseph Quinga tengo 21 años, estudio en la “Universidad de las Fuerzas Armadas-ESPE”, en ingenieria en Biotecnologia, escogi esta carrera porque me gusta realizar experimentos en el laboratorio, mi fin es crear mi propia empresa y para ello utilizare los conocimientos que ire adquieriendo durante mi carrera.
PACIENTE
library(ggplot2)
library(dplyr)
library(foreign)
library(graphics)
library(corrplot)
library(reshape2)
library(stats)
library(caTools)
library(readxl)
pacientes <- read_excel("pacientes.xlsx",
col_types = c("text", "numeric", "numeric",
"numeric", "numeric", "text"), skip = 2)- Base de datos: Describir la base de datos y las varibles VARIABLES CUANTITATIVAS VARIABLES CONTINUAS: colesterol,IMC,TAD VARIABLES DISCRETAS:EDAD VARIABLES CUALITATIVAS: VARIBLES NOMINALES:genero.
Lectura de la base de datos, nombres de columnas adecuados, definir tipo de varibles y etiquetas a las tipo factor Las variabels tip factor es el género y las varibles numéricas son IMC TAD EDAD ya que son cuantitativas
View(pacientes)- Análisis exploratorio de datos Mostral la estructura (str) y resumen de la base de datos (summary) (mínimo, media, máximo, desviación estandar, primer cuartil de cada variable numérica y la frecuencia en el caso de variables categóricas)
str(pacientes)## Classes 'tbl_df', 'tbl' and 'data.frame': 70 obs. of 6 variables:
## $ PACIENTE : chr "1" "2" "3" "4" ...
## $ EDAD : num 42 64 47 56 54 48 57 52 67 46 ...
## $ COLESTEROL: num 292 235 200 200 300 215 216 254 310 237 ...
## $ IMC : num 31.6 30.8 25.6 26.2 32 ...
## $ TAD : num 97 90 80 75 100 67 NA 70 105 70 ...
## $ GENERO : chr "Hombre" "Hombre" "Hombre" "Mujer" ...summary(pacientes)## PACIENTE EDAD COLESTEROL IMC
## Length:70 Min. :42.00 Min. :175.0 Min. :19.10
## Class :character 1st Qu.:49.00 1st Qu.:214.2 1st Qu.:22.36
## Mode :character Median :56.00 Median :230.0 Median :25.38
## Mean :55.24 Mean :236.8 Mean :25.47
## 3rd Qu.:60.00 3rd Qu.:254.0 3rd Qu.:27.81
## Max. :68.00 Max. :315.0 Max. :33.91
## NA's :2
## TAD GENERO
## Min. : 65.00 Length:70
## 1st Qu.: 75.00 Class :character
## Median : 80.00 Mode :character
## Mean : 81.65
## 3rd Qu.: 90.00
## Max. :105.00
## NA's :1** Genere diagramas de caja para variables continuas y diagramas de barras para variables discretas, describir resultados**
pacientes$GENERO <-factor(pacientes$GENERO,levels=c('Hombre','Mujer'))
par(mfrow=c(1,1))
boxplot(COLESTEROL~GENERO,pacientes,horizontal=T,xlab="COLESTEROL",ylab="GENERO")
El promedio de colesterol entre mujeres y hombres son distintos, se observa que el promedio del colesterol de hombres es mayor en comparación con las mujeres. Más del 75 porciento de hombres tienen sus nibles de Colesterol entre 180 a 280; enlas mujeres varia en un rango de 200 a 240 y existen tres datos atípicos
boxplot(IMC~GENERO,pacientes,horizontal=T,xlab="IMC",ylab="GENERO")
En este diagrama de cajas se puede observar que elpromedio del IMC entre ambos generos es similar
boxplot(TAD~GENERO,pacientes,horizontal=T,xlab="TAD",ylab="GENERO")
En este gráfico se puede observar que la media de la Tensión Aortica Diastólica es significativamente diferente, es decir, se aprecia que en los hombres el TAD es mayor.
library(ggplot2)
library(dplyr)
M=data.frame(pacientes %>% filter(GENERO=="Mujer") %>% select(EDAD,GENERO))
#M
barplot(M$EDAD,xlab ="Edad",ylab = "pacientesMujeres",names.arg = M$EDAD,main = "Diagrama de barras",col = rainbow(nrow(M)))
mean(M$EDAD)## [1] 55.89655El Promedio de las edades de las mujeres en que se realizaron los estudios es de 55.8 que equivale a 56 años
library(ggplot2)
library(dplyr)
H=data.frame(pacientes %>% filter(GENERO=="Hombre") %>% select(EDAD,GENERO))
#H
barplot(H$EDAD,xlab ="Edad",ylab = "pacientesHombres",names.arg = H$EDAD,main = "Diagrama de barras",col = rainbow(nrow(H)))
mean(H$EDAD)## [1] 54.78049El promedio de pacientes Hombres en que se realizaron los estudios fue de 54.7 lo que equivale a 55; lo que indica que en el estudio se realizó con hombres un poquito jóvenes que las mujeres, no hay mucha diferencias entre las edades de ambos géneros.
Calcule la correlación entre la variable dependiente y cada una de las variables explicativas (numéricas).
haz.cero.na=function(x){
ifelse(is.na(x),0,x)}
pacientes.2=data.frame(sapply(pacientes,haz.cero.na))
pacientes## # A tibble: 70 x 6
## PACIENTE EDAD COLESTEROL IMC TAD GENERO
## <chr> <dbl> <dbl> <dbl> <dbl> <fct>
## 1 1 42 292 31.6 97 Hombre
## 2 2 64 235 30.8 90 Hombre
## 3 3 47 200 25.6 80 Hombre
## 4 4 56 200 26.2 75 Mujer
## 5 5 54 300 32.0 100 Hombre
## 6 6 48 215 23.2 67 Hombre
## 7 7 57 216 21.2 NA Mujer
## 8 8 52 254 27.0 70 Hombre
## 9 9 67 310 24.3 105 Hombre
## 10 10 46 237 21.9 70 Mujer
## # ... with 60 more rowsView(pacientes.2)
levels(pacientes.2$GENERO) <- c("Hombre","Mujer")
tabla=table(pacientes.2$GENERO)#Tabla de frecuencias
tabla##
## Hombre Mujer
## 41 29pacientes.2$EDAD<-as.numeric(pacientes.2$EDAD)
pacientes.2$COLESTEROL<-as.numeric(pacientes.2$COLESTEROL)
pacientes.2$IMC<-as.numeric(pacientes.2$IMC)
pacientes.2$TAD<-as.numeric(pacientes.2$TAD)
correlacion<-corrplot(cor(select(pacientes.2,-c(PACIENTE,GENERO))))
correlacion## EDAD COLESTEROL IMC TAD
## EDAD 1.00000000 0.29995312 0.16273287 -0.01999005
## COLESTEROL 0.29995312 1.00000000 0.42735506 0.08814233
## IMC 0.16273287 0.42735506 1.00000000 0.08993568
## TAD -0.01999005 0.08814233 0.08993568 1.00000000Se puede determinar que existe una correlación directa entre las diversas variables además se puede determinar que existe relación entre edad-colesterol,IMC-colesterol. con esto se puede decir que la relación IMC-colesterol es la más significativa.También se determina que no existe correlación entre el TAD y la EDAD. En síntesis se puede saber que el IMC va a aumentar a medida que aumenta el colesterol.
** Muestre el efecto de las variables independientes con respecto a la variable dependiente**
pacientes.2 %>%
select(c(EDAD,COLESTEROL,IMC,TAD)) %>%
melt(id.vars = "TAD") %>%
ggplot(aes(x = value, y = TAD, colour = variable)) +
geom_point(alpha = 0.7) +
stat_smooth(aes(colour = "TAD")) +
facet_wrap(~variable, scales = "free", ncol = 2) +
labs(x = "Variable Value", y = "pacientes.2") +
theme_minimal()
No hay correlación del colesterol, IMC, TAD con respecto a la EDAD ##ANALISIS ANOVA
** Considere una variable categÓrica y realice un análisis ANOVA incluya resultados y conclusion al final** HIPOTESIS Ho : las medias del IMC en hombres y mujeres son iguales H1 = las medias del IMC en hombres y mujeres son distintas
boxplot(pacientes.2$IMC ~ pacientes.2$GENERO , col = c("yellow","blue"), ylab = "INDICE DE MASA CORPORAL")
Según la gráfica se dice que existe homocedasticidad
tapply(pacientes.2$IMC,pacientes.2$GENERO, mean)## Hombre Mujer
## 30.97561 28.06897Según estos resultados el hombre tiene más indice de masa corporal,pero la diferencia no es mucha.
Analisis de variables tipo continua y otra tipo factor o categorica
hm = aov( lm(pacientes.2$IMC ~ pacientes.2$GENERO) )
summary(hm)#Analisis de Anova## Df Sum Sq Mean Sq F value Pr(>F)
## pacientes.2$GENERO 1 144 143.5 0.478 0.492
## Residuals 68 20409 300.1names(hm)## [1] "coefficients" "residuals" "effects" "rank"
## [5] "fitted.values" "assign" "qr" "df.residual"
## [9] "contrasts" "xlevels" "call" "terms"
## [13] "model"Valor crítico de F bajo la hipotesis nula con un nivel de significancia alfa = 0.05
qf(0.05, 2-1, 70-2, lower.tail = F)## [1] 3.981896Como el estadistico F= 0.478 es menor que el Valor critico de F=3.981896 Ho no se rechaza, por lo tanto estadisticamente las medias del IMC de hombres y mujeres es igual.
media <- mean(pacientes.2$IMC[pacientes.2$GENERO =="Hombre"])
valor_t <- pt(0.05/2, 70 - 2)
sp <- sqrt(15.61 ) #desviación
ee <- valor_t * (sp/ sqrt(41))
media## [1] 30.97561media2 <- mean(pacientes.2$IMC[pacientes.2$GENERO =="Mujer"])
valor_t <- pt(0.05/2, 70 - 2)
sp <- sqrt(15.61 )
ee <- valor_t * (sp/ sqrt(29))
media2## [1] 28.06897Intervalos de confianza para Hombres
media + ee ## [1] 31.34974media - ee ## [1] 30.60148Intervalos de confianza para Mujeres
media2 + ee ## [1] 28.44309media2 - ee ## [1] 27.69484Diferencias significativas entre las medias del IMC entre hombres y mujeres
intervals = TukeyHSD(hm) #me indica si son diferentes
intervals## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = lm(pacientes.2$IMC ~ pacientes.2$GENERO))
##
## $`pacientes.2$GENERO`
## diff lwr upr p adj
## Mujer-Hombre -2.906644 -11.29463 5.481343 0.4916186Graficando se tiene que:
plot(intervals)
Como el gráfico contiene al cero los grupos son iguales estadisticamente
Validacion del modelo ANOVA
Independencia
plot(hm$residuals) 
Mas dispersos quiere decir que están menos correlacionados
Normalidad
summary(hm$residuals)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -29.976 -13.976 1.431 0.000 12.774 29.931boxplot(hm$residuals) 
La distancia de los cuartiles nos muestra si hay homocedasticidad
hist(hm$residuals)
qqnorm(hm$residuals)
qqline(hm$residuals) 
Test de Shapiro-Wilk
shapiro.test(hm$residuals) # p>=0.05 son normales p<0.05 no son normales ##
## Shapiro-Wilk normality test
##
## data: hm$residuals
## W = 0.95526, p-value = 0.0138En este caso como p=0.01447 y es menor a 0.05 no existe normalidad de residuos
Homocedasticidad
Los graficos y descriptivos nos informan si se verifica la igualdad de varianzas en los grupos descritos:
boxplot(hm$residuals~pacientes$GENERO, col = c("yellow","blue")) # Este no sale toca revisar
La varianza de los grupos se obtiene a partir de los residuos
desviaciones <- tapply(hm$residuals, pacientes$GENERO, sd)Comparando la desviacion maxima con la minima obtenemos una orientacion sobre la falta de homocedasticidad (>2 aproximadamente)
max(desviaciones) / min(desviaciones) # no se puede hacer sin lo de arriba## [1] 1.135675El resultado es menor que dos por lo tanto hay homosedasticidad
Test de Bartlett
El test de Bartlett(homosedasticidad) indica que no tenemos evidencia suficiente para rechazar la hipotesis nula (las varianzas son iguales)
bartlett.test(hm$residuals ~ pacientes$GENERO) # Mismo problema debe tener la misma longitud ##
## Bartlett test of homogeneity of variances
##
## data: hm$residuals by pacientes$GENERO
## Bartlett's K-squared = 0.51607, df = 1, p-value = 0.4725las varianzas son iguales Kruskal-Wallis y pruebas post-hoc
Ho: las medias son iguales en todas las poblaciones
Ha: hay alguna media distinta
?Que hipotesis contrasta la prueba de 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(pacientes.2$IMC, pacientes.2$GENERO)##
## Kruskal-Wallis rank sum test
##
## data: pacientes.2$IMC and pacientes.2$GENERO
## Kruskal-Wallis chi-squared = 0.48656, df = 1, p-value = 0.4855Bajo la Ho el estadistico de contraste H del test de Kruskal-Wallis se distribuye como una Chi-cuadrado de grados de libertad (I-1) (donde I es el numero de grupos que disponemos). Asi obtenemos el cuantil buscado:
qchisq(0.05, 2-1, lower.tail = F) ## [1] 3.841459En este caso con la prueba de Kruskal-Wallis el valor chi-cuadrado es 0.48656 siendo este menor a 3.841459 por lo cual no se rechaza Ho
kruskal.test(log(pacientes.2$IMC), pacientes.2$GENERO) ##
## Kruskal-Wallis rank sum test
##
## data: log(pacientes.2$IMC) and pacientes.2$GENERO
## Kruskal-Wallis chi-squared = 0.48656, df = 1, p-value = 0.4855Los 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 transformacion logaratmica, el orden entre los valores de la variable se mantiene y por lo tanto la transformacion no afecta a los resultados del test.
Grupos que generan diferencias significativas
library(PMCMR)
posthoc.kruskal.nemenyi.test(pacientes.2$IMC,pacientes.2$GENERO, method = "Chisq")##
## Pairwise comparisons using Tukey and Kramer (Nemenyi) test
## with Tukey-Dist approximation for independent samples
##
## data: pacientes.2$IMC and pacientes.2$GENERO
##
## Hombre
## Mujer 0.49
##
## P value adjustment method: noneNo hay homocedasticidad en los residuos
Construcciónn del modelo y predicción
Paquetes requeridos
library(readr)
library(ggplot2)
library(corrplot)
library(mlbench)
library(Amelia) # tratamientos de datos
library(plotly)
library(reshape2)
library(caret)
library(caTools)
library(dplyr)
library(raster)Limpieza de datos
Comprobacion si hay NA en el marco de datos.
missmap(pacientes.2,col=c('yellow','black'),y.at=1,y.labels='',legend=TRUE) # Primer color datos perdidos,segundo color datos usados
Como se puede ver en la grafica tenemos 0% de datos perdidos
Construccion de modelo y prediccion:
# establecer una semilla
set.seed(123) # numero aleatorio depende de la semilla
split <- sample.split(pacientes.2,SplitRatio =0.75)
train <- subset(pacientes.2,split==TRUE) # si se incluye dentro del data
test <- subset(pacientes.2,split==FALSE) # No se incluye en el ajuste del dato Entrenando nuestro modelo:
model <- lm( TAD~ COLESTEROL+IMC+EDAD , data = train)
summary(model) # En este caso no use genero porque es una variable categorica##
## Call:
## lm(formula = TAD ~ COLESTEROL + IMC + EDAD, data = train)
##
## Residuals:
## Min 1Q Median 3Q Max
## -6.2548 -1.0797 -0.2378 2.0406 3.7594
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 6.51276 1.11044 5.865 5.74e-07 ***
## COLESTEROL 0.04450 0.03367 1.322 0.193
## IMC 0.01650 0.02448 0.674 0.504
## EDAD -0.04016 0.05811 -0.691 0.493
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.602 on 43 degrees of freedom
## Multiple R-squared: 0.06516, Adjusted R-squared: -5.867e-05
## F-statistic: 0.9991 on 3 and 43 DF, p-value: 0.4024#IMC y TAD no son sigificativas para la edadConsiderando los cálculos anteriores genere el modelo de regresión lineal múltiple que mejor se ajuste a los datos.
## [1] "TAD= 6.51 + 0.04 COLESTEROL + 0.02 IMC -0.04 EDAD"No todas las variables fueron estadisticamente significativas, las que tuvieron mayor relevancia fueron el colesterol y el IMC.
Visualizando nuestro modelo
res <- residuals(model)
res <- as.data.frame(res)ggplot(res,aes(res)) + geom_histogram(fill='blue',alpha=0.5)
plot(model)
Predicciones
Probemos nuestro modelo prediciendo en nuestro conjunto de datos de prueba.
test$var.prediccion <- predict(model,test)
str(test)## 'data.frame': 23 obs. of 7 variables:
## $ PACIENTE : Factor w/ 70 levels "1","10","11",..: 34 45 2 3 8 9 15 16 21 22 ...
## $ EDAD : num 15 13 5 17 23 25 25 8 7 10 ...
## $ COLESTEROL : num 4 41 23 15 33 26 31 14 3 21 ...
## $ IMC : num 37 57 15 33 48 23 46 34 35 40 ...
## $ TAD : num 7 2 6 6 10 9 3 9 9 8 ...
## $ GENERO : Factor w/ 2 levels "Hombre","Mujer": 2 1 2 1 2 2 1 1 2 1 ...
## $ var.prediccion: num 6.7 8.76 7.58 7.04 7.85 ...dim(test$var.prediccion)## NULLpl1 <-test %>%
ggplot(aes(TAD,var.prediccion)) +
geom_point(alpha=0.5) +
stat_smooth(aes(colour='TAD')) +
xlab('Actual value of TAD') +
ylab('Predicted value ')+
theme_bw()
ggplotly(pl1) # puedo aplicar ggploty a los graficos ggplotEvaluemos nuestro modelo
usando Root Mean Square Error, una medida estandarizada de cuan lejos estabamos con nuestros valores predichos.
error <- test$TAD-test$var.prediccion
rmse <- sqrt(mean(error)^2)
rmse #si esta cercano a 1 significa que el modelo es bueno ## [1] 0.5583846Incluir los resultados obtenidos y las conclusiones.
El modelo que se realizó es bueno ya que tiene apxoximidad al 1, por lo tanto es posible hacer predicciones