.

# cargo de librerias
library(tidyverse)
 library(ggplot2)
library(MASS)
library(ggplot2)
library(tidyverse)
library(kableExtra)

Punto 1

Se desea ver si la temperatura en la ciudad 1 es superior a la temperatura en la ciudad 2, las temperaturas tomadas en las dos ciudades, en el verano, son las siguientes:

Ciudad 1 83 89 89 90 91 91 92 94 96
Ciudad 2 77 78 79 80 81 81 81 82

Para ello, se utiliza el test Mann-Whitney.

Donde su prueba de hipótesis se muestra a continuación:

\[\left\lbrace\begin{array}{c} H_0:\ \ E[X] \leq E[Y] \\ H_1:\ \ E[X] > E[Y] \end{array}\right.\]

Donde \(X\) representa la temperatura de la ciudad 1 y \(Y\) la temperatura de la ciudad 2.

Se tienen los siguientes datos: \(n = 9\), \(m = 8\), \(N = 9 + 8 = 17\).

Datos Rangos
83 9.0
89 10.5
89 10.5
90 12.0
91 13.5
91 13.5
92 15.0
94 16.0
96 17.0
77 1.0
78 2.0
79 3.0
80 4.0
81 6.0
81 6.0
81 6.0
82 8.0

En la tabla anterior se puede observar que existen empates entre los datos de las temperaturas de la ciudades.

Sin factor de corrección:

\[T = \sum_{i = 1}^{9}R(X_i) = 117 \] \[ \sum_{i = 1}^{17}R^2_i = 1782\]

\[T_1 = \frac{117 - 9*(\frac{18}{2})}{\sqrt{\frac{9*8}{17*16}*1782-\frac{9*8*(18^2)}{4*16}}} = 3.476908\]

Con factor de corrección:

\[T_1 = \frac{117 - 9*(\frac{18}{2})-\frac{1}{2}}{\sqrt{\frac{9*8}{17*16}*1782-\frac{9*8*(18^2)}{4*16}}} = 3.428618\]

Como se está utilizando una prueba de cola derecha se emplea la siguiente región de rechazo:

\[R.C = \{ T_1 / T_1 > Z_{0.95}\}\] \[R.C = \{ T_1 / T_1 > 1.644854\}\]

Por lo anterior, se rechaza \(H_0\) usando tanto el \(T_1\) con factor de corrección y sin factor de corrección porque dichos valores son mayores a \(1.644854\).

En este caso se utiliza \(ValP = P(Z >T_1)\)

Con factor de corrección:

\[P(Z > 3.476908) = 0.00025\] Sin factor de corrección:

\[P(Z > 3.428618) = 0.0003\]

suppressWarnings(wilcox.test(x,y,alternative = "greater",correct = T))
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  x and y
## W = 72, p-value = 0.0003033
## alternative hypothesis: true location shift is greater than 0
suppressWarnings(wilcox.test(x,y,alternative = "greater",correct = F))
## 
##  Wilcoxon rank sum test
## 
## data:  x and y
## W = 72, p-value = 0.0002536
## alternative hypothesis: true location shift is greater than 0

Se puede observar que el valor P coincide con el resultado de la función de R, en este caso para el valor con factor de corrección. Además, también coincide con el valor sin factor de corrección.

En general se concluye que se rechaza \(H_0\), es decir, la temperatura media de la ciudad 1 es mayor a la de la ciudad 2, esto con un nivel de confianza del 95%.

Punto 2

Siete estudiantes aprendieron Álgebra usando el método presente y seis estudiantes aprendieron Álgebra usando un método nuevo, halle un intervalo de confianza del 90% para la diferencia entre los puntajes promedio de los 2 métodos, los resultados fueron:

Método presente 68 72 79 69 84 80 78
Método nuevo 64 60 68 73 72 70

Sea \(X\) el puntaje obtenido con el método presente y \(Y\) el puntaje con el método nuevo. Se quiere calcular un intervalo de confianza del \(90\%\) para la diferencia entre dichos puntajes.

Dado que \(w_{0.025}\) para \(n = 7\), \(m = 6\).

Como \(n\) y \(m\) son valore pequeños, entonces se utiliza la tabla A7 en el texto de W.J.Conover Practical Nonparametric Statistics. Con la combinación de parámetros se tiene que \(w_{0.05} = 37\). De igual manera, se quizo probar la aproximación normal para ver el valor que arroja:

\[w_{0.05} = \frac{7*14}{2} + Z_{0.05}*\sqrt{\frac{42*14}{12}} = 37.48602\]

Se observa que resulta ser un valor aproximado al encontrado en la tabla A7.

Ahora se calcula \(k = 37 - \frac{7*8}{2} = 9\)

\(Y_i\)
\(X_i\) 64 60 68 73 72 70
68 4 8 0 -5 -4 -2
72 8 12 4 -1 0 2
79 15 19 11 6 7 9
69 5 9 1 -4 -3 -1
84 20 24 16 11 12 14
80 16 20 12 7 8 10
78 14 18 10 5 6 8

Al ordenar las diferencias se obtiene lo siguiente:

-5 -4 -4 -3 -2 -1 -1 0 1 2 4 4 5 5 6 6 7 7 8 8 8 8 9 9 10 1011 11 12 12 12 14 15 16 16 18 19 20 20 24

El intervalo al \(90\%\) que se pide para \(E[X] - E[Y]\):

\[(L,U) = (d^{(k = 9)}, d^{(r-k+1 = 42-9+1 = 34)}) = (0,14)\] El intervalo permite concluir que el puntaje promedio para el método presente es mayor o igual al puntaje en el método nuevo.

Punto 3

