Matriz de Markov

INFORME:

UNIVERSIDAD NACIONAL DE SAN MARCOS

FACULTAD DE CIENCIAS

CURSO: Procesos Estocasticos.

Determinación de Tiempos de Ciclo en el proceso de Tintoreria de Tela en Industrias Nettalco.

AUTOR Dubois Bermeo, Miguel Rodolfo (21147042)

PROFESOR

                Mg. Carmela Velásquez Pino. 

Lima, 26 de Junio del 2021

1. Resumen

   El presente trabajo busca determinar los diferentes tiempos de ciclo totales que se presentan dentro del proceso de Teñido de Tela en Industrias Nettalco asi como los tiempos de trancisión entre los diferentes estados, para esto se han tomado los datos de producción del ERP, donde se tiene la información história del período comprendido entre el 01/06/2020 al 31/05/2021 de los registros de inicio y fin de cada uno de los diferentes estado:

        1.- Preparar : En esta estado la tela se acondiciona para ser ingresada a las                                  maquinas de teñido.
        2.- Teñir    : Estado donde la tela es sometida a una reaccion quimica dentro de las                            máquinas de teñir para darle color.
        3.- Abrir    : Estado donde la tela es abierta y exprimida.
        4.- Controlar Color: Estado en la cual se evalua el color obtenido con el estandar                                   del cliente.
        5.- Rechazo  : Estado donde la tela se encuentra hasta definir una ruta alternativa.
        6.- Pruebas  : Estado dode la tela es sometida a pruebas de laboratorio para                                   determinar una ruta alternativa.
        7.- Secar    : Estado en el cual la tela es llevada a un porcentaje de humedad de                              7%.
        8.- Acabar   : Estado en el cual la tela se le da estabilidad dimensionas y la                                 suavidad para iniciar los procesos de corte y confección.
        9.- Despachar : Estado en el cual la tela es acondicionada para la entrega al area                              de corte y confeccion ademas es el ultimo estado del proceso de                                 teñido.

2. Introducción: Para poder encontrar cuales son los estados que generan los mayores tiempos en el proceso de teñido vamos a aplicar las Cadenas de Markov dentro de este proceso. Esto nos permitira poder tomar las acciones necesarias para desarrollar planes para reducir estos tiempo a su vez que nos servira de base para el sistema de planificación ya que podremos determinar los tiempos futuros de los cambios de estado.

3. Análisis situacional: Actualmente sabemos que el proceso de tintoreria de tela demora entre 2 a 5 dias, pero no podemos determinar cuantas ordenes van a pasar por un estado de rechazo o cuantas vamos a tener en el estado de pruebas, esto nos esta generando cuellos de botella no planificados que hacen que el tiempo total de proceso tenga variaciones altas y no se pueda tomar las decisiones oportunas para corregir estas.

4. Formulación del problema: Determinar cual es la probabilidad y el tiempo de ciclo que tienen las ordenes de producción para cambiar de un estado a otro o de llegar al proceso final.

5. Modelo utilizado: Para resolver este problema vamos a utilizar el modelo de Cadenas de Markov de estados discretos.

6. Solución del problema

Vamos a mostrar la creacion de un proceso de Markov a parir de los datos de las ordenes de produccion de Tintoreria:

Las Etapas de produccion son:

Preparar Teñir Abrir Secar C Color Acabar Pruebas Rechazos Despachar

Vamos a Cargar la Tabla que contiene los siguientes datos

NUMERO_OB : Orden de Produccion (OB) TKILOPROG : Kg de la OB TMETRPROG : Mt de la OB TCODIARTI : Codigo del Producto TDESCARTI : Descripcion del Producto TNUMECOLN : Codigo del Color TDESCCOLN : Descripcion del Color TCODIFASE : Codigo de la Fase Fases : Descripcion de la Fase TDESCFASE : Estado TCODIMAQU : Maquina de proceso TFECHINIC : Fecha de Inicio Estado TFECHFINA : Fecha de Fin de Estado Acumulado : Tiempo total de Proceso NoCambioOB: Cambi de OB

