R Complementaria 2
library(markovchain)
## Package: markovchain
## Version: 0.8.6
## Date: 2021-05-17
## BugReport: https://github.com/spedygiorgio/markovchain/issues
#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
# Literal B ---------------------------------------------------------------
alpha<-c(0,1,0,0,0)
cadenita<-new(Class = "markovchain",states=as.character(estados),transitionMatrix=matP)
#Probabilidad en 4 pasos
probaViernes<-alpha*(cadenita^4)
probaViernes
## 1 2 3 4 5
## [1,] 0.1144 0.1941 0.244 0.235 0.2125
respuesta<-probaViernes[4]+probaViernes[5]
respuesta
## [1] 0.4475
# Literal C ---------------------------------------------------------------
probaLunes<-alpha[5]
probaMartes<-alpha*(cadenita)
probaMiercoles<-alpha*(cadenita^2)
probaJueves<-alpha*(cadenita^3)
probaViernes<-alpha*(cadenita^4)
gasto<-120*(probaMartes[5]+probaMiercoles[5]+probaJueves[5]+probaViernes[5])
gasto
## [1] 40.5
# Problema 2 --------------------------------------------------------------
estados2<-c(0:15)
matQ<-matrix(0,nrow = length(estados2),ncol=length(estados2),dimnames=list(estados2,estados2))
for(i in estados2){
for(j in estados2){
#llegadas de usuarios
if(j==i+1 & i<15){
matQ[i+1,j+1]<-5
}
#Salidas de usuarios
if(j==i-1 & i>0){
matQ[i+1,j+1]<-9*i
}
}
}
diag(matQ)<-(-rowSums(matQ))
rowSums(matQ)
## 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
## 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
cadenota<-new(Class = "ctmc",states=as.character(estados2),generator=matQ)
# Literal B ---------------------------------------------------------------
library(expm)
## Loading required package: Matrix
## Warning: package 'Matrix' was built under R version 4.1.3
##
## Attaching package: 'expm'
## The following object is masked from 'package:Matrix':
##
## expm
#Definir vector de probabilidades iniciales
alpha2<-rep(0,length(estados2))
names(alpha2)<-estados2
alpha2["10"]<-1
alpha2
## 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
## 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0
probaTransitorio<-alpha2%*%expm(matQ*96)
valor<-sum(probaTransitorio*(15-estados2))
valor
## [1] 14.44444
# Problema 3 --------------------------------------------------------------
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