Econometría I

Luis Alfredo Lemus Paz

16001012

Este es el proyecto final del curso de Econometría 1 de la maestría de Investigación de Operaciones. El data frame que se analiza es el histórico de producción de una fábrica en el año 2016.

library(dplyr)
## Warning: package 'dplyr' was built under R version 3.3.2
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 3.3.2
setwd("C:/Users/Juan Carlos Quan/Desktop/Proyecto")
data_prod<-read.csv(file = "data_prod.csv")

Estructura del Data Frame.

glimpse(data_prod)
## Observations: 4,322
## Variables: 9
## $ PERIODO            <int> 116, 116, 116, 116, 116, 116, 116, 116, 116...
## $ LIBRAJE            <dbl> 672941.5, 672941.5, 672941.5, 672941.5, 672...
## $ LOTE               <int> 16010001, 16010002, 16010003, 16010004, 160...
## $ COD..PREMEZCLA     <int> 8255, 7175, 7175, 8242, 8222, 8115, 7227, 7...
## $ PREMEZCLA          <fctr> DECARBONIZED LE, EXTRA CLEAN, EXTRA CLEAN,...
## $ CLASE              <fctr> LIQ, LIQ, LIQ, LIQ, LIQ, LIQ, LIQ, LIQ, LI...
## $ LIBRAJE.1          <int> 1702, 6806, 6806, 224, 1761, 2519, 1715, 21...
## $ GALONES            <dbl> 204.07674, 816.06715, 816.06715, 26.85851, ...
## $ PRODUCCION.MENSUAL <int> 672941, 672941, 672941, 672941, 672941, 672...

Encuentra la cantidad periodos que se analizaran.

unique(data_prod$PERIODO)
##  [1]  116  216  316  416  516  616  716  816  916 1016 1116
Se analizaran los primeros 11 períodos del año 2016. No se analiza diciembre porque dicho mes no se ha finalizado.

Ordenes mayores a 6000 libras, mayores a 3000 libras y menores a 1000 libras.

unok<-nrow(filter(data_prod,LIBRAJE.1<1000))
tresk<-nrow(filter(data_prod,LIBRAJE.1>3000))
seisk<-nrow(filter(data_prod,LIBRAJE.1>6000))
unok
## [1] 2021
tresk
## [1] 866
seisk
## [1] 161
unok/nrow(data_prod)*100
## [1] 46.76076
tresk/nrow(data_prod)*100
## [1] 20.03702
seisk/nrow(data_prod)*100
## [1] 3.725127

Un 46 por ciento de las ordenes son menores de 1000 libras. Un 20 por ciento son mayores a 3000 libras y un 3 por ciento son mayores a 6000 libras.

Productos mas fabricados en el año.

by_premezcla<-group_by(data_prod,PREMEZCLA)
total_libraje<-summarise(by_premezcla, sumlibraje = sum(LIBRAJE.1, na.rm = FALSE))
tabla_final<-arrange(total_libraje, desc(sumlibraje))
head(tabla_final,10)
## # A tibble: 10 × 2
##                                        PREMEZCLA sumlibraje
##                                           <fctr>      <int>
## 1               P-260 (ALKEMY CB-401, UNIBLEACH)     546453
## 2                                    EXTRA CLEAN     391473
## 3  P-225 (ACIDSCB, ALK AS, DL45, ALS PL, DFREE4)     289599
## 4                                     CLEAN FOAM     273944
## 5                                   CLEAN FOAM C     245924
## 6                                  SANIQUAT PLUS     217448
## 7                                       WT-CS-52     202794
## 8                P-250 (MAGIC, MAGIC C, SUPREME)     198273
## 9                         P-300 (BLITZ, BLITZ C)     181145
## 10                                      STRIPPER     167516
El producto que más se ha fabricado en el año es el ALKEMY CB-401, seguido del EXTRA CLEAN y el P-225.
by_PERIODO<-group_by(data_prod,PERIODO)
periodo_libraje<-summarise(by_PERIODO, sum.libraje = sum(LIBRAJE.1, na.rm = FALSE))
periodo.libraje<-arrange(periodo_libraje, desc(sum.libraje))
periodo.libraje
## # A tibble: 11 × 2
##    PERIODO sum.libraje
##      <int>       <int>
## 1     1116      905551
## 2     1016      797163
## 3      516      738976
## 4      216      735346
## 5      816      724323
## 6      616      706382
## 7      416      683834
## 8      916      681659
## 9      116      672932
## 10     716      632578
## 11     316      608741
El mejor mes del año fue en noviembre con una produccion de 905,551 libras.
periodo.libraje %>% ggplot(aes(x=PERIODO, y=sum.libraje)) + geom_point()

fit<-lm(data=periodo.libraje, PERIODO~sum.libraje)
summary(fit)
## 
## Call:
## lm(formula = PERIODO ~ sum.libraje, data = periodo.libraje)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -444.40 -136.32   25.87  193.98  385.85 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)  
## (Intercept) -1.124e+03  7.884e+02  -1.425   0.1878  
## sum.libraje  2.426e-03  1.093e-03   2.219   0.0536 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 281.1 on 9 degrees of freedom
## Multiple R-squared:  0.3537, Adjusted R-squared:  0.2819 
## F-statistic: 4.926 on 1 and 9 DF,  p-value: 0.05362