setwd("~/R/Markov1")
#Cargamos la Libreria
#  install.packages("markovchain")
  library(markovchain)
  library(reshape2)


# Cargamos la data
Fases<-read.csv("FasesDataDepurada.csv",sep=";",dec=".")
head(Fases)

NA

Ahora vamos a trasformar los datos es una tabla donde se tenga por cada orden de produccion el estado inicial, el esta final y la cantidad de veces que cambio entre dichos estados para cada periodo de tiempo, este periodo sera de 6 horas.

mi_df <- data.frame(
  "OB" = "",
  "EstadoIni" = "", 
  "EstadoFin" = "", 
  "NroVeces"  = c(0)
  )
nreg=1
resumen=1
Periodo=6
registros=dim.data.frame(Fases)
while(nreg<=registros[1]){
  ob <-Fases$NUMERO_OB[nreg]
  estadoi <- Fases$TDESCFASE[nreg]
  pacum <- 0
  while(ob==Fases$NUMERO_OB[nreg] & nreg<=registros[1]){
    nperiodos=round((Fases$Acumulado[nreg]-pacum)/Periodo,0)
    if(nperiodos>=1){
      temp <- data.frame(
        OB= ob,
        EstadoIni= estadoi,
        EstadoFin= Fases$TDESCFASE[nreg],
        NroVeces= 1  
      ) 
      temp1 <- data.frame(
        OB= ob,
        EstadoIni= Fases$TDESCFASE[nreg],
        EstadoFin= Fases$TDESCFASE[nreg],
        NroVeces= nperiodos-1  
      )
      mi_df <- rbind(mi_df,temp)
      mi_df <- rbind(mi_df,temp1)
      estadoi<-Fases$TDESCFASE[nreg]
      pacum <- Fases$Acumulado[nreg]
    }
    nreg<-nreg+1
  }
}

head(mi_df)

NA
NA
NA

Como siguiente paso vamos a totalizar y quedarnos con la matriz de totales

# Elimino primera fila de creacion 
mi_df <- mi_df[-1,]

#Construyo Tabla dinamica

TD_mi_df <- dcast(mi_df,EstadoIni~EstadoFin,value.var="NroVeces",margins=TRUE)

Aggregation function missing: defaulting to length

head((TD_mi_df),dim(TD_mi_df)[1])

NA
NA
NA

Ahora vamos a convertirlo en una matriz de estados con sus porcentajes de probabilidad

# Elimino primera fila de creacion 
mi_df <- mi_df[-1,]

#Construyo Tabla dinamica

TD_mi_df <- dcast(mi_df,EstadoIni~EstadoFin,value.var="NroVeces",margins=TRUE)

Aggregation function missing: defaulting to length

TD_mi_df1 <- TD_mi_df[,]/TD_mi_df$`(all)` 

Warning in Ops.factor(left, right) : ‘/’ not meaningful for factors

TD_mi_df1 <- TD_mi_df1[,-1]
TD_mi_df1 <- TD_mi_df1[,-10]
TD_mi_df1 <- TD_mi_df1[-10,]
titulos<- TD_mi_df$EstadoIni
rownames(TD_mi_df1) <- titulos[-10]

MMarkov1 <- as.matrix(TD_mi_df1 )
head(MMarkov1,dim(MMarkov1)[1])

                Abrir      Acabar    C Color   Despachar   Preparar     Pruebas
Abrir     0.500000000 0.117486339 0.09562842 0.000000000 0.00000000 0.008196721
Acabar    0.000000000 0.535809019 0.00000000 0.454907162 0.00265252 0.000000000
C Color   0.077348066 0.301104972 0.50276243 0.000000000 0.00000000 0.000000000
Despachar 0.000000000 0.000000000 0.00000000 1.000000000 0.00000000 0.000000000
Preparar  0.007832898 0.010443864 0.00000000 0.000000000 0.01566580 0.000000000
Pruebas   0.000000000 0.111111111 0.22222222 0.000000000 0.00000000 0.555555556
Rechazos  0.000000000 0.285714286 0.00000000 0.000000000 0.11428571 0.028571429
Secar     0.000000000 0.371376812 0.10326087 0.009057971 0.00000000 0.005434783
Te¤ir     0.203480589 0.001338688 0.11244980 0.000000000 0.00000000 0.001338688
             Rechazos      Secar     Te¤ir
