Codigo - Design of Experiments: Script 30_07_2024.docx (parte Kruskal)
Repaso: FSCA con supuestos y pruebas no parametricas, mas diseno en bloques.
Scripts para diseno experimental
Sesion 30/07/2024 en R (FSCA + Bloques)
Repaso: FSCA con supuestos y pruebas no parametricas, mas diseno en bloques.
---
title: "Diseno 23-30/07/2024"
output: html_document
date: '2024-07-30'
---
# Clase de repaso
## Diseno Factorial simple en arreglo completamente al azar (FSCA)
# Factorial simple --> solo un factor
# Completamente al azar: aleatorizacion sin restriccion
set.seed(123)
# Factor --> densidad de siembra
ds <- gl(3, 12, 36, paste0('DS_', c(30, 40, 50)))
# Respuesta --> diametro de tallos
diam2 <- c(
rnorm(12, mean = 1.7, sd = 0.20),
rnorm(12, mean = 1.72, sd = 0.21),
rnorm(12, mean = 1.55, sd = 0.22)
)
options(digits = 3)
datos <- data.frame(ds, diam2)
head(datos)
### Analisis descriptivo
summary(diam2)
library(psych)
psych::describe.by(datos$diam2, datos$ds)
medias <- tapply(datos$diam2, datos$ds, mean)
tapply(datos$diam2, datos$ds, var)
tapply(datos$diam2, datos$ds, min)
tapply(datos$diam2, datos$ds, max)
tapply(datos$diam2, datos$ds, range)
desv <- tapply(datos$diam2, datos$ds, sd)
desv / medias
medias
#### Graficacion
boxplot(datos$diam2 ~ datos$ds, col = c('yellow', 'cyan', 'green'))
points(x = c(1, 2, 3), y = medias, col = 'red', pch = 16, cex = 2)
library(ggplot2)
ggplot(datos, aes(x = ds, y = diam2, fill = ds)) +
geom_boxplot() +
geom_violin(alpha = 0.1) +
theme_minimal() +
theme(legend.position = 'none')
### Analisis inferencial
# H0: mu_30 = mu_40 = mu_50
# Ha: al menos una media es diferente
mod1 <- aov(datos$diam2 ~ datos$ds)
summary(mod1)
ifelse(unlist(summary(mod1))[[9]] < 0.05, 'Rechaza H0', 'No rechaza H0')
# Comparaciones multiples de Tukey
tt <- TukeyHSD(mod1)
tt
## Supuestos
res <- mod1$residuals
mean(res)
var(res)
hist(res, breaks = 20)
length(res)
shapiro.test(res)
# Homocedasticidad
bartlett.test(mod1$residuals, datos$ds)
# Alternativa no parametrica
kruskal.test(diam2 ~ ds, data = datos)
rank(datos$diam2)
PMCMRplus::kwAllPairsNemenyiTest(datos$diam2 ~ datos$ds)
---
title: "Diseno en bloques 2024-07-30"
output: html_document
date: '2024-07-30'
---
## Factorial simple: diseno en bloques
bloques <- gl(3, 6, 18, c('Posterior', 'Central', 'Anterior'))
ps <- gl(6, 1, 18, paste0('ps_', c(0.2, 0.4, 0.6, 0.8, 1, 1.2)))
dag <- c(6.5, 7.0, 7.2, 7.2, 7.5, 7.2,
6.8, 7.1, 7.5, 7.7, 8.0, 8.2,
7.2, 7.4, 7.1, 7.5, 7.7, 8.1)
datos_b <- data.frame(bloques, ps, dag)
head(datos_b)
library(collapsibleTree)
collapsibleTree(datos_b, c('bloques', 'ps', 'dag'), collapsed = FALSE)
ggplot(data = datos_b, aes(x = bloques, y = ps, fill = dag, label = dag)) +
facet_wrap(~bloques) +
geom_tile(position = 'identity') +
geom_label(color = 'white') +
theme_minimal()
colores <- ifelse(bloques == 'Posterior', 'red', ifelse(bloques == 'Central', 'blue', 'green'))
datos_b$colores <- colores
ggplot(data = datos_b, aes(x = ps, y = dag)) +
geom_boxplot() +
geom_point(color = colores, size = 3) +
theme_minimal()
ggplot(data = datos_b, aes(x = bloques, y = dag)) +
geom_boxplot() +
geom_point() +
theme_minimal()
# ANOVA en bloques
# H0: no hay diferencias entre niveles de profundidad
mod <- aov(dag ~ bloques + ps, data = datos_b)
summary(mod)
ifelse(unlist(summary(mod))[[10]] >= 1, 'Valio la pena bloquear', 'No valio la pena bloquear')Lenguaje: RDescargar script