Complementaria

#Complementaria 2- 202320
# Matrices ----------------------------------------------------------------

#Crear matrices: matrix
mat = matrix(c(1,4,1,3,2,4,4,0,3,2,1,1),nrow=3,ncol=3,byrow = TRUE)

#Forma 2: cbind
a = 1:4
b = rep(c(4,2),each = 2)
c = c(1,4,1,2)
d = b - c
mat1 = cbind(a,b,c,d)


mat[,3]
## [1] 1 4 3
#Operaciones entre matrices

A = matrix(rnorm(n = 36,mean = 20,sd = 8),nrow=6,ncol=6)
B = matrix(rnorm(n = 36,mean = 10,sd = 3),nrow=6,ncol=6)

colSums(A%*%B)
## [1] 6983.065 7359.757 6280.652 6841.925 6093.466 5680.505
rowSums(A+B)
## [1] 167.2319 186.3011 169.2944 169.9293 129.4670 192.3511
solve(A)
##            [,1]        [,2]          [,3]        [,4]        [,5]        [,6]
## [1,]  0.1886110 -0.02728576 -1.254763e-05 -0.13056121  0.12143469 -0.06216146
## [2,]  0.1162323 -0.04822656  5.601933e-02 -0.08524534  0.13231316 -0.08179193
## [3,]  0.1514030  0.02992054  4.608225e-02 -0.15707481  0.11724648 -0.10268451
## [4,] -0.8719283 -0.14672235  1.522591e-02  0.87030266 -0.90218382  0.55944620
## [5,]  0.3133834  0.14019173 -5.005226e-02 -0.39918294  0.37881917 -0.19739418
## [6,] -0.1498963  0.01475765 -4.397028e-02  0.18304747 -0.09865536  0.03749316
t(A)
##           [,1]     [,2]     [,3]     [,4]      [,5]     [,6]
## [1,] 28.031123 23.23730 14.88711 25.28709 12.874823 30.80176
## [2,]  7.012917 13.09621 21.62290 17.20979 22.366527 23.07287
## [3,] 18.135433 26.87397 23.30809 17.09594  2.245066 11.70397
## [4,] 11.516480 17.34508 15.54212 13.67307 11.685743 21.43690
## [5,] 14.418044 26.38763 20.43245 19.10013 20.766468 32.61141
## [6,] 15.508703 20.81170 11.35212 22.82823 11.252405 11.95369
A+B
##          [,1]     [,2]     [,3]     [,4]     [,5]     [,6]
## [1,] 42.65724 20.10208 28.50019 25.38498 24.78287 25.80458
## [2,] 31.08411 26.84500 34.16060 25.20583 38.10027 30.90529
## [3,] 27.85155 32.28144 33.44514 26.12960 28.54831 21.03834
## [4,] 31.31427 28.39459 27.60171 23.85098 29.72349 29.04426
## [5,] 22.79827 33.12550 10.30993 18.89270 28.32893 16.01170
## [6,] 41.71832 29.88444 23.18470 34.28127 39.90991 23.37242
A%*%B
##           [,1]      [,2]      [,3]      [,4]      [,5]      [,6]
## [1,] 1081.9217 1046.1916  940.7963 1056.2084  864.4321  852.3505
## [2,] 1384.6316 1390.3163 1242.6685 1343.7646 1148.0599 1102.7906
## [3,] 1109.9495 1211.5720 1006.5320 1074.4610  999.2115  920.7769
## [4,] 1247.6883 1263.7427 1120.5690 1237.0102 1058.7265 1036.2212
## [5,]  792.2653  930.7376  738.6115  791.2714  776.9503  680.0232
## [6,] 1366.6090 1517.1965 1231.4745 1339.2094 1246.0855 1088.3420
diag(A)
## [1] 28.03112 13.09621 23.30809 13.67307 20.76647 11.95369
# Ejercicio 1 -------------------------------------------------------------

#Definir espacio de estados
estados<-c(1:5)

#Crear matriz P vacia
matP<-matrix(0, nrow=length(estados),ncol=length(estados),dimnames=list(estados,estados))

#Llenar matriz P con las probabilidades de transicion