Abrir     0.013661202 0.26502732 0.0000000
Acabar    0.006631300 0.00000000 0.0000000
C Color   0.000000000 0.11878453 0.0000000
Despachar 0.000000000 0.00000000 0.0000000
Preparar  0.000000000 0.00000000 0.9660574
Pruebas   0.111111111 0.00000000 0.0000000
Rechazos  0.514285714 0.05714286 0.0000000
Secar     0.007246377 0.50362319 0.0000000
Te¤ir     0.002677376 0.17670683 0.5020080

Ahora vamos a aplicar las funciones del r para convertirlo en una Matriz de Markov y graficarlo

CadenaTinto = new("markovchain",transitionMatrix=MMarkov1,name="CadenaTinto") 

#Diujamos la Cadena
MMarkov1

                Abrir      Acabar    C Color   Despachar   Preparar     Pruebas
Abrir     0.500000000 0.117486339 0.09562842 0.000000000 0.00000000 0.008196721
Acabar    0.000000000 0.535809019 0.00000000 0.454907162 0.00265252 0.000000000
C Color   0.077348066 0.301104972 0.50276243 0.000000000 0.00000000 0.000000000
Despachar 0.000000000 0.000000000 0.00000000 1.000000000 0.00000000 0.000000000
Preparar  0.007832898 0.010443864 0.00000000 0.000000000 0.01566580 0.000000000
Pruebas   0.000000000 0.111111111 0.22222222 0.000000000 0.00000000 0.555555556
Rechazos  0.000000000 0.285714286 0.00000000 0.000000000 0.11428571 0.028571429
Secar     0.000000000 0.371376812 0.10326087 0.009057971 0.00000000 0.005434783
Te¤ir     0.203480589 0.001338688 0.11244980 0.000000000 0.00000000 0.001338688
             Rechazos      Secar     Te¤ir
Abrir     0.013661202 0.26502732 0.0000000
Acabar    0.006631300 0.00000000 0.0000000
C Color   0.000000000 0.11878453 0.0000000
Despachar 0.000000000 0.00000000 0.0000000
Preparar  0.000000000 0.00000000 0.9660574
Pruebas   0.111111111 0.00000000 0.0000000
Rechazos  0.514285714 0.05714286 0.0000000
Secar     0.007246377 0.50362319 0.0000000
Te¤ir     0.002677376 0.17670683 0.5020080

titulos

 [1] Abrir     Acabar    C Color   Despachar Preparar  Pruebas   Rechazos  Secar    
 [9] Te¤ir     (all)    
Levels: Abrir Acabar C Color Despachar Preparar Pruebas Rechazos Secar Te¤ir (all)

plot(CadenaTinto)

NA
NA
NA
NA

Vamos a calcular algunas caracteristicas y formulas con esta matriz

1.- Clases

#Clases
print("Clases Recurrentes")

[1] "Clases Recurrentes"

cP <- recurrentClasses(CadenaTinto)
cP

[[1]]
[1] "Despachar"

print("Clases Trascientes")

[1] "Clases Trascientes"

cT <- transientStates(CadenaTinto)
cT

[1] "Abrir"    "Acabar"   "C Color"  "Preparar" "Pruebas"  "Rechazos" "Secar"    "Te¤ir"   

print("Clases Absorventes")

[1] "Clases Absorventes"

cA <- absorbingStates(CadenaTinto)
cA

[1] "Despachar"

nP <- max(dim.data.frame(recurrentClasses(CadenaTinto)))
nT <- max(dim.data.frame(transientStates(CadenaTinto)))
nA <- max(dim.data.frame(absorbingStates(CadenaTinto)))

Ahora vamos a determinar la Matriz Probabilidades de Transición y vamos a prostrar cual es la probabilidad de que una partida que esta en el estado de Teñir pase al estado de Rechazo

Posición inicial 9(Teñir) a Posición final 7(Rechazo)

