Cargaremos la base de datos y cargaremos los paquetes

## 
## Adjuntando el paquete: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
## Warning: package 'ggplot2' was built under R version 4.4.3
## Warning: package 'knitr' was built under R version 4.4.3
## 
## Adjuntando el paquete: 'kableExtra'
## The following object is masked from 'package:dplyr':
## 
##     group_rows

Estructura de la base de datos

Primero haremos un resumen para obtener información de la base de datos.

dim(datos)
## [1] 40  3
summary(datos)
##     ps_antes       ps_después     Tratamiento 
##  Min.   :125.3   Min.   :116.3   Min.   :1.0  
##  1st Qu.:137.6   1st Qu.:131.5   1st Qu.:1.0  
##  Median :144.8   Median :137.4   Median :1.5  
##  Mean   :144.9   Mean   :137.3   Mean   :1.5  
##  3rd Qu.:151.7   3rd Qu.:143.7   3rd Qu.:2.0  
##  Max.   :167.0   Max.   :162.8   Max.   :2.0
colnames(datos)
## [1] "ps_antes"    "ps_después"  "Tratamiento"
str(datos)
## tibble [40 × 3] (S3: tbl_df/tbl/data.frame)
##  $ ps_antes   : num [1:40] 151 145 137 152 154 ...
##   ..- attr(*, "format.spss")= chr "F8.2"
##  $ ps_después : num [1:40] 142 135 128 141 143 ...
##   ..- attr(*, "format.spss")= chr "F8.2"
##  $ Tratamiento: dbl+lbl [1:40] 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1...
##    ..@ format.spss: chr "F8.0"
##    ..@ labels     : Named num [1:2] 1 2
##    .. ..- attr(*, "names")= chr [1:2] "biorrelimentación" "control"
library(knitr)
library(kableExtra)
kable(datos, caption="Base de datos") %>%
  kable_styling(full_width=F) %>%
  column_spec(2, width="20em") %>%
  scroll_box(width="900px", height="450px")
Base de datos
ps_antes ps_después Tratamiento
150.67 141.69 1
145.37 134.98 1
136.55 127.82 1
151.63 140.77 1
154.29 143.36 1
157.25 144.95 1
132.98 123.95 1
137.11 127.32 1
154.20 143.48 1
136.43 125.75 1
149.94 139.31 1
139.90 131.97 1
125.34 116.29 1
129.46 118.84 1
137.69 128.10 1
142.07 130.44 1
150.98 139.20 1
154.51 143.52 1
144.55 135.45 1
138.47 129.22 1
138.64 132.93 2
148.92 144.99 2
136.86 132.16 2
145.41 140.10 2
153.47 149.15 2
136.74 132.40 2
151.76 147.89 2
152.55 148.65 2
156.66 152.75 2
150.48 146.95 2
136.45 131.61 2
166.99 162.84 2
150.44 144.06 2
144.47 139.10 2
152.50 147.38 2
137.34 131.34 2
140.49 134.43 2
139.30 132.06 2
145.14 140.07 2
140.03 135.70 2

Población: humanidad
Muestra: fue aleatoria, 20 personas para el grupo de biorealimentación y 20 para el grupo de control.
Variables:
- Tratamiento(Categórica nominal): identifica el tipo de tratamiento de cada observación. 1 para biorealimentaión y 2 para control.
- ps_antes(Numérica continua): guarda la presión sanguínea sistólica de cada observación.
- ps_después(Numérica continua): guarda la presión sanguínea sistólica de cada observación.
No.filas: 40
No.filas: 3
Nota : la base de datos vemos a simple vista que no tiene datos NA y mucho menos atípicos, gracias a la información nos arroja la función kable() y summary().

Análisis descriptivo de las variables numéricas continuas

Analizaremos cada una de las variables con las observaciones del experimento, pero para ello debemos hacerlo por tratamiento individualmente, dado que, nuestro objetivo principal es analizar el antes y después de la presión sanguinea de las personas de acuerdo al tipo de tratamiento recibido. Por tanto, haremos un filtro para separar la base de datos en dos, una con los tratamientos tipo 1 y otra con los tipo 2.

