library(tidyverse)
## Warning: package 'tidyverse' was built under R version 4.4.3
## Warning: package 'ggplot2' was built under R version 4.4.3
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.5.2     ✔ tibble    3.2.1
## ✔ lubridate 1.9.3     ✔ tidyr     1.3.1
## ✔ purrr     1.0.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

Ejercicio 1

Los siguientes datos representan los gastos anuales en publicidad
x (en millones de pesos) y las ventas
y (en millones de pesos):.

Datos observados

df <- tibble(
  publicidad = c(4.17,10.04,6.02,1.52,4.81,7.70,
                 3.63,4.65,2.97,1.57,0.82,1.57,
                 6.09,3.08,1.76,3.09,4.18),
  ventas     = c(96.97,154.70,151.61,163.92,147.82,141.77,
                 179.18,171.81,200.23,125.19,120.49,98.61,
                 196.67,289.59,105.71,275.97,95.83)
)
n <- nrow(df); n
## [1] 17

##Diagrama de dispersion

df %>% 
  ggplot(aes(x = publicidad, y = ventas)) +
  geom_point(color="blue", size=3) +
  geom_smooth(formula='y~x', method="lm", se=TRUE, color="red") +
  labs(title="Relación entre gastos en publicidad y ventas",
       x="Publicidad (millones de pesos)", y="Ventas (millones de pesos)") +
  theme_bw()

##Coeficiente de correlación de Pearson

x <- df$publicidad; y <- df$ventas

r <- cor(x, y, method="pearson")
r
## [1] 0.05999696

##Prueba de hipótesis H0:ρ=0 vs H1:ρ≠0

gl <- n-2
t0 <- r * sqrt(gl) / sqrt(1-r^2)
p_val <- 2 * pt(-abs(t0), df=gl)
c(t0=t0, gl=gl, p_val=p_val)
##         t0         gl      p_val 
##  0.2327866 15.0000000  0.8190737

No existe evidencia estadísticamente significativa de correlación lineal entre publicidad y ventas.

##Intervalo de confianza del 95%

gl <- n-2
t0 <- r * sqrt(gl) / sqrt(1-r^2)
p_val <- 2 * pt(-abs(t0), df=gl)
c(t0=t0, gl=gl, p_val=p_val)
##         t0         gl      p_val 
##  0.2327866 15.0000000  0.8190737

incluye valores negativos y positivos (de -0.43 a 0.53), confirmando la ausencia de evidencia clara de relación lineal

##Conclusion Los gastos en publicidad y las ventas en este conjunto de datos no presentan correlación lineal significativa

Ejercicio 2

Los siguientes datos representan el número
x de proyectos presentados el año pasado por 12 universidades privadas y la ayuda recibida
y (en millones de pesos) para la ejecución de estos proyectos:

Datos observados

df <- tibble(
  proyectos = c(15.7,17.2,13.8,24.2,15.0,12.7,13.8,18.7,10.8,11.8,25.4,17.2),
  ayudas    = c(4,3,6,5,3,12,5,1,12,11,2,4)
)
n <- nrow(df); n
## [1] 12

##Diagrama de dispersion

df %>%
  ggplot(aes(x = proyectos, y = ayudas)) +
  geom_point(size=3, color="blue") +
  geom_smooth(formula = 'y~x', method = "lm", se=TRUE, color="red") +
  labs(title="Proyectos vs Ayudas",
       x="Número de proyectos",
       y="Ayudas (millones de pesos)") +
  theme_bw()

##Coeficiente de correlación

r <- cor(df$proyectos, df$ayudas, method="pearson")
r
## [1] -0.6675173

Existe una correlación moderada y negativa: a más proyectos, menores ayudas.

##Prueba de hipótesis bilateral

gl   <- n - 2
t0   <- r * sqrt(gl) / sqrt(1 - r^2)
pval <- 2 * pt(-abs(t0), df=gl)
c(t=t0, gl=gl, p=pval)
##           t          gl           p 
## -2.83493343 10.00000000  0.01770152

