Analítica Avanzada de Datos

Caso #2: Pollos Riko Riko

Autor/a

Afiliación

Gabriela Díaz Porto

Universidad del Norte, Barranquilla

Generalidades

1. El ejercicio tiene 4 preguntas. El puntaje asociado a cada conjunto de preguntas se encuentra entre ().
2. La solución debe enviarse en formato HTML a jvelezv@uninorte.edu.co antes del Viernes 7 de Junio de 2024.

Contexto Analítico

Pollos Riko Riko (PRR) es la empresa líder en productos avícolas de la Región Caribe. Su centro de operaciones, ubicado en Sabanagrande, Atlántico, produce 4 tipos de producto: (i) pollo entero, (ii) bandejas de pechuga entera, (iii) bandejas de pernil y (iv) bandejas de alas. El precio promedio de venta de cada producto, por libra, es $8000, $4300, $3400 y $2900, respectivamente. Se sabe que la participación de cada producto en las ventas totales de la compañía es \(0<p_j<1\) conocido, \(j=1,2,3,4\). Por supuesto, \(p_1+p_2+p_3+p_4 = 1\).

Los animales se sacrifican luego de 40 días de ser alimentados con una dieta balanceada que incluye nutrientes especiales (variable \(x_1\) en gramos/día), agua (variable \(x_2\) en ml/día) y forraje (variable \(x_3\) en gramos/día), además de la raza (variable \(x_4\) con niveles A, B y C) y el hecho de que sean expuestos a una luz especial durante la noche (variable \(x_5\) con niveles 0: No y 1: Si). Actualmente, el peso promedio de un pollo que crece en las instalaciones de la compañía está en el intervalo (2400, 2800) gramos, con una confianza del 95%.

Con miras a aumentar la eficiencia de la planta,¹ PRR ha decidido aumentar el peso de los animales antes de su sacrificio. Para ello, decide realizar un experimento en el que a 100 grupos de 100 animales (i.e., lote) se les proporciona la dieta balanceada y se cuantifica, al final del tiempo de engorde, el peso promedio alcanzado (variable respuesta \(Y\)).

Lectura de datos

── Column specification ────────────────────────────────────────────────────────
cols(
  y = col_double(),
  x1 = col_double(),
  x2 = col_double(),
  x3 = col_double(),
  x4 = col_character(),
  x5 = col_double()
)

kbl(datos)%>%
  kable_styling(bootstrap_options = c("striped", "hover"))%>% 
    scroll_box(width = "920px", height = "300px")

y	x1	x2	x3	x4	x5
2625	20	50	60	B	0
2928	20	75	40	A	0
2823	15	50	60	B	1
2824	15	75	60	C	0
2604	20	60	60	B	0
2770	30	60	80	C	1
2797	25	50	40	C	0
2778	10	75	40	A	0
2838	15	60	40	B	1
2766	20	50	40	A	1
2686	30	75	80	B	0
2746	20	75	40	B	0
2935	20	75	60	B	1
2694	10	50	40	B	0
2849	25	60	60	A	1
2648	10	60	60	B	0
2856	10	50	40	A	1
2797	30	60	40	B	0
2859	20	75	40	A	0
2749	15	75	40	C	1
2577	15	50	80	B	1
2943	10	60	40	A	1
2951	20	50	40	C	1
2895	25	60	40	B	1
2827	10	75	60	C	0
2588	20	75	60	B	0
2770	30	50	80	C	0
2946	25	75	60	C	0
2768	15	60	80	A	1
2886	30	50	40	B	0
2599	10	50	40	C	1
2714	10	60	40	A	0
2893	15	75	40	A	0
2866	20	50	40	C	1
2520	25	60	80	B	0
3054	30	60	40	C	1
2749	30	50	40	B	1
2613	20	60	80	B	1
2565	10	50	80	B	0
2908	15	50	60	A	1
2782	30	60	40	B	1
2831	30	50	40	A	1
2988	25	75	40	A	1
2753	30	50	60	A	1
2758	15	50	40	B	1
2794	10	60	60	B	1
2813	10	50	40	C	0
2874	20	60	40	C	0
2598	10	50	80	A	0
2584	30	50	80	B	0
2687	10	50	60	B	0
2887	15	75	60	C	0
3013	25	75	40	C	1
2706	25	60	80	C	0
2694	20	50	40	C	1
2822	10	60	40	B	0
2832	15	75	60	A	0
2795	10	60	40	A	0
2895	15	75	60	C	1
2828	25	60	60	A	1
2814	30	75	60	B	1
2726	30	50	60	B	1
2626	20	50	80	C	1
2716	10	50	80	B	0
2775	25	50	80	A	1
2889	10	75	80	C	1
2838	10	60	40	A	0
2766	20	50	80	A	0
2727	25	60	80	C	1
2475	10	50	80	B	0
2945	20	75	60	A	1
2761	30	75	80	A	0
2774	20	50	80	B	0
2506	15	60	80	B	0
2687	30	75	40	B	0
2853	30	50	40	B	1
2942	20	75	80	A	1
2893	15	60	60	C	1
2766	15	50	80	C	1
2658	15	50	60	B	0
2765	25	50	40	C	1
2752	15	50	60	C	0
2607	15	50	60	C	0
2806	25	75	60	B	1
2625	25	60	40	C	0
2697	10	60	40	C	0
2778	20	60	40	B	0
2743	20	75	80	B	0
2629	10	50	80	C	0
2736	20	60	40	B	1
3021	30	60	40	C	1
2538	15	50	80	B	1
2724	20	60	40	B	0
2612	15	50	80	A	0
2557	30	50	60	B	0
2933	30	60	40	C	1
2906	20	75	40	A	1
2784	25	50	80	A	1
2967	25	75	60	C	1
2634	25	50	80	B	0