Tratamiento tipo 1
datos1<-datos %>%
  filter(Tratamiento==1)
kable(datos1, caption="Base de datos") %>%
  kable_styling(full_width=F) %>%
  column_spec(2, width="20em") %>%
  scroll_box(width="900px", height="450px")
Base de datos
ps_antes ps_después Tratamiento
150.67 141.69 1
145.37 134.98 1
136.55 127.82 1
151.63 140.77 1
154.29 143.36 1
157.25 144.95 1
132.98 123.95 1
137.11 127.32 1
154.20 143.48 1
136.43 125.75 1
149.94 139.31 1
139.90 131.97 1
125.34 116.29 1
129.46 118.84 1
137.69 128.10 1
142.07 130.44 1
150.98 139.20 1
154.51 143.52 1
144.55 135.45 1
138.47 129.22 1
Tratamiento tipo 2
datos2<-datos %>%
  filter(Tratamiento==2)
kable(datos2, caption="Base de datos") %>%
  kable_styling(full_width=F) %>%
  column_spec(2, width="20em") %>%
  scroll_box(width="900px", height="450px")
Base de datos
ps_antes ps_después Tratamiento
138.64 132.93 2
148.92 144.99 2
136.86 132.16 2
145.41 140.10 2
153.47 149.15 2
136.74 132.40 2
151.76 147.89 2
152.55 148.65 2
156.66 152.75 2
150.48 146.95 2
136.45 131.61 2
166.99 162.84 2
150.44 144.06 2
144.47 139.10 2
152.50 147.38 2
137.34 131.34 2
140.49 134.43 2
139.30 132.06 2
145.14 140.07 2
140.03 135.70 2

Ya realizado el filtro, haremos el analisis de las variables ps_antes y ps_después en cada tipo de tratamiento.

Resumen de los datos del tratamiento tipo 1

summary(datos1)
##     ps_antes       ps_después     Tratamiento
##  Min.   :125.3   Min.   :116.3   Min.   :1   
##  1st Qu.:137.0   1st Qu.:127.7   1st Qu.:1   
##  Median :143.3   Median :133.5   Median :1   
##  Mean   :143.5   Mean   :133.3   Mean   :1   
##  3rd Qu.:151.1   3rd Qu.:141.0   3rd Qu.:1   
##  Max.   :157.2   Max.   :144.9   Max.   :1

Resumen de los datos del tratamiento tipo 1

summary(datos2)
##     ps_antes       ps_después     Tratamiento
##  Min.   :136.4   Min.   :131.3   Min.   :2   
##  1st Qu.:139.1   1st Qu.:132.8   1st Qu.:2   
##  Median :145.3   Median :140.1   Median :2   
##  Mean   :146.2   Mean   :141.3   Mean   :2   
##  3rd Qu.:151.9   3rd Qu.:147.5   3rd Qu.:2   
##  Max.   :167.0   Max.   :162.8   Max.   :2

Analisis Tratamiento 1

Presión alterial antes

Gráfico 1(Histograma)

ggp1 <- ggplot(data.frame(value=datos1$ps_antes), aes(x=value)) +
  geom_histogram(fill="#FD0000", color="#E52521", alpha=0.9, binwidth = 3) +
  ggtitle("Base de datos original") +
  xlab("presión arterial") + ylab("Frequencia") +
  theme_ipsum() +
  theme(plot.title = element_text(size=15))
ggp1

Se observa de manera preliminar que el gráfico no tiene un sesgo totalmente definido, esto se refuerza porque no hay mucha diferencia entre la media y la mediana. Además, se presenta una asimetría notable, lo que refleja que puede que no siga una distribución normal sino binomal porque hay dos agrupaciones de datos.

Gráfico 2(Caja y bigotes)

ggplot(datos1, aes(y = ps_antes)) +
  geom_boxplot(outlier.colour = "orange", outlier.shape = 16, outlier.size = 2, fill = "skyblue", color = "darkblue") +
  labs(title = "Caja de Bigote",
       y = "Accuracy") +
  theme_minimal() +
  theme(plot.title = element_text(hjust = 0.5))

