knitr::opts_chunk$set(echo = TRUE, warning=FALSE, message=FALSE)
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.5.2     ✔ tibble    3.3.0
## ✔ lubridate 1.9.4     ✔ tidyr     1.3.1
## ✔ purrr     1.1.0     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(car)
## Cargando paquete requerido: carData
## 
## Adjuntando el paquete: 'car'
## 
## The following object is masked from 'package:dplyr':
## 
##     recode
## 
## The following object is masked from 'package:purrr':
## 
##     some
library(emmeans)
## Welcome to emmeans.
## Caution: You lose important information if you filter this package's results.
## See '? untidy'
library(ggpubr)

1 Ejercicio 1: Crecimiento bacteriano en ostiones y mejillones

Un investigador estudia el crecimiento bacterial en ostiones (O) y mejillones (M) sujetos a tres temperaturas de almacenamiento (T0, T5, T10). Los conteos bacterianos son altamente variables, por lo que se sugiere transformación logarítmica para cumplir supuestos de ANAVA.

1.1 Datos y transformación

datos1 <- tibble(
Unidad = rep(1:9, 2),
Temperatura = rep(c("T0", "T5", "T10"), each = 3, times = 2),
Marisco = rep(c("O", "M"), each = 9),
Bacterias = c(4879, 68, 170900, 15670000, 2101000000, 26270000, 6084000000, 2953000, 2781000000,
2.276, 52, 37840, 103960, 89510000, 243300, 13651000000, 111750, 1078600000000000)
) %>%
mutate(logBacterias = log(Bacterias + 1),
Temperatura = factor(Temperatura, levels = c("T0", "T5", "T10")),
Marisco = factor(Marisco))

head(datos1)

Se observa gran dispersión en conteos, la transformación logarítmica estabiliza la varianza.

1.2 Análisis de Varianza (ANAVA)

Se ajusta el modelo con interacción:

\[ Y_{ijk} = \mu + \alpha_i + \beta_j + (\alpha \beta)_{ij} + \epsilon_{ijk} \]

Donde:

  • \(\alpha_i\): efecto de temperatura \(i\)
  • \(\beta_j\): efecto de tipo de marisco \(j\)
  • \(\epsilon_{ijk}\): error aleatorio
anova1 <- aov(logBacterias ~ Temperatura * Marisco, data = datos1)
summary(anova1)
##                     Df Sum Sq Mean Sq F value  Pr(>F)   
## Temperatura          2  667.5   333.7   9.583 0.00326 **
## Marisco              1    7.4     7.4   0.212 0.65341   
## Temperatura:Marisco  2   51.9    26.0   0.745 0.49528   
## Residuals           12  417.9    34.8                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

1.3 Validación de Supuestos

Se grafica diagnóstico de residuos y se realizan pruebas formales.

par(mfrow = c(2,2))
plot(anova1)

shapiro <- shapiro.test(residuals(anova1))
levene <- leveneTest(logBacterias ~ Temperatura * Marisco, data = datos1)
list(Shapiro_Wilk = shapiro, Levene = levene)
## $Shapiro_Wilk
## 
##  Shapiro-Wilk normality test
## 
## data:  residuals(anova1)
## W = 0.96457, p-value = 0.6917
## 
## 
## $Levene
## Levene's Test for Homogeneity of Variance (center = median)
##       Df F value Pr(>F)
## group  5  0.9584 0.4799
##       12

La gráfica Q-Q y la prueba de Shapiro sugieren si los residuos son normales. Levene indica homogeneidad de varianza.

1.4 Comparaciones de Medias

Se realiza prueba post hoc para la interacción temperatura x marisco.

emmeans1 <- emmeans(anova1, pairwise ~ Temperatura * Marisco)
emmeans1$contrasts
##  contrast      estimate   SE df t.ratio p.value
##  T0 M - T5 M      -8.86 4.82 12  -1.838  0.4795
##  T0 M - T10 M    -17.96 4.82 12  -3.727  0.0269
##  T0 M - T0 O      -3.03 4.82 12  -0.628  0.9865
##  T0 M - T5 O     -13.14 4.82 12  -2.727  0.1402
##  T0 M - T10 O    -14.49 4.82 12  -3.008  0.0894
##  T5 M - T10 M     -9.10 4.82 12  -1.889  0.4519
##  T5 M - T0 O       5.83 4.82 12   1.210  0.8243
##  T5 M - T5 O      -4.28 4.82 12  -0.889  0.9420
##  T5 M - T10 O     -5.64 4.82 12  -1.170  0.8426
##  T10 M - T0 O     14.93 4.82 12   3.099  0.0770
##  T10 M - T5 O      4.82 4.82 12   1.000  0.9092
##  T10 M - T10 O     3.47 4.82 12   0.720  0.9757
##  T0 O - T5 O     -10.11 4.82 12  -2.099  0.3487
##  T0 O - T10 O    -11.47 4.82 12  -2.380  0.2369
##  T5 O - T10 O     -1.35 4.82 12  -0.281  0.9997
## 
## P value adjustment: tukey method for comparing a family of 6 estimates
emmeans(anova1, ~ Temperatura * Marisco)
##  Temperatura Marisco emmean   SE df lower.CL upper.CL
##  T0          M         5.23 3.41 12   -2.191     12.7
##  T5          M        14.09 3.41 12    6.664     21.5
##  T10         M        23.19 3.41 12   15.768     30.6
##  T0          O         8.26 3.41 12    0.835     15.7
##  T5          O        18.37 3.41 12   10.949     25.8
##  T10         O        19.72 3.41 12   12.301     27.1
## 
## Confidence level used: 0.95