Pregunta 1

Esquematice cómo tomaría los datos necesarios para apoyar la toma de decisiones de PRR y cómo los organizaría en un archivo. Cuál es la unidad experimental? Si en la actualidad PRR dispone de 200 galpones de \(14m\) de ancho por \(140m\) de largo en los que pueden albergar hasta 8 pollos por \(m^2\), determine el peso total promedio alcanzado al final de la etapa de engorde en las condiciones actuales.

Respuesta. Aquí escribe su respuesta. Por favor incluya el código R utilizado, si aplica.

Para tomar los datos necesarios para la toma de decisiones, se debe tener en cuenta:

1. Unidad experimental: Galpón de pollos.

2. Número y aréa de galpones disponibles:

Calcular el número de galpones dsiponibles, así como el área y la capacidad por \(m^2\) de cada uno.

3. Datos de las condiciones de crianza de los pollos en cada galpón (organizando la información de cada galpón en una carpeta):

• Variable \(x_1\): Cantidad de nutrientes en la alimentación (gramos/día)
• Variable \(x_2\): Cantidad de agua (ml/día)
• Variable \(x_3\): Cantidad de forraje (gramos/día)
• Variable \(x_4\): Raza de pollos en el galpón (A, B, o C)
• Variable \(x_5\): Exposición a luz especial durante la noche (Si o No)

4. Toma de pesos de pollos en cada galpón:

Para cada galpón, crear un archivo con la información del peso de los pollos que allí se encuentran al finalizar la etapa de engorde.

Como se cuenta con una cantidad amplia de pollos, se puede tomar el peso por grupos de 100 pollos, para luego calcular su promedio con el número de pollos en el galpón (usando el área de cada galpón y la cantidad de pollos que puede haber por \(m^2\)).

5. Resumen de información:

Se sintetiza la información tomada de cada galpón, para ubicarla en un archivo que contenga como observaciones los datos de la crianza de los pollos en cada uno de los galpones. Este archivo contiene la información de cada una de las variables \(x_i\) (fija para cada galpón), así como el peso promedio de los pollos tomado del paso anterior.

Peso total promedio:

Para calcular el peso total promedio alcanzado al final de la etapa de engorde, se tienen en cuenta los siguientes factores:

1. Peso promedio actual: \[ \frac{2400g + 2800g}{2} = 2600g \]
2. Número de pollos por galpón: \[ \text{Área del galpon} \ \ \times \ \ \text{No. de pollos por galpón} = (14m\cdot 140m)\cdot8 = 15680 \ \text{pollos/galpón} \] Con esto, se tiene que: \[ \text{Peso total promedio} = 2600 * 15680 = 40,768,000g = 40,768kg \]

Pregunta 2

Ajuste un modelo de RLM. Podemos decir que el modelo es bueno para explicar el peso promedio del grupo de 100 pollos? Si tuviera que recomendar una raza en particular, cuál sería y por qué? Es posible hablar de uniformidad en el peso, independiente de la raza? Escriba el modelo para la raza B y determine el peso promedio esperado cuando \(x_1 = 20\), \(x_2 = 60\) y \(x_3 = 60\), y los animales no se exponen a la luz. Calcule el peso promedio para la raza A en las mismas condiciones.