Un investigador piensa que los individuos de diversas profesiones tendrán distintos grados de susceptibilidad a ser hipnotizados. Para el experimento se eligen al azar a 6 abogados, 6 médicos, y 6 bailarines profesionales. A cada uno se le aplica un examen de susceptibilidad hipnótica. Los resultados aparecen abajo. Mientras mayor sea la calificación, mayor será la susceptibilidad a ser hipnotizados. Suponga que los datos violan los supuestos necesarios para el uso de la prueba F, pero al menos presentan una escala ordinal.

Abogados Médicos Bailarines
26 14 30
17 19 21
27 28 35
32 22 29
20 25 37
25 15 34

¿Los individuos de diversas profesiones tienen distintos grados de susceptibilidad a ser hipnotizados?

Para responder a esta pregunta, se utiliza el test de Kruskal-Wallis para 3 muestras.

Se tiene la siguiente información:

\[H_0: \mu_1 = \mu_2 = \mu_3 \ \ vs. \ \ H_1: Al \ \ menos \ \ un \ \ \mu_i \neq \mu_j \ \, \ \ i \neq j \ \ con \ \ i,j = 1,2,3 \]

Datos Rangos
26 10.0
17 3.0
27 11.0
32 15.0
20 5.0
25 8.5
14 1.0
19 4.0
28 12.0
22 7.0
25 8.5
15 2.0
30 14.0
21 6.0
35 17.0
29 13.0
37 18.0
34 16.0

En la tabla anterior se puede observar la existencia de empates en los datos de las tres profesiones, por tanto se usa el siguiente estadístico de prueba.

\[T = \frac{1}{S^2}*(\sum_{i = 1}^{3} \frac{R_i^2}{n_i} - \frac{18*19^2}{4})\] Donde:

\[S^2 = \frac{1}{17}*(\sum_{i = 1}^{3}\sum_{j = 1}^{n_i}R^2(X_{i,j}) - \frac{18*19^2}{4}) = 28.47059\]

\(R_i = \sum_{j =1}^{6} R(X_j)\) para \(i = 1,2,3\)

De la formula anterior se obtiene:

Con la información anteriro se concluye que \(T = 7.34969\).

La región de rechazo para la prueba planteada es:

\[R.C = \{T/ T > \chi^2_{1-0.05,2}\}\] \[R.C = \{T/ T > 5.99\}\] Como el \(T\) que se calculó es mayor a 5.99 se puede concluir que con una significancia del \(5\%\) existe información para rechazar \(H_0\).

\[ValorP = P(\chi^2_2 > 7.34969) \approx 0.02535\] Por lo anterior, se corrobora que se rechaza \(H_0\) porque se tiene un valor P menor a \(0.05\). Es por esto que se concluye que existen profesiones que tienen un distinto grado de susceptibilidad a ser hipnotizados.

Comparaciones múltiples

Cómo se rechazó \(H_0\) se deben revisar cuáles son las profesiones que tienen un distinto grado se susceptibilidad a ser hipnotizados.

\[|\frac{R_1}{n_1} - \frac{R_2}{n_2}| = 3\] \[|\frac{R_1}{n_1} - \frac{R_3}{n_3}| = 5.25\] \[|\frac{R_2}{n_2} - \frac{R_3}{n_3}| = 8.25\]

Como los tamaños de muestra son iguales para las tres profesiones, cada una de las diferencias anteriores se deben comparar con el siguiente valor y si son mayores las poblaciones relacionadas se consideran diferentes:

\[t_{1-(0.05/2, 18-3)}*(S^2*\frac{18-1-T}{18-3})^{1/2}*(\frac{1}{n_i}+\frac{1}{n_j})^{1/2} = 4.331686\]

Por tanto, se concluye que los abogados y los bailarines tienen un grado diferente de susceptibilidad diferente a ser hipnotizados, lo mismo ocurre con los médicos y bailarines.

  • Comparación con funciones de R:
data = c(Ab,Me,Ba)
g = c(rep(1,6),rep(2,6),rep(3,6))
kruskal.test(data,g)
## 
##  Kruskal-Wallis rank sum test
## 
## data:  data and g
## Kruskal-Wallis chi-squared = 7.3497, df = 2, p-value = 0.02535

Se observa que coinciden tanto el valor del estadístico como el del valor P.

# Comparaciones múltiples.
library(PMCMRplus)
z = suppressWarnings(kwAllPairsConoverTest(data~g, p.adjust.method = "BH"))
summary(z)
##            t value Pr(>|t|)  
## 2 - 1 == 0  -1.214 0.243475  
## 3 - 1 == 0   2.125 0.075963 .
## 3 - 2 == 0   3.339 0.013462 *

El resultado de esta función no coincide con los resultados a mano, esto puede ser debido a la corrección que se realiza para el valor P, en este caso por el método Bonferroni. En este caso solo se identifica la diferencia entre la suceptibilidad de los médicos y bailarines para ser hipnotizados con un nivel de significancia del \(5\%\).

Punto 4

Una sicóloga investiga la hipótesis de que el orden de nacimiento en una familia afecta la asertividad. Los sujetos del experimento son 20 jóvenes adultos entre 20 y 25 años de edad. Hay 7 primogénitos, 6 individuos que nacieron en segundo lugar y 7 que en tercero. Cada sujeto presenta una prueba de asertividad con los siguientes resultados. Las calificaciones altas indican una mayor asertividad. Suponga que los datos no se distribuyen de manera normal, por lo que la prueba F no puede utilizarse, pero los datos presentan al menos una escala ordinal.

De esta tabla se cuenta con la siguiente información:

Se procede a utilizar la metodología de Kruskal-Wallis. Donde se encontraron los siguientes rangos en R:

