library(dplyr)
library(haven)
library(kableExtra)
library(htmltools)
library(gridExtra)
library(grid)
library(car)
library(haven)
Data <- read_sav("biorealimentacixn (1).sav")
View(Data)

Actividad 1

Un equipo de investigación médica estudió la efectividad de un programa de entrenamiento de realimentación biológica (bio feedback) diseñado por reducir la presión sanguínea (PS). Los voluntarios fueron asignados aleatoriamente a un grupo biorealimentación y a un grupo control. Todos los voluntarios recibieron información sobre educación para la salud y una charla breve sobre el tema. Además, el grupo biorealimentación recibió ocho semanas de preparación en relajación, biorealimentación y ejercicios de respiración. Los resultados de la presión sanguínea sistólica, antes y después de estas ocho semanas se encuentran en el fichero biorealimentación.sav.

¿Hay diferencias significativas entre las presiones sanguíneas de los dos grupos antes del experimento?

#Filtramos los datos por tratamiento
GrupoSin <- Data %>% filter(Tratamiento == 1)
Borrar1 <- c("Tratamiento")
GrupoBio <- GrupoSin[, !(names(GrupoSin) %in% Borrar1)]

GrupoSin2 <- Data %>% filter(Tratamiento == 2)
GrupoCon <- GrupoSin2[, !(names(GrupoSin2) %in% Borrar1)]

GrupoT1 <- GrupoBio %>% rename("Presión Sanguínea Antes" = ps_antes, "Presión Sanguínea Después" = ps_después)
GrupoT2 <- GrupoCon %>% rename("Presión Sanguínea Antes" = ps_antes, "Presión Sanguínea Después" = ps_después)

#Ponemos los datos en una tabla
Tabla1 <- kable(GrupoT1, caption = "Tabla 1: Tratamiento 1", align = "c") %>%  # Alinear columnas al centro
  kable_styling(full_width = TRUE, bootstrap_options = c("striped", "hover", "condensed", "responsive"), font_size = 15, fixed_thead = TRUE) %>%
  column_spec(1, width = "10em") %>%   # Resaltar la columna de Variable
  column_spec(2, width = "10em") %>%                # Ajustar ancho de Naturaleza
  row_spec(0, bold = TRUE, background = "#bfcde6", color = "black") %>%
  scroll_box(width = "100%", height = "300px")

Tabla2 <- kable(GrupoT2, caption = "Tabla 2: Tratamiento 2", align = "c") %>%  # Alinear columnas al centro
  kable_styling(full_width = TRUE, bootstrap_options = c("striped", "hover", "condensed", "responsive"), font_size = 15, fixed_thead = TRUE) %>%
  column_spec(1, width = "10em") %>%   # Resaltar la columna de Variable
  column_spec(2, width = "10em") %>%                # Ajustar ancho de Naturaleza
  row_spec(0, bold = TRUE, background = "#bfcde6", color = "black") %>%
  scroll_box(width = "100%", height = "300px")  

Tabla1
Tabla 1: Tratamiento 1
Presión Sanguínea Antes Presión Sanguínea Después
150.67 141.69
145.37 134.98
136.55 127.82
151.63 140.77
154.29 143.36
157.25 144.95
132.98 123.95
137.11 127.32
154.20 143.48
136.43 125.75
149.94 139.31
139.90 131.97
125.34 116.29
129.46 118.84
137.69 128.10
142.07 130.44
150.98 139.20
154.51 143.52
144.55 135.45
138.47 129.22 
Tabla2
Tabla 2: Tratamiento 2
Presión Sanguínea Antes Presión Sanguínea Después
138.64 132.93
148.92 144.99
136.86 132.16
145.41 140.10
153.47 149.15
136.74 132.40
151.76 147.89
152.55 148.65
156.66 152.75
150.48 146.95
136.45 131.61
166.99 162.84
150.44 144.06
144.47 139.10
152.50 147.38
137.34 131.34
140.49 134.43
139.30 132.06
145.14 140.07
140.03 135.70 
#Son muestras independiente, por ende, no hay necesidad de calcular la diferencia.
ps_bio <- c(GrupoBio$ps_antes)
ps_con <- c(GrupoCon$ps_antes)

Datos_PS <- data.frame(
  ps_antes = c(ps_bio, ps_con),  # Unir ambos vectores
  grupo = factor(c(rep("Bio", length(ps_bio)), rep("Con", length(ps_con))))  # Crear la variable de grupo
)

leveneTest(ps_antes ~ grupo, data = Datos_PS)
## Levene's Test for Homogeneity of Variance (center = median)
##       Df F value Pr(>F)
## group  1  0.6848 0.4131
##       38
shapiro.test(ps_bio)
## 
##  Shapiro-Wilk normality test
## 
## data:  ps_bio
## W = 0.94927, p-value = 0.3561
shapiro.test(ps_con)
## 
##  Shapiro-Wilk normality test
## 
## data:  ps_con
## W = 0.91647, p-value = 0.08474