Respuesta. Aquí escribe su respuesta. Por favor incluya el código R utilizado, si aplica.

modelo <- lm(y ~ ., data = datos)
summary(modelo)

Call:
lm(formula = y ~ ., data = datos)

Residuals:
     Min       1Q   Median       3Q      Max 
-222.022  -51.849    7.082   57.180  187.069 

Coefficients:
             Estimate Std. Error t value Pr(>|t|)    
(Intercept) 2630.7862    68.4619  38.427  < 2e-16 ***
x1             2.0990     1.2563   1.671 0.098135 .  
x2             4.1656     0.8549   4.873 4.51e-06 ***
x3            -2.5947     0.5130  -5.058 2.12e-06 ***
x4B          -86.5364    21.6830  -3.991 0.000131 ***
x4C          -10.0919    22.2276  -0.454 0.650868    
x51           74.8475    17.8246   4.199 6.13e-05 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 84.65 on 93 degrees of freedom
Multiple R-squared:  0.5742,    Adjusted R-squared:  0.5468 
F-statistic:  20.9 on 6 and 93 DF,  p-value: 2.237e-15

De los resultados arrojados del resumen del modelo, se puede observar que, al tener un p-valor de 0.6508 > 0.05, la raza c de pollos no presenta una diferencia significativa con respecto a la variable de referencia (raza A). Sin embargo, no se removerá la variable pues puede otorgar información valiosa para interpretación y entendimiento del esta variable en el modelo.

En cuanto a la variable x1, presenta un p-valor de 0.09813 > 0.05, por lo que no es significativa para el modelo.

Sin embargo, se observa que al eliminar la variable x1, la diferencia significativa entre la raza C y la raza de referencia A disimuye, como se muestra en el siguiente resumen.

modelo1 <- lm(y ~ x2+x3+x4+x5, data = datos)
summary(modelo1)

Call:
lm(formula = y ~ x2 + x3 + x4 + x5, data = datos)

Residuals:
     Min       1Q   Median       3Q      Max 
-244.204  -52.284    6.095   51.461  198.419 

Coefficients:
             Estimate Std. Error t value Pr(>|t|)    
(Intercept) 2657.4635    67.2052  39.543  < 2e-16 ***
x2             4.2991     0.8592   5.004 2.61e-06 ***
x3            -2.5965     0.5178  -5.014 2.50e-06 ***
x4B          -80.9787    21.6296  -3.744 0.000312 ***
x4C           -7.4635    22.3821  -0.333 0.739533    
x51           82.1084    17.4506   4.705 8.70e-06 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 85.45 on 94 degrees of freedom
Multiple R-squared:  0.5615,    Adjusted R-squared:  0.5381 
F-statistic: 24.07 on 5 and 94 DF,  p-value: 1.625e-15

Por lo tanto, se decide dejar el modelo con todas las variables explicativas, teniendo como resultado la siguiente ecuación del modelo ajustado:

\[ \hat{y} = 2630.79 + 2.099x_1 + 4.166x_2 - 2.594x_3 - 86.536x_{4B} - 10.092x_{4C} + 74.848x_{51} \]

Ahora, para determinar si el modelo es bueno para explicar el peso promedio, se fija la atención en el calor del Adjusted R-squared, el cual es de 0.5468. Este puntaje muestra que la mayor parte de la variabilidad de los datos está explicada por el modelo, aunque no tiene un ajuste tan fuerte como se quisiera.

Por otro lado, se quiere saber si el peso promedio mantiene el mismo comportamiento indepedendientemente de la raza del pollo. Para empezar, se visualiza la distribución del peso promedio en cada una de las razas como se muestra a continuación:

razaA <- filter(datos, x4 == "A")
razaB <- filter(datos, x4 == "B")
razaC <- filter(datos, x4 == "C")


par(mfrow = c(1, 3))
hist(razaA$y, col = "lightgreen", main = "Distribución de pesos en raza A", xlab = "Raza A")
hist(razaB$y, col = "lightblue", main = "Distribución de pesos en raza B", xlab = "Raza B")
hist(razaC$y, col = "pink", main = "Distribución de pesos en raza C", xlab = "Raza C")

Si se observa el comportamiento del peso en cada una de las razas, se puede notar que las 3 tienen concentrado el peso alrededor de 2800 gramos, teniendo una mayor frecuencia en pesos mayores. La única diferencia que podría notarse es en la raza A, la cual presenta menos valores menores a 2800 que las otras 2.

Además, la diferencia de las medias no muestra una gran diferencia entre las razas A y C.

c(mean(razaA$y), mean(razaB$y), mean(razaC$y))