Además, se propone la siguiente prueba de hipótesis: \[\left\lbrace\begin{array}{c} H_0:\ \ \mu_1 = \mu_2 =\mu_3 \\ H_1:\ \ \mu_i \neq \mu_j, \ \ para \ \ algún \ \ i \ \ y \ \ j \ \ con \ \ i,j = 1,2,2 \end{array}\right.\]

Como hay empates, por tanto se usa:

Estadático de prueba: \[T = \frac{1}{S^2} \sum_{i=1}^3 \frac{R_i^2}{n} - \frac{20(21)^2}{4}\] \[S^2 = \frac{1}{19} \sum_{i=1}^k \sum_{j=1}^{n_i} R^2(X_{ij}) - \frac{20(21)^2}{4} = 35\]

Donde el \(T_{cal} = 0.6946\).

Región de rechazo:

{T / T> \(\chi_{1-0.05,2}^2\)} = {T / T > 5.99}

Como \(T_{cal} = 0.6946 < 5.99\). Entonces no se rechaza \(H_0\) a una significancia \(\alpha = 0.05\).

También, se calcula el valor p así:

\[Valor_p = P (\chi_{(2)}^2 > 0.6946 ) \approx 0.7066\]

Como \(P_{cal} = 0.7066 > 0.05\). Por lo cual, no se rechaza \(H_0\) y por tanto se concluye que, con un nivel de significancia del 95%, los tres grupos muestran una asertividad media similar. Notar que en este caso no se realizan comparaciones multiples.

Punto 5

Se realiza un experimento con grupos independientes para ver si el tratamiento A difiere del B. Se asigna de manera aleatoria 8 sujetos al tratamiento A y 7 al tratamiento B, se reúnen los siguientes datos:

¿Son los tratamientos A y B diferentes?

Para dar respuesta a esta pregunta, se utiliza el test Mann-Whitney.

Sean \(X_i\) y \(Y_j\) las variables que representan la información del tratamiento A y B respectivamente con \(i = 1,...,8\) y \(j = 1,...,7\).

Los datos del problema son:

Posteriormente, se plantea la siguiente prueba de hipótesis:

\[\left\lbrace\begin{array}{c} H_0:\ \ E[X] = E[Y] \\ H_1:\ \ E[X] \neq E[Y] \end{array}\right.\]

TratA = c(30,35,34,40,19,32,21,23)
TratB = c(14,8,25,16,26,28,9)

rangos = rank(c(TratA, TratB))
knitr::kable(data.frame(Datos = c(TratA,TratB),Rangos = rangos))
Datos Rangos
30 11
35 14
34 13
40 15
19 5
32 12
21 6
23 7
14 3
8 1
25 8
16 4
26 9
28 10
9 2

Como se observa en la tabla anterior no existen repeticiones, por tanto se define el siguiente estadístico de prueba.

\[T = \sum_{i = 1}^{8}R(X_i) = 83\] - Región de rechazo

Como se está utilizando una prueba de dos colas, entonces se tiene la siguiente región de rechazo:

\[R.C = \{T/ T < w_{0.025} \ \ o \ \ T > w_{0.975}\}\] Para encontrar los respectivos cuantiles se tiene en cuenta que \(n \leq 20\) y \(m \leq 20\), es por esto que se utiliza la Tabla A7 del texto de Estadística No Paramétrica de Conover.

\[w_{0.025} = 47 \ \ y \ \ w_{0.975} = 8*16 - 47 = 81\] \[R.C = \{T/ T < 47 \ \ o \ \ T > 81\}\] Como el valor \(T = 83\) es mayor a \(81\), entonces se rechazo \(H_0\).

En primer lugar se calcula \(T'\) y \(min\{T,T'\}\)

\[T' = 8*16 - 83 = 45, \ \ min\{T,T' \} = min\{83,45\} = 45\] \[valor_p = 2*P(Z \leq \frac{45+\frac{1}{2} - 8*\frac{16}{2}}{\sqrt{\frac{56*16}{12}}}) = 0.03227\] Se puede concluir que se rechaza \(H_0\) con una significancia del \(5\%\), es decir, la eficacia de los tratamientos difieren.

wilcox.test(TratA, TratB,alternative = "two.sided")
## 
##  Wilcoxon rank sum exact test
## 
## data:  TratA and TratB
## W = 47, p-value = 0.0289
## alternative hypothesis: true location shift is not equal to 0

El valor P no coincide con el calculado a mano, sin embargo se llega a la misma conclusión de rechazo de \(H_0\).

Punto 6

Tres diferentes métodos de instrucción son comparados por estudiantes de quinto grado, asignados aleatoriamente a tres diferentes aulas. El nivel del grado del talento (medido por un examen estándar) de cada estudiante se mide al comienzo de cada año y nuevamente al final de año, y se mide el incremento de cada estudiante, los resultados fueron:

Método de instrucción
clases estructuradas Estudios individuales No aulas
0.7 1.7 0.9
1 2.1 0.9
2 -0.4 1
1.4 0 0
0.5 1.1 0.1
0.8 0.9 -0.6
1 2.3 2.2
1.1 1.3 -0.3
1.9 0.4 0.6
1.2 0.5 2.4
1.5 1.0 2.5

Se tiene información del incremento en el grado de talento de una grupo de estudiantes con tres métodos diferentes de aprendizaje. Se quiere conocer si existe una diferencia en la varianza de la diferencia en los grados de talente de los estudiantes. Para esto se utiliza un test de diferencia de varianza para más de dos muestras.

Se consideran las muestras en el orden de la tabla anterior, es decir, las clases estructuradas son la muestra 1, los estudios individuales la 2 y no aulas la 3.