El valor p es mayor a 0.05, por lo que, no hay suficiente evidencia para rechazar la hipótesis nula. Es decir, las varianzas son iguales. Por otro lado, los datos siguen una distribución normal según la prueba de Shapiro, por lo cual, no tendremos mayor problema al realizar los intervalos de confianza.

#Primero sin Función
xBio = mean(ps_bio)
xCon = mean(ps_con)
VarBio = var(ps_bio)
VarCon = var(ps_con)
n = 20

ValorT = qt(1 - 0.025, df = 38)
ValorT
## [1] 2.024394
s2 = (((n-1)*VarBio) + ((n-1)*VarCon)) / (n + n - 2)

Error = ValorT * sqrt((s2 / n) + (s2 / n))

IntInf = round((xBio - xCon) - Error, 2)
IntSup = round((xBio - xCon) + Error, 2)

print(paste(IntInf, "< μ1 - μ2 <", IntSup))
## [1] "-8.35 < μ1 - μ2 < 2.82"
#Aplicamos función t.test
t.test(ps_bio, ps_con, paired = FALSE, var.equal = TRUE)
## 
##  Two Sample t-test
## 
## data:  ps_bio and ps_con
## t = -1.0015, df = 38, p-value = 0.3229
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -8.346288  2.821288
## sample estimates:
## mean of x mean of y 
##  143.4695  146.2320

El intervalo incluye el 0, lo cual sugiere que no existe evidencia suficiente en la muestra como para rechazar la idea de la igualdad de medias entre ambas poblaciones. Es decir, no existe una diferencia significativa de presiones sanguíneas antes del tratamiento entre los dos grupos, en pocas palabras, antes del entrenamientos las presiones sanguíneas eran relativamente parecidas.

¿Es posible afirmar, a nivel 0.01, que el grupo biorealimentación experimentó un descenso en la presión sanguínea?

#Presión sanguínea antes
ps_bioant <- c(GrupoBio$ps_antes)

#Presión sanguínea después
ps_biodes <- c(GrupoBio$ps_después)

#Calculamos la diferencia
ps_bioT <- ps_bioant - ps_biodes
n = length(ps_bioT)
x = mean(ps_bioT)
s = sd(ps_bioT)

#Ho: El grupo biorealimentación no experimentó un descenso en la presión sanguínea.
#H1: El grupo biorealimentación experimentó un descenso en la presión sanguínea.

#Test de normalidad
shapiro.test(ps_bioT) #Es normal
## 
##  Shapiro-Wilk normality test
## 
## data:  ps_bioT
## W = 0.96088, p-value = 0.5615
t = qt(1-0.005, 19)
Error2 = t * s / sqrt(n)
IntInf2 = round( x - Error2, 2)
IntSup2 = round( x + Error2, 2)

print(paste(IntInf2, "< μ <", IntSup2))
## [1] "9.41 < μ < 10.89"
#Con prueba

t.test(ps_bioT, conf.level = 0.99)
## 
##  One Sample t-test
## 
## data:  ps_bioT
## t = 39.15, df = 19, p-value < 2.2e-16
## alternative hypothesis: true mean is not equal to 0
## 99 percent confidence interval:
##   9.407355 10.890645
## sample estimates:
## mean of x 
##    10.149

Como el intervalo no incluye el 0, se puede rechazar la hipótesis nula, es decir, el grupo de biorealimentación experimentó un descenso en la presión sanguínea, en otras palabras, el tratamiento redujo significativamente la presión sanguínea en aproximadamente 10.14 unidades en promedio. Estamos un 99% seguros que la verdadera reducción en la presión sanguínea esta entre 9.606 y 10.691 unidades. Se puede inferir, los tratamientos y preparaciones que se hicieron antes habrán incidido estadísticamente en los resultados (para bien).

Para el mismo nivel de signicatividad ¿se puede dar idéntica conclusión para el grupo control?

#Separamos por antes y después
ps_conant <- c(GrupoCon$ps_antes)
ps_condes <- c(GrupoCon$ps_después)

#Calculamos la diferencia
ps_ConT <- ps_conant - ps_condes
n2 = length(ps_ConT)
x2 = mean(ps_ConT)
s2 = sd(ps_ConT)

#Ho: El grupo control no experimentó un descenso en la presión sanguínea.
#H1: El grupo control experimentó un descenso en la presión sanguínea.

