Ejercicios DiseƱo de experimentos
Lady Diana Arias C
22/04/2021
1.Prueba t-Dos muestras independientes
colombia=c(0.45,0.41,0.44,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.34,0.36,0.39,0.41,0.37,0.42,0.41)Analisis descriptivo
med_col<-mean(colombia);med_col## [1] 0.4528571med_oca<-mean(ocarina);med_oca## [1] 0.3576923Sacando la media de cada variedad se podria decir que la variedad colombia tiene mejor media en comparaciĆ³n con la variedad ocarina.
var_col<-(sd(colombia))^2;var_col## [1] 0.001237363var_oca <-(sd(ocarina))^2;var_oca## [1] 0.002669231\[H_{o}:\mu_{Col}=\mu_{Oca}\] \[H_{a}:\mu_{Col}\neq\mu_{Oca}\]
prueba1<-t.test(colombia, ocarina, alternative = "t",mu= 0, var.equal = T, conf.level = 0.95)
ifelse(prueba1$p.value<0.05,"Rechazo Ho","No rechazo Ho")## [1] "Rechazo Ho"Se rechaza la Ho, lo cual indica que la media de la variadad colombia y ocarina son diferentes estadisticamente.
\[H_{o}:\sigma^2_{Col}=\sigma^2_{Oca}\]
\[H_{a}:\sigma^2_{Col}\neq\sigma^2_{Oca}\]
var_cest<-var.test(colombia,ocarina,alternative = 't',ratio = 1,conf.level = 0.95)
ifelse(var_cest$p.value<0.05,"Rechazo Ho","No Rechazo Ho")## [1] "No Rechazo Ho"La Ho nos indica que la varianza de la varidad colombia es igual a la varinza de la variedad ocarina, al realizar el test de varianzas podemos definir que estaditicamente la Ho se cumple.
2. Prueba t-Dos muestras dependientes/pareadas
dias_siem45<-c(69,66,72,68,65,66,67,68,69,64,66,68,64,67,60,68)
dias_siem77<-c(873,850,832,834,843,840,845,790,905,910,920,840,832,800,759,812)Analisis descriptivo
med_45<-mean(dias_siem45);med_45## [1] 66.6875med_77<-mean(dias_siem77);med_77## [1] 842.8125var_45<-(sd(dias_siem45))^2;var_45## [1] 7.295833var_77 <-(sd(dias_siem77))^2;var_77## [1] 1882.029\[H_{o}:\mu_{45dd}=\mu_{77dd}\] \[H_{a}:\mu_{45dd}\neq\mu_{77dd}\]
med_ds<-t.test(dias_siem45, dias_siem77, alternative = "t",mu= 0, paired = T, var.equal = T, conf.level = 0.95)
ifelse(med_ds$p.value<0.05,"Rechazo Ho","No rechazo Ho")## [1] "Rechazo Ho"par(mfrow=c(1,2))
boxplot(dias_siem45, xlab="Parcela 1", ylab= "peso de tuberculo", main= "45 dds")
boxplot(dias_siem77, xlab="Parcela 2", ylab= "peso de tuberculo", main= "75 dds")
cam_re_45<- 100*(med_77-med_45)/med_45;cam_re_45## [1] 1163.824cof_cp<- cor(dias_siem45, dias_siem77, method = "pearson");cof_cp## [1] 0.21110823.Prueba de Wilcoxon de la suma de rangos-Dos muestras independientes
palma<-c(3,4,3,4,4,3,3,4,4,3,4,4,2,4,3,4,3,3,3,4,4)
maiz<-c(3,4,4,4,4,4,3,4,3,4,4,4,4,3,4,4,4,3,3,4,3)med_pa<- median(palma);med_pa## [1] 4med_ma<- median(maiz);med_ma## [1] 4cal_f<- c(3,4,3,4,4,3,3,4,4,3,4,4,2,4,3,4,3,3,3,4,4,3,4,4,4,4,4,3,4,3,4,4,4,4,3,4,4,4,3,3,4,3)
niveles<- gl(2,21,42, labels = c("palma"," maiz"))
df_f<- data.frame(cal_f, niveles)library(lattice)
bwplot(df_f$cal_f~df_f$niveles)
\[H_o: Med_{Palma}=Med_{Maiz}\]
pru_w<-wilcox.test(palma, maiz, alternative = "t", mu=0, conf.level = 0.95)## Warning in wilcox.test.default(palma, maiz, alternative = "t", mu = 0,
## conf.level = 0.95): cannot compute exact p-value with tiesifelse(pru_w$p.value<0.05, "Rechazo Ho", "No rechazo")## [1] "No rechazo"4. Prueba de Wilcoxon de la suma de rangos-Dos muestras pareadas
l_4<-c(69.26,68.15,69.17,68.88,70.01,70.15,70.66,68.68,71.00,72.18,69.15,70.00,68.64,68.12,68.12)
a_4<-c(-1.31,-1.25,-1.42,-1.35,-1.32,-1.15,-1.25,-1.29,-1.42,-1.45,-1.29,-1.22,-1.19,-1.25,-1.25)
b_4<-c(28.68,27.66,28.02,27.66,27.66,26.88,26.25,26.26,28.15,30,28.24,25.59,24.69,25.56,26.26)
l_12<-c(62.2,60.45,63.12,61.64,61.25,62.55,64.12,65.65,66.87,65.11,66.14,62.64,61.97,60.58,60.68)
a_12<-c(0.81,0.78,0.55,0.81,0.77,0.69,0.59,0.55,0.42,0.39,0.41,0.37,0.35,0.34,0.34)
b_12<-c(37.31,35.9,36.36,36.12,36.45,35.99,36.14,36.14,35.55,34.77,32.32,31.96,30.17,36.65,37.15)pr_wa<-wilcox.test(a_4, a_12, alternative = "t", paired = T, mu=0)## Warning in wilcox.test.default(a_4, a_12, alternative = "t", paired = T, :
## cannot compute exact p-value with tiesifelse(pr_wa$p.value<0.05, "Rechazo Ho", "No rechazo Ho")## [1] "Rechazo Ho"pr_wl<-wilcox.test(l_4, l_12, alternative = "t", paired = T, mu=0)
ifelse(pr_wl$p.value<0.05, "Rechazo Ho", "No rechazo Ho")## [1] "Rechazo Ho"pr_wb<-wilcox.test(b_4, b_12, alternative = "t", paired = T, mu=0)
ifelse(pr_wb$p.value<0.05, "Rechazo Ho", "No rechazo Ho")## [1] "Rechazo Ho"\[\Delta{E}=\sqrt{(L^*_{12}-L^*_{4})^2+(a_{12}^*-a_4^*)^2+(b_{12}^*-b_4^*)}\]
del_E<-function(a,b,c,d,e,f){
cal<-sqrt(((a-b)^2)+((c-d)^2)+((e-f)^2))
print(cal)}
del_E(l_12,l_4,a_12, a_4, b_12,b_4)## [1] 11.349665 11.458992 10.489948 11.342610 12.584506 12.005736 11.998721
## [8] 10.496709 8.671937 8.724872 5.347570 9.862789 8.768746 13.504362
## [15] 13.284344library(plotly)## Loading required package: ggplot2##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutpar(mfrow=c(1,2))
L12 <- l_12
b12 <- b_12
a12 <- a_12
fig12 <- plot_ly(x = ~L12, y = ~b12, z = ~a12, type = 'mesh3d')
fig12L4 <- l_4
b4 <- b_4
a4 <- a_4
fig4 <- plot_ly(x = ~L4, y = ~b4, z = ~a4, type = 'mesh3d')
fig45.
A<-c(0.221,0.314,0.265,0.166,0.128,0.272,0.334,0.296,0.187,0.097,0.183,0.207)
B<-c(0.284,0.363,0.338,0.231,0.196,0.222,0.292,0.360,0.261,0.127,0.158,0.268)\[H_0:\sigma_A^2=\sigma_B^2\] \[H_a:\sigma_A^2 \neq \sigma_B^2\]
var<-var.test(A,B,alternative="t", ratio = 1, conf.level=0.95);var##
## F test to compare two variances
##
## data: A and B
## F = 0.97771, num df = 11, denom df = 11, p-value = 0.9709
## alternative hypothesis: true ratio of variances is not equal to 1
## 95 percent confidence interval:
## 0.2814613 3.3962767
## sample estimates:
## ratio of variances
## 0.9777118ifelse(var$p.value<0.05,"Rechazo Ho","No Rechazo Ho")## [1] "No Rechazo Ho"\[H_o= A\ y\ B\ no~son~pareadas\] \[H_o= A\ y\ B\ ~son~pareadas\]
pearson<-cor.test(A,B, alternative="t",method = "pearson");pearson##
## Pearson's product-moment correlation
##
## data: A and B
## t = 4.2912, df = 10, p-value = 0.001583
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.4296038 0.9431752
## sample estimates:
## cor
## 0.805026ifelse(pearson$p.value<0.05,"Rechazo Ho","No Rechazo Ho")## [1] "Rechazo Ho"\[H_o: \mu_A=\mu_B\] \[H_a: \mu_A\neq\mu_B\]
nopar<-t.test(A, B, alternative = "t",mu= 0, var.equal = T, conf.level = 0.95)
ifelse(nopar$p.value<0.05, "Rechazo Ho","No Rechazo Ho")## [1] "No Rechazo Ho"par<-t.test(A, B, alternative = "t",mu= 0 ,paired = T, conf.level = 0.95)
ifelse(par$p.value<0.05, "Rechazo Ho","No Rechazo Ho")## [1] "Rechazo Ho"6. Prueba para comparar dos prevalencias (enfoque paramƩtrico)
\[H_o: Pre_1=Pre_2\] \[H_o: Pre_1\neq Pre_2\]
pruebaz <- prop.test(x = c(25, 34), n = c(104, 110));pruebaz##
## 2-sample test for equality of proportions with continuity correction
##
## data: c(25, 34) out of c(104, 110)
## X-squared = 0.94307, df = 1, p-value = 0.3315
## alternative hypothesis: two.sided
## 95 percent confidence interval:
## -0.19723372 0.05982113
## sample estimates:
## prop 1 prop 2
## 0.2403846 0.3090909ifelse(pruebaz$p.value<0.05, "Rechazo Ho", "No rechazo Ho")## [1] "No rechazo Ho"7. Prueba para comparar dos tasas de incidencia
\[H_o: Inciden_{(mes0)}=Inciden_{(2 mes)}\] \[H_o: Inciden_{(mes0)}\neq Inciden_{(2 mes)}\]
library(rateratio.test)
inci_1<-rateratio.test(c(25,37),c(104,104));inci_1##
## Exact Rate Ratio Test, assuming Poisson counts
##
## data: c(25, 37) with time of c(104, 104), null rate ratio 1
## p-value = 0.1619
## alternative hypothesis: true rate ratio is not equal to 1
## 95 percent confidence interval:
## 0.3898755 1.1528682
## sample estimates:
## Rate Ratio Rate 1 Rate 2
## 0.6756757 0.2403846 0.3557692ifelse(inci_1$p.value<0.05, "Rechazo Ho", "No rechazo Ho")## [1] "No rechazo Ho"inci_2<-rateratio.test(c(34,52),c(110,110));inci_1##
## Exact Rate Ratio Test, assuming Poisson counts
##
## data: c(25, 37) with time of c(104, 104), null rate ratio 1
## p-value = 0.1619
## alternative hypothesis: true rate ratio is not equal to 1
## 95 percent confidence interval:
## 0.3898755 1.1528682
## sample estimates:
## Rate Ratio Rate 1 Rate 2
## 0.6756757 0.2403846 0.3557692ifelse(inci_2$p.value<0.05, "Rechazo Ho", "No rechazo Ho")## [1] "No rechazo Ho"8. Prueba F- AOV-FSCA-B
fosf_3<-c(7.1,6.8,6.6,6.7,6.8,6.7,6.9,6.8,6.7,6.6,6.9,7.4,6.6,6.7,6.7,7.0,6.4,6.7,7.1,6.6,6.6,6.9,6.0,6.2,6.4,6.6,6.9,6.6,6.4,6.4,6.5,6.3,6.4,6.6,6.6,6.7,6.4,6.2,6.6,6.3,5.8,6.5,6.2,6.4,9.1,7.1,7.8,7.3,7.6,7.8,7.4,7.3,7.3,7.1,8.0,8.7,7.6,7.8,7.8,7.4,7.2,7.2,7.3,7.5,7.1,5.1)
niveles<-gl(3,22,66,labels = c("Bray","Olsen","Mechilch_3"))
df_3<-data.frame(niveles, fosf_3)Analisis descriptivo
tapply(df_3$fosf_3, df_3$niveles, sd) ## Bray Olsen Mechilch_3
## 0.2210267 0.2408499 0.7309041tapply(df_3$fosf_3, df_3$niveles, mean)## Bray Olsen Mechilch_3
## 6.786364 6.409091 7.477273boxplot(df_3$fosf_3~df_3$niveles)
medias= tapply(df_3$fosf_3, df_3$niveles, mean);medias## Bray Olsen Mechilch_3
## 6.786364 6.409091 7.477273desvia= tapply(df_3$fosf_3, df_3$niveles, sd);desvia## Bray Olsen Mechilch_3
## 0.2210267 0.2408499 0.7309041cv= 100*desvia/medias;cv## Bray Olsen Mechilch_3
## 3.256924 3.757941 9.775009points(1:3, medias, pch=15, col='red ')
\[H_o: \tau_{bray}= \tau_{olsen}= \tau_{mechilch3}\]
\[H_a: H_o=0\]
aov_3 = aov(lm(fosf_3 ~ niveles, df_3)); aov_3## Call:
## aov(formula = lm(fosf_3 ~ niveles, df_3))
##
## Terms:
## niveles Residuals
## Sum of Squares 12.91182 13.46273
## Deg. of Freedom 2 63
##
## Residual standard error: 0.4622706
## Estimated effects may be unbalancedsumm_3<-summary(aov_3)p_valor = summ_3[[1]][1,5]
ifelse(p_valor<0.05, 'Rechazo Ho', 'No Rechazo Ho')## [1] "Rechazo Ho"resid_3<-residuals(aov_3)##Shapiro.test
library(agricolae)
resid_3<-residuals(aov_3)
shapiro.test(resid_3)##
## Shapiro-Wilk normality test
##
## data: resid_3
## W = 0.75921, p-value = 4.736e-09##Analisis de varianza desbalanceado
aovd_3 = aov(fosf_3 ~ niveles, df_3); aovd_3## Call:
## aov(formula = fosf_3 ~ niveles, data = df_3)
##
## Terms:
## niveles Residuals
## Sum of Squares 12.91182 13.46273
## Deg. of Freedom 2 63
##
## Residual standard error: 0.4622706
## Estimated effects may be unbalancedsumdesv_3<-summary(aovd_3)Es igual al haber solo un factor
data.aov<-aov(fosf_3 ~ niveles, df_3)
plot(data.aov)
anova(data.aov)## Analysis of Variance Table
##
## Response: fosf_3
## Df Sum Sq Mean Sq F value Pr(>F)
## niveles 2 12.912 6.4559 30.211 6.315e-10 ***
## Residuals 63 13.463 0.2137
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1cuadrado_medio = unlist(data.aov)[6]; cuadrado_medio## $residuals.3
## [1] -0.1863636var(resid_3)## [1] 0.2071189