\[H_0: \sigma_1^2 = \sigma_2^2 = \sigma_3^2 \ \ vs. \ \ H_1: Al \ \ menos \ \ un \ \ \sigma_i^2 \neq \sigma_j^2 \ \ para \ \ i \neq j \ \ con \ \ i, j = 1,2,3\]

\[T_2 = \frac{1}{D^2}*(\sum_{j = 1}^{k = 3} \frac{S_j^2}{n_j} - N*\bar{S}^2) \sim \chi^2_{k-1}\] Para el cálculo de \(T_2\) es necesario calcular las diferencias de las observaciones con respecto a su media muestral y sus respectivos rangos.

Diferencia_muestra1 Diferencia_muestra2 Diferencia_muestra3
0.4909091 0.7090909 0.0181818
0.1909091 1.1090909 0.0181818
0.8090909 1.3909091 0.1181818
0.2090909 0.9909091 0.8818182
0.6909091 0.1090909 0.7818182
0.3909091 0.0909091 1.4818182
0.1909091 1.3090909 1.3181818
0.0909091 0.3090909 1.1818182
0.7090909 0.5909091 0.2818182
0.0090909 0.4909091 1.5181818
0.3090909 0.0090909 1.6181818

Y los rangos de los valores que se presentan en la tabla anterior son:

16.5 9.5 23.0 11.0 19.0 15.0 9.5 5.0 20.5 1.5 13.5 20.5 26.0 30.0 25.0 7.0 6.0 28.0 13.5 18.0 16.5 1.5 3.5 3.5 8.0 24.0 22.0 31.0 29.0 27.0 12.0 32.0 33.0

Donde: \(n_j = [11,11,11], N = 33\), \(S_j:\) es la suma de cuadrados de los rangos de la muestra j, \(j = 1,2,3\), es decir, \(S_j = [2318.5, 4271, 5936.5]\)

Por otra parte, \(\bar{S} = \frac{1}{33}\sum_{j = 1}^{3} S_j = 379.5758\) y \(D^2 = \frac{1}{N-1}*(\sum_{1}^{N}R_i^2 - N*\bar{S^2}) = 114828.5\)

Con la información anterior se puede calcular \(T_2 = 5.192479\)

\[R.C = \{T_2/T_2 > \chi^2_{1-0.05,2}\}\] \[R.C = \{T_2/T_2 > 5.991465\}\] Como el valor de \(T_2\) calculado es menor a 5.991456, entonces no se rechazo \(H_0\) con una significancia de \(5\%\)

\[ValorP = P(\chi^2_2 \geq T_2) = P(\chi^2_2 \geq 5.192479) = 0.074534\]

Como el valor P es mayor a 0.05, entonces se corrobora que no se rechaza \(H_0\). De esto se puede concluir que la variabilidad del incremento en el nivel de talento de los estudiantes es similar para los tres métodos de enseñanza.

Punto 7

Una pareja de esposos salieron a jugar bolos y guardaron sus resultados para ver si existía alguna relación entre dichos resultados, los puntajes fueron:

Esposo 147 158 131 142 183 151 196 129 155 158
Esposa 122 128 125 123 115 120 108 143 124 123

Use el \(\tau\) de Kendall y el \(\rho\) de Spearman para realizar una prueba de independencia entre estos puntajes.

Recordar que, tanto el \(\tau\) de Kendall como el \(\rho\) de Spearman sirven para probar independencia entre dos variables X (Esposo) y Y (Esposa) que en este caso corresponden con los resultados en un juego de bolos.

En este punto se utiliza el \(\tau\) de Kendall y el \(\rho\) se Spearman para realizar una prueba de correlación.

Test Kendall

  • Prueba de hipótesis

\[\left\lbrace\begin{array}{c} H_0:\ \ los \ \ X_i \ \ y \ \ los \ \ Y_i \ \ son \ \ mutuamente \ \ independientes. \\ H_1:\ \ los \ \ pares \ \ de \ \ observaciones \ \ tienden \ \ a \ \ ser \ \ concordantes \ \ o \ \ discordantes. \end{array}\right.\]

Luego, para calcular el \(\tau\) en el que se encuentran las discordancias, concordancias y empates en los pares de datos:

\((X_i,Y_i)\) Concordantes Discordantes
(129,143) 0 9
(131,125) 1 7
(142,123) 2.5 4.5
(147,122) 3 3
(151,120) 3 2
(155,124) 1 3
(158,123) 0 2
(158,128) 0 0
(183,115) 0 0
(196,108) 0 0

De la tabla anterior se conculye que:

  • \(N_c = 10.5\).
  • \(N_d = 33.5\).

Por lo tanto, \(\tau = \frac{10.5-33.5}{10.5+33.5} = -0.523\) lo cual coincide con la función de R.

cor(Y, X, method = "kendall")
## [1] -0.5227273

Se usa como estadístico de prueba al \(\tau\) calculado.

  • Región de rechazo

\[R.C = \{ \tau/\tau<W_{0.025} \ \ o \ \ \tau > W_{0.975}\}\]

Como existen empates en los datos entonces los cuatiles se calculan así:

\[W_{0.025} = Z_{0.025}*\frac{\sqrt{2*(2*10 + 5)}}{3*\sqrt{10*(10-1)}} = -1.498822\]

\[W_{0.975} = Z_{0.975}*\frac{\sqrt{2*(2*10 + 5)}}{3*\sqrt{10*(10-1)}} = 1.498822\]

\[R.C = \{ \tau/\tau<-0.486957 \ \ o \ \ \tau > 0.486957\}\]

Como el \(\tau\) calculado es menor que el cuantil inferior \(W_{0.025}\), entonces se rechaza \(H_0\)

  • Valor P