for(i in estados){
  for(j in estados){
    
    #Aumenta nivel de ica y no etamos en 5
    if(j==i+1 & i<5){
      matP[i,j]<-0.5
    }
    
    #Dsiminuye nivel ica y no estamos en 1
    if(j==i-1 & i>1){
      matP[i,j]<-0.2
    }
    
    #Mantiene ICA y esta entre 1 y 5 
    if(j==i & i<5 & i>1){
      matP[i,j]<-0.3
    }
    
    #Mantiene ICA y esta en nivel 1
    if(j==i & i==1){
      matP[i,j]<-0.5
    }
    
    #Mantiene ICA y esta en nivel 5
    if(j==i & i==5){
      matP[i,j]<-0.8
    }
    
  }
}
matP
##     1   2   3   4   5
## 1 0.5 0.5 0.0 0.0 0.0
## 2 0.2 0.3 0.5 0.0 0.0
## 3 0.0 0.2 0.3 0.5 0.0
## 4 0.0 0.0 0.2 0.3 0.5
## 5 0.0 0.0 0.0 0.2 0.8
rowSums(matP)
## 1 2 3 4 5 
## 1 1 1 1 1
#Obtener valores de matrices
matP[1,1]
## [1] 0.5
matP[1,]
##   1   2   3   4   5 
## 0.5 0.5 0.0 0.0 0.0
matP[,]
##     1   2   3   4   5
## 1 0.5 0.5 0.0 0.0 0.0
## 2 0.2 0.3 0.5 0.0 0.0
## 3 0.0 0.2 0.3 0.5 0.0
## 4 0.0 0.0 0.2 0.3 0.5
## 5 0.0 0.0 0.0 0.2 0.8
matP[1,2:4]
##   2   3   4 
## 0.5 0.0 0.0
matP["1","2"]
## [1] 0.5
#Operaciones matriciales
matP+matP
##     1   2   3   4   5
## 1 1.0 1.0 0.0 0.0 0.0
## 2 0.4 0.6 1.0 0.0 0.0
## 3 0.0 0.4 0.6 1.0 0.0
## 4 0.0 0.0 0.4 0.6 1.0
## 5 0.0 0.0 0.0 0.4 1.6
matP%*%matP #Producto matricial
##      1    2    3    4    5
## 1 0.35 0.40 0.25 0.00 0.00
## 2 0.16 0.29 0.30 0.25 0.00
## 3 0.04 0.12 0.29 0.30 0.25
## 4 0.00 0.04 0.12 0.29 0.55
## 5 0.00 0.00 0.04 0.22 0.74
diag(matP)
##   1   2   3   4   5 
## 0.5 0.3 0.3 0.3 0.8
colSums(matP)
##   1   2   3   4   5 
## 0.7 1.0 1.0 1.0 1.3
library(markovchain)
## Package:  markovchain
## Version:  0.8.6
## Date:     2021-05-17
## BugReport: https://github.com/spedygiorgio/markovchain/issues
cadena<-new(Class = "markovchain",states=as.character(estados),transitionMatrix=matP)

cadena
## Unnamed Markov chain 
##  A  5 - dimensional discrete Markov Chain defined by the following states: 
##  1, 2, 3, 4, 5 
##  The transition matrix  (by rows)  is defined as follows: 
##     1   2   3   4   5
## 1 0.5 0.5 0.0 0.0 0.0
## 2 0.2 0.3 0.5 0.0 0.0
## 3 0.0 0.2 0.3 0.5 0.0
## 4 0.0 0.0 0.2 0.3 0.5
## 5 0.0 0.0 0.0 0.2 0.8
# Ejercicio 2 ---------------------------------------------------------------

estadosDias<-c(1:7) #Estados de los dias de la semana
estadosICA<-c(1:5) #Estados del ICA