Notamos una dispersión equilibrada, sin valores atípicos evidentes, lo que indica una distribución estable según el gráfico. Los bigotes son simétricos, sugiriendo la ausencia de sesgo significativo en los datos. Ahora, verificaremos todo esto con pruebas.

Análisis de normalidad:

Como las pruebas son menores al 50 entonces usaremos shapiro wilk.

shapiro.test(datos1$ps_antes)
## 
##  Shapiro-Wilk normality test
## 
## data:  datos1$ps_antes
## W = 0.94927, p-value = 0.3561

Vemos que el p-value es mayor al 0.05 entonces podemos concluir que la distribución sigue una distribución normal.

Gráfico 3(QQ-plot)

qqnorm(datos1$ps_antes, main = "ps_antes tipo 1")
qqline(datos1$ps_antes, col = "red")

Presión alterial después

Gráfico 4(Histograma)

ggp1 <- ggplot(data.frame(value=datos1$ps_después), aes(x=value)) +
  geom_histogram(fill="#FD0000", color="#E52521", alpha=0.9, binwidth = 3) +
  ggtitle("Base de datos original") +
  xlab("presión arterial") + ylab("Frequencia") +
  theme_ipsum() +
  theme(plot.title = element_text(size=15))
ggp1

Se observa de manera preliminar que el gráfico no tiene un sesgo totalmente definido, esto se refuerza porque no hay mucha diferencia entre la media y la mediana. Además, se presenta una asimetría notable, lo que refleja que puede que no siga una distribución normal sino binomal porque hay dos agrupaciones de datos.

Gráfico 5(Caja y bigotes)

ggplot(datos1, aes(y = ps_después)) +
  geom_boxplot(outlier.colour = "orange", outlier.shape = 16, outlier.size = 2, fill = "skyblue", color = "darkblue") +
  labs(title = "Caja de Bigote",
       y = "Accuracy") +
  theme_minimal() +
  theme(plot.title = element_text(hjust = 0.5))

Notamos una dispersión equilibrada, sin valores atípicos evidentes, lo que indica una distribución estable según el gráfico. Los bigotes son simétricos, sugiriendo la ausencia de sesgo significativo en los datos. Ahora, verificaremos todo esto con pruebas.

Análisis de normalidad:

Como las pruebas son menores al 50 entonces usaremos shapiro wilk.

shapiro.test(datos1$ps_después)
## 
##  Shapiro-Wilk normality test
## 
## data:  datos1$ps_después
## W = 0.93975, p-value = 0.2372

Vemos que el p-value es mayor al 0.05 entonces podemos concluir que la distribución sigue una normal.

Gráfico 6(QQ-plot)

qqnorm(datos1$ps_después, main = "ps_después tipo 1")
qqline(datos1$ps_después, col = "red")

Analisis Tratamiento 2

Presión alterial antes

Gráfico 7(Histograma)

ggp1 <- ggplot(data.frame(value=datos2$ps_antes), aes(x=value)) +
  geom_histogram(fill="#FD0000", color="#E52521", alpha=0.9, binwidth = 3) +
  ggtitle("Base de datos original") +
  xlab("presión arterial") + ylab("Frequencia") +
  theme_ipsum() +
  theme(plot.title = element_text(size=15))
ggp1

Se observa de manera preliminar que el gráfico no tiene un sesgo totalmente definido, esto se refuerza porque no hay mucha diferencia entre la media y la mediana. Además, se presenta una asimetría notable, lo que refleja que puede que no siga una distribución normal sino binomal porque hay dos agrupaciones de datos.

Gráfico 8(Caja y bigotes)

ggplot(datos2, aes(y = ps_antes)) +
  geom_boxplot(outlier.colour = "orange", outlier.shape = 16, outlier.size = 2, fill = "skyblue", color = "darkblue") +
  labs(title = "Caja de Bigote",
       y = "Accuracy") +
  theme_minimal() +
  theme(plot.title = element_text(hjust = 0.5))