\[ValorP = 2*min\{P(Z \leq \frac{(T+1)*\sqrt{18}}{\sqrt{10*9*25}}, P(Z \leq \frac{(T-1)*\sqrt{18}}{\sqrt{10*9*25}}) \}\] Donde \(T = N_c - N_d = -23\)

\[ValorP = 2*min\{0.02454899, 0.01591156\}= 0.03182313\] Como el valor P es menor a \(0.05\), entonces se rechaza \(H_0\) y se puede concluir que los puntajes obtenidos por el esposo y esposa no son independientes.

  • Comparación con las funciones de R:
# test de correlación usando el método Kendall

cor(X,Y, method = "kendall")
## [1] -0.5227273
cor.test(X,Y, method = "kendall")
## Warning in cor.test.default(X, Y, method = "kendall"): Cannot compute exact p-
## value with ties
## 
##  Kendall's rank correlation tau
## 
## data:  X and Y
## z = -2.0737, p-value = 0.03811
## alternative hypothesis: true tau is not equal to 0
## sample estimates:
##        tau 
## -0.5227273

Test Spearman

Donde la medida de correlación es como sigue: \[\rho = \frac{\sum_{i=1}^n R(x_i)R(y_i) - n(\frac{n+1}{2})^2}{[\sum_{i=1}^nR^2(x_i) - n(\frac{n+1}{2})^2 ]^{1/2} [\sum_{i=1}^nR^2(y_i) - n(\frac{n+1}{2})^2 ]^{1/2}} \] \[\rho = \frac{\sum_{i = 1}^{10}R(X_i)R(X_j) - 10*(\frac{11}{2})^2}{(\sum_{i = 1}^{10}R^2(X_i)-10*(\frac{11}{2})^2)^{1/2}*(\sum_{i = 1}^{10}R^2(Y_i)-10*(\frac{11}{2})^2)^{1/2})} = -0.6128049\]

Lo anterior se obtuvo utilizando los siguientes rangos:

\(R(X_i)\) \(R(Y_i)\) \(R(X_i)R(Y_i)\)
4 4 16
7.5 9 67.5
2 8 16
3 5.5 16.5
9 2 18
5 3 15
10 1 10
1 10 10
6 7 42
7.5 5.5 41.25

Como se puede ver el cálculo coincide con la función de R.

cor(Y, X, method = "spearman")
## [1] -0.6128049

La hipótesis se define de manera similar a como se hizo en el test con el \(\tau\) de kendall.

Se plantea la siguiente prueba de hipótesis:

\[\left\lbrace\begin{array}{c} H_0:\ \ los \ \ X_i \ \ y \ \ los \ \ Y_i \ \ son \ \ mutuamente \ \ independientes. \\ H_1:\ \ los \ \ X_i \ \ y \ \ los \ \ Y_i \ \ no \ \ son \ \ mutuamente \ \ independientes. \end{array}\right.\]

  • Región de rechazo

\[R.C = \{\rho / |\rho| > W_{0.975}\}\]

Como existen empates el cuantil aproximado para \(\rho\) es \(w_{0.975} = \frac{Z_{0.975}}{sqrt(9)} = 0.6533213\)

\[R.C = \{\rho / |\rho| > 0.6533213\}\] Como el \(\rho\) calculado es menor al cuantil aproximado, entonces no se rechaza \(H_0\).

  • Valor P

\[ValorP = 2*P(Z \geq |\rho|*\sqrt{9}) = 2*P(Z \geq |\rho|*\sqrt{9}) = 0.06600128 \]

Por lo anterior, no se rechaza \(H_0\) y se concluye que los puntajes de los esposos y esposas son independientes, es decir, no tienen ninguna relación positiva o negativa.

  • Comparación con las funciones de R:
# test de correlación usando el método Kendall

cor(X,Y, method = "spearman")
## [1] -0.6128049
cor.test(X,Y, method = "spearman")
## Warning in cor.test.default(X, Y, method = "spearman"): Cannot compute exact p-
## value with ties
## 
##  Spearman's rank correlation rho
## 
## data:  X and Y
## S = 266.11, p-value = 0.05961
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##        rho 
## -0.6128049

Punto 8

Cada vez que un carro tanqueaba, un dispositivo llevó el control de la cantidad de gasolina en galones puestos en el tanque, y la distancia en millas recorridas, los resultados fueron:

Millas 142 116 194 250 88 157 255 154 43 208
Galones 11.1 5.7 14.2 15.8 7.5 12.5 17.4 8.8 3.4 15.2

Usando mínimos cuadrados se tiene las siguientes estimaciones para la pendiente a y el intercepto b:

\[b = \frac{\sum_{i} X_iY_i - \frac{(\sum_iX)(\sum_iY)}{n} }{\sum_i X^2 - \frac{(\sum_iX)^2}{n}}\] Y \[a = \hat Y - b\hat X\]

El calculo de la pendiente se presenta a continuación:

Donde

Por lo cual, el calculo de la pendiente es como sigue: \[b = \frac{\sum_{i} X_iY_i - \frac{(\sum_iX)(\sum_iY)}{n} }{\sum_i X^2 - \frac{(\sum_iX)^2}{n}} = \frac{20664.7 - \frac{179341.2}{10}}{1442.28 - \frac{12454.56}{10}} = 13.873\]

Y el calculo del intercepto es como sigue: \[a = \hat Y - b\hat X = \frac{1}{10}(142+116+194+...+208) - 13.873\frac{1}{10}(11.1+5.7+14.2+ ...+15.2) = 160.7 - 13.873 \cdot 11.16= 5.875015\]

Analogamente, también se halla la recta de regresión lineal en R usando la función lm().