#Probabilidades de Transicion


CadenaTinto[9,7]

[1] 0.002677376

Es decir lo probabilidad que una orden despues de teñirse vaya a un estado de rechazo (no conformidad) es de 0.26%

Ahora vamos a determinar en que posicion se va a encontrar una orden de produccion des pues de 1 dia es decir 4 pasos, porque hemos defínido que cada período sea de 6 horas.

Calcular la matriz de 4 pasos

#Matriz de transicion de n pasos

n <- 4 # El número de pasos al futuro
head(CadenaTinto ^ n,dim(CadenaTinto)[1])

                Abrir     Acabar      C Color  Despachar    Preparar      Pruebas
Abrir     0.078752782 0.30917068 0.0983947380 0.31834769 0.002857574 0.0083755265
Acabar    0.001014114 0.08634213 0.0008021036 0.90157487 0.001073416 0.0003449023
C Color   0.042406322 0.28547432 0.0990795996 0.46178773 0.001686244 0.0025870569
Despachar 0.000000000 0.00000000 0.0000000000 1.00000000 0.000000000 0.0000000000
Preparar  0.167897105 0.22982305 0.1489496770 0.06970441 0.001136035 0.0058444666
Pruebas   0.031004781 0.27535036 0.1458835824 0.27502856 0.012157614 0.1016584676
Rechazos  0.038197633 0.23229943 0.0435109672 0.40766852 0.017847898 0.0189359794
Secar     0.012821151 0.27834185 0.0593653434 0.54109751 0.002232391 0.0040703496
Te¤ir     0.122104321 0.28326706 0.1326350439 0.16916677 0.001799519 0.0064453185
             Rechazos      Secar       Te¤ir
Abrir     0.015631218 0.16495453 0.003515257
Acabar    0.003943398 0.00163932 0.003265745
C Color   0.007643560 0.09756593 0.001769238
Despachar 0.000000000 0.00000000 0.000000000
Preparar  0.010171196 0.23998010 0.126493948
Pruebas   0.072716771 0.06593290 0.020266962
Rechazos  0.080452636 0.07195378 0.089133151
Secar     0.009792790 0.08914316 0.003135453
Te¤ir     0.011855076 0.20797383 0.064753067

De esta tabla podemos determinar que una orden que esta por Acabar tiene una probalididad de 90.15% de estar en 24 horas en Despachar.

Ahora vamos a calcular los tiempos de ciclo.

Forma canonica Matriz P,Q,R e indentidad

CadenaTintoCanonica <- canonicForm(CadenaTinto)
head(CadenaTintoCanonica)

          Despachar       Abrir     Acabar    C Color   Preparar     Pruebas  Rechazos
Despachar 1.0000000 0.000000000 0.00000000 0.00000000 0.00000000 0.000000000 0.0000000
Abrir     0.0000000 0.500000000 0.11748634 0.09562842 0.00000000 0.008196721 0.0136612
Acabar    0.4549072 0.000000000 0.53580902 0.00000000 0.00265252 0.000000000 0.0066313
C Color   0.0000000 0.077348066 0.30110497 0.50276243 0.00000000 0.000000000 0.0000000
Preparar  0.0000000 0.007832898 0.01044386 0.00000000 0.01566580 0.000000000 0.0000000
Pruebas   0.0000000 0.000000000 0.11111111 0.22222222 0.00000000 0.555555556 0.1111111
              Secar     Te¤ir
Despachar 0.0000000 0.0000000
Abrir     0.2650273 0.0000000
Acabar    0.0000000 0.0000000
C Color   0.1187845 0.0000000
Preparar  0.0000000 0.9660574
Pruebas   0.0000000 0.0000000

P <-  as.matrix(CadenaTintoCanonica[1:nP,1:nP])
i <- nP+1
j <- nP+nT
R <-  as.matrix(CadenaTintoCanonica[i:j,1:nP])
Q <-  as.matrix(CadenaTintoCanonica[i:j,i:j])
I <-  diag(j-i+1)

print("Matriz P")

[1] "Matriz P"

head(P,dim(P)[1])

     [,1]
[1,]    1