Como p<0.05 se rechaza H0 El número de proyectos y las ayudas están correlacionads linealmente

##Prueba unilateral

pval_uni <- 1 - pt(t0, df=gl)   # prueba unilateral hacia la derecha
pval_uni
## [1] 0.9911492

No hay evidencia de que la correlación sea positiva; por el contrario, los datos muestran una relación negativa.

Ejercicio 3

Los siguientes datos se obtienen en un estudio de la relación entre el peso
x (en kilogramos) y el volumen
y (en centímetros cúbicos) de un tipo de recipiente: ————————————————————————

Datos observados

df <- tibble(
  peso = c(5.52,3.21,4.32,2.31,4.30,3.71,2.75,2.15,4.41),
  volumen = c(36.5,27.2,27.7,28.3,30.3,29.7,29.5,26.3,32.2)
)
n <- nrow(df); n
## [1] 9

##Diagrama de dispersion

df %>%
  ggplot(aes(x = peso, y = volumen)) +
  geom_point(size=3, color="blue") +
  geom_smooth(formula='y~x', method="lm", se=TRUE, color="red") +
  labs(title="Relación entre peso y volumen",
       x="Peso (kg)", y="Volumen (cm³)") +
  theme_bw()

##Coeficiente de correlación

r <- cor(df$peso, df$volumen, method="pearson")
r
## [1] 0.7923075

##Prueba de hipótesis unilateral

gl <- n - 2
t0 <- r * sqrt(gl) / sqrt(1 - r^2)
pval <- 1 - pt(t0, df=gl)   # unilateral hacia la derecha
c(t=t0, gl=gl, p=pval)
##           t          gl           p 
## 3.435786070 7.000000000 0.005449651

Com0 p<0.01, se rechaza H0 el peso y el volumen están positivamente correlacionados.

##Porcentaje de variación

r2 <- r^2 * 100
r2
## [1] 62.77512

el 62.8% de la variación en el volumen de los recipientes se explica linealmente por el peso.

Ejercicio 4

Se ha seleccionado una muestra aleatoria de 12 estudiantes de bachillerato que han repetido el séptimo grado este año y, para cada uno, se ha anotado el promedio global de las calificaciones de todas las asignaturas, tanto el de este año ( y ) como el del año pasado ( x ): ————————————————————————

Datos observados

df <- tibble(
  x = c(65,55,70,65,70,55,70,50,55,65,50,55),  # promedio año pasado
  y = c(90,85,87,94,98,81,91,76,74,85,74,76)   # promedio este año
)
n <- nrow(df); n
## [1] 12

##Diagrama de dispersion

df %>%
  ggplot(aes(x=x, y=y)) +
  geom_point(size=3, color="blue") +
  geom_smooth(formula='y~x', method="lm", se=TRUE, color="red") +
  labs(title="Promedios año pasado (x) vs año actual (y)",
       x="Promedio año pasado", y="Promedio año actual") +
  theme_bw()

##Coeficiente de correlación

r <- cor(df$x, df$y, method="pearson")
r
## [1] 0.8624546

##Prueba de hipótesis unilateral

rho0 <- 0.5
z_obs <- (atanh(r) - atanh(rho0)) * sqrt(n - 3)
pval <- 1 - pnorm(z_obs)   # unilateral hacia la derecha
c(Z=z_obs, pval=pval)
##          Z       pval 
## 2.26062663 0.01189119

se rechaza la hipótesis de que p=0.5. la correlación poblacional es mayor a 0.5.

Ejercicio 5

Los siguientes datos representan el tiempo de vida
x de un bombillo de marca A (en horas), así como el tiempo de vida
y de un bombillo de marca B (en minutos):

Datos observados