[1] 2822.815 2705.878 2810.375

Sin embargo, es importante realizar una prueba analítica para determinar si existe una diferencia significativa entre las diferentes razas. Esto se realiza a través de una prueba ANOVA, donde se quiere verificar si es posible rechazar la hipótesis nula de que no existen diferencias significativas entre los grupos.

anova_raza <- aov(y ~ x4, data = datos)
summary(anova_raza)

            Df  Sum Sq Mean Sq F value   Pr(>F)    
x4           2  295976  147988   11.31 3.84e-05 ***
Residuals   97 1269138   13084                     
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Dado que el p-valor es 0.000038 < 0.05, se rechaza la hipótesis nula de que los grupos de razas son iguales, por lo que exsite al menos una raza que muestra diferencias con respecto a las otras. En el contexto del problema, es posible que la raza que presente diferencias sea la raza B. Para comprobarlo, se realiza una prueba de Tukey para ver cuál es el grupo particular.

TukeyHSD(anova_raza)

  Tukey multiple comparisons of means
    95% family-wise confidence level

Fit: aov(formula = y ~ x4, data = datos)

$x4
          diff        lwr       upr     p adj
B-A -116.93677 -184.41543 -49.45810 0.0002298
C-A  -12.43981  -83.58655  58.70692 0.9090440
C-B  104.49695   40.27546 168.71844 0.0005682

Como se observa en la prueba de pares, la raza que presenta diferencias es la raza B. Por lo tanto, es posible afirmar que no existe uniformidad en el peso promedio en términos de la raza.

Ahora, se calculan los intervalos de confianza de cada variable:

confint.default(modelo)

                   2.5 %      97.5 %
(Intercept) 2496.6034309 2764.969042
x1            -0.3633595    4.561367
x2             2.4901124    5.841087
x3            -3.6001142   -1.589352
x4B         -129.0344167  -44.038429
x4C          -53.6572601   33.473418
x51           39.9118304  109.783094

De lo anterior, se puede obversar que la raza A es la que presenta un mayor promedio entre las 3 posibles, sobrepasando levemente el promedio de la raza C. Sin embargo, al calcular el máximo del peso promedio teniendo en cuenta las variables simultáneamente, la raza C tiene un impacto mayor.

\[ \text{Máximo raza A} = 2767.969 + 4.561 + 5.8411 - 1.589 + 109.783 = 2886.565 \] \[ \text{Máximo raza C}= 2767.969 + 4.561 + 5.8411 - 1.589 + 33.473 + 109.783 = 2920.038 \] Por último, se puede hacer un diagrama de violin que permite ver cómo es la distribucióny dispersión del peso promedio por cada una de las razas.

ggplot(datos, aes(x = x4, y = y, fill = x4)) +
  geom_violin() + 
  geom_boxplot(width = 0.3, fill = "white", color = "black", alpha = 0.5) + 
  theme_minimal() +
  labs(title = "Distribución y dispersión del peso promedio por raza",
       x = "Raza", 
       y = "Peso promedio (g)",
       fill = "Raza")

Del diagrama se puede ver que la dispersión de la raza A es menor que la de la raza C, por lo que puede ser más estable al momento de calcular los pesos.

Teniendo en cuenta todos los resultados anteriores, al ser más estable y presentar mejores medidas (aunque no sean significativamente diferentes), la raza que se recomendaría es la raza A.

Modelo para raza B:

En este caso, se tomará el peso promedio cuando \(x_1 = 20\), \(x_2 = 60\) y \(x_3 = 60\), y los animales no se exponen a la luz.

\[ E[y|\mathbf{x}_0] = \hat{y} = 2630.79 + 2.099(20) + 4.166(60) - 2.594(60) - 86.536(1) - 10.092(0) + 74.848(0) \] \[ E[y|\mathbf{x}_0] = \hat{y} = 2680.554 \] Modelo para raza A:

En este caso, se tomará el peso promedio cuando \(x_1 = 20\), \(x_2 = 60\) y \(x_3 = 60\), y los animales no se exponen a la luz.

\[ E[y|\mathbf{x}_0] = \hat{y} = 2630.79 + 2.099(20) + 4.166(60) - 2.594(60) - 86.536(0) - 10.092(0) + 74.848(0) \] \[ E[y|\mathbf{x}_0] = \hat{y} = 2767.09 \]

Pregunta 3