print("Matriz R")

[1] "Matriz R"

head(R,dim(R)[1])

                [,1]
Abrir    0.000000000
Acabar   0.454907162
C Color  0.000000000
Preparar 0.000000000
Pruebas  0.000000000
Rechazos 0.000000000
Secar    0.009057971
Te¤ir    0.000000000

print("Matriz Q")

[1] "Matriz Q"

head(Q,dim(Q)[1])

               Abrir      Acabar    C Color   Preparar     Pruebas    Rechazos      Secar
Abrir    0.500000000 0.117486339 0.09562842 0.00000000 0.008196721 0.013661202 0.26502732
Acabar   0.000000000 0.535809019 0.00000000 0.00265252 0.000000000 0.006631300 0.00000000
C Color  0.077348066 0.301104972 0.50276243 0.00000000 0.000000000 0.000000000 0.11878453
Preparar 0.007832898 0.010443864 0.00000000 0.01566580 0.000000000 0.000000000 0.00000000
Pruebas  0.000000000 0.111111111 0.22222222 0.00000000 0.555555556 0.111111111 0.00000000
Rechazos 0.000000000 0.285714286 0.00000000 0.11428571 0.028571429 0.514285714 0.05714286
Secar    0.000000000 0.371376812 0.10326087 0.00000000 0.005434783 0.007246377 0.50362319
Te¤ir    0.203480589 0.001338688 0.11244980 0.00000000 0.001338688 0.002677376 0.17670683
             Te¤ir
Abrir    0.0000000
Acabar   0.0000000
C Color  0.0000000
Preparar 0.9660574
Pruebas  0.0000000
Rechazos 0.0000000
Secar    0.0000000
Te¤ir    0.5020080

print("Matriz Identidad")

[1] "Matriz Identidad"

head(I,dim(I)[1])

     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
[1,]    1    0    0    0    0    0    0    0
[2,]    0    1    0    0    0    0    0    0
[3,]    0    0    1    0    0    0    0    0
[4,]    0    0    0    1    0    0    0    0
[5,]    0    0    0    0    1    0    0    0
[6,]    0    0    0    0    0    1    0    0
[7,]    0    0    0    0    0    0    1    0
[8,]    0    0    0    0    0    0    0    1

Ahora vamos a deterinar cuantas visitas van a realizarse entre los estados transitorios antes de llegar al estado absorvente final.

[uij] = M = [I − Q]^−1

M <- solve((I-Q)) # Esta funcion invierte a una matirz

head(M,dim(M)[1])

               Abrir   Acabar    C Color    Preparar     Pruebas   Rechazos      Secar
Abrir    2.128421050 2.171606 0.72459988 0.020280213 0.063723886 0.12426994 1.33812470
Acabar   0.009350673 2.197897 0.01076773 0.009544952 0.002450874 0.03119775 0.01775246
C Color  0.357757477 2.183437 2.24846999 0.012330728 0.019337322 0.05552705 0.74398890
Preparar 0.982529469 2.168728 0.97211400 1.033553625 0.048820625 0.10158392 1.48268536
Pruebas  0.246600242 2.187522 1.21815075 0.072232908 2.298289616 0.57136518 0.53883209
Rechazos 0.261535342 2.185316 0.36489528 0.254725224 0.152032947 2.14320886 0.64959809
Secar    0.087937979 2.154484 0.49446791 0.014215936 0.033239625 0.07243617 2.19803471
Te¤ir    0.983759308 2.168389 0.98451380 0.017704584 0.049201082 0.10216091 1.49969458
              Te¤ir
Abrir    0.03934170
Acabar   0.01851631
C Color  0.02392045
Preparar 2.00499654
Pruebas  0.14012503
Rechazos 0.49414291
Secar    0.02757757
Te¤ir    2.04240974

Ahora podemos determinar que desde Abrir (1) hasta Acabar (2) pasan 2.17 pasos es decir 2.17*6 horas lo que nos da 13 horas aproximadamente.

Pero como este dato es una Esperanza tiene una Varianza la cual vamos a pasar a calcular.

[V(Nij)] = M (2MD – I) - M2