X_8 <- c(11.1,5.7,14.2,15.8,7.5,12.5,17.4,8.8,3.4,15.2) # Galones
Y_8 <- c(142,116,194,250,88,157,255,154,43,208) # Millas
automovil <- data.frame(X_8,Y_8)

# ajustando un modelo de regresión lineal
modelo_8 <- lm(Y_8~X_8, method = "qr")
summary(modelo_8)
## 
## Call:
## lm(formula = Y_8 ~ X_8, method = "qr")
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -22.290 -15.912  -8.811  20.629  31.048 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)    5.875     18.843   0.312    0.763    
## X_8           13.873      1.569   8.842 2.11e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 22.01 on 8 degrees of freedom
## Multiple R-squared:  0.9072, Adjusted R-squared:  0.8956 
## F-statistic: 78.18 on 1 and 8 DF,  p-value: 2.11e-05
# formula para calcular a beta_1
X__2 = X_8**2
X__2
##  [1] 123.21  32.49 201.64 249.64  56.25 156.25 302.76  77.44  11.56 231.04
xy = X_8*Y_8
xy
##  [1] 1576.2  661.2 2754.8 3950.0  660.0 1962.5 4437.0 1355.2  146.2 3161.6
num = sum(xy) - (sum(X_8)*sum(Y_8))/10
den = sum(X__2) - (sum(X_8)**2)/10
m = num/den
m
## [1] 13.87321
# formula para calcular a beta_0 (Intercepto)
b_0 = mean(Y_8) - m*mean(X_8) 
b_0
## [1] 5.875015

Por lo tanto, la ecuación de la recta ajustada por mínimos cuadrados es: \[Y = 5.875 + 13.873X\]

Donde X representa los galones de gasolina necesarios para tanquear el automóvil. Mientras que, Y representa las millas recorridas por dicho automóvil.

Además, se grafica la regresión:

Suponiendo que el millaje de este carro está en 18 millas por galón. Por ello se busca probar la siguienye prueba de hipótesis: \[\left\lbrace\begin{array}{c} H_0:\ \ \beta_1 = 18 \\ H_1:\ \ \beta_1 \neq 18 \end{array}\right.\]

Donde para cada par \(()X_i,Y_i)\), se calcula un \(u_i = Y_i - \beta_1X_i\) y luego se procede a hallar el p de Spearman entre los pares \((X_i,u_i)\).

Primero se calculan los \(u_i\)s:

# calculo del  vector u_i
u_i <- Y_8 - 18*X_8
u_i
##  [1] -57.8  13.4 -61.6 -34.4 -47.0 -68.0 -58.2  -4.4 -18.2 -65.6

Luego, se halla el \(\rho\) de Spearman entre los pares \((X_i,u_i)\)

O sea, primero se hallan los rangos \(R(x_i)\) y \(R(u_i)\):

X_8 <- c(11.1,5.7,14.2,15.8,7.5,12.5,17.4,8.8,3.4,15.2)
a = sort(X_8)
a
##  [1]  3.4  5.7  7.5  8.8 11.1 12.5 14.2 15.2 15.8 17.4
b = sort(u_i)
b
##  [1] -68.0 -65.6 -61.6 -58.2 -57.8 -47.0 -34.4 -18.2  -4.4  13.4

Donde la medida de correlación es como sigue: \[\rho = \frac{\sum_{i=1}^n R(x_i)R(y_i) - n(\frac{n+1}{2})^2}{[\sum_{i=1}^nR^2(x_i) - n(\frac{n+1}{2})^2 ]^{1/2} [\sum_{i=1}^nR^2(y_i) - n(\frac{n+1}{2})^2 ]^{1/2}}\]

Donde:

Luego \(\rho\) es:

\[\rho = \frac{253 - 302.5}{\sqrt{385 - 302.5}\sqrt{385 - 302.5}} = \frac{-49.5}{82.5} = -0.6\]

Región de rechazo:

{\(\rho\) / \(\rho\) < \(W_{a/2}\) o \(\rho\) > \(W_{1-a/2}\)}

Con la aproximación normal: \(W_{0.025} = -0.6533213\) y \(W_{0.975} = 0.6533213\).

Donde {\(\rho\) / \(\rho = -0.6\) < \(W_{a/2} = -0.6533213\)}. Por lo cual no se rechaza \(H_0\)

Como \(\rho = 0.2 < W_{0,95} = 0,5515\), entonces no se rechaza \(H_0\) y se concluye que hay evidencia muestral suficiente para sugerir que \(\beta_1 = 18\). con \(\alpha = 0.05\).

Y el valor p está dado por:

\[Valor_p = 2P(Z \geq |-0.6| \sqrt 9) = 2P(Z \geq 1.8) = 0.072\]

Como el valor P = 0.072> 0.05. Se concluye que la cifra de 18 millas por galón es significativamente aplicable al carro en cuestión, con un nivel de significancia del 95%.

\(W_{1-0.025} = 21\), para \(T = N_c - N_d\), N = 45.

\(r = \frac{1}{2}(45-21)\), \(S = 45 + 1 -12 = 34\)

Donde el I.C. al 95% para \(\beta_1\) es: [$S^{(12)}, S^{(34)} $].

\[P(S^{(12)} \lneq \beta_1 \lneq S^{(34)}) = 1- 0.05\]

Entonces el intervalo es: [10.97561, 19.0625].

Se puede observar como contiene a \(\beta_1 = 18\). Además, la cantidad de millas al aumentar un galón de gasolina está entre 10.97561 y 19.0625 millas por galón.

Punto 9

Diez compañías reportaron sus incrementos en porcentaje en costos de publicidad (X) y sus incrementos en porcentaje de ventas (Y), para el último año comparado con el año anterior, los resultados fueron:

X 4 62 31 -11 47 88 16 -1 74 21
Y 10 33 39 -14 37 39 18 -8 45 33

Primero se hallan los rangos \(R(x_i)\) y \(R(Y_i)\) de la siguiente manera:

Los \(R(x_i)\):

Los \(R(y_i)\):

Ahora, se procede a realizar la regresión por minimos cuadrados para esos rangos:

\[Y = a_2 + b_2x\]

Donde \[b_2 = \frac{\sum_i^n R(x_i)R(y_i)- n(n+1)^2/4}{\sum_i^n R^2(x_i)- n(n+1)^2/4}\] \[a_2 = (1-b_2) (n+1)/2\]

Por consiguiente, se tiene que: \[b_2 = \frac{\sum_i^{10} (1+2+3+...+10)(1+2+3+..+10)- 10(10+1)^2/4}{\sum_i^{10} (1+2+3+...+10)^2- 0(10+1)^2/4} = \frac{376.5- 302.5}{385- 302.5} = \frac{81.5}{82.5} = 0.8969697\] \[a_2 = (1-0.9878788) (10+1)/2 =\frac{0.0121212\cdot 11}{2} = 0.1333332/2 = 0.5666667\]

Adicionalmente, se presentan dichos calculos en R:

# regresión estimada
x_9 = c(4,62,31,-11,47,88,16,-1,74,21)
y_9 = c(10,33,39,-14,37,39,18,-8,45,33)

# rangos:

Rx = rank(x_9)
Ry = rank(y_9)
Rx
##  [1]  3  8  6  1  7 10  4  2  9  5
Ry
##  [1]  3.0  5.5  8.5  1.0  7.0  8.5  4.0  2.0 10.0  5.5
# Reg minimos cuadrados para rangos:

b2 = (sum(Rx*Ry) - 10*(11^2)/4)/(sum(Rx^2) -10*(11^2)/4)
b2
## [1] 0.8969697
a2 = (1-b2)*(11)/2
a2
## [1] 0.5666667

Luego, la regresión por minimos cuadrados de los rangos es: \[Y = a_2 + b_2X \Longleftrightarrow Y = 0.5666667 + 0.8969697\]

Después, se procede a calcular los \(R(X_i)\) y \(R(X_i)\):

# Rhatyi

Restyi = a2 + (b2*Rx)
Restyi
##  [1] 3.257576 7.742424 5.948485 1.463636 6.845455 9.536364 4.154545 2.360606
##  [9] 8.639394 5.051515
# Rhatxi

Restxi = (1/b2)*(Ry-a2)
Restxi
##  [1]  2.7128378  5.5000000  8.8445946  0.4831081  7.1722973  8.8445946
##  [7]  3.8277027  1.5979730 10.5168919  5.5000000
# se cresn vectores con los valores techo y piso para hacer interpolaciones
c = vector()
f = vector()
for(i in Restxi){
  c = c(c,ceiling(i))
  f = c(f,floor(i))
}

c # rango de los techos
##  [1]  3  6  9  1  8  9  4  2 11  6
f # rango de los pisos
##  [1]  2  5  8  0  7  8  3  1 10  5
# No se calculan los rangos de Rx = 10 y Rx = 1

# Solo rangos de X
data = data.frame(x_9,y_9,Rx,Ry,Restxi,Restyi,f,c)
data = data[order(Rx),]

min(Ry)
## [1] 1
max(Ry)
## [1] 10
data
# Para el primer valor no se calcula el xihat.

xihat = c(-11 + (( (data$Restxi[2] - 1) / (2-1) )*(-1+11)),
          -1 + (( (data$Restxi[3] - 2) / (3-2) )*(4+1))
,4 + (( (data$Restxi[4] - 3) / (4-3) )*(16-4))
,21 + (( (data$Restxi[5] - 5) / (6-5) )*(31-21))
,62 + (( (data$Restxi[6] - 8) / (9-8) )*(74-62))
,47 + (( (data$Restxi[7] - 7) / (8-7) )*(62-47))
,21 + (( (data$Restxi[5] - 5) / (6-5) )*(31-21))
,62 + (( (data$Restxi[6] - 8) / (9-8) )*(74-62)))

yihat = c( -14 + (( (data$Restyi[1] - 1) / (2-1) )*(-8+14)),
           -8 + (( (data$Restyi[2] - 2) / (3-2) )*(10+8)),
           10 + (( (data$Restyi[3] - 3) / (4-3) )*(18-10)),
           18 + (( (data$Restyi[4] - 4) / (5.5-4) )*(33-18)),
           33 + (( (data$Restyi[5] - 5.5) / (7-5.5) )*(37-33)),
           33 + (( (data$Restyi[6] - 5.5) / (7-5.5) )*(37-33)),
           33 + (( (data$Restyi[7] - 5.5) / (7-5.5) )*(37-33)),
           37 + (( (data$Restyi[8] - 7) / (8.5-7) )*(39-37)),
           39 + (( (data$Restyi[9] - 8.5) / (10-8.5) )*(45-39)),
           39 + (( (data$Restyi[10] - 8.5) / (10-8.5) )*(45-39))
)

Luego de haber calculado los \(\hat R(x_i)\) y \(\hat R(y_i)\). Se presenta la tabla general de los datos obtenidos para el desarrollo de la regresión monótoma.

kable(data, booktabs = TRUE,format = "latex",
caption = "Reultados de la regresion monotona",
col.names = c("X","Y","R(x_i)", "R(Y_i)", "R(x_i)est", "R(Y_i)est","f","c")) %>%
kable_styling( latex_options = c("striped", "condensed","HOLD_position"),
position = "center",
full_width = FALSE)

Finalmente, se grafican los puntos y la recta ajustada por segmentos:

plot(x1,y1,type="l",xlab="Publicidad", ylab="porcentaje de ventas")
points(x2,y2)

Adicionalmente, se realiza una regresión LOESS en R de la siguiente forma:

Como X representa el costo en pubnlicidad en porcentaje, entonces \(x_0 = 25\). Por ende se procede a estimar a \(y_o\).

Se hace una predicción usando regresión LOESS, así:

##  [1]   7.0427207  38.7809963  37.1625736 -17.2481697  37.2935621  40.5225863
##  [7]  23.1818726  -0.5846981  39.6315443  29.2097387

Ademas, Puesto que \(\hat y_i = 18 + (5.4103 - 4)(5.5 - 4)(33-18) = 32.103\)

Se espera que por un aumento del 25% en costos de publicidad, las ventas aumenten en un 32.103%.

Punto 10

Una muestra aleatoria de 20 personas que conducen automóviles fue seleccionada para ver si el alcohol afecta el tiempo de reacción. El tiempo de reacción de cada conductor fue medido en un laboratorio antes y después de tomar una cantidad específica de alcohol. El tiempo de reacción en segundos fue el siguiente:

Antes 0.68 0.64 0.68 0.82 0.58 0.8 0.72 0.65 0.84 0.73
Después 0.73 0.62 0.66 0.92 0.68 0.87 0.77 0.7 0.88 0.79
Antes 0.65 0.59 0.78 0.67 0.65 0.76 0.61 0.86 0.74 0.88
Después 0.72 0.6 0.78 0.66 0.68 0.77 0.72 0.86 0.72 0.97

¿Se puede decir que el alcohol afecta el tiempo de reacción?

Para dar respuesta a esta pregunta se usará el test de rangos señalados de Wilcoxon, ya que este nos sirve a la hora de determinar si una m.a. en este caso de 20 conductores, donde se tiene observaciones pareadas en “Antes” y “Después”. Se busca saber si estas dos v.a. tiene la misma media a fin de determinar si el alcohol afecta el tiempo de reacción.

Por ello se realiza el siguiente procedimiento:

Donde \(X_i\) representa el tiempo de reacción “antes” de consumir alcohol y \(Y_i\) representa el tiempo de reacción “después” de consumir alcohol. La prueba de hipótesis está dada por:

En este caso se realizará un test de cola derecha, ya que se quiere encontrar si el tiempo de reacción medio antes de tomar alcohol es menor al tiempo medio de reacción después de tomar alcohol.

\[\left\lbrace\begin{array}{c} H_0:\ \ E[X_i] \geq E[Y_i] \\ H_1:\ \ E[X_i] < E[Y_i] \end{array}\right.\]

Y su estadístico de prueba.

Para hallar el estadístico de prueba \(R_i\), \(T^+\) y \(T^-\), primero se hacen las diferencias entre todos los pares \((X_i,Y_i)\).

Ahora, se calculan los rangos del valor absoluto de las diferencias anteriores \(R(|D_i|)\) sin tener en cuenta las diferencias iguales a cero para \(i = 1,...,18\):

9.5 5.0 5.0 16.5 16.5 13.5 11.0 9.5 8.0 12.0 13.5 2.0 2.0 7.0 2.0 18.0 5.0 15.0

Luego se asignan los rangos positivos y negativos \(R_i\) con respecto a \(D_i\) para \(i = 1,...,18\) sin considerar las diferencias igual a cero:

9.5,-5.0,-5.0, 16.5, 16.5, 13.5, 11.0, 9.5, 8.0, 12.0, 13.5, 2.0, -2.0, 7.0, 2.0, 18.0, -5.0 ,15.0

Con la información anterior se obtiene el estadístico de prueba \(T^+ = \sum_{i:D_i>0}R_i = 154\)

\[R.C = \{ T^+/T^+<w_{0.05}\}\] Sin embargo, como existen varios empates, se utiliza el estadístico de prueba con la aproximación normal. \[T = \frac{\sum_{i= 1}^{18}R_i}{\sqrt{\sum_{i = 1}^{18}R_i^2}} = 2.987097\] Y la región de rechazo es:

\[R.C = \{ T/T<Z_{0.05}\} = \{ T/T<-1.644854\}\] Entonces, como \(T\) es mayor que \(Z_{0.05}\) no hay información suficiente para rechazar \(H_0\).

\[ValorP = P(Z \leq \frac{\sum_{i = 1}^{18}R_i+1}{\sqrt{\sum_{i = 1}^{18}R_i^2}}) = P(\frac{138}{\sqrt{2103.5}}) = 0.998689\]

Como el valor P es mucho más grande que un nivel de significancia del \(5\%\) se corrobora el no rechazo de \(H_0\) y se puede concluir que el tiempo medio de reacción no aumenta de manera significativamente al beber alcohol.

Luego, se aplica el test usando la función wilcox.test() sobre las v.a. Antes y Después, de la siguiente manera:

# tiempo de reacción de conductores
antes <- c(0.68,0.64,0.68,0.82,0.58,0.8,0.72,0.65,0.84,0.73,
           0.65,0.59,0.78,0.67,0.65,0.76,0.61,0.86,0.74,0.88)

despues <- c(0.73,0.62,0.66,0.92,0.68,0.87,0.77,0.7,0.88,0.79,
             0.72,0.6,0.78,0.66,0.68,0.77,0.72,0.86,0.72,0.97)


# Test de rangos señalados de wilcoxon
wilcox.test(antes,despues,alternative = "greater", paired = T)
## 
##  Wilcoxon signed rank test with continuity correction
## 
## data:  antes and despues
## V = 17, p-value = 0.9987
## alternative hypothesis: true location shift is greater than 0