Notamos una dispersión equilibrada, sin valores atípicos evidentes, lo que indica una distribución estable según el gráfico. Los bigotes no son simétricos porque el de arriba es más largo que el de abajo, sugiriendo un sesgo hacia la derecha un poco significativo en los datos. Ahora, verificaremos todo esto con pruebas.

Análisis de normalidad:

Como las pruebas son menores al 50 entonces usaremos shapiro wilk.

shapiro.test(datos2$ps_antes)
## 
##  Shapiro-Wilk normality test
## 
## data:  datos2$ps_antes
## W = 0.91647, p-value = 0.08474

Vemos que el p-value es mayor al 0.05 entonces podemos concluir que la distribución es normal.

Gráfico 9(QQ-plot)

qqnorm(datos2$ps_antes, main = "ps_antes tipo 2")
qqline(datos2$ps_antes, col = "red")

Presión alterial después

Gráfico 10(Histograma)

ggp1 <- ggplot(data.frame(value=datos2$ps_después), aes(x=value)) +
  geom_histogram(fill="#FD0000", color="#E52521", alpha=0.9, binwidth = 3) +
  ggtitle("Base de datos original") +
  xlab("presión arterial") + ylab("Frequencia") +
  theme_ipsum() +
  theme(plot.title = element_text(size=15))
ggp1

Se observa de manera preliminar que el gráfico no tiene un sesgo totalmente definido, esto se refuerza porque no hay mucha diferencia entre la media y la mediana. Además, se presenta una asimetría notable, lo que refleja que puede que no siga una distribución normal sino binomal porque hay dos agrupaciones de datos.

Gráfico 11(Caja y bigotes)

ggplot(datos2, aes(y = ps_después)) +
  geom_boxplot(outlier.colour = "orange", outlier.shape = 16, outlier.size = 2, fill = "skyblue", color = "darkblue") +
  labs(title = "Caja de Bigote",
       y = "Accuracy") +
  theme_minimal() +
  theme(plot.title = element_text(hjust = 0.5))

Notamos una dispersión equilibrada, sin valores atípicos evidentes, lo que indica una distribución estable según el gráfico. Los bigotes no son simétricos porque el de arriba es más largo que el de abajo, sugiriendo un sesgo hacia la derecha un poco significativo en los datos. Ahora, verificaremos todo esto con pruebas.

Análisis de normalidad:

Como las pruebas son menores al 50 entonces usaremos shapiro wilk.

shapiro.test(datos2$ps_después)
## 
##  Shapiro-Wilk normality test
## 
## data:  datos2$ps_después
## W = 0.90896, p-value = 0.0609

Vemos que el p-value es mayor al 0.05 entonces podemos concluir que la distribución es normal.

Gráfico 12(QQ-plot)

qqnorm(datos2$ps_después, main = "ps_después tipo 2")
qqline(datos2$ps_después, col = "red")

¿Hay diferencia significativa entre las presiones sanguineas de los dos grupos antes del experimento?

Aquí cargaremos variables de interés como medias, tamaño de muestras y demás.

n1_antes<-length(datos1$ps_antes)
n1_despues<-length(datos1$ps_después)
n2_antes<-length(datos2$ps_antes)
n2_despues<-length(datos2$ps_después)
var1_antes<-var(datos1$ps_antes)
var1_despues<-var(datos1$ps_después)
var2_antes<-var(datos2$ps_antes)
var2_despues<-var(datos2$ps_después)
media1_antes<-mean(datos1$ps_antes)
media1_despues<-mean(datos1$ps_después)
media2_antes<-mean(datos2$ps_antes)
media2_despues<-mean(datos2$ps_después)

Las muestras son independientes porque al principio los voluntarios fueron asignados aleatoriamente a sus grupos y solo se analiza el antes del experimento.
Tenemos como supuestos que ambos grupos no siguen una distribución normal, ahora veremos si tienen igualdad de varianza.

