Codigo - Design of Experiments: Script 30_07_2024.docx

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
    Script 30_07_2024.docx - Diseno de Experimentos