Determine si el modelo es o no válido para predecir. Calcule \(E[y|\mathbf{x}_0]\) donde \(\mathbf{x}_0 = (28, 65, 70,\) A \(,1)\). Recomendaría el engorde de los pollos en estas condiciones para aumentar la eficiencia? Si la pechuga, los dos perniles y las alas representan el 40%, 30% y 15% del peso del pollo, respectivamente, cuál es el precio de venta promedio de un pollo engordado en estas condiciones? Suponga que \(p_1=0.1\), \(p_2=0.3\), \(p_3=0.45\) y \(p_4=0.15\).

Respuesta. Aquí escribe su respuesta. Por favor incluya el código R utilizado, si aplica.

Para determinar si el modelo es válido para predecir, es necesario verificar los supuestos referentes a los residuales del modelo.

Normalidad

shapiro.test(rstudent(modelo))$p.value

[1] 0.7810988

Como el valor \(p\) es \(>0.05\), entonces los errores del modelo siguen una distribución Normal.

Varianza constante

car:::ncvTest(modelo)$p

[1] 0.7729436

Como el valor \(p\) es \(>0.05\), podemos concluir que los errores tienen varianza constante.

Independencia

car:::durbinWatsonTest(modelo)$p

[1] 0.468

Este resultado indica que los errores del modelo ajustado son independientes.

Como todos los supuestos se cumplen, se puede afirmar que el modelo es válido para predecir.

Ahora, se procede a calcular el peso promedio esperado cuando \(\mathbf{x}_0 = (28, 65, 70,\) A \(,1)\).

x0 <- data.frame(x1 = 28, x2 = 65, x3 = 70, x4 = 'A', x5 = '1')

pred <- predict(modelo, newdat = x0)
pred

       1 
2853.538 

Por lo tanto, el peso promedio esperado es de 2853.538 gramos.

predict(modelo, newdata = x0, interval = "confidence")

       fit     lwr      upr
1 2853.538 2809.43 2897.647

Con este nuevo intervalo de confianza bajo las nuevas condiciones de engorde, se observa que el mínimo del nuevo intervalo supera al máximo del intervalo de las condiciones actuales. Por lo tanto, el peso promedio mejora bajo las nuevas condiciones de engorde.

Ahora, para calcular el precio de venta promedio un pollo engordadom se procede de la siguiente manera:

#peso en libras de cada parte del pollo
peso_pech <- (pred*0.4)/453.6
peso_pern <- (pred*0.3)/453.6
peso_wing <- (pred*0.15)/453.6
peso_entero <- pred/453.6

Con estos pesos, se tiene que el precio para cada parte del pollo es:

precio_pech <- peso_pech*4300*0.3
precio_pern <- peso_pern*3400*0.45
precio_wing <- peso_wing*2900*0.15
precio_entero <- peso_entero*8000*0.1

precio_total <- precio_pech + precio_pern + precio_wing + precio_entero

Por lo tanto, el precio de venta promedio de un pollo engordado será $11576.8.

Pregunta 4

A cuánto ascienden las ventas de los 4 tipos de producto al utilizar estas condiciones de engorde? Si los gastos operacionales ascienden a $5,000,000 mensuales/galpón, aproxime la utilidad.

Respuesta. Aquí escribe su respuesta. Por favor incluya el código R utilizado, si aplica.

Para calcular las nuevas ventas de cada tipo de producto, se tiene en cuenta que los pollos se sacrifican cada 40 días, y que los gastos operaciones son mensuales (30 días).

Por lo tanto, se hace una proyección a los 120 días (4 meses) para calcular la relación entre las ganas y los costos operacionales.

Cada 4 meses, se sacrifican 62720 pollos, y se tiene un gastos operacional de $20000000. Con esto,

Ganancias por galpón:

poll_galp <- 15680

ventas_pollo <- precio_entero * poll_galp
ventas_pechuga <- precio_pech * poll_galp
ventas_perniles <- precio_pern * poll_galp
ventas_alas <- precio_wing * poll_galp

venta_total <- ventas_pollo + ventas_pechuga + ventas_perniles + ventas_alas

• Pechugas: $50.898.671,80
• Perniles: $45.276.144,10
• Alas: $6.436.314,60
• Pollo entero: $78.912.669,46

Con estos precios, las ventas promedios por galpón son $181.523.799,96.

Así, la utlidad a 4 meses sería:

gastos_4 <- 5000000*4
ganancias_4 <- (venta_total)*3

utilidad <- ganancias_4 - gastos_4

Utilidad: $524.571.399,88

Notas

1. Esto se refiere a que, al final del período de engorde, el peso promedio de los animales al utilizar las nuevas condiciones, supere el peso promedio actual.