#Test de normalidad
shapiro.test(ps_ConT) #Es normal
## 
##  Shapiro-Wilk normality test
## 
## data:  ps_ConT
## W = 0.94098, p-value = 0.2502
t2 = qt(1-0.005, 19)
Error3 = t2 * s2 / sqrt(n2)
IntInf3 = round( x2 - Error3, 2)
IntSup3 = round( x2 + Error3, 2)

print(paste(IntInf3, "< μ <", IntSup3))
## [1] "4.27 < μ < 5.54"
#Con prueba
t.test(ps_ConT, conf.level = 0.99)
## 
##  One Sample t-test
## 
## data:  ps_ConT
## t = 22.057, df = 19, p-value = 5.333e-15
## alternative hypothesis: true mean is not equal to 0
## 99 percent confidence interval:
##  4.267931 5.540069
## sample estimates:
## mean of x 
##     4.904

Como el intervalo no incluye el 0, se puede rechazar la hipótesis nula, es decir, el grupo de control experimentó un descenso en la presión sanguínea, en otras palabras, el tratamiento redujo significativamente la presión sanguínea en aproximadamente 4.904 unidades en promedio. Estamos un 99% seguros que la verdadera reducción en la presión sanguínea esta entre 4.27 y 5.54 unidades.

Se considera que la biorealimentación es eficaz si la disminución de la presión sanguínea del grupo biorealimentación es superior a la disminución experimentada por el grupo control. ¿Hay evidencia, a nivel 0.01, que la biorealimentación es eficaz?

Sí hay evidencia puesto que en ambos se vio una disminución; sin embargo, en el grupo control fue de aproximadamente 4.904 unidades en promedio, mientras que en el grupo biorealimentación fue de 10.14 unidades en promedio, es decir, fue superior. Básicamente, en el grupo biorealimentación las personas eran mas propensas a bajar su presión sanguínea a un número más alto, en otras palabras, les “bajaba” más, en cambio, en el grupo control aunque sí disminuye no lo hace tanto como el grupo biorealimentación.

Datos_PS <- data.frame(
  ps_despues = c(ps_biodes, ps_condes),  # Unir ambos vectores
  grupo = factor(c(rep("Bio", length(ps_bio)), rep("Con", length(ps_con))))  # Crear la variable de grupo
)

leveneTest(ps_despues ~ grupo, data = Datos_PS)
## Levene's Test for Homogeneity of Variance (center = median)
##       Df F value Pr(>F)
## group  1  0.0199 0.8885
##       38
shapiro.test(ps_biodes)
## 
##  Shapiro-Wilk normality test
## 
## data:  ps_biodes
## W = 0.93975, p-value = 0.2372
shapiro.test(ps_condes)
## 
##  Shapiro-Wilk normality test
## 
## data:  ps_condes
## W = 0.90896, p-value = 0.0609
#Ho: No hay diferencia significativa de disminución entre los dos grupos (u1-u2 = 0).
#H1: La disminución del grupo biorealimentación es mayor que la del grupo control (u1 - u2 > 0).

n = length(ps_bioT)
x = mean(ps_bioT)
s = sd(ps_bioT)

n2 = length(ps_ConT)
x2 = mean(ps_ConT)
s2 = sd(ps_ConT)

s21 = (((n-1)*(s^2)) + ((n-1)*(s2^2))) / (n + n - 2)

t4 = (x - x2) / sqrt((s21/n) + (s21/n))

t3 = qt(1-0.005, 38)

t4
## [1] 15.35812
t3
## [1] 2.711558
t.test(ps_bioT, ps_ConT, alternative = "greater", var.equal = TRUE)
## 
##  Two Sample t-test
## 
## data:  ps_bioT and ps_ConT
## t = 15.358, df = 38, p-value < 2.2e-16
## alternative hypothesis: true difference in means is greater than 0
## 95 percent confidence interval:
##  4.669224      Inf
## sample estimates:
## mean of x mean of y 
##    10.149     4.904

Como se puede ver, se hizo una prueba de hipotesis para diferencias de medias y se vio que se afirmo lo del inicio. La presión sanguínea en el grupo biorealimentación disminuyó más que en el grupo control. se puede concluir que a nivel 0.01, es más eficaz que en el grupo biorealimentación disminuya más la presión sanguínea.

En caso de que tu conclusión sea que la biorealimentación no es eficaz, trata de explicar la causa; Si por el contrario, concluyes que es eficaz, estima el efecto de la biorealimentación

Como se concluyo, el grupo biorealimentación fue mas eficaz que el grupo control, el primero con una media de disminución de la presion sanguínea de 10.149 y el segundo con una media de 4.904, es decir, una diferencia de 5.245. Una de los efectos puede ser que el grupo de biorealimentación recibió unas 8 semanas de preparación, y ejercicios de respiración, y eso tuvo un efecto positivo en la disminución de la presión sanguínea según los resultados arrojados antes.