Se midió la conductancia estomática (gs: mol/m^2s) en dos cultivares de papa diploide (Colombia y Ocarina) bajo una condición de déficit de riego. Parte de los datos se muestran en la siguiente tabla:
Colombia <- c(0.45,0.41,0.42,0.46,0.39,0.44,0.48,0.42,0.44,0.48,0.50,0.47,0.44,0.52)
Ocarina <- c(0.28,0.25,0.32,0.34,0.36,0.40,0.32,0.36,0.39,0.41,0.37,0.42,0.41)
tbl1=data.frame(gs = c (Colombia, Ocarina), variedad = gl(2, 14, 27, c('Colombia', 'Ocarina') ))
tbl1
## gs variedad
## 1 0.45 Colombia
## 2 0.41 Colombia
## 3 0.42 Colombia
## 4 0.46 Colombia
## 5 0.39 Colombia
## 6 0.44 Colombia
## 7 0.48 Colombia
## 8 0.42 Colombia
## 9 0.44 Colombia
## 10 0.48 Colombia
## 11 0.50 Colombia
## 12 0.47 Colombia
## 13 0.44 Colombia
## 14 0.52 Colombia
## 15 0.28 Ocarina
## 16 0.25 Ocarina
## 17 0.32 Ocarina
## 18 0.34 Ocarina
## 19 0.36 Ocarina
## 20 0.40 Ocarina
## 21 0.32 Ocarina
## 22 0.36 Ocarina
## 23 0.39 Ocarina
## 24 0.41 Ocarina
## 25 0.37 Ocarina
## 26 0.42 Ocarina
## 27 0.41 Ocarina
Determinar al 95% de nivel de confianza si las dos medias obtenidas para los cultivares son estadísticamente iguales. Utilice la información del artículo mostrado en clase para decidir si las varianzas pueden considerarse iguales o no.
Planteamiento de hipótesis:
\[H_o: \mu_{Col} = \mu_{Ocar} \\ H_a: \mu_{Col} \neq \mu_{Ocar}\]
La hipótesis nula considera que el promedio de la conductancia estomática en la variedad Colombia, es igual en la varidad Ocarina. Por su parte, la hipótesis alterna plantea que la conductancia entre variedades es diferente.
Se realizó un diagrama de cajas que representa el comportamiento de la conductancia para cada variedad. El punto rojo corresponde al promedio de conductancia.
boxplot(tbl1$gs ~ tbl1$variedad, main= 'Diagrama de cajas')
points(c(1,2), c(mean(Colombia), mean(Ocarina)), pch=20, col= 'red')
En este gráfico se observó que los promedios son diferentes.
library(ggplot2)
ggplot(data=tbl1, aes(tbl1$variedad, tbl1$gs)) +
geom_violin(fill="cyan") + stat_summary(fun.y=mean, geom="point", shape=18,
size=3, color="red")
## Warning: `fun.y` is deprecated. Use `fun` instead.
## Warning: Use of `tbl1$variedad` is discouraged. Use `variedad` instead.
## Warning: Use of `tbl1$gs` is discouraged. Use `gs` instead.
## Warning: Use of `tbl1$variedad` is discouraged. Use `variedad` instead.
## Warning: Use of `tbl1$gs` is discouraged. Use `gs` instead.
También se puede usar este gráfico de violin, para representar el comportamiento de los datos brutos, en el cual el punto rojo representa la media de conductancia para cada variedad. La forma achatada del violin para la variedad Colombia expresa que los datos son menos variables en comparación con la variedad Ocarina. Ello se puede verificar a partir de los valores de varianza que se muestran a continuación:
var(Colombia)
## [1] 0.001305495
var(Ocarina)
## [1] 0.002758974
A pesar de que la gráfica muestra que los valores de la media son diferentes, se aplicó una prueba t-student para confirmar el resultado.
prueba1 = t.test(tbl1$gs ~ tbl1$variedad, alternative= 't', var.equal=F)
prueba1
##
## Welch Two Sample t-test
##
## data: tbl1$gs by tbl1$variedad
## t = 5.4511, df = 21.101, p-value = 2.049e-05
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.0589380 0.1316115
## sample estimates:
## mean in group Colombia mean in group Ocarina
## 0.4514286 0.3561538
ifelse(prueba1$p.value<0.05, 'Medias diferentes', 'Medias iguales')
## [1] "Medias diferentes"
En dicha prueba se consideró que las varianzas son diferentes, puesto que en las desviaciones estándar no se presenta que un valor sea el doble del otro.
sd(Colombia)
## [1] 0.03613163
sd(Ocarina)
## [1] 0.05252594
No obstante, se realizó una prueba de varianzas partiendo de la siguiente hipótesis:
\[H_o: \sigma_{Col} = \sigma_{Ocar} \\ H_a: \sigma_{Col} \neq \sigma_{Ocar}\]
prueba_var = var.test(tbl1$gs ~ tbl1$variedad)
ifelse(prueba_var$p.value<0.05, 'Varianzas diferentes', 'varianzas iguales')
## [1] "varianzas iguales"
El resultado de la prueba de varianzas permite comprobar que la regla de las desviaciones estándar no siempre se cumple. Puesto que por la prueba de varianzas, se determinó que son iguales. Por tanto, se debe corroborar el resultado de la prueba t-student para las medias, con varianzas iguales.
prueba1.1 = t.test(tbl1$gs ~ tbl1$variedad, alternative= 't', var.equal= T)
ifelse(prueba1.1$p.value<0.05, 'Medias diferentes', 'Medias iguales')
## [1] "Medias diferentes"
A partir de la evidencia estadística, se puede concluir que se rechaza la hipótesis nula y se acepta la hipótesis alternativa. Eso significa, que el promedio de la conductancia estomática en la variedad Colombia y Ocarina, sometidas a défecit de riego, es diferente.
El error estándar permite calcular la variabilidad de los promedios. Este se puede estimar usando la siguiente formula:
\[EE = \frac{s}{\sqrt{n}}\] Aunque, dicho valor se precisa mediante el resultado de la desviación estandar de los promedios.
Como en este caso se tienen datos brutos, se debe realizar un remuestreo (bootstrap), que se calcula de manera computacional como se indica a continuación:
Boots_col= replicate(10, sample(x = Colombia, size = 14, replace = T))
Boots_oca= replicate(10, sample(x = Ocarina, size = 14, replace = T))
Boots_col
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
## [1,] 0.48 0.48 0.44 0.45 0.47 0.42 0.42 0.50 0.41 0.39
## [2,] 0.41 0.44 0.39 0.50 0.48 0.48 0.41 0.50 0.39 0.52
## [3,] 0.41 0.50 0.50 0.42 0.47 0.48 0.52 0.44 0.42 0.42
## [4,] 0.48 0.44 0.48 0.41 0.52 0.48 0.44 0.47 0.44 0.50
## [5,] 0.47 0.44 0.45 0.42 0.47 0.42 0.48 0.41 0.42 0.41
## [6,] 0.52 0.42 0.44 0.50 0.52 0.50 0.48 0.50 0.44 0.42
## [7,] 0.39 0.42 0.45 0.48 0.48 0.47 0.45 0.44 0.42 0.52
## [8,] 0.41 0.50 0.50 0.48 0.44 0.50 0.47 0.41 0.50 0.42
## [9,] 0.46 0.52 0.42 0.39 0.48 0.44 0.44 0.45 0.48 0.39
## [10,] 0.48 0.42 0.46 0.52 0.47 0.39 0.39 0.52 0.41 0.44
## [11,] 0.46 0.44 0.44 0.46 0.48 0.39 0.48 0.39 0.46 0.48
## [12,] 0.50 0.44 0.50 0.44 0.52 0.52 0.52 0.41 0.41 0.41
## [13,] 0.44 0.44 0.45 0.45 0.47 0.39 0.45 0.46 0.48 0.50
## [14,] 0.42 0.42 0.42 0.48 0.48 0.39 0.46 0.39 0.44 0.47
Boots_oca
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
## [1,] 0.41 0.25 0.39 0.42 0.32 0.36 0.41 0.42 0.28 0.41
## [2,] 0.36 0.41 0.41 0.41 0.39 0.37 0.36 0.41 0.41 0.36
## [3,] 0.39 0.36 0.42 0.36 0.40 0.36 0.41 0.37 0.40 0.25
## [4,] 0.25 0.36 0.37 0.25 0.36 0.39 0.40 0.34 0.40 0.36
## [5,] 0.37 0.37 0.42 0.28 0.32 0.41 0.40 0.39 0.37 0.37
## [6,] 0.36 0.37 0.41 0.40 0.40 0.40 0.41 0.32 0.32 0.32
## [7,] 0.25 0.36 0.37 0.34 0.32 0.34 0.36 0.36 0.25 0.37
## [8,] 0.42 0.37 0.39 0.37 0.40 0.42 0.32 0.25 0.41 0.39
## [9,] 0.41 0.42 0.42 0.34 0.40 0.39 0.40 0.32 0.40 0.32
## [10,] 0.25 0.37 0.42 0.42 0.41 0.32 0.32 0.37 0.41 0.28
## [11,] 0.41 0.37 0.32 0.34 0.41 0.41 0.41 0.41 0.42 0.28
## [12,] 0.40 0.34 0.34 0.28 0.41 0.41 0.41 0.36 0.25 0.36
## [13,] 0.40 0.32 0.28 0.32 0.34 0.37 0.40 0.36 0.39 0.28
## [14,] 0.40 0.36 0.41 0.36 0.32 0.32 0.36 0.40 0.39 0.42
Ahora, cada variable cuenta con 10 remuestras de 14 datos cada una, a las cuales se les calculó el valor promedio, de la siguiente manera:
mean_boots_col = round(colMeans(Boots_col), 2)
mean_boots_oca = round(colMeans(Boots_oca), 2)
mean_boots_col
## [1] 0.45 0.45 0.45 0.46 0.48 0.45 0.46 0.45 0.44 0.45
mean_boots_oca
## [1] 0.36 0.36 0.38 0.35 0.37 0.38 0.38 0.36 0.36 0.34
Partiendo de estos promedios, se calculó el error estándar:
EEboot_sd= sd(c(mean_boots_col,mean_boots_oca))
EEboot_sd
## [1] 0.04767213
La variabilidad de los promedios corresponde a 0.052. Esto indica baja dispersión en los datos.
Se propuso un plan de fertilización en papa criolla tal como se muestra a continuación:
(rto_45 <- c (69, 66, 72, 68, 65, 66, 67, 68, 69, 64, 66, 68, 64, 67, 60,68))
## [1] 69 66 72 68 65 66 67 68 69 64 66 68 64 67 60 68
(rto_77 <- c (873, 850, 832, 834, 843, 840, 845, 790, 905, 910, 920, 840, 832, 800, 759, 812))
## [1] 873 850 832 834 843 840 845 790 905 910 920 840 832 800 759 812
tbl2 = data.frame(rto = c(rto_45, rto_77),
dias = gl(2,16,32, c('45 días después', '77 días después')))
tbl2
## rto dias
## 1 69 45 días después
## 2 66 45 días después
## 3 72 45 días después
## 4 68 45 días después
## 5 65 45 días después
## 6 66 45 días después
## 7 67 45 días después
## 8 68 45 días después
## 9 69 45 días después
## 10 64 45 días después
## 11 66 45 días después
## 12 68 45 días después
## 13 64 45 días después
## 14 67 45 días después
## 15 60 45 días después
## 16 68 45 días después
## 17 873 77 días después
## 18 850 77 días después
## 19 832 77 días después
## 20 834 77 días después
## 21 843 77 días después
## 22 840 77 días después
## 23 845 77 días después
## 24 790 77 días después
## 25 905 77 días después
## 26 910 77 días después
## 27 920 77 días después
## 28 840 77 días después
## 29 832 77 días después
## 30 800 77 días después
## 31 759 77 días después
## 32 812 77 días después
Se planteó la siguiente prueba de hipótesis:
\[H_o: \mu_{rto 45dds} \geq \mu_{rto77dds} \\ H_a: \mu_{rto 45dds} <\mu_{rto77dds}\]
Con el objetivo de probar la hipótesis nula se usó la prueba t-studen para una muestra pareada, de la siguiente manera:
(prueba2 = t.test(tbl2$rto ~ tbl2$dias,
alternative='l',
paired = T))
##
## Paired t-test
##
## data: tbl2$rto by tbl2$dias
## t = -72.377, df = 15, p-value < 2.2e-16
## alternative hypothesis: true difference in means is less than 0
## 95 percent confidence interval:
## -Inf -757.3264
## sample estimates:
## mean of the differences
## -776.125
Luego, se utilizó la función ifelse para dar la condión de rechazo o no rechazo a la hipótesis nula.
ifelse(prueba2$p.value<0.05, 'Rechazo Ho', 'No rechazo Ho')
## [1] "Rechazo Ho"
Como resultado de la evidencia estadística, se rechaza la hipótesis nula y se acepta la alterna. Por tanto, se establece que el promedio del rendimiento en dicha papa criolla, no es mayor después de los 45 dias de fertilización.
A continuación, se ilustran algunas gráficas que muestran el comportamiento de los datos de las variables:
par(mfrow= c(1,2))
hist(rto_45, main= "45 días después")
hist(rto_77, main= "77 días después")
par(mfrow= c(1,2))
barplot(rto_45, ylim=c (0,1000), main= "45 días después")
barplot(rto_77, ylim=c (0,1000), main= "77 días después")
Por otra lado, se calculó el cambio relativo porcentual de las variables:
Cambio_Relativo= ((rto_77-rto_45)/rto_77)*100
Med_cr= mean(Cambio_Relativo)
Med_cr
## [1] 92.07167
El cambio relativo del rendimiento después de 45 días de fertilización, comparado con el rendimiento después de 77 días de fertilización, es 92.1% menor.
PruebaCor= cor.test(rto_45, rto_77, conf.level = 0.95, alternative = 'l', method = "pearson", paired=T)
PruebaCor
##
## Pearson's product-moment correlation
##
## data: rto_45 and rto_77
## t = 0.80811, df = 14, p-value = 0.7837
## alternative hypothesis: true correlation is less than 0
## 95 percent confidence interval:
## -1.0000000 0.5853293
## sample estimates:
## cor
## 0.2111082
qqnorm(rto_77, xlab = "", ylab = "", main = "Coeficiente de Pearson")
qqline(rto_77)
Finalmente, el valor del coeficiente de Pearson y su gráfica, pertimitieron concluir que las dos variables de rendimiento, a los 45 y 77 días, presentan una baja correlación positiva y poseen una relación fuerte en la zona media, pero débil hacia los extremos, debido a que en estas zonas las datos son mas dispersos.