var.test(datos1$ps_antes,datos2$ps_antes)
## 
##  F test to compare two variances
## 
## data:  datos1$ps_antes and datos2$ps_antes
## F = 1.2594, num df = 19, denom df = 19, p-value = 0.6202
## alternative hypothesis: true ratio of variances is not equal to 1
## 95 percent confidence interval:
##  0.4984842 3.1818016
## sample estimates:
## ratio of variances 
##           1.259396
datos<-c(datos1$ps_antes,datos2$ps_antes)
#grupos<-

Vemos que podemos aceptar la hipotesis nula de que las varianzas de los grupos son iguales porque el p-value es mayor a 0.05. Por tanto, tenemos el supuesto de que las varianzas son iguales.

Siguiendo estos supuesto de que ambos grupos siguen distribución normal y las varianzas son iguales, podemos usar la prueba paramétrica

t.test(datos1$ps_antes,datos2$ps_antes,var.equal = TRUE)
## 
##  Two Sample t-test
## 
## data:  datos1$ps_antes and datos2$ps_antes
## 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

Vemos que el p valor es mayor al 0.01, entonces aceptamos la hipotesis nula que no hay diferencia significativa entre ambos grupos. Además, el t.test nos proporciona el intervalo de confianza para diferencia de medias y vemos que el 0 se encuentra incluido, por tanto, es otra prueba de que las medias son iguales.

Hagamoslo manualmente Ho: U1-U2=0 H1: U1-U2!=0

S2<-((n1_antes-1)*var1_antes+(n2_antes-1)*var2_antes)/(n1_antes+n2_antes-2)
t<-(media1_antes-media2_antes)/sqrt((S2+S2)/n1_antes)
tcritico<-qt(0.05,n1_antes+n2_antes-2,lower.tail = FALSE)
cat("t calculado es: ", t)
## t calculado es:  -1.00154
cat("t critico es: ", tcritico)
## t critico es:  1.685954

Vemos que el t calculado cae en la zona de aceptación de Ho porque t calculado > -tcritico y t calculado < +t critico.

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

Trabajaremos con muestras pareadas porque queremos analizar el antes y después de un mismo grupo de individuos.
En este caso haremos primero el intervalo de confianza con un vector que contenga la diferencia de las presiones sanguineas de forma antes-despues del grupo 1 (Biorealimentación).
Además, tenemos los supuestos de que tanto la muestra de antes y después siguen una distribución normal.

dif1_bio<-c(datos1$ps_antes-datos1$ps_después)
error_muestral<-var(dif1_bio)/sqrt(length(dif1_bio))
error_aleatorio<-qt(0.05,length(dif1_bio)-1,lower.tail = FALSE)
Error<-error_muestral*error_aleatorio
media_dif<-mean(dif1_bio)
limite_inferior<-media_dif-Error
limite_superior<-media_dif+Error
cat(limite_inferior," <= U <= ",limite_superior)
## 9.62934  <= U <=  10.66866
t.test(dif1_bio,conf.level = 0.95)
## 
##  One Sample t-test
## 
## data:  dif1_bio
## t = 39.15, df = 19, p-value < 2.2e-16
## alternative hypothesis: true mean is not equal to 0
## 95 percent confidence interval:
##   9.606422 10.691578
## sample estimates:
## mean of x 
##    10.149

El intervalo de confianza nos muestra que efectivamente antes de la prueba de biorealimentación había más presión sanguinea. Sin embargo, usaremos la prueba de hipotesis para confirmar el resultado.
Las hipotesis serán: Ho: U>=0 H1: U<0

t2<-mean(dif1_bio)/(sd(dif1_bio)/sqrt(length(dif1_bio)))
tcritico2<-qt(0.05,df=length(dif1_bio)-1,lower.tail = FALSE)
t2
## [1] 39.15033
tcritico2
## [1] 1.729133

Vemos que el t calculado es mayor al t critico, y como la prueba es con cola hacia la derecha, entonces se acepta la hipotesis alternativa, reafirmandose que hubo un descenso de la presión alterial.

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