k <-dim(M)
I <- diag(k[1])
MD <- diag(k[1])
for(m in 1:k[1]) {
  MD[m,m] <- diag(M)[m]
}  
M2 <- diag(k[1])
for(m in 1:k[1]) {
  for(n in 1:k[1]){
    M2[m,n] <- M[m,n]^2
  }
}
  
Varianza <- M %*% (2*MD-I)-M2
head(Varianza,dim(Varianza)[1])

               [,1]     [,2]       [,3]       [,4]        [,5]      [,6]       [,7]
Abrir    2.40175511 2.658455 2.00883731 0.02122988 0.225127270 0.3929599 2.75378666
Acabar   0.03036623 2.632855 0.03753815 0.01009438 0.008808757 0.1015555 0.05997344
C Color  1.03716920 2.647107 2.80714732 0.01300616 0.069174279 0.1794018 1.97311847
Preparar 2.23457918 2.661174 2.45441869 0.03467947 0.173203792 0.3235279 2.83694653
Pruebas  0.74232637 2.643123 2.77590882 0.07186267 2.983845545 1.5512865 1.53957116
Rechazos 0.78337858 2.645278 1.14286834 0.20693419 0.523684525 2.4501354 1.78410253
Secar    0.27866702 2.674383 1.48462609 0.01496784 0.118444072 0.2328085 2.63332188
Te¤ir    2.23616635 2.661492 2.47351826 0.01857924 0.174534843 0.3253066 2.84398307
               [,8]
Abrir    0.11981428
Acabar   0.05677661
C Color  0.07321808
Preparar 2.16504126
Pruebas  0.41262539
Rechazos 1.28016445
Secar    0.08431132
Te¤ir    2.12902781

Ahora podemos decir que la Varianza para el caso anterior es de 2.65*6 horas que nos da aproximadamente 16 horas y pdriamos decir que la desviacion aproximadamente de 4 horas.

Ahora vamos a caluclar cual es la priobabilida de que unaorden se despache es decir llegue de un estado transitorio a un estado absorvente (Despachar)

Probabilidad de que el proceso partiendo de i ∈ T entre a j ∈C F = [fij] = M R = [I – Q]-1 R

F <- M %*% R
head(F,dim(F)[1])

         [,1]
Abrir       1
Acabar      1
C Color     1
Preparar    1
Pruebas     1
Rechazos    1
Secar       1
Te¤ir       1

Como vemos cualquier proceso que inicia siempre va a tener la probabilida de 100% de terminar.

Ahora vamos a calcular cual es el tiempo esperado de que una orden de produccion que se encuentre en en un determinado estado llegue al estado absorvente (Despachar) esto nos dara el tiempo medio de ciclo total.

[E(Ni)] = Mp = [∑j∈T uij] i ∈ T

Mp <- (rep(0,dim(M)[1]))
for( i in 1:dim(M)[1]){
  for(j in 1:dim(M)[1]){
     Mp[j] <- Mp[j]+M[j,i]  
  }
}

Mp

[1] 6.610368 2.297478 5.644769 8.795011 7.273117 6.505455 5.082394 7.847833

Podemos decir que cuando una orden parte de Preparar (4) se demora 8.79*6 horas en terminar su ciclo es decir 2.2 dias

7. Conclusiones y Recomendaciones La principal conclusion es que las Cadenas de Markov aplicada al proceso de Tintoreria nos permite concocer de una manera bastante agil y clara los diferentes tiempos de ciclo que podemos tener en los diferentes proceso productivos de Industrias Nettalco, el cual es el punto de partida para poder encontrar cuales son los principales “Cuellos de Botella” y realizar planes de accion para corregirlos.

8. Bibliografía

“Cadenas de Markoc en R” http://rstudio-pubs-static.s3.amazonaws.com/409332_c1c431cbf42a403a9f5d2f5e48bcfec1.html

The markovchain Package: A Package for Easily Handling Discrete Markov Chains in R (Giorgio Alfredo Spedicato, Tae Seung Kang, Sai Bhargav Yalamanchi, Deepak Yadav, Ignacio Cord´on)