1.5 Conclusión

La transformación logarítmica de los conteos bacterianos fue esencial para cumplir los supuestos de normalidad y homogeneidad de varianza en el análisis de varianza. Se encontró que tanto la temperatura de almacenamiento como el tipo de marisco afectan significativamente el crecimiento bacterial, además de que existe una interacción entre estos factores, indicando que el efecto de la temperatura depende de la especie (ostión o mejillón). Esto resalta la necesidad de controlar estrictamente las temperaturas según el tipo de marisco para minimizar el riesgo de proliferación bacterial.

2 Ejercicio 2: Cuadro Latino para Volumen de Leche y % Proteína

Evaluación del efecto de tipo de concentrado (Testigo, 5%, 10% energía suplementada) sobre volumen y proteína, controlando efectos de vacas y periodos.

2.1 Datos de volumen de leche

vacas <- rep(c("A", "B", "C"), each=3)
periodo <- rep(c("P1", "P2", "P3"), 3)
tratamiento <- rep(c("Testigo", "5%", "10%"), each=3)

volumen <- c(60, 65, 60, 72, 74, 65, 45, 49, 67)
proteina <- c(3.01, 3.09, 3.10, 2.95, 2.89, 2.72, 3.50, 3.40, 3.30)

volumen_df <- tibble(Vaca=vacas, Periodo=periodo, Tratamiento=tratamiento, Volumen=volumen) %>%
mutate(across(c(Vaca, Periodo, Tratamiento), factor))

proteina_df <- tibble(Vaca=vacas, Periodo=periodo, Tratamiento=tratamiento, Proteina=proteina) %>%
mutate(across(c(Vaca, Periodo, Tratamiento), factor))

volumen_df

2.2 Modelo estadístico planteado:

\[ Y_{ijk} = \mu + \tau_i + \beta_j + \gamma_k + \epsilon_{ijk} \]

Donde:

  • \(\tau_i\): efecto de tratamiento (3 niveles),
  • \(\beta_j\): efecto de vaca (3 niveles),
  • \(\gamma_k\): efecto de periodo (3 niveles),
  • \(\epsilon_{ijk}\): error aleatorio

2.3 Análisis de Varianza Volumen de leche

anova_vol <- aov(Volumen ~ Tratamiento + Vaca + Periodo, data = volumen_df)
summary(anova_vol)
##             Df Sum Sq Mean Sq F value Pr(>F)
## Tratamiento  2  416.9  208.44   2.819  0.172
## Periodo      2   40.2   20.11   0.272  0.775
## Residuals    4  295.8   73.94

2.4 Validación de supuestos

par(mfrow=c(2,2))
plot(anova_vol)

shapiro.test(residuals(anova_vol))
## 
##  Shapiro-Wilk normality test
## 
## data:  residuals(anova_vol)
## W = 0.93087, p-value = 0.4896
leveneTest(Volumen ~ Tratamiento, data=volumen_df)

2.5 Comparaciones de medias Volumen

emmeans_vol <- emmeans(anova_vol, pairwise ~ Tratamiento)
emmeans_vol$contrasts
##  contrast          estimate   SE df t.ratio p.value
##  Testigo A - 5% B     -8.67 7.02  4  -1.234  0.4969
##  Testigo A - 10% C     8.00 7.02  4   1.139  0.5432
##  5% B - 10% C         16.67 7.02  4   2.374  0.1546
## 
## Results are averaged over the levels of: Periodo 
## P value adjustment: tukey method for comparing a family of 3 estimates

2.6 Análisis de Varianza Proteína

anova_prot <- aov(Proteina ~ Tratamiento + Vaca + Periodo, data=proteina_df)
summary(anova_prot)
##             Df Sum Sq Mean Sq F value  Pr(>F)   
## Tratamiento  2 0.4555 0.22773  28.231 0.00438 **
## Periodo      2 0.0211 0.01053   1.306 0.36603   
## Residuals    4 0.0323 0.00807                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

2.7 Validación supuestos proteína

par(mfrow=c(2,2))
plot(anova_prot)

shapiro.test(residuals(anova_prot))
## 
##  Shapiro-Wilk normality test
## 
## data:  residuals(anova_prot)
## W = 0.98868, p-value = 0.994
leveneTest(Proteina ~ Tratamiento, data=proteina_df)

2.8 Comparaciones de medias Proteína

emmeans_prot <- emmeans(anova_prot, pairwise ~ Tratamiento)
emmeans_prot$contrasts
##  contrast          estimate     SE df t.ratio p.value
##  Testigo A - 5% B     0.213 0.0733  4   2.909  0.0910
##  Testigo A - 10% C   -0.333 0.0733  4  -4.545  0.0227
##  5% B - 10% C        -0.547 0.0733  4  -7.455  0.0038
## 
## Results are averaged over the levels of: Periodo 
## P value adjustment: tukey method for comparing a family of 3 estimates

2.9 Conclusión

  • En volumen de leche, el efecto tratamiento no es significativo según p-valor.
  • En porcentaje de proteína, sí existe efecto significativo del tratamiento.
  • El análisis considerando vaca y periodo como bloqueo es adecuado para controlar variabilidad.
  • Se recomienda implementar el concentrado con incremento energético que ofrezca el mejor balance entre rendimiento y costo, optimizando así la rentabilidad de la producción lechera.