Trabajaremos con muestras pareadas porque queremos analizar el antes y después de un mismo grupo de individuos.
En este caso haremos primero el intervalo de confianza con un vector que contenga la diferencia de las presiones sanguineas de forma antes-despues del grupo 2 (CONTROL).
Además, tenemos los supuestos de que tanto la muestra de antes y después siguen una distribución normal.

dif2_con<-c(datos2$ps_antes-datos2$ps_después)
error_muestral<-var(dif2_con)/sqrt(length(dif2_con))
error_aleatorio<-qt(0.05,length(dif2_con)-1,lower.tail = FALSE)
Error<-error_muestral*error_aleatorio
media_dif2<-mean(dif2_con)
limite_inferior2<-media_dif2-Error
limite_superior2<-media_dif2+Error
cat(limite_inferior2," <= U <= ",limite_superior2)
## 4.52176  <= U <=  5.28624
t.test(dif2_con,conf.level = 0.95)
## 
##  One Sample t-test
## 
## data:  dif2_con
## t = 22.057, df = 19, p-value = 5.333e-15
## alternative hypothesis: true mean is not equal to 0
## 95 percent confidence interval:
##  4.43866 5.36934
## sample estimates:
## mean of x 
##     4.904

El intervalo de confianza nos muestra que efectivamente antes de la prueba de control había más presión sanguinea. Sin embargo, usaremos la prueba de hipotesis para confirmar el resultado.
Las hipotesis serán: Ho: U>=0 H1: U<0

t2<-mean(dif2_con)/(sd(dif2_con)/sqrt(length(dif2_con)))
tcritico2<-qt(0.05,df=length(dif2_con)-1,lower.tail = FALSE)
t2
## [1] 22.0574
tcritico2
## [1] 1.729133

Vemos que el t calculado es mayor al t critico, y como la prueba es con cola hacia la derecha, entonces se acepta la hipotesis alternativa, reafirmandose que hubo un descenso de la presión alterial.

Se considera que la biorealimentación es eficaz si la disminución de la presión sanguínea en el grupo biorealimentación es

superior a la disminución experimentada por el grupo control. ¿Hay evidencia, a nivel 0.05, que la biorealimentación es eficaz?

Como la presión sanguinea de los dos grupos antes del experimento no tuvieron diferencias significativdad, entonces debemos ahora comparar la presión de los dos grupos después del experimento, en este caso, si la presión media del grupo biorealimentación es mayor a la del grupo control.

Analisis de normalidad y varianza
SAbemos de ante mano por el análisis descriptivo del principio, que las muestras de estos dos grupos que analizaremos siguen una distribución normal. por tanto, verificaremos si tienen varianzas iguales.

var.test(datos1$ps_después,datos2$ps_después)
## 
##  F test to compare two variances
## 
## data:  datos1$ps_después and datos2$ps_después
## F = 0.97917, num df = 19, denom df = 19, p-value = 0.9639
## alternative hypothesis: true ratio of variances is not equal to 1
## 95 percent confidence interval:
##  0.3875667 2.4738209
## sample estimates:
## ratio of variances 
##          0.9791684

Vemos que el p-valor es mayor al 0.05, entonces se acepta la hipotesis nula de que existe igualdad de varianzas.

Teniendo la los supuestos de normalidad, haremos la prueba de hipotesis para verificar si la media del primer grupo 1 biorealimentación, es mayor a la del grupo 2 de control.

t.test(datos1$ps_después,datos2$ps_después,var.equal = TRUE,alternative = "less")
## 
##  Two Sample t-test
## 
## data:  datos1$ps_después and datos2$ps_después
## t = -2.922, df = 38, p-value = 0.002913
## alternative hypothesis: true difference in means is less than 0
## 95 percent confidence interval:
##       -Inf -3.387299
## sample estimates:
## mean of x mean of y 
##  133.3205  141.3280

El P valor es mayor al 0.05, por tanto, se acepta la hipotesis nula de la presión sanguinea del grupo de biorealimentación es menor a la del grupo de control. Por tanto, el tratamiento de biorealimentación es más efectivo.