#Estados conjuntos> combinaciones
estadosC<-as.vector(outer(estadosICA,estadosDias,paste,sep=","))
estadosC
##  [1] "1,1" "2,1" "3,1" "4,1" "5,1" "1,2" "2,2" "3,2" "4,2" "5,2" "1,3" "2,3"
## [13] "3,3" "4,3" "5,3" "1,4" "2,4" "3,4" "4,4" "5,4" "1,5" "2,5" "3,5" "4,5"
## [25] "5,5" "1,6" "2,6" "3,6" "4,6" "5,6" "1,7" "2,7" "3,7" "4,7" "5,7"
#Crear matriz de transiciones de probabilidad
matrizP<-matrix(0, nrow=length(estadosC),ncol=length(estadosC), dimnames = list(estadosC,estadosC))
matrizP
##     1,1 2,1 3,1 4,1 5,1 1,2 2,2 3,2 4,2 5,2 1,3 2,3 3,3 4,3 5,3 1,4 2,4 3,4 4,4
## 1,1   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 2,1   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 3,1   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 4,1   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 5,1   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 1,2   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 2,2   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 3,2   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 4,2   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 5,2   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 1,3   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 2,3   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 3,3   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 4,3   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 5,3   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 1,4   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 2,4   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 3,4   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 4,4   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 5,4   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 1,5   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 2,5   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 3,5   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 4,5   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 5,5   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 1,6   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 2,6   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 3,6   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 4,6   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 5,6   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 1,7   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 2,7   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 3,7   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 4,7   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 5,7   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
##     5,4 1,5 2,5 3,5 4,5 5,5 1,6 2,6 3,6 4,6 5,6 1,7 2,7 3,7 4,7 5,7
## 1,1   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 2,1   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 3,1   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 4,1   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 5,1   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 1,2   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 2,2   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 3,2   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 4,2   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 5,2   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 1,3   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 2,3   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 3,3   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 4,3   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 5,3   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 1,4   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 2,4   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 3,4   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 4,4   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 5,4   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 1,5   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 2,5   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 3,5   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 4,5   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 5,5   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 1,6   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 2,6   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 3,6   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 4,6   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 5,6   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 1,7   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 2,7   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 3,7   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 4,7   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
## 5,7   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0
for (filas in estadosC) {
  for(columnas in estadosC){
    
    #Nivel ica en n
    i<-as.numeric(unlist(strsplit(filas,","))[1])
    #Dia semana en n
    j<-as.numeric(unlist(strsplit(filas,","))[2])
    
    #Nivel ica en n+1
    iprima<-as.numeric(unlist(strsplit(columnas, ","))[1])
    #Dia semana en n+1
    jprima<-as.numeric(unlist(strsplit(columnas,","))[2])
    
    #Aumenta
    #Aumenta y entre semana
    if(iprima==i+1 & i<5 & jprima==j+1 & j<=5){
      matrizP[filas, columnas]<-0.5
    }
    
    #AUmenta y sabado
    if(iprima==i+1 & i<5 & jprima==j+1 & j==6){
      matrizP[filas, columnas]<-0.1
    }
    
    #Aumenta y domingo
    if(iprima==i+1 & i<5 & jprima==1 & j==7){
      matrizP[filas, columnas]<-0.1
    }
    
    #Disminuye
    #Disminuye y entre semana
    if(iprima==i-1 & i>1 & jprima==j+1 & j<=5){
      matrizP[filas, columnas]<-0.2
    }
    
    #Disminuye y sabado
    if(iprima==i-1 & i>1 & jprima==j+1 & j==6){
      matrizP[filas, columnas]<-0.6
    }
    
    #Disminuye y domingo
    if(iprima==i-1 & i>1 & jprima==1 & j==7){
      matrizP[filas, columnas]<-0.6
    }
    
    #Manriene y esta entre 2 y 4
    #Mantiene y entre semana
    if(iprima==i & i>1 & i<5 & jprima==j+1 & j<=5){
      matrizP[filas, columnas]<-0.3
    }
    
    #Mantiene y sabado
    if(iprima==i & i>1 & i<5 & jprima==j+1 & j==6){
      matrizP[filas, columnas]<-0.3
    }
    
    #Mantiene y domingo
    if(iprima==i & i>1 & i<5 & jprima==1 & j==7){
      matrizP[filas, columnas]<-0.3
    }
    
    #Manriene y esta en 1 ICA
    #Mantiene y entre semana
    if(iprima==i & i==1 & jprima==j+1 & j<=5){
      matrizP[filas, columnas]<-0.5
    }
    
    #Mantiene y sabado
    if(iprima==i & i==1 & jprima==j+1 & j==6){
      matrizP[filas, columnas]<-0.9
    }
    
    #Mantiene y domingo
    if(iprima==i & i==1 & jprima==1 & j==7){
      matrizP[filas, columnas]<-0.9
    }
    
    #Manriene y esta en 5 ICA
    #Mantiene y entre semana
    if(iprima==i & i==5 & jprima==j+1 & j<=5){
      matrizP[filas, columnas]<-0.8
    }
    
    #Mantiene y sabado
    if(iprima==i & i==5 & jprima==j+1 & j==6){
      matrizP[filas, columnas]<-0.4
    }
    
    #Mantiene y domingo
    if(iprima==i & i==5 & jprima==1 & j==7){
      matrizP[filas, columnas]<-0.5
    }
    
  }
}

rowSums(matrizP)
## 1,1 2,1 3,1 4,1 5,1 1,2 2,2 3,2 4,2 5,2 1,3 2,3 3,3 4,3 5,3 1,4 2,4 3,4 4,4 5,4 
## 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 
## 1,5 2,5 3,5 4,5 5,5 1,6 2,6 3,6 4,6 5,6 1,7 2,7 3,7 4,7 5,7 
## 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.1