Caso #2
HTML a jvelezv@uninorte.edu.co antes del Viernes 7 de Junio de 2024.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,1 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\)). Los datos que se tomaron se encuentran aquí.
A continuación se visualiza la tabla de datos del enlace proporcinado en el contexto analítico. .
d <- read.table(path, header = TRUE)
d$x4 <- as.factor(d$x4)
d$x5 <- as.factor(d$x5)
# Mostrar las primeras filas de los datos
datatable(d,
filter = "top", # Mostrar cuadros de búsqueda en la parte superior de cada columna
options = list(pageLength = 10) # Agregar título encima de la tabla
)Durante el análisis, se caracterizó un total de 100 lotes, obteniendo el peso promedio alcanzado al final de la etapa de engorde de los 100 animales que conformaban cada lote. Entre estos lotes, se incluyeron animales de tres razas de pollos distintas. Se distribuyeron en 27 galpones los pollos de la raza A, 41 galpones albergaron la raza B y 32 galpones albergaron la raza C.
Se observó que el 49% de los lotes implementaron una alimentación continua día y noche mediante el uso de una luz especial durante la noche, mientras que el 51% restante optó por alimentar a los animales únicamente durante el día.
A continuación se relaciona el peso promedio alcanzado por raza y el uso o no de una luz especial durante la noche:
| Raza del Pollo | Uso de Luz Especial | Peso Promedio en gramos |
|---|---|---|
| A | No | 2781.167 |
| A | Si | 2856.133 |
| B | No | 2668.160 |
| B | Si | 2764.812 |
| C | No | 2768.143 |
| C | Si | 2843.222 |
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.
Para apoyar en la toma de decisión de PRR se deben tomar los datos y almacenar la información de la siguiente forma:
ID galpón;
ID pollo;
Cantidad de nutrientes especiales (g/día) etapa 1 (Crianza inicial);
Cantidad de agua (ml/día) etapa 1 (Crianza inicial);
Cantidad de forraje (g/día) etapa 1 (Crianza inicial);
Peso del pollo (g) crianza inicial
Inicio de etapa de crecimiento (días): 7
Cantidad de nutrientes especiales (g/día) etapa 2 (Crecimiento);
Cantidad de agua (ml/día) etapa 2 (Crecimiento);
Cantidad de forraje (g/día) etapa 2 (Crecimiento);
Peso del pollo (g) etapa 2 (Crecimiento);
Inicio de etapa de engorde (días): 21(I) o 28(II);
Cantidad de nutrientes especiales (g/día) etapa 3 (Engorde);
Cantidad de agua (ml/día) etapa 3 (Engorde);
Cantidad de forraje (g/día) etapa 3 (Engorde);
Peso del pollo (g) etapa 3 (Engorde);
Raza: A(I), B(II) o C (III)
Luz especial durante la noche: Si(I) o No(II).
Para explorar el efecto de las variables predictoras (cantidad de nutrientes especiales, agua, forraje y exposición a luz especial) en lotes específicos, es fundamental establecer valores fijos para estas variables y asignar una identificación única a cada galpón.
Para determinar el peso total promedio alcanzado por galpón los datos deben resumirse como se muestra a continuación:
| ID galpón | Aréa (\(m^2\)) del galpón | número de pollos por galpón | Cantidad de nutrientes especiales (g/día) | Cantidad de agua (ml/día) | Cantidad de forraje (g/día) | Raza | Luz Especial durante la noche | Peso promedio (g) |
|---|---|---|---|---|---|---|---|---|
| A | NO | |||||||
| B | SI | |||||||
| C |
Unidad experimental: Lote de pollo.
El peso promedio actual de un pollo que crece en las instalaciones de la compañía está en el intervalo (2400, 2800), cuyo punto medio es 2600 g.
Factor de conversión: 1 tonelada (Tm) equivale a 1.000.000 gramos (g).
Teniendo en cuenta que cada galpón tiene medidas de 1.960 \(m^2\) y puede albergar hasta 8 pollos por \(m^2\), la capacidad por cada galpón es de 15680 pollos. Dado que el peso promedio medio es de 2600g, podemos calcular el peso promedio por gapón como se muestra a continuación:
\[ peso_{\text{promedio total x galpón}} = 15680*2600g = 40.768.000g \]
Como PRR dispone de 200 galpones para cálcular el peso total promedio alcanzado al final de la etapa de engorde en las condiciones actuales, es de:
\[ peso_{\text{promedio total}} = 40.768.000g*200 = 8.153.600.000 g = 8.153,6 Tm. \]
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.
El modelo ajustado es:
model<- lm(y ~ ., data = d)
summary(model)
Call:
lm(formula = y ~ ., data = d)
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-15Ahora, queremos recomendar una raza de pollo en particular.
Los intervalos de confianza del 95% para los coeficientes pueden obtenerse a través de la función confint.default() haciendo
## 95% CI para los coeficientes
confint.default(model) 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.783094Para dar respuesta a lo anterior realizaremos una breve inferencia para \(\beta\)
Al comparar el coeficiente de la raza B (\(\beta_B\)) con el coeficiente de referencia o raza A (\(\beta_{A}\)), se evidencia que la raza B es más ligera en 86.5364 gramos por cada unidad de gramo de la raza A, y esta diferencia es estadísticamente significativa. Por otro lado, al contrastar el coeficiente de la raza C (\(\beta_C\)) con el coeficiente de referencia o raza A (\(\beta_{A}\)), no se observa una diferencia significativa en el peso entre la raza C y la raza A, ya que el coeficiente (\(\beta_C\)) de la raza C no es estadísticamente significativo (p-value = 0.650868), más sin embargo se puede afirmar que la raza C es 10.0919 más ligera;
Dado lo anterior, se puede afirmar que tanto la raza A como la raza C, son una buena opción para recomendarlas, sin embargo, al calcular los intervalos de confianza IC para cada uno de los coeficientes, se observa que, en algunos casos, los pollos de la raza C son 33.4734 gramos más pesada que la raza A. Sin embargo, cuando calculamos el peso promedio según raza, el valor obtenido para la raza A fue ligeramente superior la raza C.
A continuación se muestra el peso promedio de cada una de las razas de pollo de los 100 galpones:
| Raza del Pollo | Peso Promedio en gramos |
|---|---|
| A | 2822.815 |
| B | 2705.878 |
| C | 2810.375 |
Basándome en los resultados presentados, sugeriría optar por las razas A y C, pero si se debe elegir solo una raza, se recomendaría la raza A debido a que existe menos dispersión en los datos, esto se puede observar en el siguiente gráfico:
fig_v_p1 <- d %>%
plot_ly(
x = ~x4,
y = ~y,
type = 'violin',
color = ~x4,
colors = c("#8C4D3F","#1B7F7A", "#DEB887"),
box = list(visible = TRUE),
meanline = list(visible = TRUE)
) %>%
layout(
violinmode = "group",
yaxis = list(zeroline = FALSE, title = "Peso promedio pollo (g)"),
title = "Distribución peso promedio (g) según raza de pollo",
xaxis = list(title = "Raza de Pollo"),
legend = list(title = list(text = 'Raza de Pollo'))
)
fig_v_p1Ahora, validaremos si existe uniformidad en los pesos promedios de los datos segun la raza, para esto realizamos una prueba para la comparación de las medias del peso promedio según la raza del pollo.
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 ' ' 1Dado que el p-valor es se puede afirmar que al menos una de las razas de pollo tiene un efecto significativo en el peso promedio de los pollos (g).
Para establecer, donde existe la diferencia realizamos una prueba usando la función TukeyHSD().
Tukey multiple comparisons of means
95% family-wise confidence level
Fit: aov(formula = y ~ x4, data = d)
$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
Dado lo anterior, se concluye que con un nivel de confianza del 95%, que existen diferencias de medias entre los tipos de raza B-A y la raza C-B, las cuales generan un efecto significativo en el peso promedio de los pollos (g).
Lo anterior, se puede visualizar a tráves del siguiente gráfico:
Basándonos en los gráficos anteriores, se puede afirmar que la distribución en la raza A tiene una distribución asimétrica a la izquierda y un sesgo a la derecha, es decir, la mayor frecuencia en el peso promedio se concentran en los valores más altos del promedio del peso en gramos. Mientras que la Raza B y C tienen un comportamiento similar en cuanto a su distribución, comprando las dos razas antes mencionadas si se puede hablar de uniformidad en el peso promedio.
Ahora, veremos la gráfica de la distribución del peso promedio sin realizar la segmentación según la raza del pollo. En terminos generales, el peso promedio de los pollos no se distribuye de forma uniforme.
A continuación, se muestra la ecuación del modelo para la raza B y se determinó el promedio esperado cuando \(x_1 = 20\), \(x_2 = 60\) y \(x_3 = 60\), y los animales no se exponen a la luz.
\[ \hat{y} = 2630.7862 + 2.0990 (20) + 4.1656(60) - 2.5947(60) -86.5364\]
y_razaB <- 2630.7862+2.0990*(20) + 4.1656*(60) - 2.5947*(60) - 86.5364El peso promedio esperado para la raza B cuando \(x_1 = 20\), \(x_2 = 60\) y \(x_3 = 60\), y los animales no se exponen a la luz es de 2680.4838.
A continuación, se muestra la ecuación del modelo para la raza A y se determinó el promedio esperado, bajo las mismas condiciones para la raza B .
\[ \hat{y} = 2630.7862 + 2.0990 (20) + 4.1656(60) - 2.5947(60)\]
y_razaA <- 2630.7862+2.0990*(20) + 4.1656*(60) - 2.5947*(60) El peso promedio esperado para la raza A cuando \(x_1 = 20\), \(x_2 = 60\) y \(x_3 = 60\), y los animales no se exponen a la luz es de 2767.0202.
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\).
df_val_model <- data.frame(val_model(model))
names(df_val_model) <- c('Coeficiente de Determinación', 'Significancia Global', 'Significancia Marginal', 'Test de Normalidad' , 'Test de Independencia', 'Test de Homocedasticidad', 'Verificación de Outliers')
df_r2 <- df_val_model[,c('Coeficiente de Determinación')]
names(df_r2) <- c('Coeficiente de Determinación')
# Generar la tabla con kableExtra
kbl(df_r2,
align = "lc",
position = "top") %>%
kable_classic(full_width = FALSE,
html_font = "Verdana",
bootstrap_options = "hover")| x | |
|---|---|
| Coeficiente de Determinación | El modelo tiene un desempeño deficiente, explica en un 54.68 % la variabilidad de la variable dependiente |
La existencia de multicolinealidad puede probarse utilizando el ill-condition number (ICN)
## ICN
kappa(model) [1] 342.3963Dado que el ICN es \(>30\), aparentemente, existe multicolinealidad entre \(x_1, x_2, x_3, x_4\) y \(x_5\).
A continuación determinaremos cuál de las variables independientes tiene mayor grado de colinealidad, a través de la función VIF():
car::vif(model) GVIF Df GVIF^(1/(2*Df))
x1 1.082171 1 1.040275
x2 1.047698 1 1.023571
x3 1.028809 1 1.014302
x4 1.082995 2 1.020132
x5 1.108078 1 1.052653Al evaluar el VIF, se evidencia la presencia de multicolinealidad entre las variables predictoras. No obstante, resulta difícil determinar cuál de estas variables exhibe una redundancia más significativa ya que ningun VIF \(> 5\).
A continuación realizaremos una prueba adicional de para la detección de multicolinealidad en el paquete mctest:
## otras pruebas de multicolinealidad
(res <- mctest(model)$odiags) results detection
Determinant 0.5730669 0
Farrar Chi-Square 53.5410606 1
Red Indicator 0.1786286 0
sum of Lambda Invers 7.3543905 0
Theil Indicator -1.9206744 0
Condition Number 22.2467502 0Con base a los resultados obtenidos con el paquete mctest, es posible confirmar la existencia de multicolinealidad. Aparece el valor de 1 en la columna detection.
df_val_model <- data.frame(val_model(model))
names(df_val_model) <- c('Coeficiente de Determinación', 'Significancia Global', 'Significancia Marginal', 'Test de Normalidad' , 'Test de Independencia', 'Test de Homocedasticidad', 'Verificación de Outliers')
df_supuestos <- df_val_model[,c('Test de Normalidad' , 'Test de Independencia', 'Test de Homocedasticidad', 'Verificación de Outliers')]
# Generar la tabla con kableExtra
kbl(df_supuestos,
align = "ccccc",
position = "top") %>%
kable_classic(full_width = FALSE,
html_font = "Verdana",
bootstrap_options = "hover")| Test de Normalidad | Test de Independencia | Test de Homocedasticidad | Verificación de Outliers | |
|---|---|---|---|---|
| value | Los residuales siguen una distribución normal | Los residuales son independientes | Los residuales tienen varianza constante | No existen Outliers |
Conclusión : Dando seguimiento a los resultados previos podemos confirmar la validez de nuestro modelo para realizar predicciones, debido a que se cumplen con los supuestos de normalidad, independencia y homocedasticidad de los residuales del modelo, sin embargo se observa que existe multicolinealidad entre las variables predictoras, por lo que es necesario hacer un estudio a profundidad de la naturaleza de los datos y eliminar este efecto.
Ahora, nos interesa calcular el \(E[y|\mathbf{x}_0]\) donde \(\mathbf{x}_0 = (28, 65, 70,\) A \(,1)\).
## x0
x0 <- data.frame(x1 = 28, x2 = 65, x3 = 70, x4 = 'A', x5='1')
## estimación
x0_predic <- predict(model, newdat = x0) Por lo tanto, \(\widehat{E[Y|\mathbf{x}_0]} =\) 2853.5384938 gramos.
En la actualidad el peso promedio por pollo se encuentra en un intervalo de (2400,2800) gramos, teniendo en cuenta el resultado anterior se recomienda el engorde de los pollos bajo estas condiciones: \(x_1 = 28,\space x_2 = 65,\space x_3 = 70,\space x_4 = A\space y\space x_5 = 1\).
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\).
Los cálculos de precios se llevaron a cabo utilizando el siguiente factor de conversión: 453.592 gramos (g) equivalen a 1 libra (l).
Dado que el enunciado del ejercicio solo especifica los porcentajes (85%) de ciertas partes del pollo, sin mencionar las partes que conforman el 15% restante, asumimos que este último porcentaje corresponde a cualquier otra parte del pollo vendido al mismo precio que el pollo entero, que es de 8.000 COP por libra. Lo anterior, se tiene en cuenta para el cálculo del precio de venta por pollo bajo las condiciones de \(X_0\).
pechuga_p <- (x0_predic*0.40)
perniles_p <- (x0_predic*0.30)
alas_p <- (x0_predic*0.15)
resto_p <- (x0_predic*0.15)
pollo_p <- (x0_predic)
precio_pechuga <- 4300*(pechuga_p/453.592)
precio_pernil <- 3400*(perniles_p/453.592)
precio_alas <- 2900*(alas_p/453.592)
pollo_precio <- 8000*(pollo_p/453.592)
precio_resto <- 8000*(resto_p/453.592)
precio_total <- (precio_pechuga*0.3)+(precio_pernil*0.45)+(precio_alas*0.15)+((pollo_precio+precio_resto)*0.1)
precio_total_f <- format(precio_total, big.mark=".")
#Bajo las condiciones del enunciado se estiman los precios por parte
v_pechuga <- 0.3*(precio_pechuga*15680)
v_pernil <- 0.45*(precio_pernil*15680)
v_alas <- 0.15*(precio_alas*15680)
v_pollo <-0.1*((pollo_precio+precio_resto)*15680)
ventas_totales <- v_pechuga+v_pernil+v_alas+v_pollo
ventas_totales_f <- format(ventas_totales, big.mark=".")El precio de venta promedio de un pollo engordado si la pechuga, los dos perniles y las alas representan el 40%, 30% y 15% del peso del pollo, respectivamente es de $12.331.89 COP.
Bajo las siguientes de condiciones de participación de cada producto en ventas totales de la compañia \(p_1=0.1\), \(p_2=0.3\), \(p_3=0.45\) y \(p_4=0.15\), se estima que las ventas totales por galpón sean de $193.364.111 COP.
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.
Para calcular las utilidades, se determinaron las ventas totales considerando un periodo de 120 días, lo que equivale a cada 4 meses, tomando en cuenta que los pollos son sacrificados a los 40 días. Además, se incluyeron los gastos de mantenimiento por galpón, los cuales ascienden a $20.000.000 COP cada 4 meses.
utilidad = (ventas_totales*3)-(5000000*4)
utilidad_f <- format(utilidad, big.mark = ".")Las ventas de los 4 tipos de producto ascienden a $ 560.092.332 COP, bajo las condiciones de participación de cada producto en las ventas cuatrimestrales de la compañia.
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.↩︎