df <- tibble(
  A_horas = c(4200,3600,3750,3675,4050,2770,4870,4500,3450,2700,3750,3300),
  B_min   = c(370,340,375,310,350,200,400,375,285,225,345,285)
)
n <- nrow(df); n
## [1] 12

##Coeficiente de correlación

r <- cor(df$A_horas, df$B_min, method="pearson")
r
## [1] 0.9231564

existe una correlación positiva muy fuerte entre los tiempos de vida de ambas marcas.

##Invariancia de la correlación

Si se intercambian las variables el coeficiente de correlación no cambia: sigue siendo r≈0.953

Si se convierte y de minutos a horas el coeficiente tampoco cambia porque la correlación es invariante ante transformaciones lineales

##Gráficas de probabilidad normal

# Gráfico normalidad Marca A
qqnorm(df$A_horas, main="Q-Q plot Marca A (horas)")
qqline(df$A_horas, col="red")

# Gráfico normalidad Marca B
qqnorm(df$B_min, main="Q-Q plot Marca B (minutos)")
qqline(df$B_min, col="red")

##Prueba de hipótesis

gl <- n - 2
t0 <- r * sqrt(gl) / sqrt(1 - r^2)
pval <- 2 * pt(-abs(t0), df = gl)

c(t = t0, gl = gl, p = pval)
##            t           gl            p 
## 7.593888e+00 1.000000e+01 1.852845e-05

Decisión: Como p<0.05, se rechaza H0 Hay correlación lineal entre el tiempo de vida de ambas marcas.

Ejercicio 6

Se muestran el peso y la presión sistólica sanguínea (BP) de 26 hombres seleccionados al azar, en el grupo de edades de 25 a 30 años. Suponer que el peso y la presión sanguínea tienen distribución normal conjunta.

Datos observados

df <- tibble(
  peso = c(165,167,180,155,212,175,190,210,200,149,158,169,170,
           172,159,168,174,183,215,195,180,143,240,235,192,187),
  bp   = c(130,133,150,128,151,146,150,140,148,125,133,135,150,
           153,128,132,149,158,150,163,156,124,170,165,160,159)
)

n <- nrow(df); n
## [1] 26

##Diagrama de dispersión

df %>%
  ggplot(aes(x = peso, y = bp)) +
  geom_point(size=3, color="blue") +
  geom_smooth(formula='y~x', method="lm", se=TRUE, color="red") +
  labs(title="Peso vs Presión sistólica",
       x="Peso (lbs)", y="BP sistólica (mmHg)") +
  theme_bw()

##Coeficiente de correlación

r <- cor(df$peso, df$bp, method="pearson")
r
## [1] 0.7734903

existe una correlación positiva fuerte entre peso y presión sistólica

##Prueba de hipótesis

gl <- n - 2
t0 <- r * sqrt(gl) / sqrt(1 - r^2)
pval <- 2 * pt(-abs(t0), df = gl)
c(t=t0, gl=gl, p=pval)
##            t           gl            p 
## 5.978644e+00 2.400000e+01 3.591105e-06

Como p<0.05, se rechaza H0 correlación lineal positiva entre peso y presión.

##Prueba de hipótesis

rho0 <- 0.6
z_obs <- (atanh(r) - atanh(rho0)) * sqrt(n - 3)
pval2 <- 2 * (1 - pnorm(abs(z_obs)))
c(Z=z_obs, pval=pval2)
##         Z      pval 
## 1.6104946 0.1072899

Como p>0.05, no se rechaza H0

No hay evidencia suficiente para afirmar que ρ difiere de 0.6.

##Intervalo de confianza al 95% para p

z0   <- atanh(r)
se_z <- 1 / sqrt(n - 3)
z975 <- qnorm(0.975)
ci_r <- tanh(c(z0 - z975*se_z, z0 + z975*se_z))
ci_r
## [1] 0.5513214 0.8932215

la correlación poblacional es positiva y bastante alta.