El RMSE para el comportamiento de la producción de la fábrica mensualmente es de 281.1 lo cual se considera aceptable.

by_clase<-group_by(data_prod,CLASE)
clase_libraje<-summarise(by_clase, sum.libraje.clase = sum(LIBRAJE.1, na.rm=FALSE))
clase.libraje<-arrange(clase_libraje, desc(sum.libraje.clase))
clase.libraje
## # A tibble: 3 × 2
##    CLASE sum.libraje.clase
##   <fctr>             <int>
## 1    LIQ           7418405
## 2    POL            469080
## 3                        0
De productos líquidos se fabricaron 7,418,405 libras y de polvos se fabricaron 469,080 libras en todo el año.

El producto polvo que más se fabrica.

table(data_prod$CLASE)
## 
##       LIQ  POL 
##    2 3374  946
polvos = filter(data_prod,CLASE == "POL")
by_polvos <- group_by(polvos,PREMEZCLA)
polvos.libraje<-summarise(by_polvos, sum.libraje.polvos = sum(LIBRAJE.1,  na.rm=FALSE))
polvos.final<-arrange(polvos.libraje, desc(sum.libraje.polvos))
head(polvos.final,10)
## # A tibble: 10 × 2
##                                      PREMEZCLA sum.libraje.polvos
##                                         <fctr>              <int>
## 1  P-610 (ALKEMY A-10, ALKEMY HC-300, ETCHING)              43217
## 2                              CHALLENGE LEMON              41600
## 3                    P-025 (W-2852, ULTRACLOR)              38800
## 4                                     MEGACLOR              35325
## 5                                    BIOBLEACH              30800
## 6                           P-615 (DETER FOOD)              27624
## 7                             P-810 (BIOBRITE)              26400
## 8                              ALKEMY SC - 100              19025
## 9                                     WT-BS-12              18575
## 10                                    WT-BI-14              15275
El producto de polvos que más se fabricó en el año fue de P-610 con 43,217 libras.

Ordenes de produccion de las dos clases de producto.

table(data_prod$CLASE)
## 
##       LIQ  POL 
##    2 3374  946
Se generaron 3374 ordenes de líquidos y 946 ordenes de polvos de enero a noviembre de 2016.
polvos<-filter(data_prod,CLASE == "POL")
polvos.final<-(polvos$PERIODO)
polvos.final1<-table(polvos.final)
polvos.final1
## polvos.final
##  116  216  316  416  516  616  716  816  916 1016 1116 
##   79   88   65   88   88   92   76  105   79   89   97

Como análisis para la planta de polvos podemos decir que la tabla anterior muestra la cantidad de ordenes de producción efectuadas en el transcurso del año.

Comportamiento de la demanda del producto ALKEMY CB-401.
demanda_cb_401<-filter(data_prod, PREMEZCLA == "P-260 (ALKEMY CB-401, UNIBLEACH)")
table(demanda_cb_401$PERIODO)
## 
##  116  216  316  416  516  616  716  816  916 1016 1116 
##   14   17   14   16   17   19   17   16   23   16   10
by_cb401<-group_by(demanda_cb_401,PERIODO)
totalcb401<-summarise(by_cb401, sumlibrajecb401 = sum(LIBRAJE.1, na.rm=FALSE))
totalcb401
## # A tibble: 11 × 2
##    PERIODO sumlibrajecb401
##      <int>           <int>
## 1      116           35245
## 2      216           47479
## 3      316           33839
## 4      416           51249
## 5      516           63727
## 6      616           57508
## 7      716           49407
## 8      816           54759
## 9      916           63919
## 10    1016           46612
## 11    1116           42709
summary(totalcb401)
##     PERIODO     sumlibrajecb401
##  Min.   : 116   Min.   :33839  
##  1st Qu.: 366   1st Qu.:44661  
##  Median : 616   Median :49407  
##  Mean   : 616   Mean   :49678  
##  3rd Qu.: 866   3rd Qu.:56134  
##  Max.   :1116   Max.   :63919

Con este análisis podemos decir que el promedio de libraje para cada mes del año 2016 en la fabricación del producto CB-401 es de 49,407. El máximo fabricado fue de 63,919 y el mínimo fue de 33,839.

totalcb401 %>% ggplot(aes(x=PERIODO, y=sumlibrajecb401)) + geom_point()

fit1<-lm(data=totalcb401, PERIODO~sumlibrajecb401)
summary(fit1)
## 
## Call:
## lm(formula = PERIODO ~ sumlibrajecb401, data = totalcb401)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -374.62 -240.15  -90.38  138.48  580.44 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)
## (Intercept)      42.59272  520.87951   0.082    0.937
## sumlibrajecb401   0.01154    0.01030   1.121    0.291
## 
## Residual standard error: 327.5 on 9 degrees of freedom
## Multiple R-squared:  0.1226, Adjusted R-squared:  0.02506 
## F-statistic: 1.257 on 1 and 9 DF,  p-value: 0.2912

El RMSE para el comportamiento de la producción de CB401 en el presente año es de 327.5 lo cual se considera aceptable.

Este fue el análisis general del histórico de producción de una fábrica para los meses de enero a noviembre del año 2016.