markovchain/0000755000176200001440000000000014715236602012562 5ustar liggesusersmarkovchain/tests/0000755000176200001440000000000014714756746013743 5ustar liggesusersmarkovchain/tests/testthat/0000755000176200001440000000000014715236602015564 5ustar liggesusersmarkovchain/tests/testthat/testFits.R0000644000176200001440000000165214714756746017537 0ustar liggesuserscontext("Checking that fitting works") #load & prepare data data(rain) data(holson) myHolson<-as.matrix(holson[,-1]); rownames(myHolson)<-holson$id test_that("Check createSequenceMatrix", { expect_equal(createSequenceMatrix(rain$rain), checksAlofiRawTransitions) }) #data preparation ciao<-c("a","a","b","b","a",NA,"b","a","b","a","a") test_that("Check markovchainFit & listFit", { expect_equal(markovchainFit(ciao), simpleMcCiaoFit) expect_equal(markovchainListFit(data=myHolson), checkmarkovchainFitList) }) #### tests for noofVisitsDist function transMatr<-matrix(c(0.4,0.6,.3,.7),nrow=2,byrow=TRUE) simpleMc<-new("markovchain", states=c("a","b"), transitionMatrix=transMatr, name="simpleMc") answer <- c(0.348148, 0.651852) names(answer) <- c("a","b") test_that("Check noofVisitsDist works", { expect_equal(noofVisitsDist(simpleMc,5,"a"),answer) }) markovchain/tests/testthat/testPeriod.R0000644000176200001440000000302614714756746020051 0ustar liggesusers# Period examples from http://www.math.wisc.edu/~anderson/605F11/Notes/StochBioChapter3.pdf #library(markovchain) mcPeriodic<-new("markovchain", states=c("0","1","2"), transitionMatrix= matrix(c(0,1,0, 0,0,1, 1,0,0),nrow=3, byrow=TRUE, dimnames=list(c("0","1","2"), c("0","1","2")) )) myMatr<-matrix(c(0 , 0 , 1/2 , 1/4 , 1/4 , 0 , 0, 0 , 0 , 1/3 , 0 , 2/3, 0 , 0 , 0 , 0 , 0 , 0 , 0 , 1/3 , 2/3 , 0 , 0 , 0 , 0 , 0 , 1/2 , 1/2 , 0 , 0 , 0 , 0 , 0 , 3/4 , 1/4 , 1/2, 1/2 , 0 , 0 , 0 , 0 , 0 , 1/4, 3/4 , 0 , 0 , 0 , 0 , 0),byrow=TRUE, nrow = 7) mcPeriodic2<-as(myMatr, "markovchain") mcAperiodic<-new("markovchain", states=c("0","1","2","3","4"), transitionMatrix= matrix(c(1/2,1/2,0,0,0, 1/2,0,1/2,0,0, 0,1/2,0,1/2,0, 0,0,1/2,0,1/2, 0,0,0,1,0),nrow=5, byrow=TRUE, dimnames=list(c("0","1","2","3","4"), c("0","1","2","3","4")) )) ####end creating DTMC context("Basic DTMC proprieties") test_that("States are those that should be", { expect_equal(period(mcPeriodic),3) expect_equal(period(mcPeriodic2),3) expect_equal(period(mcAperiodic),1) })markovchain/tests/testthat/testBasic1.R0000644000176200001440000004350414714756746017736 0ustar liggesusers#library(markovchain) #create basic markov chains markov1<-new("markovchain", states=c("a","b","c"), transitionMatrix= matrix(c(0.2,0.5,0.3, 0,1,0, 0.1,0.8,0.1),nrow=3, byrow=TRUE, dimnames=list(c("a","b","c"), c("a","b","c")) )) mathematicaMatr <- markovchain:::zeros(5) mathematicaMatr[1,] <- c(0, 1/3, 0, 2/3, 0) mathematicaMatr[2,] <- c(1/2, 0, 0, 0, 1/2) mathematicaMatr[3,] <- c(0, 0, 1/2, 1/2, 0) mathematicaMatr[4,] <- c(0, 0, 1/2, 1/2, 0) mathematicaMatr[5,] <- c(0, 0, 0, 0, 1) statesNames <- letters[1:5] mathematicaMc <- new("markovchain", transitionMatrix = mathematicaMatr, name = "Mathematica MC", states = statesNames) ####end creating DTMC context("Basic DTMC proprieties") test_that("States are those that should be", { expect_equal(absorbingStates(markov1), "b") expect_equal(transientStates(markov1), c("a","c")) expect_equal(is.irreducible(mathematicaMc),FALSE) expect_equal(transientStates(mathematicaMc), c("a","b")) expect_equal(is.accessible(mathematicaMc, "a", "c"),TRUE) expect_equal(canonicForm(mathematicaMc)@transitionMatrix, markovchain:::.canonicFormRcpp(mathematicaMc)@transitionMatrix) expect_equal(recurrentClasses(mathematicaMc), list(c("c", "d"), c("e"))) expect_equal(summary(mathematicaMc), list(closedClasses = list(c("c", "d"), c("e")), recurrentClasses = list(c("c", "d"), c("e")), transientClasses = list(c("a", "b")))) }) ###testing proper conversion of objects context("Conversion of objects") provaMatr2Mc<-as(mathematicaMatr,"markovchain") test_that("Conversion of objects", { expect_equal(class(provaMatr2Mc)=="markovchain",TRUE) }) ### Markovchain Fitting sequence1 <- c("a", "b", "a", "a", NA, "a", "a", NA) sequence2 <- c(NA, "a", "b", NA, "a", "a", "a", NA, "a", "b", "a", "b", "a", "b", "a", "a", "b", "b", "b", "a", NA) mcFit <- markovchainFit(data = sequence1, byrow = FALSE, sanitize = TRUE) mcFit2 <- markovchainFit(c("a","b","a","b"), sanitize = TRUE) test_that("Fit should satisfy", { expect_equal((mcFit["logLikelihood"])[[1]], log(1/3) + 2*log(2/3)) expect_equal(markovchainFit(data = sequence2, method = "bootstrap")["confidenceInterval"] [[1]]["confidenceLevel"][[1]], 0.95) expect_equal(mcFit2$upperEndpointMatrix, matrix(c(0,1,1,0), nrow = 2, byrow = TRUE, dimnames = list(c("a", "b"), c("a", "b")))) }) ### Markovchain Fitting for bigger markov chain bigseq <- rep(c("a", "b", "c"), 500000) bigmcFit <- markovchainFit(bigseq) test_that("MC Fit for large sequence 1", { expect_equal(bigmcFit$logLikelihood, 0) expect_equal(bigmcFit$confidenceLevel, 0.95) expect_equal(bigmcFit$estimate@transitionMatrix, bigmcFit$upperEndpointMatrix) }) bigmcFit <- markovchainFit(bigseq, sanitize = TRUE) test_that("MC Fit for large sequence 2", { expect_equal(bigmcFit$logLikelihood, 0) expect_equal(bigmcFit$confidenceLevel, 0.95) expect_equal(bigmcFit$estimate@transitionMatrix, bigmcFit$upperEndpointMatrix) }) ### Markovchain Fitting For dataframe or matrix as an input matseq <- matrix(c("a", "b", "c", NA ,"b", "c"), nrow = 2, byrow = T) # for matrix as input test_that("Markovchain Fit for matrix as input", { # for matrix as input expect_equal(markovchainFit(matseq)$estimate@transitionMatrix, matrix(c(0, 1, 0, 0, 0, 1, 0, 0, 0), nrow = 3, byrow = TRUE, dimnames = list(c("a", "b", "c"), c("a", "b", "c")))) expect_equal(markovchainFit(matseq, sanitize = TRUE)$estimate@transitionMatrix, matrix(c(0, 1, 0, 0, 0, 1, 1/3, 1/3, 1/3), nrow = 3, byrow = TRUE, dimnames = list(c("a", "b", "c"), c("a", "b", "c")))) # for data frame as input expect_equal(markovchainFit(as.data.frame(matseq))$estimate@transitionMatrix, matrix(c(0, 1, 0, 0, 0, 1, 0, 0, 0), nrow = 3, byrow = TRUE, dimnames = list(c("a", "b", "c"), c("a", "b", "c")))) expect_equal(markovchainFit(as.data.frame(matseq), sanitize = TRUE)$estimate@transitionMatrix, matrix(c(0, 1, 0, 0, 0, 1, 1/3, 1/3, 1/3), nrow = 3, byrow = TRUE, dimnames = list(c("a", "b", "c"), c("a", "b", "c")))) }) ### Markovchain Fitting(mle) with sanitize parameter mle_sequence <- c("a", "b", NA, "b", "b", "a", "a", "a", "b", "b", NA, "b", "b", "a", "a", "b", "a", "a", "b", "c") mle_fit1 <- markovchainFit(mle_sequence) mle_fit2 <- markovchainFit(mle_sequence, sanitize = TRUE) test_that("MarkovchainFit MLE", { expect_equal(mle_fit1$estimate@transitionMatrix, matrix(c(0.5, 0.5, 0, 3/7, 3/7, 1/7, 0, 0, 0), nrow = 3, byrow = TRUE, dimnames = list(c("a", "b", "c"), c("a", "b", "c")))) expect_equal(mle_fit2$estimate@transitionMatrix, matrix(c(0.5, 0.5, 0, 3/7, 3/7, 1/7, 1/3, 1/3, 1/3), nrow = 3, byrow = TRUE, dimnames = list(c("a", "b", "c"), c("a", "b", "c")))) expect_equal(mle_fit1$logLikelihood, mle_fit2$logLikelihood) expect_equal(mle_fit1$confidenceInterval, mle_fit2$confidenceInterval) expect_equal(mle_fit2$standardError, mle_fit2$standardError) }) ### Markovchain Fitting(laplace) with sanitize parameter lap_sequence <- c("a", "b", NA, "b", "b", "a", "a", "a", "b", "b", NA, "b", "b", "a", "a", "b", "a", "a", "b", "c") lap_fit1 <- markovchainFit(lap_sequence, "laplace") lap_fit2 <- markovchainFit(lap_sequence, "laplace", sanitize = TRUE) test_that("Markovchain Laplace", { expect_equal(lap_fit1$estimate@transitionMatrix, matrix(c(0.5, 0.5, 0, 3/7, 3/7, 1/7, 0, 0, 0), nrow = 3, byrow = TRUE, dimnames = list(c("a", "b", "c"), c("a", "b", "c")))) expect_equal(lap_fit2$estimate@transitionMatrix, matrix(c(0.5, 0.5, 0, 3/7, 3/7, 1/7, 1/3, 1/3, 1/3), nrow = 3, byrow = TRUE, dimnames = list(c("a", "b", "c"), c("a", "b", "c")))) expect_equal(lap_fit1$logLikelihood, lap_fit2$logLikelihood) }) ### Markovchain Fitting when some states are not present in the given sequence mix_seq <- c("a", "b", NA, "b", "b", "a", "a", "a", "b", "b", NA, "b", "b", "a", "a", "b", "a", "a", "b", "c") mix_fit1 <- markovchainFit(mix_seq, "mle", sanitize = TRUE, possibleStates = c("d")) mix_fit2 <- markovchainFit(mix_seq, "laplace", sanitize = TRUE, possibleStates = c("d")) mix_fit3 <- markovchainFit(mix_seq, "map", sanitize = TRUE, possibleStates = c("d")) test_that("Mixture of Markovchain Fitting", { expect_equal(mix_fit2$estimate@transitionMatrix, matrix(c(.5, .5, 0, 0, 3/7, 3/7, 1/7, 0, 1/4, 1/4, 1/4, 1/4, 1/4, 1/4, 1/4, 1/4), nrow = 4, byrow = TRUE, dimnames = list(c("a", "b", "c", "d"), c("a", "b", "c", "d")) ) ) expect_equal(mix_fit1$estimate@transitionMatrix, matrix(c(.5, .5, 0, 0, 3/7, 3/7, 1/7, 0, 1/4, 1/4, 1/4, 1/4, 1/4, 1/4, 1/4, 1/4), nrow = 4, byrow = TRUE, dimnames = list(c("a", "b", "c", "d"), c("a", "b", "c", "d")) ) ) expect_equal(mix_fit3$estimate@transitionMatrix, matrix(c(.5, .5, 0, 0, 3/7, 3/7, 1/7, 0, 1/4, 1/4, 1/4, 1/4, 1/4, 1/4, 1/4, 1/4), nrow = 4, byrow = TRUE, dimnames = list(c("a", "b", "c", "d"), c("a", "b", "c", "d")) ) ) }) ### Test for createSequenceMatrix rsequence <- c("a", "b", NA, "b", "b", "a", "a", "a", "b", "b", NA, "b", "b", "a", "a", "b", "a", "a", "b", "c") test_that("createSequenceMatrix : Permutation of parameters",{ expect_equal(createSequenceMatrix(rsequence, FALSE, FALSE), matrix(c(4, 4, 0, 3, 3, 1, 0, 0, 0), nrow = 3, byrow = TRUE, dimnames = list(c("a", "b", "c"), c("a", "b", "c")))) expect_equal(createSequenceMatrix(rsequence, FALSE, TRUE), matrix(c(4, 4, 0, 3, 3, 1, 1, 1, 1), nrow = 3, byrow = TRUE, dimnames = list(c("a", "b", "c"), c("a", "b", "c")))) expect_equal(createSequenceMatrix(rsequence, TRUE, FALSE), matrix(c(4/8, 4/8, 0, 3/7, 3/7, 1/7, 0, 0, 0), nrow = 3, byrow = TRUE, dimnames = list(c("a", "b", "c"), c("a", "b", "c")))) expect_equal(createSequenceMatrix(rsequence, TRUE, TRUE), matrix(c(4/8, 4/8, 0, 3/7, 3/7, 1/7, 1/3, 1/3, 1/3), nrow = 3, byrow = TRUE, dimnames = list(c("a", "b", "c"), c("a", "b", "c")))) }) ### Test for createSequenceMatrix : input nx2 matrix data <- matrix(c("a", "a", "b", "a", "b", "a", "b", "a", NA, "a", "a", "a", "a", "b", NA, "b"), ncol = 2, byrow = TRUE) test_that("createSequenceMatrix : input as matrix",{ expect_equal(createSequenceMatrix(data), matrix(c(2, 1, 3, 0), nrow = 2, byrow = TRUE, dimnames = list(c("a", "b"), c("a", "b")))) expect_equal(createSequenceMatrix(data, toRowProbs = TRUE), matrix(c(2/3, 1/3, 3/3, 0), nrow = 2, byrow = TRUE, dimnames = list(c("a", "b"), c("a", "b")))) expect_equal(createSequenceMatrix(data, toRowProbs = TRUE, possibleStates = "d", sanitize = TRUE), matrix(c(2/3, 1/3, 0, 1, 0, 0, 1/3, 1/3, 1/3), nrow = 3, byrow = TRUE, dimnames = list(c("a", "b", "d"), c("a", "b", "d")))) }) ### Test for markovchainSequence and rmarkovchain statesNames <- c("a", "b", "c") mcB <- new("markovchain", states = statesNames, transitionMatrix = matrix(c(0.2, 0.5, 0.3, 0, 0.2, 0.8, 0.1, 0.8, 0.1), nrow = 3, byrow = TRUE, dimnames = list(statesNames, statesNames))) s1 <- markovchainSequence(10, mcB) s2 <- markovchainSequence(10, mcB, include.t0 = TRUE) s3 <- markovchainSequence(10, mcB, t0 = "b", include.t0 = TRUE) s4 <- markovchainSequence(10, mcB, useRCpp = FALSE) s5 <- markovchainSequence(10, mcB, include.t0 = TRUE, useRCpp = FALSE) s6 <- markovchainSequence(10, mcB, t0 = "b", include.t0 = TRUE, useRCpp = FALSE) test_that("Output format of markovchainSequence", { expect_equal(length(s1), 10) expect_equal(length(s2), 11) expect_equal(length(s3), 11) expect_equal(s3[1], "b") expect_equal(length(s4), 10) expect_equal(length(s5), 11) expect_equal(length(s6), 11) expect_equal(s6[1], "b") }) statesNames <- c("a", "b", "c") mcA <- new("markovchain", states = statesNames, transitionMatrix = matrix(c(0.2, 0.5, 0.3, 0, 0.2, 0.8, 0.1, 0.8, 0.1), nrow = 3, byrow = TRUE, dimnames = list(statesNames, statesNames))) mcB <- new("markovchain", states = statesNames, transitionMatrix = matrix(c(0.2, 0.5, 0.3, 0, 0.2, 0.8, 0.1, 0.8, 0.1), nrow = 3, byrow = TRUE, dimnames = list(statesNames, statesNames))) mcC <- new("markovchain", states = statesNames, transitionMatrix = matrix(c(0.2, 0.5, 0.3, 0, 0.2, 0.8, 0.1, 0.8, 0.1), nrow = 3, byrow = TRUE, dimnames = list(statesNames, statesNames))) mclist <- new("markovchainList", markovchains = list(mcA, mcB, mcC)) o1 <- rmarkovchain(15, mclist, "list") o2 <- rmarkovchain(15, mclist, "matrix") o3 <- rmarkovchain(15, mclist, "data.frame") o4 <- rmarkovchain(15, mclist, "list", t0 = "a", include.t0 = TRUE) o5 <- rmarkovchain(15, mclist, "matrix", t0 = "a", include.t0 = TRUE) o6 <- rmarkovchain(15, mclist, "data.frame", t0 = "a", include.t0 = TRUE) test_that("Output format of rmarkovchain", { expect_equal(length(o1), 15) expect_equal(length(o1[[1]]), 3) expect_equal(all(dim(o2) == c(15, 3)), TRUE) expect_equal(all(dim(o3) == c(45, 2)), TRUE) expect_equal(length(o4), 15) expect_equal(length(o4[[1]]), 4) expect_equal(o4[[1]][1], "a") expect_equal(all(dim(o5) == c(15, 4)), TRUE) expect_equal(all(o5[, 1] == "a"), TRUE) expect_equal(all(dim(o6) == c(60, 2)), TRUE) }) ### MAP fit function tests data1 <- c("a", "b", "a", "c", "a", "b", "a", "b", "c", "b", "b", "a", "b") data2 <- c("c", "a", "b") test_that("MAP fits must satisfy", { expect_identical(markovchainFit(data1, method = "map")$estimate@transitionMatrix, markovchainFit(data1, method = "mle")$estimate@transitionMatrix) expect_identical(markovchainFit(data1, method = "map")$estimate@transitionMatrix, matrix(c(0.0, 0.6, 0.5, 0.8, 0.2, 0.5, 0.2, 0.2, 0.0), nrow = 3, dimnames = list(c("a", "b", "c"), c("a", "b", "c")))) expect_identical(markovchainFit(data1, method = "map", hyperparam = matrix(c(2, 1, 3, 4, 5, 2, 2, 2, 1), nrow = 3, dimnames = list(c("a", "b", "c"), c("a", "b", "c"))))$estimate@transitionMatrix, matrix(c(1/10, 3/10, 3/5, 7/10, 5/10, 2/5, 2/10, 2/10, 0), nrow = 3, dimnames = list(c("a", "b", "c"), c("a", "b", "c")))) }) test_that("predictiveDistribution must satisfy", { expect_equal(predictiveDistribution(data1, character()), 0) expect_equal(predictiveDistribution(data1, data2, hyperparam = matrix(c(2, 1, 3, 4, 5, 2, 2, 2, 1), nrow = 3, dimnames = list(c("a", "b", "c"), c("a", "b", "c")))), log(4 / 13)) }) test_that("inferHyperparam must satisfy", { expect_identical(inferHyperparam(data = data1)$dataInference, matrix(c(1, 4, 2, 5, 2, 2, 2, 2, 1), nrow = 3, dimnames = list(c("a", "b", "c"), c("a", "b", "c")))) expect_identical(inferHyperparam(transMatr = matrix(c(0.0, 0.6, 0.5, 0.8, 0.2, 0.5, 0.2, 0.2, 0.0), nrow = 3, dimnames = list(c("a", "b", "c"), c("a", "b", "c"))), scale = c(10, 10, 10))$scaledInference, matrix(c(0, 6, 5, 8, 2, 5, 2, 2, 0), nrow = 3, dimnames = list(c("a", "b", "c"), c("a", "b", "c")))) }) pDRes <- c(log(3/2), log(3/2)) names(pDRes) <- c("a", "b") test_that("priorDistribution must sastisfy", { expect_equal(priorDistribution(matrix(c(0.5, 0.5, 0.5, 0.5), nrow = 2, dimnames = list(c("a", "b"), c("a", "b"))), matrix(c(2, 2, 2, 2), nrow = 2, dimnames = list(c("a", "b"), c("a", "b")))), pDRes) }) energyStates <- c("sigma", "sigma_star") byRow <- TRUE gen <- matrix(data = c(-3, 3, 1, -1), nrow = 2, byrow = byRow, dimnames = list(energyStates, energyStates)) molecularCTMC <- new("ctmc", states = energyStates, byrow = byRow, generator = gen, name = "Molecular Transition Model") test_that("steadyStates must satisfy", { expect_identical(steadyStates(molecularCTMC), matrix(c(1/4, 3/4), nrow = 1, dimnames = list(c(), energyStates))) }) ### Tests for expectedRewards function ### Examples taken from Stochastic Processes: Theory for Applications, Robert G. Gallager,Cambridge University Press transMatr<-matrix(c(0.99,0.01,0.01,0.99),nrow=2,byrow=TRUE) simpleMc<-new("markovchain", states=c("a","b"), transitionMatrix=transMatr) test_that("expectedRewards must satisfy", { expect_equal(expectedRewards(simpleMc,1,c(0,1)),c(0.01,1.99)) expect_equal(expectedRewards(simpleMc,2,c(0,1)),c(0.0298,2.9702)) }) ### Tests for committorAB function transMatr <- matrix(c(0,0,0,1,0.5, 0.5,0,0,0,0, 0.5,0,0,0,0, 0,0.2,0.4,0,0, 0,0.8,0.6,0,0.5),nrow = 5) object <- new("markovchain", states=c("a","b","c","d","e"),transitionMatrix=transMatr, name="simpleMc") answer <- c(0.444,0.889,0.000,0.444,1.000) names <- c("a","b","c","d","e") names(answer) <- names test_that("committorAB must satisfy", { expect_equal(round(committorAB(object,c(5),c(3)),3),answer) }) ### Tests for firstPassageMultiple function statesNames <- c("a", "b", "c") testmarkov <- new("markovchain", states = statesNames, transitionMatrix = matrix(c(0.2, 0.5, 0.3, 0.5, 0.1, 0.4, 0.1, 0.8, 0.1), nrow = 3, byrow = TRUE, dimnames = list(statesNames, statesNames) )) answer <- matrix(c(.8000, 0.6000, 0.2540 ),nrow = 3,dimnames = list(c("1","2","3"),"set")) test_that("firstPassageMultiple function satisfies", { expect_equal(firstPassageMultiple(testmarkov,"a",c("b","c"),3),answer) }) markovchain/tests/testthat/testMultinomCI.R0000644000176200001440000000327014714756746020650 0ustar liggesusers#library(markovchain) seq<-c("a", "b", "a", "a", "a", "a", "b", "a", "b", "a", "b", "a", "a", "b", "b", "b", "a") mcfit<-markovchainFit(data=seq,byrow=TRUE) # print(mcfit) seqmat<-createSequenceMatrix(seq) seqmat mCI <- .multinomialCIRcpp(mcfit$estimate@transitionMatrix, seqmat, 0.95) # print(mCI) ####end of creating multinomialCI context("Multinomial confidence interval") test_that("multinomial CI statisfay", { # expect_equal(mCI$lowerEndpointMatrix, matrix(c(0.2222222,0.3333333, # 0.5714286,0.1428571),nrow=2, byrow=TRUE, dimnames=list(c("a","b"), # c("a","b")) # )) # expect_equal(mCI$upperEndpointMatrix, matrix(c(0.8111456,0.9222567, # 1,0.6839473),nrow=2, byrow=TRUE, dimnames=list(c("a","b"), # c("a","b")) # )) expect_equal(mCI$upperEndpointMatrix[2,1],1) }) # Multinomial distribution with 3 classes, from which 79 samples # were drawn: 23 of them belong to the first class, 12 to the # second class and 44 to the third class. Punctual estimations # of the probabilities from this sample would be 23/79, 12/79 # and 44/79 but we want to build 95% simultaneous confidence intervals # for the true probabilities # m = multinomialCI(c(23,12,44), 0.05) # print(paste("First class: [", m[1,1], m[1,2], "]")) # print(paste("Second class: [", m[2,1], m[2,2], "]")) # print(paste("Third class: [", m[3,1], m[3,2], "]")) # seq<-c(4, 5) # m = multinomialCI(seq, 0.05) # m markovchain/tests/testthat/testStatesClassification.R0000644000176200001440000000430214714756746022744 0ustar liggesuserscontext("Classification of states") A <- structure(c(0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0.5, 0.3, 0.3, 0, 0, 0, 0, 0, 0.5, 0.7, 0.7, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.3, 0.4, 0, 0, 0, 0, 0, 0.4, 0, 0.5, 0, 0, 0, 0, 0, 0.6, 0.7, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 1), .Dim = c(8L, 8L), .Dimnames = list( c("1", "2", "3", "4", "5", "6", "7", "8"), c("1", "2", "3", "4", "5", "6", "7", "8"))) mchain <- new("markovchain", transitionMatrix=A) #summary(mchain) test_that("States are those that should be", { expect_equal(recurrentClasses(mchain), list(c("3", "4"), c("8"))) expect_equal(transientStates(mchain), c("1", "2", "5", "6", "7")) expect_equal(absorbingStates(mchain), "8") }) #https://www.math.ucdavis.edu/~gravner/MAT135B/materials/ch13.pdf mcMatr1<-markovchain:::zeros(3) mcMatr1[1,]<-c(0.5,0.5,0) mcMatr1[2,]<-c(0.5,0.25,0.25) mcMatr1[3,]<-c(0,1/3,2/3) mc1<-as(mcMatr1,"markovchain") test_that("States are those that should be", { expect_equal(is.irreducible(mc1),TRUE) }) mcMatr2<-matrix(c(0, 0, 1/2, 1/2,1, 0 ,0, 0,0, 1, 0, 0,0, 1, 0, 0),ncol = 4,byrow=TRUE) mc2<-as(mcMatr2,"markovchain") test_that("States are those that should be", { expect_equal(recurrentClasses(mc2),list(c("s1","s2","s3","s4"))) }) mcMatr3<-matrix(c( 0,1,0,0,0,0, 0.4,0.6,0,0,0,0, 0.3,0,0.4,0.2,0.1,0, 0,0,0,0.3,0.7,0, 0,0,0,0.5,0,0.5, 0,0,0,0.3,0,0.7),nrow = 6,byrow=TRUE) mc3<-as(mcMatr3,"markovchain") recurrentClasses(mc3) transientStates(mc3) #canonicForm(mc3) test_that("States are those that should be", { expect_equal(recurrentClasses(mc3),list(c("s1","s2"),c("s4","s5","s6") )) expect_equal(transientStates(mc3),"s3") }) mcMatr4<-markovchain:::zeros(5) mcMatr4[1:2,1:2]<-0.5*markovchain:::ones(2) mcMatr4[5,1]<-1 mcMatr4[3,3]<-1 mcMatr4[4,3:4]<-0.5 mc4<-as(mcMatr4,"markovchain") test_that("States are those that should be", { expect_equal(recurrentClasses(mc4),list(c("s1","s2"),c("s3"))) expect_equal(absorbingStates(mc4),"s3") expect_equal(transientStates(mc4),c("s4","s5")) } ) markovchain/tests/testthat/testctmc.R0000644000176200001440000001065514714756746017563 0ustar liggesuserslibrary(markovchain) context("Checking that ExpectedTime function works as expected; it depends on ctmcd") # Example from the book Markovchains, J. R. Norris, Cambridge University Press states <- c("a","b","c","d") byRow <- TRUE gen <- matrix(data = c(-1, 1/2, 1/2, 0, 1/4, -1/2, 0, 1/4, 1/6, 0, -1/3, 1/6, 0, 0, 0, 0), nrow = 4,byrow = byRow, dimnames = list(states,states)) ctmc <- new("ctmc",states = states, byrow = byRow, generator = gen, name = "testctmc") test_that("Check Expected hitting time from one state to another",{ # Skip the test if the ctmcd package is not available if (!requireNamespace("ctmcd", quietly = TRUE)) { skip("The ctmcd package is not available") } expect_equal(ExpectedTime(ctmc,1,4),7) expect_equal(ExpectedTime(ctmc,2,4),5.5) }) context("Checking that probabilityatT function works as expected") # TESTS for probabilityatT function # Example taken from the book INTRODUCTION TO STOCHASTIC PROCESSES WITH R, ROBERT P. DOBROW, Wiley states <- c("a","b","c","d","e") # taken exactly from book ansMatrix <- matrix(data = c(0.610, 0.290, 0.081, 0.016, 0.003, 0.232, 0.443, 0.238, 0.071, 0.017, 0.052, 0.190, 0.435, 0.238, 0.085, 0.008, 0.045, 0.191, 0.446, 0.310, 0.001, 0.008, 0.054, 0.248, 0.688),nrow = 5,byrow = T,dimnames = list(states,states)) byRow <- TRUE gen <- matrix(c(-1/4,1/4,0,0,0,1/5,-9/20,1/4,0,0,0,1/5,-9/20,1/4,0,0,0,1/5,-9/20,1/4,0,0,0,1/5,-1/5), nrow=5,byrow=byRow, dimnames = list(states,states)) ctmc <- new("ctmc",states = states, byrow = byRow, generator = gen, name = "testctmc") test_that("Check probabilityatT using a ctmc object:",{ if (!requireNamespace("ctmcd", quietly = TRUE)) { skip("The ctmcd package is not available") } expect_equal(round(probabilityatT(ctmc,2.5),3),ansMatrix) }) ### Adds tests for impreciseprobabilityatT function context("Checking that impreciseprobabilityatT function works as expected:") states <- c("n","y") Q <- matrix(c(-1,1,1,-1),nrow = 2,byrow = T,dimnames = list(states,states)) range <- matrix(c(1/52,3/52,1/2,2),nrow = 2,byrow = 2) name <- "testictmc" ictmc <- new("ictmc",states = states,Q = Q,range = range,name = name) test_that("Check impreciseProbabilityatT function using an ictmc object:",{ if (!requireNamespace("ctmcd", quietly = TRUE)) { skip("The ctmcd package is not available") } expect_equal(round(impreciseProbabilityatT(ictmc,2,0,1,error = 10^-3),4),c(0.0083,0.1410)) }) ### Adds tests for freq2Generator function sample <- matrix(c(150,2,1,1,1,200,2,1,2,1,175,1,1,1,1,150),nrow = 4,byrow = TRUE) sample_rel = rbind((sample/rowSums(sample))[1:dim(sample)[1]-1,],c(rep(0,dim(sample)[1]-1),1)) answer <- matrix(c( -0.024, 0.015, 0.009, 0, 0.007, -0.018, 0.012, 0, 0.013 , 0.007, -0.021, 0, 0.000, 0.000, 0.000, 0 ),nrow = 4,byrow = TRUE) test_that("Check if ",{ if (!requireNamespace("ctmcd", quietly = TRUE)) { skip("The ctmcd package is not available") } expect_equal(round(freq2Generator(sample_rel,1),3),answer) }) ### tests for is.CTMCirreducible fcuntion energyStates <- c("sigma", "sigma_star") byRow <- TRUE gen <- matrix(data = c(-3, 3, 1, -1), nrow = 2, byrow = byRow, dimnames = list(energyStates, energyStates)) molecularCTMC <- new("ctmc", states = energyStates, byrow = byRow, generator = gen, name = "Molecular Transition Model") test_that("is.CTMCirreducible works", { if (!requireNamespace("ctmcd", quietly = TRUE)) { skip("The ctmcd package is not available") } expect_equal(is.CTMCirreducible(molecularCTMC),TRUE) }) ### tests for is.TimeReversible function energyStates <- c("sigma", "sigma_star") byRow <- TRUE gen <- matrix(data = c(-3, 3, 1, -1), nrow = 2, byrow = byRow, dimnames = list(energyStates, energyStates)) molecularCTMC <- new("ctmc", states = energyStates, byrow = byRow, generator = gen, name = "Molecular Transition Model") test_that("is.TimeReversible works", { if (!requireNamespace("ctmcd", quietly = TRUE)) { skip("The ctmcd package is not available") } expect_equal(is.TimeReversible(molecularCTMC),TRUE) }) markovchain/tests/testthat/test-sparse.R0000644000176200001440000000016614714756746020203 0ustar liggesuserstest_that("sparse transition matrix is accepted", { expect_is(as(sparsematrix, "markovchain"), "markovchain") }) markovchain/tests/testthat.R0000644000176200001440000000010414714756746015721 0ustar liggesuserslibrary(testthat) library(markovchain) test_check("markovchain") markovchain/MD50000644000176200001440000001747014715236602013103 0ustar liggesusersd78fc492da6a07ef74e0eeb2d9d3826e *DESCRIPTION 68857cf199687465e7a83880494dca6d *LICENSE 3ab103442e49de45ffeee91e4f7294bf *NAMESPACE 452448b58f964214389a681c25e06786 *NEWS.md 984f3d39a96d96f00d0ce5411f21ed17 *R/RcppExports.R ab6b6527178986dc26f25ce8a963ca43 *R/classesAndMethods.R de2bd558f0b4120acaaf8872ca2299f2 *R/ctmcClassesAndMethods.R 6ccb09d5d44f9d3de7de3cd22005b2aa *R/ctmcProbabilistic.R 8c7ce890d00d92ce802b378a2bcf1dfd *R/data.R a99314ea622a69a8e36076b40bc5fbdd *R/fitHigherOrder.R 0be873b92b60f1099954ecdd2345a910 *R/fittingFunctions.R c0b6439b5ec5882b173a83de5013c43d *R/hommc.R 17e37e252d07bf19e4dc49d1f943dcff *R/markovchain.R 2fa8aca8212bfacdd1524bd97f3c4e5c *R/matlab_package_functions.R c173f5676e42f00709b9423416bfd27e *R/probabilistic.R 8c90c159a9489b0f5dfb8ce08e0495e8 *R/random.R 41fc8f8e9367fd173a69c2f7feebfc3a *R/statisticalTests.R 993a960ae22cf15eee4f42b12007acf1 *R/supplementaryPlot.R ae3663e3cf44a6a02be461905443f952 *R/sysdata.rda 39b735feac8bc2ead976b8f9d61db649 *R/utils.R db74c50b2544eddf346897e1a7a1e11d *R/zzz.R c248ed4f77e9159cf733ae0b2280027a *README.md 98393dd88ed76d8e4e74af682009bc22 *build/vignette.rds 8f535b925486660a612e98d338dbd01c *data/blanden.rda 03f3f916a62f19fc4c3b38a509ef5415 *data/craigsendi.rda 7f5674109aa64320e5fd28a9b7a3134e *data/holson.rda fa2c8c3df0e29ef60c80842f0a4a1740 *data/kullback.rda 62b1605f8531945ea63f6210c893ee6f *data/preproglucacon.rda 9a536adaa0d4ad95bc59b7a900d5f604 *data/rain.rda 1b39b0943b63037d4df9e6bf764070d9 *data/sales.rda d2e30755392d0ac042dcb9f1c1dd53cc *data/tm_abs.rda 7062e44a453478115862d4383d21b1aa *demo/00Index 341e2275587b8537b7a3817aaf3588a4 *demo/bard.R 1700f0b961dc53993a9686ce375b2f06 *demo/computationTime.R dbf49ba2e9ce80d4d1f034650764a231 *demo/examples.R fb3046e24980a921d79cba3c3ef6f3b0 *demo/extractMatrices.R 89142f6fd07792388e74fd69002dffeb *demo/mathematica.R 837a7db4def223b7ba17ba93f52039f5 *demo/quasiBayesian.R 1dc619850b52023f072249b66f191b92 *demo/quickStart.R 9b61f7557c1e6c863affd1bc5f07480e *demo/reliability.R 8acad8740c32beedb885f1fae3c13754 *inst/CITATION aa940addbddf7d9ae7bd9bb17cc61f2c *inst/doc/an_introduction_to_markovchain_package.R 188e3e0fc06b0132d66029180117be7b *inst/doc/an_introduction_to_markovchain_package.Rmd b5d2afc4e9e74af18b94e8651c07a431 *inst/doc/an_introduction_to_markovchain_package.pdf c2bedc94f73fce561113feaf3ce0f0e2 *inst/doc/gsoc_2017_additions.R dce63235269c77778c9417678e262b8f *inst/doc/gsoc_2017_additions.Rmd 91b468aea43e46642c98a35c096ea7b6 *inst/doc/gsoc_2017_additions.html c54bccab235c1b2ddb7b002273cb6700 *inst/doc/higher_order_markov_chains.R 875c852572812e1c9b0124da2f1a7907 *inst/doc/higher_order_markov_chains.Rmd f145d273b18c8def4013f81139bd6854 *inst/doc/higher_order_markov_chains.html 730fbb92cced04056c80f883f3566252 *inst/extdata/ltdItaData.txt 75bf84bd1d2c1ad2c18b97199443d27f *man/ExpectedTime.Rd 3a7587d2c12ba2a1652ad7e38cc69443 *man/HigherOrderMarkovChain-class.Rd 2207974462e269879736e2aa4f45f3bf *man/absorptionProbabilities.Rd 984657ac88a51f09cd8013b2ad5ccf81 *man/blanden.Rd 515e8fd8bfffcfe1cf5349200a7682a6 *man/committorAB.Rd 6a4eb256b4f993212a37f877712edf59 *man/conditionalDistribution.Rd cd4830df7e3f9ab722d4edb724aa9c1e *man/craigsendi.Rd 84d44f1e1dae8840ee345b2368ebede6 *man/ctmc-class.Rd 7b1edcd40aab0fa00c37a2b8b0a32588 *man/ctmcFit.Rd 1a601c7098ade1f736a926f7e33bb90b *man/expectedRewards.Rd 13ef966850f4dae14aaa7221b1181720 *man/expectedRewardsBeforeHittingA.Rd aff4c6974caafc84c7d410d6d706ad62 *man/firstPassage.Rd bbaac4bed94a47e88deacbf976b86e9e *man/firstPassageMultiple.Rd d2c9c7016cb65119ae51207965beac19 *man/fitHighOrderMultivarMC.Rd 24b9ff5bd194750b8bc5da4f66775cd7 *man/fitHigherOrder.Rd 11f3ca6a0117afde424469092c385e59 *man/freq2Generator.Rd dad43a04be77e9a9b7ae1d3a9fb7a495 *man/generatorToTransitionMatrix.Rd c9840a546f9357451f76ca09b23a0bd8 *man/getName.Rd cf61b91702f4f73d44e9fd5608ca4d65 *man/hittingProbabilities.Rd add6fde771cc5bf6c02827ea3536fc96 *man/holson.Rd a46092594d426a3bedb4bd1782da2da2 *man/hommc-class.Rd 297096be86b88ebeaabd6ee7ed0a6486 *man/hommc-show.Rd 10dbf12cf0346f0054d567cd09fb65ff *man/ictmc-class.Rd 592eb7fba6781dfdcee2d2dff82df000 *man/impreciseProbabilityatT.Rd eb6b353a91450ff5674cb25090d46d70 *man/inferHyperparam.Rd db14356077967b114596ac92021a8a20 *man/is.CTMCirreducible.Rd 61cd70542034adea9588515a291dc19c *man/is.TimeReversible.Rd 4dceef72c917d3e66e97adfd880435c9 *man/is.accessible.Rd 93a3d28c78d94b800997dc44077bd480 *man/is.irreducible.Rd df3496a2d6e96dd76409386c6d3f40f0 *man/is.regular.Rd 44c9b0250b8fd6a2e46bcd0a8545f59b *man/kullback.Rd c51527c9bc308340e1cd43be60561e83 *man/markovchain-class.Rd f4c20c05797d74dd7d1dde4577043cdb *man/markovchain.Rd 1f9c346ec9e424d384535c24540a9079 *man/markovchainFit.Rd c3c1420c4aec6d3ee30ff46f68756329 *man/markovchainList-class.Rd 16c1cbb7705b17ebb518f1106583dfa2 *man/markovchainListFit.Rd 9be58105d48ce7cbefa8ad420a47f2c0 *man/markovchainSequence.Rd abbaca484a9abb47564201cf4dd69834 *man/meanAbsorptionTime.Rd a26bc397e9698f97f458b3af618a88b3 *man/meanFirstPassageTime.Rd 3f11047d088c7d3e5848c6dca4c02493 *man/meanNumVisits.Rd a51431e1948ef165709ff5329b469948 *man/meanRecurrenceTime.Rd 2f53a77e485cefec6a31883806563a7e *man/multinomialConfidenceIntervals.Rd 5fa42ddb7efca956e8e6c354bced7302 *man/names.Rd c7d4ada0e1a238d53ec005b32d93515f *man/noofVisitsDist.Rd 0100107bf1240600eeb5113b53dde8f5 *man/ones.Rd f371b228dbd222f85535f1d4c9219b43 *man/predictHommc.Rd fc9bb6a67bee60dda7b4dad14bf7f3ca *man/predictiveDistribution.Rd 29a6c0777531665ad64fc774c6e87e25 *man/preproglucacon.Rd d1755ab27b558f63b9e740af441f7777 *man/priorDistribution.Rd 80fbd5430cc4b8d68d031b1424b62a75 *man/probabilityatT.Rd 4817c2004dc1ac01c19cc8f9a3212b45 *man/rain.Rd 9d4ee477a6139b177ed5d218b12e7fb3 *man/rctmc.Rd 954bc6c4ee8923a7ecec4928f121e9c1 *man/rmarkovchain.Rd 0c8479de816d083d212b802a03c6e802 *man/sales.Rd 4ba99b5946a10b828a943aeedf40e50a *man/setName.Rd be0b6000cb92dc3757c227737ebcef4c *man/states.Rd a28a8b97f9354cb3bf08733359978209 *man/statisticalTests.Rd 3825bbb52da090aae367cac4de6f13f0 *man/steadyStates.Rd 84702a1a7cdd752c4d65bdd9b2abb26c *man/structuralAnalysis.Rd cc0565a34593f573e482e92783e6cd27 *man/tm_abs.Rd b60ba3fe4b6b18d4e99878b7b259562a *man/transition2Generator.Rd 19d5e66645633e19a90cd83e3049b0c9 *man/transitionProbability.Rd d4e1724cc0091b2ddf22097d1f1b2075 *man/zeros.Rd 7a3aeb1aa851dfb26ed4b62a9db06cec *src/Makevars 46afad93db0f8369499180b529bbac9a *src/Makevars.win 4c8bf0a3e340b7aa84647f337918e08b *src/RcppExports.cpp 4b77a04f31755a0fc89baed5d50c8aca *src/classesAndMethods.cpp e28005d65e2b51dac4973cb40de229b5 *src/ctmcClassesAndMethods.cpp 100a776c9e36949f4bc77fa3467ba1b6 *src/ctmcFittingFunctions.cpp 02ce3f3715895ea5a19302312ea0eabf *src/ctmcProbabilistic.cpp d99e875a963f6fbaf1734b3470ca67fb *src/fitHigherOrder.cpp 38f521db2ed674e72c530f346b2c06b0 *src/fittingFunctions.cpp 8c9f0905b63553383414ccbbf6dfbea5 *src/helpers.h 723761dbfb6fbf1cad9db40ef8dcfcf7 *src/mapFitFunctions.h 671ba94f3c19dc66524665fd56d2b82c *src/multinomCI.cpp 693f21d800e439415365d7d75ca318a5 *src/probabilistic.cpp 8118d2d4fb74432e8cee34693663e394 *src/utils.cpp 9ca86bdb9770b1d4f09faaccd4b207c0 *tests/testthat.R 69833e484d922ca478fddbf26d0ecf44 *tests/testthat/test-sparse.R 8702f384348e3b3a74de2ba9d8bd5f46 *tests/testthat/testBasic1.R 95866d62c44f628264aac082f16f8562 *tests/testthat/testFits.R c6b1cc046d56e93de12430fa159cca00 *tests/testthat/testMultinomCI.R 76426c64e1f40feec3af8d9efe2b77fc *tests/testthat/testPeriod.R 9fda6f42d517e727c4a080c8a1fe8baf *tests/testthat/testStatesClassification.R c84a4418ecfd4c94fb810586787b3d40 *tests/testthat/testctmc.R 188e3e0fc06b0132d66029180117be7b *vignettes/an_introduction_to_markovchain_package.Rmd dce63235269c77778c9417678e262b8f *vignettes/gsoc_2017_additions.Rmd 875c852572812e1c9b0124da2f1a7907 *vignettes/higher_order_markov_chains.Rmd c19f024e4ed601bd7796030986ef807b *vignettes/markovchainBiblio.bib 057d08248e65d85ee90839f9c2e6ba4f *vignettes/template.tex markovchain/R/0000755000176200001440000000000014715232510012755 5ustar liggesusersmarkovchain/R/ctmcProbabilistic.R0000644000176200001440000005154714714756745016575 0ustar liggesusers#' @title rctmc #' #' @description The function generates random CTMC transitions as per the #' provided generator matrix. #' @usage rctmc(n, ctmc, initDist = numeric(), T = 0, include.T0 = TRUE, #' out.type = "list") #' #' @param n The number of samples to generate. #' @param ctmc The CTMC S4 object. #' @param initDist The initial distribution of states. #' @param T The time up to which the simulation runs (all transitions after time #' T are not returned). #' @param include.T0 Flag to determine if start state is to be included. #' @param out.type "list" or "df" #' #' @details In order to use the T0 argument, set n to Inf. #' @return Based on out.type, a list or a data frame is returned. The returned #' list has two elements - a character vector (states) and a numeric vector #' (indicating time of transitions). The data frame is similarly structured. #' @references #' Introduction to Stochastic Processes with Applications in the Biosciences #' (2013), David F. Anderson, University of Wisconsin at Madison #' #' @author Sai Bhargav Yalamanchi #' @seealso \code{\link{generatorToTransitionMatrix}},\code{\link{ctmc-class}} #' @examples #' energyStates <- c("sigma", "sigma_star") #' byRow <- TRUE #' gen <- matrix(data = c(-3, 3, 1, -1), nrow = 2, #' byrow = byRow, dimnames = list(energyStates, energyStates)) #' molecularCTMC <- new("ctmc", states = energyStates, #' byrow = byRow, generator = gen, #' name = "Molecular Transition Model") #' #' statesDist <- c(0.8, 0.2) #' rctmc(n = Inf, ctmc = molecularCTMC, T = 1) #' rctmc(n = 5, ctmc = molecularCTMC, initDist = statesDist, include.T0 = FALSE) #' @export rctmc <- function(n, ctmc, initDist = numeric(), T = 0, include.T0 = TRUE, out.type = "list") { if (identical(initDist, numeric())) state <- sample(ctmc@states, 1) # sample state randomly else if (length(initDist) != dim(ctmc) | round(sum(initDist), 5) != 1) stop("Error! Provide a valid initial state probability distribution") else state <- sample(ctmc@states, 1, prob = initDist) # if valid probability distribution, # sample accordingly # obtain transition probability matrix from the generator matrix trans <- generatorToTransitionMatrix(ctmc@generator) states <- c() time <- c() if (include.T0 == TRUE){ states <- c(states, state) time <- c(time, 0) } t <- 0 i <- 1 while (i <= n){ idx <- which(ctmc@states == state) if (ctmc@generator[idx, idx] == 0) { # absorbing state; stay here forever t <- Inf } else { t <- t + rexp(1, -ctmc@generator[idx, idx]) } if((T > 0 & t > T) | (is.infinite(t))) break state <- ctmc@states[sample(1:dim(ctmc), 1, prob = trans[idx, ])] states <- c(states, state) time <- c(time, t) i <- i + 1 } out <- list(states, time) if (out.type == "list") return(out) else if(out.type == "df"){ df <- data.frame(matrix(unlist(out), nrow = length(states))) names(df) <- c("states", "time") return(df) } else stop("Not a valid output type") } #' @title Return the generator matrix for a corresponding transition matrix #' #' @description Calculate the generator matrix for a #' corresponding transition matrix #' #' @param P transition matrix between time 0 and t #' @param t time of observation #' @param method "logarithm" returns the Matrix logarithm of the transition matrix #' #' @return A matrix that represent the generator of P #' @export #' #' @examples #' mymatr <- matrix(c(.4, .6, .1, .9), nrow = 2, byrow = TRUE) #' Q <- transition2Generator(P = mymatr) #' expm::expm(Q) #' #' @seealso \code{\link{rctmc}} transition2Generator<-function(P, t = 1,method = "logarithm") { if (method == "logarithm") { Q = logm(P)/t } #else return(Q) } #' Returns a generator matrix corresponding to frequency matrix #' #' @description The function provides interface to calculate generator matrix corresponding to #' a frequency matrix and time taken #' #' @param P relative frequency matrix #' @param t (default value = 1) #' @param method one among "QO"(Quasi optimaisation), "WA"(weighted adjustment), "DA"(diagonal adjustment) #' @param logmethod method for computation of matrx algorithm (by default : Eigen) #' #' @return returns a generator matix with same dimnames #' #' @references E. Kreinin and M. Sidelnikova: Regularization Algorithms for #' Transition Matrices. Algo Research Quarterly 4(1):23-40, 2001 #' #' @examples #' sample <- matrix(c(150,2,1,1,1,200,2,1,2,1,175,1,1,1,1,150),nrow = 4,byrow = TRUE) #' sample_rel = rbind((sample/rowSums(sample))[1:dim(sample)[1]-1,],c(rep(0,dim(sample)[1]-1),1)) #' freq2Generator(sample_rel,1) #' #' data(tm_abs) #' tm_rel=rbind((tm_abs/rowSums(tm_abs))[1:7,],c(rep(0,7),1)) #' ## Derive quasi optimization generator matrix estimate #' freq2Generator(tm_rel,1) #' #' @export #' freq2Generator <- function(P,t = 1,method = "QO",logmethod = "Eigen"){ if(requireNamespace('ctmcd', quietly = TRUE)) { if(method == "QO"){ out <- ctmcd::gmQO(P, t, logmethod) } else if(method == "WA") { out <- ctmcd::gmWA(P, t, logmethod) } else if(method == "DA") { out <- ctmcd::gmDA(P, t, logmethod) } } else { warning("package ctmcd is not installed") out = NULL } return(out) } #' @title Returns expected hitting time from state i to state j #' #' @description Returns expected hitting time from state i to state j #' #' @usage ExpectedTime(C,i,j,useRCpp) #' #' @param C A CTMC S4 object #' @param i Initial state i #' @param j Final state j #' @param useRCpp logical whether to use Rcpp #' #' @details According to the theorem, holding times for all states except j should be greater than 0. #' #' @return A numerical value that returns expected hitting times from i to j #' #' @references Markovchains, J. R. Norris, Cambridge University Press #' #' @author Vandit Jain #' #' @examples #' states <- c("a","b","c","d") #' byRow <- TRUE #' gen <- matrix(data = c(-1, 1/2, 1/2, 0, 1/4, -1/2, 0, 1/4, 1/6, 0, -1/3, 1/6, 0, 0, 0, 0), #' nrow = 4,byrow = byRow, dimnames = list(states,states)) #' ctmc <- new("ctmc",states = states, byrow = byRow, generator = gen, name = "testctmc") #' ExpectedTime(ctmc,1,4,TRUE) #' #' @export ExpectedTime <- function(C,i,j,useRCpp = TRUE){ # take generator from ctmc-class object Q <- C@generator # in case where generator is written column wise if(C@byrow==FALSE){ Q <- t(Q) } NoofStates <- dim(C) Exceptj <- c(1:NoofStates) # create vector with all values from 1:NoofStates except j Exceptj <- which(Exceptj!=j) # build matrix with vlaues from Q such that row!=j or column!=j Q_Exceptj <- Q[Exceptj,Exceptj] # check for positivity of holding times except for state j if(!all(diag(Q_Exceptj)!=0)){ stop("Holding times for all states except j should be greater than 0") } # get b for solving the system of linear equation Ax = b where A is Q_Exceptj b <- rep(-1,dim(Q_Exceptj)[1]) # use solve function from base packge to solve Ax = b if(useRCpp == TRUE){ out <- .ExpectedTimeRCpp(Q_Exceptj,b) } else { out <- solve(Q_Exceptj,b) } # out will be of size NoofStates-1, hence the adjustment for different cases of i>= NoofStates || x0 < 1){ stop("Initial state provided is not correct") } return(P[x0,]) } } #' Calculating full conditional probability using lower rate transition matrix #' #' This function calculates full conditional probability at given #' time s using lower rate transition matrix #' #' @usage impreciseProbabilityatT(C,i,t,s,error,useRCpp) #' #' @param C a ictmc class object #' @param i initial state at time t #' @param t initial time t. Default value = 0 #' @param s final time #' @param error error rate. Default value = 0.001 #' @param useRCpp logical whether to use RCpp implementation; by default TRUE #' #' @references Imprecise Continuous-Time Markov Chains, Thomas Krak et al., 2016 #' #' @author Vandit Jain #' #' @examples #' states <- c("n","y") #' Q <- matrix(c(-1,1,1,-1),nrow = 2,byrow = TRUE,dimnames = list(states,states)) #' range <- matrix(c(1/52,3/52,1/2,2),nrow = 2,byrow = 2) #' name <- "testictmc" #' ictmc <- new("ictmc",states = states,Q = Q,range = range,name = name) #' impreciseProbabilityatT(ictmc,2,0,1,10^-3,TRUE) #' @export impreciseProbabilityatT <- function(C, i, t=0, s, error = 10^-3, useRCpp = TRUE){ ## input validity checking if(s <= t){ stop("Please provide time points such that initial time is greater than or equal to end point") } if(!is(C,'ictmc')){ stop("Please provide a valid ictmc-class object") } noOfstates <-length(C@states) if(i <= 0 || i > noOfstates){ stop("Please provide a valid initial state") } ### validity checking ends if(useRCpp == TRUE) { Qgx <- .impreciseProbabilityatTRCpp(C,i,t,s,error) } else { ## extract values from ictmc object Q <- C@Q range <- C@range ### calculate ||QI_i|| #initialise Q norm value QNorm <- -1 for(i in 1:noOfstates){ sum <- 0 for(j in 1:noOfstates){ sum <- sum + abs(Q[i,j]) } QNorm <- max(sum*range[i,2],QNorm) } ### calculate no of iterations # The 1 is for norm of I_s i.e. ||I_s|| which equals 1 n <- max((s-t)*QNorm, (s-t)*(s-t)*QNorm*QNorm*1/(2*error)) ### calculate delta delta <- (s-t)/n ### build I_i vector Ii <- rep(0, noOfstates) Ii[i] <- 1 ### calculate value of lower operator _QI_i(x) for all x belongs to no ofStates values <- Q%*%Ii Qgx <- rep(0, noOfstates) for(i in 1:noOfstates){ Qgx[i] <- min(values[i]*range[i,1], values[i]*range[i,2]) } Qgx <- delta*Qgx Qgx <- Ii + Qgx for(iter in 1:n-1){ temp <- Qgx values <- Q%*%Qgx for(i in 1:noOfstates){ Qgx[i] <- min(values[i]*range[i,1], values[i]*range[i,2]) } Qgx <- delta*Qgx Qgx <- temp + Qgx } } return(Qgx) } #' Check if CTMC is irreducible #' #' @description #' This function verifies whether a CTMC object is irreducible #' #' @usage is.CTMCirreducible(ctmc) #' #' @param ctmc a ctmc-class object #' #' @references #' Continuous-Time Markov Chains, Karl Sigman, Columbia University #' #' @author Vandit Jain #' #' @return a boolean value as described above. #' #' @examples #' energyStates <- c("sigma", "sigma_star") #' byRow <- TRUE #' gen <- matrix(data = c(-3, 3, #' 1, -1), nrow = 2, #' byrow = byRow, dimnames = list(energyStates, energyStates)) #' molecularCTMC <- new("ctmc", states = energyStates, #' byrow = byRow, generator = gen, #' name = "Molecular Transition Model") #' is.CTMCirreducible(molecularCTMC) #' #' @export is.CTMCirreducible <- function(ctmc) { if(!is(ctmc, 'ctmc') ) { stop("please provide a valid ctmc class object") } ## gets the embeded chain matrix embeddedChainMatrix <- generatorToTransitionMatrix(ctmc@generator) ## forms a markovchain object related to embedded transition matrix markovchainObject <- new("markovchain",states = ctmc@states, transitionMatrix = embeddedChainMatrix) ## returns result using is.irreducible function on embedded chain transition matrix return(is.irreducible(markovchainObject)) } #' checks if ctmc object is time reversible #' #' @description #' The function returns checks if provided function is time reversible #' #' @usage is.TimeReversible(ctmc) #' #' @param ctmc a ctmc-class object #' #' @return Returns a boolean value stating whether ctmc object is time reversible #' #' @author Vandit Jain #' #' @return a boolean value as described above #' #' @references #' INTRODUCTION TO STOCHASTIC PROCESSES WITH R, ROBERT P. DOBROW, Wiley #' #' @examples #' energyStates <- c("sigma", "sigma_star") #' byRow <- TRUE #' gen <- matrix(data = c(-3, 3, #' 1, -1), nrow = 2, #' byrow = byRow, dimnames = list(energyStates, energyStates)) #' molecularCTMC <- new("ctmc", states = energyStates, #' byrow = byRow, generator = gen, #' name = "Molecular Transition Model") #' is.TimeReversible(molecularCTMC) #' #' @export is.TimeReversible <- function(ctmc) { if(!is(ctmc,"ctmc")) { stop("please provide a valid ctmc-class object") } ## get steady state probabilities Pi <- steadyStates(ctmc) ## initialise boolean result check <- TRUE ## no of states m <- length(ctmc@states) ## checks for byrow if(ctmc@byrow == FALSE) gen <- t(ctmc@generator) else gen <- ctmc@generator ## iterates for every state for( i in 1:m) { for(j in 1:m) { if(Pi[i]*gen[i,j] != Pi[j]*gen[j,i]) { check <- FALSE break } } } return(check) } # `generator/nextki` <- function(k) { # if(k >= 0) return(-1-k) # return(-k) # } # # `generator/nextk` <- function(k, Kmin, Kmax) { # if(is.null(k)) { # k <- rep(0, length(Kmin)) # return(list(ans = TRUE, k = k)) # } # # if(length(Kmin) == 0) { # return(list(ans = FALSE, k = k)) # } # # i <- 1 # kl <- k # kl[i] <- `generator/nextki`(kl[i]) # while (kl[i] > Kmax[i] || kl[i] < Kmin[i]) { # kl[i] <- 0 # i <- i+1 # if(i > length(kl)) { # k <- kl # return(list(ans = FALSE, k = k)) # } # kl[i] <- `generator/nextki`(kl[i]) # } # k <- kl # return(list(ans = TRUE, k = k)) # } # # `generator/generator` <- function(Po, Di, odi) { # P <- Po # N <- nrow(P) # # if(Di > 22) return(NULL) # bad idea # options(digits = Di) # odigs <- odi # # rSum <- rowSums(P) # if(! all(abs(1-rSum) < 0.001)) { # stop("Sum of each rows of Po should be equal to 1") # } # # P <- P/rSum # d <- det(P) # # if(d <= 0) { # cat("Matrix has non-positive determinant") # return(NULL) # } # # diagP <- 1 # for(i in 1:nrow(P)) diagP <- diagP * P[i, i] # # if(d >= diagP) { # cat("Determinant exceeds product of diagonal elements\n") # return(NULL) # } # # E <- eigen(P)[[1]] # B <- eigen(P)[[2]] # # print("Eigenvalues") # print(E) # # # risky # if(length(unique(E)) != length(E)) { # warning("Matrix does not have distinct eigenvalues") # } # # L <- abs(log(d)) # addigs <- 2 + round(log10(1/Matrix::rcond(B))) + round(L/log(10)) # problem # # if(options()$digits < odigs + addigs) { # if(odigs + addigs > 100) { # print("Eigenvector matrix is singular") # return(NULL) # } # # cat('Going to', odigs + addigs, "digits") # return(`generator/generator`(Po, odigs + addigs, odigs)) # } # # Bi <- solve(B) # # posevs <- NULL # negevs <- NULL # bestj <- NULL # bestQ <- NULL # marks <- rep(TRUE, length(E)) # # for(i in 1:length(E)) { # if(marks[i] && !(Re(E[i]) > 0 && Im(E[i]) == 0)) { # invalid comparison of complex number # cj <- Conj(E[i]) # best <- Inf # if(i+1 <= length(E)) { # for(j in (i+1):length(E)) { # if(marks[j]) { # score <- abs(cj-E[j]) # if(score < best) { # best <- score # bestj <- j # } # } # } # } # # if(best > 10^(3-options()$digits)) { # cat("Unpaired non-positive eigenvalue", E[i]) # return(NULL) # } # marks[bestj] <- FALSE # if(Im(E[i]) >= 0) { # posevs <- c(posevs, i) # negevs <- c(negevs, bestj) # if(Im(E[bestj]) == 0) { # E[bestj] <- complex(real = E[bestj], imaginary = 0) # } # } else { # posevs <- c(posevs, bestj) # negevs <- c(negevs, i) # if(Im(E[i]) == 0) { # E[i] <- complex(real = E[i], imaginary = 0) # } # } # } # } # # npairs <- length(posevs) # # display conjugate pairs # # Kmax <- rep(0, npairs) # Kmin <- Kmax # # for(i in 1:npairs) { # a <- Arg(E[posevs[i]]) # Kmax[i] <- trunc((L-a)/2*pi) # Kmin[i] <- trunc((-L-a)/2*pi) # } # # # display K-max # # display K-min # # best <- -0.001 # DD <- diag(log(E)) # DK <- matlab::zeros(N) # res <- list(); p <- 1 # k <- NULL # while(TRUE) { # # dlist <- `generator/nextk`(k, Kmin, Kmax) # k <- dlist$k # # if(dlist$ans == FALSE) {break} # # # display value of k # for(i in 1:npairs) { # ke <- complex(real = 0, imaginary = 2*pi*k[i]) # DK[posevs[i], posevs[i]] <- ke # DK[negevs[i], negevs[i]] <- -ke # } # # Q <- B %*% (DD + DK) %*% Bi # # Q <- fnormal(Re(Q), options()$digits, 5*(10^(-1-odigs))) # define fnormal of maple # qmin <- Q[1,2] # for(i in 1:N) { # for(j in 1:N) { # if(i != j) { # if(Q[i, j] < qmin) qmin <- Q[i, j] # } # } # } # # if(EnvAllGenerators == TRUE) { # if(qmin > -.001) { # cat("Possible generator with qmin =", qmin) # res[[p]] <- round(Q, odigs) # p <- p + 1 # } else { # cat("qmin =", qmin) # } # # } else { # if(qmin >= 0) { # cat("Found a generator") # return(round(Q, odigs)) # } else { # if(qmin > best) { # best <- qmin # bestQ <- Q # } # if(qmin > -.001) { # cat("Approximate generator with qmin = ", qmin) # } else { # cat("qmin =", qmin) # } # } # } # } # # if(EnvAllGenerators == TRUE) { # return(res) # } # # warning("No completely valid generator found") # # if(! is.null(bestQ)) { # return(round(bestQ, odigs)) # } else return(NULL) # # } # # generator <- function(Po, digits = 10) { # odigs <- digits # options(digits = 15) # if(is.matrix(Po)) { # P <- Po # } else { # stop("Po must be matrix") # } # # if(nrow(P) != ncol(P)) { # print(P) # stop('Po must be square matrix') # } # # if(! all(P >= 0)) { # print(P) # stop('Po must be non negative square matrix') # } # # `generator/generator`(P, options()$digits, odigs) # } markovchain/R/RcppExports.R0000644000176200001440000005016314715232510015376 0ustar liggesusers# Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 .isGenRcpp <- function(gen) { .Call(`_markovchain_isGen`, gen) } #' @name generatorToTransitionMatrix #' @title Function to obtain the transition matrix from the generator #' @description The transition matrix of the embedded DTMC is inferred from the CTMC's generator #' #' @usage generatorToTransitionMatrix(gen, byrow = TRUE) #' #' @param gen The generator matrix #' @param byrow Flag to determine if rows (columns) sum to 0 #' @return Returns the transition matrix. #' #' @references #' Introduction to Stochastic Processes with Applications in the Biosciences (2013), David F. #' Anderson, University of Wisconsin at Madison #' #' @author Sai Bhargav Yalamanchi #' @seealso \code{\link{rctmc}},\code{\link{ctmc-class}} #' @examples #' energyStates <- c("sigma", "sigma_star") #' byRow <- TRUE #' gen <- matrix(data = c(-3, 3, 1, -1), nrow = 2, #' byrow = byRow, dimnames = list(energyStates, energyStates)) #' generatorToTransitionMatrix(gen) #' #' @export generatorToTransitionMatrix <- function(gen, byrow = TRUE) { .Call(`_markovchain_generatorToTransitionMatrix`, gen, byrow) } #' @name ctmcFit #' @title Function to fit a CTMC #' @description This function fits the underlying CTMC give the state #' transition data and the transition times using the maximum likelihood #' method (MLE) #' @usage ctmcFit(data, byrow = TRUE, name = "", confidencelevel = 0.95) #' @param data It is a list of two elements. The first element is a character #' vector denoting the states. The second is a numeric vector denoting the #' corresponding transition times. #' @param byrow Determines if the output transition probabilities of the #' underlying embedded DTMC are by row. #' @param name Optional name for the CTMC. #' @param confidencelevel Confidence level for the confidence interval #' construnction. #' @return It returns a list containing the CTMC object and the confidence intervals. #' #' @details Note that in data, there must exist an element wise corresponding #' between the two elements of the list and that data[[2]][1] is always 0. #' @references Continuous Time Markov Chains (vignette), Sai Bhargav Yalamanchi, Giorgio Alfredo Spedicato 2015 #' @author Sai Bhargav Yalamanchi #' @seealso \code{\link{rctmc}} #' #' @examples #' data <- list(c("a", "b", "c", "a", "b", "a", "c", "b", "c"), c(0, 0.8, 2.1, 2.4, 4, 5, 5.9, 8.2, 9)) #' ctmcFit(data) #' #' @export #' ctmcFit <- function(data, byrow = TRUE, name = "", confidencelevel = 0.95) { .Call(`_markovchain_ctmcFit`, data, byrow, name, confidencelevel) } .ExpectedTimeRCpp <- function(x, y) { .Call(`_markovchain_ExpectedTimeRcpp`, x, y) } .probabilityatTRCpp <- function(y) { .Call(`_markovchain_probabilityatTRCpp`, y) } .impreciseProbabilityatTRCpp <- function(C, i, t, s, error) { .Call(`_markovchain_impreciseProbabilityatTRCpp`, C, i, t, s, error) } #' @export seq2freqProb <- function(sequence) { .Call(`_markovchain_seq2freqProb`, sequence) } #' @export seq2matHigh <- function(sequence, order) { .Call(`_markovchain_seq2matHigh`, sequence, order) } .markovchainSequenceRcpp <- function(n, markovchain, t0, include_t0 = FALSE) { .Call(`_markovchain_markovchainSequenceRcpp`, n, markovchain, t0, include_t0) } .markovchainListRcpp <- function(n, object, include_t0 = FALSE, t0 = character()) { .Call(`_markovchain_markovchainListRcpp`, n, object, include_t0, t0) } .markovchainSequenceParallelRcpp <- function(listObject, n, include_t0 = FALSE, init_state = character()) { .Call(`_markovchain_markovchainSequenceParallelRcpp`, listObject, n, include_t0, init_state) } #' @rdname markovchainFit #' #' @export createSequenceMatrix <- function(stringchar, toRowProbs = FALSE, sanitize = FALSE, possibleStates = character()) { .Call(`_markovchain_createSequenceMatrix`, stringchar, toRowProbs, sanitize, possibleStates) } .mcListFitForList <- function(data) { .Call(`_markovchain_mcListFitForList`, data) } .matr2Mc <- function(matrData, laplacian = 0, sanitize = FALSE, possibleStates = character()) { .Call(`_markovchain__matr2Mc`, matrData, laplacian, sanitize, possibleStates) } .list2Mc <- function(data, laplacian = 0, sanitize = FALSE) { .Call(`_markovchain__list2Mc`, data, laplacian, sanitize) } #' @name inferHyperparam #' @title Function to infer the hyperparameters for Bayesian inference from an a priori matrix or a data set #' @description Since the Bayesian inference approach implemented in the package is based on conjugate priors, #' hyperparameters must be provided to model the prior probability distribution of the chain #' parameters. The hyperparameters are inferred from a given a priori matrix under the assumption #' that the matrix provided corresponds to the mean (expected) values of the chain parameters. A #' scaling factor vector must be provided too. Alternatively, the hyperparameters can be inferred #' from a data set. #' #' @param transMatr A valid transition matrix, with dimension names. #' @param scale A vector of scaling factors, each element corresponds to the row names of the provided transition #' matrix transMatr, in the same order. #' @param data A data set from which the hyperparameters are inferred. #' #' @details transMatr and scale need not be provided if data is provided. #' @return Returns the hyperparameter matrix in a list. #' #' @note The hyperparameter matrix returned is such that the row and column names are sorted alphanumerically, #' and the elements in the matrix are correspondingly permuted. #' #' @references Yalamanchi SB, Spedicato GA (2015). Bayesian Inference of First Order Markov Chains. R #' package version 0.2.5 #' #' @author Sai Bhargav Yalamanchi, Giorgio Spedicato #' @seealso \code{\link{markovchainFit}}, \code{\link{predictiveDistribution}} #' #' @examples #' data(rain, package = "markovchain") #' inferHyperparam(data = rain$rain) #' #' weatherStates <- c("sunny", "cloudy", "rain") #' weatherMatrix <- matrix(data = c(0.7, 0.2, 0.1, #' 0.3, 0.4, 0.3, #' 0.2, 0.4, 0.4), #' byrow = TRUE, nrow = 3, #' dimnames = list(weatherStates, weatherStates)) #' inferHyperparam(transMatr = weatherMatrix, scale = c(10, 10, 10)) #' #' @export #' inferHyperparam <- function(transMatr = matrix(), scale = numeric(), data = character()) { .Call(`_markovchain_inferHyperparam`, transMatr, scale, data) } #' @name markovchainFit #' @title Function to fit a discrete Markov chain #' @description Given a sequence of states arising from a stationary state, #' it fits the underlying Markov chain distribution using either MLE (also using a #' Laplacian smoother), bootstrap or by MAP (Bayesian) inference. #' #' @param data It can be a character vector or a \deqn{n x n} matrix or a \deqn{n x n} data frame or a list #' @param method Method used to estimate the Markov chain. Either "mle", "map", "bootstrap" or "laplace" #' @param byrow it tells whether the output Markov chain should show the transition probabilities by row. #' @param nboot Number of bootstrap replicates in case "bootstrap" is used. #' @param laplacian Laplacian smoothing parameter, default zero. It is only used when "laplace" method #' is chosen. #' @param name Optional character for name slot. #' @param parallel Use parallel processing when performing Boostrap estimates. #' @param confidencelevel \deqn{\alpha} level for conficence intervals width. #' Used only when \code{method} equal to "mle". #' @param confint a boolean to decide whether to compute Confidence Interval or not. #' @param hyperparam Hyperparameter matrix for the a priori distribution. If none is provided, #' default value of 1 is assigned to each parameter. This must be of size #' \deqn{k x k} where k is the number of states in the chain and the values #' should typically be non-negative integers. #' @param stringchar It can be a \deqn{n x n} matrix or a character vector or a list #' @param toRowProbs converts a sequence matrix into a probability matrix #' @param sanitize put 1 in all rows having rowSum equal to zero #' @param possibleStates Possible states which are not present in the given sequence #' #' @details Disabling confint would lower the computation time on large datasets. If \code{data} or \code{stringchar} #' contain \code{NAs}, the related \code{NA} containing transitions will be ignored. #' #' @return A list containing an estimate, log-likelihood, and, when "bootstrap" method is used, a matrix #' of standards deviations and the bootstrap samples. When the "mle", "bootstrap" or "map" method #' is used, the lower and upper confidence bounds are returned along with the standard error. #' The "map" method also returns the expected value of the parameters with respect to the #' posterior distribution. #' @references A First Course in Probability (8th Edition), Sheldon Ross, Prentice Hall 2010 #' #' Inferring Markov Chains: Bayesian Estimation, Model Comparison, Entropy Rate, #' and Out-of-Class Modeling, Christopher C. Strelioff, James P. Crutchfield, #' Alfred Hubler, Santa Fe Institute #' #' Yalamanchi SB, Spedicato GA (2015). Bayesian Inference of First Order Markov Chains. R #' package version 0.2.5 #' #' @author Giorgio Spedicato, Tae Seung Kang, Sai Bhargav Yalamanchi #' @note This function has been rewritten in Rcpp. Bootstrap algorithm has been defined "heuristically". #' In addition, parallel facility is not complete, involving only a part of the bootstrap process. #' When \code{data} is either a \code{data.frame} or a \code{matrix} object, only MLE fit is #' currently available. #' #' @seealso \code{\link{markovchainSequence}}, \code{\link{markovchainListFit}} #' @examples #' sequence <- c("a", "b", "a", "a", "a", "a", "b", "a", "b", "a", "b", "a", "a", #' "b", "b", "b", "a") #' sequenceMatr <- createSequenceMatrix(sequence, sanitize = FALSE) #' mcFitMLE <- markovchainFit(data = sequence) #' mcFitBSP <- markovchainFit(data = sequence, method = "bootstrap", nboot = 5, name = "Bootstrap Mc") #' #' na.sequence <- c("a", NA, "a", "b") #' # There will be only a (a,b) transition #' na.sequenceMatr <- createSequenceMatrix(na.sequence, sanitize = FALSE) #' mcFitMLE <- markovchainFit(data = na.sequence) #' #' # data can be a list of character vectors #' sequences <- list(x = c("a", "b", "a"), y = c("b", "a", "b", "a", "c")) #' mcFitMap <- markovchainFit(sequences, method = "map") #' mcFitMle <- markovchainFit(sequences, method = "mle") #' @rdname markovchainFit #' #' @export #' markovchainFit <- function(data, method = "mle", byrow = TRUE, nboot = 10L, laplacian = 0, name = "", parallel = FALSE, confidencelevel = 0.95, confint = TRUE, hyperparam = matrix(), sanitize = FALSE, possibleStates = character()) { .Call(`_markovchain_markovchainFit`, data, method, byrow, nboot, laplacian, name, parallel, confidencelevel, confint, hyperparam, sanitize, possibleStates) } .noofVisitsDistRCpp <- function(matrix, i, N) { .Call(`_markovchain_noofVisitsDistRCpp`, matrix, i, N) } .multinomialCIForRowRcpp <- function(x, confidencelevel) { .Call(`_markovchain_multinomialCIForRow`, x, confidencelevel) } .multinomialCIRcpp <- function(transMat, seqMat, confidencelevel) { .Call(`_markovchain_multinomCI`, transMat, seqMat, confidencelevel) } .commClassesKernelRcpp <- function(P) { .Call(`_markovchain_commClassesKernel`, P) } .communicatingClassesRcpp <- function(object) { .Call(`_markovchain_communicatingClasses`, object) } .transientStatesRcpp <- function(object) { .Call(`_markovchain_transientStates`, object) } .recurrentStatesRcpp <- function(object) { .Call(`_markovchain_recurrentStates`, object) } .recurrentClassesRcpp <- function(object) { .Call(`_markovchain_recurrentClasses`, object) } .transientClassesRcpp <- function(object) { .Call(`_markovchain_transientClasses`, object) } .reachabilityMatrixRcpp <- function(obj) { .Call(`_markovchain_reachabilityMatrix`, obj) } .isAccessibleRcpp <- function(obj, from, to) { .Call(`_markovchain_isAccessible`, obj, from, to) } .summaryKernelRcpp <- function(object) { .Call(`_markovchain_summaryKernel`, object) } .firstpassageKernelRcpp <- function(P, i, n) { .Call(`_markovchain_firstpassageKernel`, P, i, n) } .firstPassageMultipleRCpp <- function(P, i, setno, n) { .Call(`_markovchain_firstPassageMultipleRCpp`, P, i, setno, n) } .expectedRewardsRCpp <- function(matrix, n, rewards) { .Call(`_markovchain_expectedRewardsRCpp`, matrix, n, rewards) } .expectedRewardsBeforeHittingARCpp <- function(matrix, s0, rewards, n) { .Call(`_markovchain_expectedRewardsBeforeHittingARCpp`, matrix, s0, rewards, n) } .gcdRcpp <- function(a, b) { .Call(`_markovchain_gcd`, a, b) } #' @rdname structuralAnalysis #' #' @export period <- function(object) { .Call(`_markovchain_period`, object) } #' @title predictiveDistribution #' #' @description The function computes the probability of observing a new data #' set, given a data set #' @usage predictiveDistribution(stringchar, newData, hyperparam = matrix()) #' #' @param stringchar This is the data using which the Bayesian inference is #' performed. #' @param newData This is the data whose predictive probability is computed. #' @param hyperparam This determines the shape of the prior distribution of the #' parameters. If none is provided, default value of 1 is assigned to each #' parameter. This must be of size kxk where k is the number of states in the #' chain and the values should typically be non-negative integers. #' @return The log of the probability is returned. #' #' @details The underlying method is Bayesian inference. The probability is #' computed by averaging the likelihood of the new data with respect to the #' posterior. Since the method assumes conjugate priors, the result can be #' represented in a closed form (see the vignette for more details), which is #' what is returned. #' @references #' Inferring Markov Chains: Bayesian Estimation, Model Comparison, Entropy Rate, #' and Out-of-Class Modeling, Christopher C. Strelioff, James P. #' Crutchfield, Alfred Hubler, Santa Fe Institute #' #' Yalamanchi SB, Spedicato GA (2015). Bayesian Inference of First Order Markov #' Chains. R package version 0.2.5 #' #' @author Sai Bhargav Yalamanchi #' @seealso \code{\link{markovchainFit}} #' @examples #' sequence<- c("a", "b", "a", "a", "a", "a", "b", "a", "b", "a", "b", "a", "a", #' "b", "b", "b", "a") #' hyperMatrix<-matrix(c(1, 2, 1, 4), nrow = 2,dimnames=list(c("a","b"),c("a","b"))) #' predProb <- predictiveDistribution(sequence[1:10], sequence[11:17], hyperparam =hyperMatrix ) #' hyperMatrix2<-hyperMatrix[c(2,1),c(2,1)] #' predProb2 <- predictiveDistribution(sequence[1:10], sequence[11:17], hyperparam =hyperMatrix2 ) #' predProb2==predProb #' @export #' predictiveDistribution <- function(stringchar, newData, hyperparam = matrix()) { .Call(`_markovchain_predictiveDistribution`, stringchar, newData, hyperparam) } #' @title priorDistribution #' #' @description Function to evaluate the prior probability of a transition #' matrix. It is based on conjugate priors and therefore a Dirichlet #' distribution is used to model the transitions of each state. #' @usage priorDistribution(transMatr, hyperparam = matrix()) #' #' @param transMatr The transition matrix whose probability is the parameter of #' interest. #' @param hyperparam The hyperparam matrix (optional). If not provided, a #' default value of 1 is assumed for each and therefore the resulting #' probability distribution is uniform. #' @return The log of the probabilities for each state is returned in a numeric #' vector. Each number in the vector represents the probability (log) of #' having a probability transition vector as specified in corresponding the #' row of the transition matrix. #' #' @details The states (dimnames) of the transition matrix and the hyperparam #' may be in any order. #' @references Yalamanchi SB, Spedicato GA (2015). Bayesian Inference of First #' Order Markov Chains. R package version 0.2.5 #' #' @author Sai Bhargav Yalamanchi, Giorgio Spedicato #' #' @note This function can be used in conjunction with inferHyperparam. For #' example, if the user has a prior data set and a prior transition matrix, #' he can infer the hyperparameters using inferHyperparam and then compute #' the probability of their prior matrix using the inferred hyperparameters #' with priorDistribution. #' @seealso \code{\link{predictiveDistribution}}, \code{\link{inferHyperparam}} #' #' @examples #' priorDistribution(matrix(c(0.5, 0.5, 0.5, 0.5), #' nrow = 2, #' dimnames = list(c("a", "b"), c("a", "b"))), #' matrix(c(2, 2, 2, 2), #' nrow = 2, #' dimnames = list(c("a", "b"), c("a", "b")))) #' @export priorDistribution <- function(transMatr, hyperparam = matrix()) { .Call(`_markovchain_priorDistribution`, transMatr, hyperparam) } .hittingProbabilitiesRcpp <- function(object) { .Call(`_markovchain_hittingProbabilities`, object) } .canonicFormRcpp <- function(obj) { .Call(`_markovchain_canonicForm`, obj) } .steadyStatesRcpp <- function(obj) { .Call(`_markovchain_steadyStates`, obj) } .absorbingStatesRcpp <- function(obj) { .Call(`_markovchain_absorbingStates`, obj) } .isIrreducibleRcpp <- function(obj) { .Call(`_markovchain_isIrreducible`, obj) } .isRegularRcpp <- function(obj) { .Call(`_markovchain_isRegular`, obj) } .meanAbsorptionTimeRcpp <- function(obj) { .Call(`_markovchain_meanAbsorptionTime`, obj) } .absorptionProbabilitiesRcpp <- function(obj) { .Call(`_markovchain_absorptionProbabilities`, obj) } .meanFirstPassageTimeRcpp <- function(obj, destination) { .Call(`_markovchain_meanFirstPassageTime`, obj, destination) } .meanRecurrenceTimeRcpp <- function(obj) { .Call(`_markovchain_meanRecurrenceTime`, obj) } .minNumVisitsRcpp <- function(obj) { .Call(`_markovchain_meanNumVisits`, obj) } .isProbability <- function(prob) { .Call(`_markovchain_isProb`, prob) } .isStochasticMatrix <- function(m, byrow) { .Call(`_markovchain_isStochasticMatrix`, m, byrow) } .isProbabilityVector <- function(prob) { .Call(`_markovchain_isProbVector`, prob) } .testthatIsAccesibleRcpp <- function(obj) { .Call(`_markovchain_checkIsAccesibleMethod`, obj) } .approxEqualMatricesRcpp <- function(a, b) { .Call(`_markovchain_approxEqual`, a, b) } .testthatIsPartitionRcpp <- function(commClasses, states) { .Call(`_markovchain_isPartition`, commClasses, states) } .testthatAreHittingRcpp <- function(probs, hitting, byrow) { .Call(`_markovchain_areHittingProbabilities`, probs, hitting, byrow) } .testthatAreMeanNumVisitsRcpp <- function(probs, numVisits, hitting, byrow) { .Call(`_markovchain_areMeanNumVisits`, probs, numVisits, hitting, byrow) } .testthatRecurrentHittingRcpp <- function(recurrentClasses, hitting, states, byrow) { .Call(`_markovchain_recurrentHitting`, recurrentClasses, hitting, states, byrow) } .testthatHittingAreOneRcpp <- function(matrix) { .Call(`_markovchain_hittingProbsAreOne`, matrix) } .testthatAbsorbingAreRecurrentClassRcpp <- function(absorbingStates, recurrentClasses) { .Call(`_markovchain_absorbingAreRecurrentClass`, absorbingStates, recurrentClasses) } markovchain/R/fittingFunctions.R0000644000176200001440000006152114714756745016466 0ustar liggesusers#' Function to generate a sequence of states from homogeneous Markov chains. #' #' Provided any \code{markovchain} object, it returns a sequence of #' states coming from the underlying stationary distribution. #' #' @param n Sample size #' @param markovchain \code{markovchain} object #' @param t0 The initial state #' @param include.t0 Specify if the initial state shall be used #' @param useRCpp Boolean. Should RCpp fast implementation being used? Default is yes. #' #' @details A sequence of size n is sampled. #' #' @return A Character Vector #' #' @references A First Course in Probability (8th Edition), Sheldon Ross, Prentice Hall 2010 #' #' @author Giorgio Spedicato #' #' @seealso \code{\link{markovchainFit}} #' #' @examples #' # define the markovchain object #' statesNames <- c("a", "b", "c") #' mcB <- new("markovchain", states = statesNames, #' transitionMatrix = matrix(c(0.2, 0.5, 0.3, 0, 0.2, 0.8, 0.1, 0.8, 0.1), #' nrow = 3, byrow = TRUE, dimnames = list(statesNames, statesNames))) #' #' # show the sequence #' outs <- markovchainSequence(n = 100, markovchain = mcB, t0 = "a") #' #' @export markovchainSequence <-function (n, markovchain, t0 = sample(markovchain@states, 1), include.t0 = FALSE, useRCpp = TRUE) { # check whether given initial state is possible state or not if (!(t0 %in% markovchain@states)) stop("Error! Initial state not defined") # call to cpp implmentation of markovchainSequence if (useRCpp) { return(.markovchainSequenceRcpp(n, markovchain, t0, include.t0)) } # R implementation of the function # create a sequence of size n initially not initialized chain <- rep(NA,n) # initial state state <- t0 # populate the sequence for (i in 1:n) { # row probabilty corresponding to the current state rowProbs <- markovchain@transitionMatrix[state, ] # select the next state outstate <- sample(size = 1, x = markovchain@states, prob = rowProbs) # store the new state chain[i] <- outstate # update the current state state <- outstate } # output out <- chain # whether to include initial state or not if (include.t0) { out <- c(t0, out) } return(out) } ################## # random sampler # ################## # check if the subsequent states are included in the previous ones # check the validity of non homogeneous markovchain list # object is a list of markovchain object .checkSequence <- function(object) { # assume non homogeneous markovchain list is valid out <- TRUE # list of one transition matrix implies valid if (length(object) == 1) { return(out) } # if number of transition matrices are more than one for (i in 2:length(object)) { # select the states which are reachable in one step if(object[[i - 1]]@byrow) { reachable <- (colSums(object[[i - 1]]@transitionMatrix) != 0) } else { reachable <- (rowSums(object[[i - 1]]@transitionMatrix) != 0) } # possible states in the previous markovchain object statesNm1 <- states(object[[i - 1]])[reachable] # possible states in the current markovchain object statesN <- states(object[[i]]) # common states intersection <- intersect(statesNm1, statesN) # condition to check whether statesNm1 is a subset of statesN or not if (setequal(intersection, statesNm1) == FALSE) { out <- FALSE break } } return(out) } #' Function to generate a sequence of states from homogeneous or non-homogeneous Markov chains. #' #' Provided any \code{markovchain} or \code{markovchainList} objects, it returns a sequence of #' states coming from the underlying stationary distribution. #' #' @param n Sample size #' @param object Either a \code{markovchain} or a \code{markovchainList} object #' @param what It specifies whether either a \code{data.frame} or a \code{matrix} #' (each rows represent a simulation) or a \code{list} is returned. #' @param useRCpp Boolean. Should RCpp fast implementation being used? Default is yes. #' @param parallel Boolean. Should parallel implementation being used? Default is yes. #' @param num.cores Number of Cores to be used #' @param ... additional parameters passed to the internal sampler #' #' @details When a homogeneous process is assumed (\code{markovchain} object) a sequence is #' sampled of size n. When a non - homogeneous process is assumed, #' n samples are taken but the process is assumed to last from the begin to the end of the #' non-homogeneous markov process. #' #' @return Character Vector, data.frame, list or matrix #' #' @references A First Course in Probability (8th Edition), Sheldon Ross, Prentice Hall 2010 #' #' @author Giorgio Spedicato #' #' @note Check the type of input #' #' @seealso \code{\link{markovchainFit}}, \code{\link{markovchainSequence}} #' #' @examples #' # define the markovchain object #' statesNames <- c("a", "b", "c") #' mcB <- new("markovchain", states = statesNames, #' transitionMatrix = matrix(c(0.2, 0.5, 0.3, 0, 0.2, 0.8, 0.1, 0.8, 0.1), #' nrow = 3, byrow = TRUE, dimnames = list(statesNames, statesNames))) #' #' # show the sequence #' outs <- rmarkovchain(n = 100, object = mcB, what = "list") #' #' #' #define markovchainList object #' statesNames <- c("a", "b", "c") #' mcA <- new("markovchain", states = statesNames, transitionMatrix = #' matrix(c(0.2, 0.5, 0.3, 0, 0.2, 0.8, 0.1, 0.8, 0.1), nrow = 3, #' byrow = TRUE, dimnames = list(statesNames, statesNames))) #' mcB <- new("markovchain", states = statesNames, transitionMatrix = #' matrix(c(0.2, 0.5, 0.3, 0, 0.2, 0.8, 0.1, 0.8, 0.1), nrow = 3, #' byrow = TRUE, dimnames = list(statesNames, statesNames))) #' mcC <- new("markovchain", states = statesNames, transitionMatrix = #' matrix(c(0.2, 0.5, 0.3, 0, 0.2, 0.8, 0.1, 0.8, 0.1), nrow = 3, #' byrow = TRUE, dimnames = list(statesNames, statesNames))) #' mclist <- new("markovchainList", markovchains = list(mcA, mcB, mcC)) #' #' # show the list of sequence #' rmarkovchain(100, mclist, "list") #' #' @export rmarkovchain <- function(n, object, what = "data.frame", useRCpp = TRUE, parallel = FALSE, num.cores = NULL, ...) { # check the class of the object if (is(object,"markovchain")) { out <- markovchainSequence(n = n, markovchain = object, useRCpp = useRCpp, ...) return(out) } if (is(object,"markovchainList")) { ####################################################### if(useRCpp && !parallel) { # if include.t0 is not passed as extra argument then set include.t0 as false include.t0 <- list(...)$include.t0 include.t0 <- ifelse(is.null(include.t0), FALSE, include.t0) # check whether initial state is passed or not t0 <- list(...)$t0 if (is.null(t0)) t0 <- character() # call fast cpp function dataList <- .markovchainListRcpp(n, object@markovchains, include.t0, t0) # format in which results to be returned if (what == "data.frame") { out <- data.frame(iteration = dataList[[1]], values = dataList[[2]]) } else { # output in matrix format # each row is an independent sequence out <- matrix(data = dataList[[2]], nrow = n, byrow = TRUE) # output in list format if (what == "list") { # outlist <- list() # for (i in 1:nrow(out)) # outlist[[i]] <- out[i, ] # out <- outlist out <- as.list(data.frame(t(out), stringsAsFactors = FALSE)) out <- unname(out) } } return(out) } ########################################################## if(useRCpp && parallel) { # Calculate the number of cores # It's not good to use all cores no_cores <- max(1,parallel::detectCores() - 1) # number of cores specified should be less than or equal to maximum cores available if((! is.null(num.cores)) && num.cores <= no_cores + 1 && num.cores >= 1) { no_cores <- num.cores } RcppParallel::setThreadOptions(no_cores) # if include.t0 is not passed as extra argument then set include.t0 as false include.t0 <- list(...)$include.t0 include.t0 <- ifelse(is.null(include.t0), FALSE, include.t0) # check whether initial state is passed or not t0 <- list(...)$t0 if (is.null(t0)) t0 <- character() dataList <- .markovchainSequenceParallelRcpp(object, n, include.t0, t0) if(what == "list") return(dataList) # dimension of matrix to be returned nrow <- length(dataList) ncol <- length(dataList[[1]]) if(what == "matrix") { out <- matrix(unlist(dataList), nrow = nrow, ncol = ncol, byrow = TRUE) # for(i in 1:nrow) out[i, ] <- dataList[[i]] return(out) } iteration <- unlist(lapply(1:nrow, rep, times = ncol)) values <- unlist(dataList) # if what id data frame # for(i in 1:nrow) { # iteration <- c(iteration, rep(i, ncol)) # values <- append(values, dataList[[i]]) # } return(data.frame(iteration = iteration, values = values)) } ########################################################## if(!useRCpp && parallel) { # if include.t0 is not passed as extra argument then set include.t0 as false include.t0 <- list(...)$include.t0 include.t0 <- ifelse(is.null(include.t0), FALSE, include.t0) # check whether initial state is passed or not t0 <- list(...)$t0 if (is.null(t0)) t0 <- character() dataList <- .markovchainSequenceParallel(n, object, t0, num.cores, include.t0) if(what == "list") return(dataList) # dimension of matrix to be returned nrow <- length(dataList) ncol <- length(dataList[[1]]) if(what == "matrix") { out <- matrix(nrow = nrow, ncol = ncol) for(i in 1:nrow) out[i, ] <- dataList[[i]] return(out) } iteration <- numeric() values <- character() # if what id data frame for(i in 1:nrow) { iteration <- append(iteration, rep(i, ncol)) values <- append(values, dataList[[i]]) } return(data.frame(iteration = iteration, values = values)) } ########################################################## # store list of markovchain object in object object <- object@markovchains # check the validity of markovchainList object verify <- .checkSequence(object = object) # show warning if sequence is invalid if (!verify) { warning("Warning: some states in the markovchain sequences are not contained in the following states!") } # helper vector iteration <- numeric() values <- character() # create one sequence in each iteration for (i in 1:n) { # the first iteration may include initial state sampledValues <- markovchainSequence(n = 1, markovchain = object[[1]], ...) outIter <- rep(i, length(sampledValues)) # number of markovchain objects are more than one if (length(object) > 1) { for (j in 2:length(object)) { pos2take <- length(sampledValues) # select new state of the sequence from the old state # t0 refers to the old state newVals <-markovchainSequence(n = 1, markovchain = object[[j]], t0 = sampledValues[pos2take]) # update in every iteration outIter <- c(outIter, i) sampledValues <- c(sampledValues, newVals) } } # populate the helper vectors iteration <- c(iteration, outIter) values <- c(values, sampledValues) } # defining the output if (what == "data.frame") { out <- data.frame(iteration = iteration, values = values) } else { # ouput in matrix format out <- matrix(data = values, nrow = n, byrow = TRUE) # store each row of the matrix in the list if (what == 'list') { outlist <- list() for (i in 1:nrow(out)) outlist[[i]] <- out[i, ] out <- outlist } } } return(out) } ###################################################################### # helper function to calculate one sequence .markovchainSPHelper <- function(x, t0, mclist, include.t0) { # number of transition matrices n <- length(mclist@markovchains) # take care of initial state vin <- 0 if(include.t0) vin <- 1 # a character vector to store a single sequence seq <- character(length = n + vin) if(length(t0) == 0) { stateNames <- mclist@markovchains[[1]]@states t0 <- sample(x = stateNames, size = 1, prob = rep(1 / length(stateNames), length(stateNames))) } if(include.t0) seq[1] <- t0 invisible(lapply(seq_len(n), function(i) { stateNames <<- mclist@markovchains[[i]]@states byRow <- mclist@markovchains[[i]]@byrow # check whether transition matrix follows row-wise or column-wise fashion if(byRow) prob <- mclist@markovchains[[i]]@transitionMatrix[which(stateNames == t0), ] else prob <- mclist@markovchains[[i]]@transitionMatrix[, which(stateNames == t0)] # initial state for the next transition matrix t0 <<- sample(x = stateNames, size = 1, prob = prob) # populate the sequence vector seq[i+vin] <<- t0 } )) return(seq) } # Function to generate a list of sequence of states in parallel from non-homogeneous Markov chains. # # Provided any markovchainList object, it returns a list of sequence of states coming # from the underlying stationary distribution. # # @param n Sample size # @param object markovchainList object # @param t0 Initial state # @param num.cores Number of cores # .markovchainSequenceParallel <- function(n, object, t0 = character(), num.cores = NULL, include.t0 = FALSE) { # check for the validity of non-uniform markov chain verify <- .checkSequence(object@markovchains) if (!verify) { warning("Warning: some states in the markovchain sequences are not contained in the following states!") } # Calculate the number of cores # It's not good to use all cores no_cores <- max(1,parallel::detectCores() - 1) # number of cores specified should be less than or equal to maximum cores available if((! is.null(num.cores)) && num.cores <= no_cores + 1 && num.cores >= 1) { no_cores <- num.cores } # Initiate cluster cl <- parallel::makeCluster(no_cores) # export the variables to be used in the helper function # parallel::clusterExport(cl, "t0") # export the variables to be used in the helper function mclist <- object # parallel::clusterExport(cl, "mclist") # list of n sequence listSeq <- tryCatch(parallel::parLapply(cl, 1:n, .markovchainSPHelper, t0, mclist, include.t0), error=function(e) e, warning=function(w) w) # release the resources parallel::stopCluster(cl) return(listSeq) } ###################################################################### # function to fit a DTMC with Laplacian Smoother .mcFitLaplacianSmooth <- function(stringchar, byrow, laplacian = 0.01) { # every element of the matrix store the number of times jth state appears just # after the ith state origNum <- createSequenceMatrix(stringchar = stringchar, toRowProbs = FALSE) # add laplacian to the sequence matrix # why? to avoid the cases where sum of row is zero newNum <- origNum + laplacian # store sum of each row in the vector newSumOfRow <- rowSums(newNum) # helper matrix to convert frequency matrix to transition matrix newDen <- matrix(rep(newSumOfRow, length(newSumOfRow)), byrow = FALSE, ncol = length(newSumOfRow)) # transition matrix transMatr <- newNum / newDen # create a markovchain object outMc <- new("markovchain", transitionMatrix = transMatr, name = "Laplacian Smooth Fit") # transpose the transition matrix if (!byrow) { outMc@transitionMatrix <- t(outMc@transitionMatrix) outMc@byrow <- FALSE } # wrap markovchain object in a list out <- list(estimate = outMc) return(out) } # function that return a Markov Chain from a given matrix of observations # .matr2Mc <- function(matrData, laplacian = 0) { # # # number of columns in the input matrix # nCols <- ncol(matrData) # # # an empty character vector to store names of possible states # uniqueVals <- character() # # # populate uniqueVals with names of states # for(i in 1:nCols) { # uniqueVals <- union(uniqueVals, unique(as.character(matrData[,i]))) # } # # # possible states in lexicographical order # uniqueVals <- sort(uniqueVals) # # # create a contingency matrix which store the number of times # # jth state appear just after the ith state # contingencyMatrix <- matrix(rep(0, length(uniqueVals)^2), ncol = length(uniqueVals)) # # # set the names of rows and columns # rownames(contingencyMatrix) <- colnames(contingencyMatrix) <- uniqueVals # # # fill the contingency matrix # for (i in 1:nrow(matrData)) { # for (j in 2:nCols) { # # state in the ith row and (j-1)th column # stateBegin <- as.character(matrData[i, j-1]) # # # index of beginning state # whichRow <- which(uniqueVals == stateBegin) # # # state in the ith row and jth column # stateEnd <- as.character(matrData[i, j]) # # # index of ending state # whichCols <- which(uniqueVals == stateEnd) # # # update the contingency matrix # contingencyMatrix[whichRow, whichCols] <- contingencyMatrix[whichRow, whichCols] + 1 # } # } # # # add laplacian correction if needed # contingencyMatrix <- contingencyMatrix + laplacian # # # take care of rows with all entries 0 # sumOfRows <- rowSums(contingencyMatrix) # for(i in 1:length(sumOfRows)) { # if(sumOfRows[i] == 0) { # contingencyMatrix[i, ] <- 1 # sumOfRows[i] <- length(sumOfRows) # } # } # # # get a transition matrix and a DTMC # transitionMatrix <- contingencyMatrix / sumOfRows # # # markov chain object to be returned # outMc <- new("markovchain", transitionMatrix = transitionMatrix) # # return(outMc) # } #' @title markovchainListFit #' #' @description Given a data frame or a matrix (rows are observations, by cols #' the temporal sequence), it fits a non - homogeneous discrete time markov chain #' process (storing row). In particular a markovchainList of size = ncol - 1 is obtained #' estimating transitions from the n samples given by consecutive column pairs. #' #' @param data Either a matrix or a data.frame or a list object. #' @param laplacian Laplacian correction (default 0). #' @param byrow Indicates whether distinc stochastic processes trajectiories are shown in distinct rows. #' @param name Optional name. #' #' @details If \code{data} contains \code{NAs} then the transitions containing \code{NA} will be ignored. #' @return A list containing two slots: #' estimate (the estimate) #' name #' #' @examples #' #' # using holson dataset #' data(holson) #' # fitting a single markovchain #' singleMc <- markovchainFit(data = holson[,2:12]) #' # fitting a markovchainList #' mclistFit <- markovchainListFit(data = holson[, 2:12], name = "holsonMcList") #' @export markovchainListFit <- function(data, byrow = TRUE, laplacian = 0, name) { # check the format of input data if (!any(is.list(data),is.data.frame(data),is.matrix(data))) { stop("Error: data must be either a matrix or a data.frame or a list") } freqMatrixes <- list() # a pure list= a list and not a data frame if((is.list(data) == TRUE) & (is.data.frame(data)==FALSE)) { markovchains <- list() # list of frequency matrix freqMatrixes <- .mcListFitForList(data) } else{ # if input is data frame convert it to matrix if(is.data.frame(data)) { data <- unname(as.matrix(data)) } # make the entries row wise if it is not if(!byrow) { data <- t(data) } # number of columns in the matrix nCols <- ncol(data) # fit by columns freqMatrixes <- lapply(seq_len(nCols-1), function(i){ # (i-1)th transition matrix for transition from (i-1)th state to ith state matrData <- data[, c(i, i+1)] matrData[1, ] <- as.character(matrData[1, ]) # checking particular data for NA values. validTransition <- any(apply(matrData, 1, function(x){ !any(is.na(x)) })) if(validTransition) createSequenceMatrix(matrData, toRowProbs = FALSE, sanitize = TRUE) }) freqMatrixes <- freqMatrixes[ !sapply(freqMatrixes, is.null) ] } if(length(freqMatrixes) == 0) { return(list()) } markovchains <- lapply(freqMatrixes, function(freqMatrix){ # add laplacian correction freqMatrix <- freqMatrix + laplacian rSums <- rowSums(freqMatrix) # transition matrix tMatrix <- freqMatrix / rSums; estMc <- new("markovchain", transitionMatrix = tMatrix) estMc }) # create markovchainList object outMcList <- new("markovchainList", markovchains = markovchains) # wrap the object in a list out <- list(estimate = outMcList) # set the name of markovchainList object as given in the argument if(!missing(name)) { out$estimate@name <- name } return(out) } #' A function to compute multinomial confidence intervals of DTMC #' #' @description Return estimated transition matrix assuming a Multinomial Distribution #' #' @param transitionMatrix An estimated transition matrix. #' @param countsTransitionMatrix Empirical (conts) transition matrix, on which the \code{transitionMatrix} was performed. #' @param confidencelevel confidence interval level. #' #' @return Two matrices containing the confidence intervals. #' #' @seealso \code{markovchainFit} #' #' @references Constructing two-sided simultaneous confidence intervals #' for multinomial proportions for small counts in a large number of cells. #' Journal of Statistical Software 5(6) (2000) #' #' @examples #' seq<-c("a", "b", "a", "a", "a", "a", "b", "a", "b", "a", "b", "a", "a", "b", "b", "b", "a") #' mcfit<-markovchainFit(data=seq,byrow=TRUE) #' seqmat<-createSequenceMatrix(seq) #' multinomialConfidenceIntervals(mcfit$estimate@transitionMatrix, seqmat, 0.95) #' @export multinomialConfidenceIntervals<-function(transitionMatrix, countsTransitionMatrix, confidencelevel=0.95) { out<-.multinomialCIRcpp(transMat=transitionMatrix, seqMat=countsTransitionMatrix,confidencelevel=confidencelevel) return(out) } #' return a joint pdf of the number of visits to the various states of the DTMC #' #' @description This function would return a joint pdf of the number of visits to #' the various states of the DTMC during the first N steps. #' #' @usage noofVisitsDist(markovchain,N,state) #' #' @param markovchain a markovchain-class object #' @param N no of steps #' @param state the initial state #' #' @details #' This function would return a joint pdf of the number of visits to #' the various states of the DTMC during the first N steps. #' #' @return a numeric vector depicting the above described probability density function. #' #' @author Vandit Jain #' #' @examples #' transMatr<-matrix(c(0.4,0.6,.3,.7),nrow=2,byrow=TRUE) #' simpleMc<-new("markovchain", states=c("a","b"), #' transitionMatrix=transMatr, #' name="simpleMc") #' noofVisitsDist(simpleMc,5,"a") #' #' @export noofVisitsDist <- function(markovchain,N = 5,state) { if(!is(markovchain,"markovchain")) stop("please provide a valid markovchain-class object") if(N <= 0) stop("please enter positive number of steps") # the transition matrix Tmatrix <- markovchain@transitionMatrix # character vector of states of the markovchain stateNames <- states(markovchain) i<--1 # initial state i <- which(stateNames == state) if(i==-1) stop("please provide a valid inital state") # call to Rcpp implementation of the function out <- .noofVisitsDistRCpp(Tmatrix,i,N) # adds state names names to the output vector names(out) <- stateNames out <- c(out) return(out) } markovchain/R/matlab_package_functions.R0000644000176200001440000000047114714756745020131 0ustar liggesusers#' Matrix to create zeros #' #' @param n size of the matrix #' #' @return a square matrix of zeros zeros <- function(n) { return(matrix(0,n,n)) } #' Returns an Identity matrix #' #' @param n size of the matrix #' #' @return a identity matrix ones <- function(n) { return(matrix(1,n,n)) } markovchain/R/fitHigherOrder.R0000644000176200001440000000542514714756745016037 0ustar liggesusers#' @title Higher order Markov Chains class #' @name HigherOrderMarkovChain-class #' @description The S4 class that describes \code{HigherOrderMarkovChain} objects. #' #' @export setClass("HigherOrderMarkovChain", #class name representation( states = "character", order = "numeric", transitions = "list", name = "character" ) # , prototype(states = c("a","b"), byrow = TRUE, # prototypizing # transitionMatrix=matrix(data = c(0,1,1,0), # nrow=2, byrow=TRUE, dimnames=list(c("a","b"), c("a","b"))), # name="Unnamed Markov chain") ) # objective function to pass to solnp .fn1=function(params) { QX <- get("QX") X <- get("X") error <- 0 for (i in 1:length(QX)) { error <- error+(params[i] * QX[[i]]-X) } return(sum(error^2)) } # equality constraint function to pass to solnp .eqn1=function(params){ return(sum(params)) } #' @name fitHigherOrder #' @aliases seq2freqProb seq2matHigh #' @title Functions to fit a higher order Markov chain #' #' @description Given a sequence of states arising from a stationary state, it #' fits the underlying Markov chain distribution with higher order. #' @usage #' fitHigherOrder(sequence, order = 2) #' seq2freqProb(sequence) #' seq2matHigh(sequence, order) #' #' @param sequence A character list. #' @param order Markov chain order #' @return A list containing lambda, Q, and X. #' #' @references #' Ching, W. K., Huang, X., Ng, M. K., & Siu, T. K. (2013). Higher-order markov #' chains. In Markov Chains (pp. 141-176). Springer US. #' #' Ching, W. K., Ng, M. K., & Fung, E. S. (2008). Higher-order multivariate #' Markov chains and their applications. Linear Algebra and its Applications, #' 428(2), 492-507. #' #' @author Giorgio Spedicato, Tae Seung Kang #' #' @examples #' sequence<-c("a", "a", "b", "b", "a", "c", "b", "a", "b", "c", "a", "b", #' "c", "a", "b", "c", "a", "b", "a", "b") #' fitHigherOrder(sequence) #' #' @export fitHigherOrder<-function(sequence, order = 2) { # prbability of each states of sequence if (requireNamespace("Rsolnp", quietly = TRUE)) { X <- seq2freqProb(sequence) # store h step transition matrix Q <- list() QX <- list() for(o in 1:order) { Q[[o]] <- seq2matHigh(sequence, o) QX[[o]] <- Q[[o]]%*%X } environment(.fn1) <- environment() params <- rep(1/order, order) model <- Rsolnp::solnp(params, fun=.fn1, eqfun=.eqn1, eqB=1, LB=rep(0, order), control=list(trace=0)) lambda <- model$pars out <- list(lambda=lambda, Q=Q, X=X) } else { print("package Rsolnp unavailable") out <- NULL } return(out) } markovchain/R/markovchain.R0000644000176200001440000000371414714756745015433 0ustar liggesusers#' @docType package #' @name markovchain-package #' @rdname markovchain #' @title Easy Handling Discrete Time Markov Chains #' #' @description The package contains classes and method to create and manage #' (plot, print, export for example) discrete time Markov chains (DTMC). In #' addition it provide functions to perform statistical (fitting and drawing #' random variates) and probabilistic (analysis of DTMC proprieties) analysis #' #' @author #' Giorgio Alfredo Spedicato #' Maintainer: Giorgio Alfredo Spedicato #' @references Discrete-Time Markov Models, Bremaud, Springer 1999 #' @keywords package #' #' @examples #' # create some markov chains #' statesNames=c("a","b") #' mcA<-new("markovchain", transitionMatrix=matrix(c(0.7,0.3,0.1,0.9),byrow=TRUE, #' nrow=2, dimnames=list(statesNames,statesNames))) #' #' statesNames=c("a","b","c") #' mcB<-new("markovchain", states=statesNames, transitionMatrix= #' matrix(c(0.2,0.5,0.3,0,1,0,0.1,0.8,0.1), nrow=3, #' byrow=TRUE, dimnames=list(statesNames, statesNames))) #' #' statesNames=c("a","b","c","d") #' matrice<-matrix(c(0.25,0.75,0,0,0.4,0.6,0,0,0,0,0.1,0.9,0,0,0.7,0.3), nrow=4, byrow=TRUE) #' mcC<-new("markovchain", states=statesNames, transitionMatrix=matrice) #' mcD<-new("markovchain", transitionMatrix=matrix(c(0,1,0,1), nrow=2,byrow=TRUE)) #' #' #' #operations with S4 methods #' mcA^2 #' steadyStates(mcB) #' absorbingStates(mcB) #' markovchainSequence(n=20, markovchain=mcC, include=TRUE) NULL #' @useDynLib markovchain, .registration = TRUE #' @import igraph #' @import Matrix #' @import methods #' @import parallel #' @importFrom utils packageDescription #' @importFrom Rcpp evalCpp #' @importFrom RcppParallel RcppParallelLibs #' @importFrom stats4 plot summary #' @importFrom expm %^% logm #' @importFrom stats sd rexp chisq.test pchisq predict aggregate #' @importFrom grDevices colors NULLmarkovchain/R/supplementaryPlot.R0000644000176200001440000000541614714756745016701 0ustar liggesusers# plot a diagram using diagram for a markovchain object .plotdiagram <- function(object, ...) { if(is(object,"markovchain")){ mat <- object@transitionMatrix list <- .communicatingClassesRcpp(object) sections <- length(list) colorList <- grDevices::colors() colorList <- sample(colorList,sections) colorvector <- rep("white",length(object@states)) for(i in 1:length(list)){ part <- list[[i]] for(j in 1:length(part)){ colorvector[match(part[j],object@states)] <- colorList[i] } } } else if(is(object,"ctmc")){ mat <- object@generator colorvector <- rep("white",length(object@states)) } if(object@byrow == FALSE) { mat <- t(mat) } if (!requireNamespace("diagram", quietly = TRUE)) { print("The diagram package is not available") } else{ diagram::plotmat(t(mat),relsize = 0.75,box.col = colorvector, ...) } } # plot a diagram using DiagrammeR for a markovchain object .plotDiagrammeR <- function(object, ...) { if(is(object,"markovchain")){ mat <- object@transitionMatrix } else if(is(object,"ctmc")){ mat <- object@generator } names <- rownames(mat) # names of nodes nodes <- '' for(i in 1:nrow(mat)) { nodes <- paste0(nodes, names[i], "; ") } # store edges edges <- '' for(i in 1:nrow(mat)) { for(j in 1:ncol(mat)) { edges <- paste0(edges, names[i], "->", names[j], " [label = ", mat[i,j], "] ") } } # extract extra parameter dots <- list(...) args <- "" for(name in names(dots)) { args <- paste0(args, name, "=\"", dots[[name]], "\" ") } # print(args) if (requireNamespace("DiagrammeR", quietly = TRUE)) { res <- DiagrammeR::grViz(paste0(" digraph circles { graph [overlap = true, fontsize = 10] node [shape = circle, fixedsize = true, width = 0.9] // sets as circles ", nodes, " ", edges, args," // labelfontsize = 20 labelloc='t' label ='Weather transition matrix' } ")) return (res) } else { print("Diagrammer unavailable") } } # How to do plotting? # mcWeather <- new("markovchain", states = c("sunny", "cloudy", "rain"), # transitionMatrix = matrix(data = c(0.70, 0.2, 0.1, # 0.3, 0.4, 0.3, # 0.2, 0.45, 0.35), byrow = T, nrow = 3), # name = "Weather") # mcWeather # .plotdiagram(mcWeather, box.size = 0.06) # .plotDiagrammeR(mcWeather, label ="Weather transition matrix", labelloc = "t") # plot(mcWeather, package = "DiagrammeR", label = "Weather transition matrix")markovchain/R/zzz.R0000644000176200001440000000112314714756745013756 0ustar liggesusers# Author: Giorgio ############################################################################### # loading the markovchain package .onAttach <- function(libname, pkgname) { desc <- packageDescription(pkgname, libname) packageStartupMessage('Package: ', desc$Package, '\n', 'Version: ', desc$Version, '\n', 'Date: ', desc$Date, '\n', 'BugReport: ', desc$BugReports, '\n') } # for unloading dynamic libraries .onUnload <- function (libpath) { library.dynam.unload("markovchain", libpath) }markovchain/R/hommc.R0000644000176200001440000002572014714756745014235 0ustar liggesusers#' An S4 class for representing High Order Multivariate Markovchain (HOMMC) #' #' @slot order an integer equal to order of Multivariate Markovchain #' @slot states a vector of states present in the HOMMC model #' @slot P array of transition matrices #' @slot Lambda a vector which stores the weightage of each transition matrices in P #' @slot byrow if FALSE each column sum of transition matrix is 1 else row sum = 1 #' @slot name a name given to hommc #' #' @author Giorgio Spedicato, Deepak Yadav #' #' @examples #' statesName <- c("a", "b") #' #' P <- array(0, dim = c(2, 2, 4), dimnames = list(statesName, statesName)) #' P[,,1] <- matrix(c(0, 1, 1/3, 2/3), byrow = FALSE, nrow = 2) #' P[,,2] <- matrix(c(1/4, 3/4, 0, 1), byrow = FALSE, nrow = 2) #' P[,,3] <- matrix(c(1, 0, 1/3, 2/3), byrow = FALSE, nrow = 2) #' P[,,4] <- matrix(c(3/4, 1/4, 0, 1), byrow = FALSE, nrow = 2) #' #' Lambda <- c(0.8, 0.2, 0.3, 0.7) #' #' ob <- new("hommc", order = 1, states = statesName, P = P, #' Lambda = Lambda, byrow = FALSE, name = "FOMMC") #' #'@export hommc <- setClass("hommc", slots = list(order = "numeric", states = "character", P = "array", Lambda = "numeric", byrow = "logical", name = "character") ) # internal method to show hommc object in informative way .showHommc <- function(object) { # whether data in transition matrices are stored in column-wise or row-wise fashion if(object@byrow == TRUE) { direction <- "(by rows)" } else { direction <- "(by cols)" } # display order and unique states cat("Order of multivariate markov chain =", object@order, "\n") cat("states =", object@states, "\n") cat("\n") cat("List of Lambda's and the corresponding transition matrix", direction,":\n") # display transition matrices and the corresponding lambdas n <- object@order s <- sqrt((dim(object@P))[3]/n) for(i in 1:s) { for(j in 1:s) { # t is the index of transition matrix for transition from i sequence to j sequence # order of transition matrices in P is P1{1,1},P2{1,1}..Pn{1,1},P1{1,2}....Pn{s,s} t <- n * s * (i-1) + (j-1) * n for(k in 1:n) { cat("Lambda", k, "(", i, ",", j, ") : ", object@Lambda[t+k],"\n", sep = "") cat("P", k, "(", i, ",", j, ") : \n", sep = "") print(object@P[, , t+k]) cat("\n") } } } } #' @title Function to display the details of hommc object #' @description This is a convenience function to display the slots of hommc object #' in proper format #' #' @param object An object of class hommc #' #' @rdname hommc-show #' @export setMethod("show", "hommc", function(object){ .showHommc(object) } ) # all transition matrices # n*s*s n = order s = number of categorical sequences # verified using two examples from research paper .allTransMat <- function(data, order = 2) { n <- order # order uelement <- sort(unique(as.character(data))) # unique element m <- length(uelement) # dim of trans-matrix s <- nrow(data) # number of categorical sequence lseq <- ncol(data) # length of each categorical sequence # store all transition matrices allTmat <- array(dim = c(length(uelement), length(uelement), n*s*s), dimnames = list(uelement, uelement)) t <- 1 # help for(i in 1:s) { for(j in 1:s) { x <- data[j, ] # jth sequence y <- data[i, ] # ith sequence # jumps for(h in 1:n) { # column wise allTmat[ , , t] <- t(createSequenceMatrix(matrix(c(x[1:(lseq-h)], y[-(1:h)]), ncol = 2, byrow = FALSE), toRowProbs = TRUE, possibleStates = uelement, sanitize = TRUE)) t <- t + 1 } } } return(allTmat) } # distribution of each categorical sequence based on the frequency # verified using two examples from research paper .allFreqProbMat <- function(data) { uelement <- sort(unique(as.character(data))) # unique element m <- length(uelement) # dim of trans-matrix s <- nrow(data) # number of categorical sequence # frequency based probability for all sequences freqMat <- array(0, dim = c(m, 1, s), dimnames = list(uelement)) for(i in 1:s) { idata <- data[i, ] # ith categorical sequence # populate frequency matrix for(j in idata) { freqMat[j, 1, i] <- freqMat[j, 1, i] + 1 } # normalization freqMat[, , i] <- freqMat[, , i] / sum(freqMat[, , i]) } return(freqMat) } # objective function to pass to solnp .fn3 <- function(params, ...) { hdata <- list(...) # calculate error error <- 0 # number of categorical sequence s <- hdata$s # order n <- hdata$n # number of uniq states || dimension of t-matrix m <- hdata$m # array of transition matrices allTmat <- hdata$allTmat # all frequency matrix freqMat <- hdata$freqMat # norm Norm <- hdata$Norm for(i in 1:s) { helper <- matrix(0, nrow = m*n, ncol = 1) for(j in 1:s) { helper2 <- matrix(0, nrow = m, ncol = 1) y <- n * (j - 1 + s * (i - 1)) for(k in 1:n) { helper2 <- helper2 + params[y + k] * (allTmat[ , , y + k] %*% matrix(freqMat[ , , j])) } helper[1:m, ] <- helper[1:m, ] + helper2 if(i == j && n>= 2) { for(k in 2:n) { p <- (k - 1) * m helper[(p + 1):(p + m)] <- freqMat[ , , j] } } } error <- error + sum(abs((helper - freqMat[ , , i]) ^ Norm)) } return(error ^ (1 / Norm)) } # equality constraint function to pass to solnp .eqn3 <- function(params, ...) { hdata <- list(...) # number of categorical sequence s <- hdata$s # order n <- hdata$n toReturn <- numeric() for(i in 1:s) { toReturn[i] <- sum(params[((i - 1) * n * s + 1):(i * n * s)]) } return(toReturn) } #' Function to fit Higher Order Multivariate Markov chain #' #' @description Given a matrix of categorical sequences it fits #' Higher Order Multivariate Markov chain. #' #' @param seqMat a matrix or a data frame where each column #' is a categorical sequence #' @param order Multivariate Markov chain order. Default is 2. #' @param Norm Norm to be used. Default is 2. #' #' @return an hommc object #' #' @examples #' data <- matrix(c('2', '1', '3', '3', '4', '3', '2', '1', '3', '3', '2', '1', #' c('2', '4', '4', '4', '4', '2', '3', '3', '1', '4', '3', '3')), #' ncol = 2, byrow = FALSE) #' #' fitHighOrderMultivarMC(data, order = 2, Norm = 2) #' #' @references W.-K. Ching et al. / Linear Algebra and its Applications #' #' @author Giorgio Spedicato, Deepak Yadav #' #' @export fitHighOrderMultivarMC <- function(seqMat, order = 2, Norm = 2) { if (requireNamespace("Rsolnp", quietly = TRUE)) { message("This function is experimental") if(is.data.frame(seqMat) == TRUE) { seqMat <- as.matrix(seqMat) } seqMat <- t(seqMat) # array of transition matrices allTmat <- .allTransMat(seqMat, order = order) # array of freq probability freqMat <- .allFreqProbMat(seqMat) n <- order # order uelement <- sort(unique(as.character(seqMat))) # unique element m <- length(uelement) # dim of trans-matrix s <- nrow(seqMat) # number of categorical sequence lmbda <- rep(1 / (n * s), n * s * s) fit <- Rsolnp::solnp(pars = lmbda, fun = .fn3, eqfun = .eqn3, eqB = rep(1, s), LB = rep(0, n * s * s), control = list(trace = 0), allTmat = allTmat, freqMat = freqMat, n = n, m = m, s = s, Norm = Norm) return(new("hommc", order = order, Lambda = fit$pars, P = allTmat, states = uelement, byrow = FALSE)) } else { print("Rsolnp unavailable") return(NULL) } } #' Simulate a higher order multivariate markovchain #' #' @description #' This function provides a prediction of states for a higher order #' multivariate markovchain object #' #' @usage predictHommc(hommc,t,init) #' #' @param hommc a hommc-class object #' @param t no of iterations to predict #' @param init matrix of previous states size of which depends on hommc #' #' @details #' The user is required to provide a matrix of giving n previous coressponding #' every categorical sequence. Dimensions of the init are s X n, where s is #' number of categorical sequences and n is order of the homc. #' #' @return #' The function returns a matrix of size s X t displaying t predicted states #' in each row coressponding to every categorical sequence. #' #' @author Vandit Jain #' #' #' @export predictHommc <- function(hommc, t, init) { ## order of markovchain n <- hommc@order ## number of categorical sequences s <- sqrt((dim(hommc@P))[3]/n) ## list of states states <- hommc@states ## size of set of all possible states m <- length(states) ## if initial states not provided take statndard example if(missing(init)) { init <- matrix(rep(states[1],s*n),nrow = s,byrow = TRUE) } if(!all(dim(init) == c(s,n))){ stop("Please provide sufficient number of previous states") } if(!is(hommc, "hommc")) { stop("Please provide a valid hommc-class object") } if(t <=0) stop("T should be a positive integer") for(i in 1:s) { for(j in 1:n) { if(!(init[i,j] %in% states)) stop("invalid states in provided state matrix init") } } ## initialize result matrix result <- matrix(NA,nrow = s,ncol = t) ## runs loop according to hommc class structure for(i in 1:t) { for(j in 1:s) { ## initialises probability according rowProbs <- rep(0,m) ## probability for current sequence depends all sequence for(k in 1:s) { ## gets index of coressponding in the 3-D array P # index is the index of transition matrix for transition from i sequence to j sequence # order of transition matrices in P is P1{1,1},P2{1,1}..Pn{1,1},P1{1,2}....Pn{s,s} index <- n * s * (j-1) + n * (k-1) ## iterates for all order 1 to n for(h in 1:n) { prev <- init[j,n-h+1] label <- which(prev == states) rowProbs <- rowProbs + hommc@Lambda[h + index] * hommc@P[label, ,h + index] } } ## uses sample function from base package curr <- sample(size = 1, x = states, prob = rowProbs) ## changes init for next t iteration for(temp in 2:n) { if(temp <= n) init[j,temp-1] = init[j,temp] } init[j,n] = curr; result[j,i] = curr; } } ## returns result return(result) } markovchain/R/random.R0000644000176200001440000000235114714756745014405 0ustar liggesusers# Methods to generate random markov chains normalizeMatrix <- function(matrix, byrow = TRUE) { margin <- ifelse (byrow, 1, 2) n <- nrow(matrix) result <- sapply(1:n, function(i) { row <- matrix[i, ] rowSum <- sum(row) if (rowSum == 0) { values <- c(rep(0, i - 1), 1, rep(0, n - i)) values } else { row / rowSum } }) # If we want the result by rows, we have to transpose the matrix, # since the apply method with margin = 1 (over rows) returns the result # by columns if (byrow) t(result) else result } # Returns a random stochastic matrix randomStochasticMatrix <- function(n, zeroProb, byrow = TRUE) { numRandom <- n * n randomNums <- stats::runif(numRandom) remainProb <- (1 - zeroProb) / numRandom probs <- c(zeroProb, rep(remainProb, numRandom)) entries <- sample(c(0, randomNums), numRandom, prob = probs, replace = TRUE) result <- matrix(entries, n, n, byrow) result <- normalizeMatrix(result, byrow) result } randomMarkovChain <- function(n, zeroProb = 0.95, byrow = TRUE) { matrix <- randomStochasticMatrix(n, zeroProb, byrow) new("markovchain", transitionMatrix = matrix, byrow = byrow) }markovchain/R/statisticalTests.R0000644000176200001440000004317714714756745016507 0ustar liggesusers#helper functions #helper function for checkMP .findNijPjk<-function(Nijk = Nijk, Nij = Nij, trans, row = 1){ i <- Nijk[row,1] j <- Nijk[row,2] k <- Nijk[row,3] fromCh <- as.character(j) toCh <- as.character(k) Pjk <- trans[fromCh,toCh] m1 <- which(Nij[, 1] == i) m2 <- which(Nij[, 2] == j) m <- c(m1, m2) return(Nij[m[anyDuplicated(m)], 3] * Pjk) } #' @name verifyMarkovProperty #' #' @rdname statisticalTests #' @family statisticalTests #' #' @title Various functions to perform statistical inference of DTMC #' @description These functions verify the Markov property, assess #' the order and stationarity of the Markov chain. #' #' @param sequence An empirical sequence. #' @param verbose Should test results be printed out? #' @param nblocks Number of blocks. #' #' @return Verification result #' #' @references Anderson and Goodman. #' #' @author Tae Seung Kang, Giorgio Alfredo Spedicato #' #' @seealso \code{markovchain} #' #' @examples #' sequence <- c("a", "b", "a", "a", "a", "a", "b", "a", "b", #' "a", "b", "a", "a", "b", "b", "b", "a") #' mcFit <- markovchainFit(data = sequence, byrow = FALSE) #' verifyMarkovProperty(sequence) #' assessOrder(sequence) #' assessStationarity(sequence, 1) #' #' #' @export # check if the sequence holds the Markov property verifyMarkovProperty <- function(sequence, verbose = TRUE) { #warning("The accuracy of the statistical inference functions has been questioned. It will be thoroughly investigated in future versions of the package.") #fitting the markovchain transMatrix <- markovchainFit(data = sequence)$estimate@transitionMatrix #make the (n-2)x3 matrix for observations subSample<-sequence[1:(length(sequence) - (length(sequence)%%3))] seqSet1<-matrix(c(subSample[1:(length(subSample) - 2)], subSample[2:(length(subSample) - 1)], subSample[3:(length(subSample))] ),ncol = 3) #fill the matrix in reverse order so position 11 is the first obersvation,12 second and 13 third #compute row frequencies temp<-as.data.frame(seqSet1) Nijk<-aggregate(temp, by = temp, length)[1:(ncol(temp) + 1)] seqSet2 <- seqSet1[, -3] #make matrix of couples temp2 <- as.data.frame(seqSet2) Nij <- aggregate(temp2, by = temp2, length)[1:(ncol(temp2) + 1)] #rowfrequencies included test<-c(length = dim(Nijk)[1]) #compute the test statistic invisible(lapply(seq_len(dim(Nijk)[1]),function(i) { foundNijPjk <- .findNijPjk(Nijk = Nijk, Nij = Nij, trans = transMatrix, row = i) test[i] <<- ((Nijk[i,4]-foundNijPjk)^2)/foundNijPjk }) ) statistic <- sum(test) #return value of the test statistic and test at confience level 95% and 99% #dof #Steps : No. of df = No. of triplets - No. of doubles + No. of observations - 1 #Creating vector of doubles/pairs doubles = numeric(length(sequence)-1) for(i in 1:(length(doubles))) {doubles[i] = paste(sequence[i], sequence[i+1], sep="", collapse = NULL)} #Creating vector of triplets triples = numeric(length(sequence)-2) for(i in 1:(length(triples))) {triples[i] = paste(sequence[i], sequence[i+1], sequence[i+2], sep="", collapse = NULL)} #Hence no. of df is--- dof = length(unique(triples)) - length(unique(doubles)) + length(unique(sequence)) - 1 pvalue <- 1-pchisq(q = statistic,df = dof) out <- list(statistic = statistic,dof = dof,p.value = pvalue) if (verbose == TRUE) { cat("Testing markovianity property on given data sequence\n") cat("Chi - square statistic is:", statistic, "\n") cat("Degrees of freedom are:", dof, "\n") cat("And corresponding p-value is:", pvalue, "\n") } invisible(out) } #' @rdname statisticalTests #' @export # check if sequence is of first order or of second order assessOrder <- function(sequence, verbose = TRUE) { warning("The accuracy of the statistical inference functions has been questioned. It will be thoroughly investigated in future versions of the package.") # length of sequence n <- length(sequence) # unique states states <- unique(sequence) # number of unique states nelements <- length(states) TStat <- 0 for(present in states) { # going to be a transition matrix mat <- zeros(nelements) dimnames(mat) <- list(states, states) # populate transition matrix for(i in 1:(n - 2)) { if(present == sequence[i + 1]) { past <- sequence[i] future <- sequence[i + 2] mat[past, future] <- mat[past, future] + 1 } } # chi-squared test res <- chisq.test(mat) TStat <- TStat + res$statistic } k <- nelements df <- k * (k - 1)^2 pvalue <- 1-pchisq(q = TStat, df) out <- list(statistic = TStat[[1]], p.value = pvalue[[1]]) # returning the output if (verbose == TRUE) { cat("The assessOrder test statistic is: ", TStat, "\n") cat("The Chi-Square d.f. are: ", df, "\n") cat("The p-value is: ", pvalue, "\n") } invisible(out) } #' @rdname statisticalTests #' @export # check if sequence is stationary assessStationarity <- function(sequence, nblocks, verbose = TRUE) { warning("The accuracy of the statistical inference functions has been questioned. It will be thoroughly investigated in future versions of the package.") # length of sequence n <- length(sequence) # size of each block blocksize <- n / nblocks # vector of unique states states <- unique(sequence) # number of states nstates <- length(states) # sum of the statistics TStat <- 0 # chi-squared test for each state for(i in states) { # init matrix mat <- matrix(0,nblocks, nstates) dimnames(mat) <- list(1:nblocks, states) # compute the transition matrix from sequence for(j in 1:(n - 1)) { if(sequence[j] == i) { # row index b <- ceiling(j / blocksize) # next state future <- sequence[j+1] # update transition matrix mat[b, future] <- mat[b, future] + 1 } } # vector to store row sum of matrix rowsums <- rowSums(mat) # store the indices with zero row sum indices <- which(rowsums == 0) # update rows with zero sum for(k in indices) mat[k, ] <- 1/nstates # update row sum after checking zero sum row rowsums <- rowSums(mat) # row-wise normalize. mat <- mat/rowsums # Some columns may still be all zeros. This causes NaN for chi-squared test. # chi-squared test res <- chisq.test(mat) TStat <- TStat + res$statistic } k <- nstates # degree of freedom df <- k * (nblocks - 1) * (k - 1) pvalue <- 1 - pchisq(TStat, df) # returning the output if (verbose==TRUE) { cat("The assessStationarity test statistic is: ", TStat, "\n") cat("The Chi-Square d.f. are: ", df, "\n") cat("The p-value is: ", pvalue, "\n") } out <- list(statistic = TStat[[1]], p.value = pvalue[[1]]) invisible(out) } # sequence to transition frequencey matrix .seq2mat <- function(sequence) { # basic requirement to create transition matrix n <- length(sequence) states <- unique(sequence) nstates <- length(states) # create transition matrix mat <- zeros(nstates) dimnames(mat) <- list(states, states) # populate transition matrix for(i in 1:(n - 1)) { from <- sequence[i] to <- sequence[i+1] mat[from, to] <- mat[from, to] + 1 } return (mat) } #' @title test whether an empirical transition matrix is compatible to a theoretical one #' #' @description This function tests whether an empirical transition matrix is statistically compatible #' with a theoretical one. It is a chi-square based test. In case a cell in the empirical transition matrix is >0 #' that is 0 in the theoretical transition matrix the null hypothesis is rejected. #' #' @rdname statisticalTests #' @family statisticalTests #' #' @param data matrix, character or list to be converted in a raw transition matrix #' @param object a markovchain object #' #' @return a list with following slots: statistic (the chi - square statistic), dof (degrees of freedom), and corresponding p-value. In case a cell in the empirical transition matrix is >0 #' that is 0 in the theoretical transition matrix the null hypothesis is rejected. In that case a p-value of 0 and statistic and dof of NA are returned. #' @export #' #' @examples #' #' #Example taken from Kullback Kupperman Tests for Contingency Tables and Markov Chains #' #' sequence<-c(0,1,2,2,1,0,0,0,0,0,0,1,2,2,2,1,0,0,1,0,0,0,0,0,0,1,1, #' 2,0,0,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,0,2,1,0, #' 0,2,1,0,0,0,0,0,0,1,1,1,2,2,0,0,2,1,1,1,1,2,1,1,1,1,1,1,1,1,1,0,2, #' 0,1,1,0,0,0,1,2,2,0,0,0,0,0,0,2,2,2,1,1,1,1,0,1,1,1,1,0,0,2,1,1, #' 0,0,0,0,0,2,2,1,1,1,1,1,2,1,2,0,0,0,1,2,2,2,0,0,0,1,1) #' #' mc=matrix(c(5/8,1/4,1/8,1/4,1/2,1/4,1/4,3/8,3/8),byrow=TRUE, nrow=3) #' rownames(mc)<-colnames(mc)<-0:2; theoreticalMc<-as(mc, "markovchain") #' #' verifyEmpiricalToTheoretical(data=sequence,object=theoreticalMc) #' verifyEmpiricalToTheoretical <- function(data, object, verbose = TRUE) { #warning("The accuracy of the statistical inference functions has been questioned. It will be thoroughly investigated in future versions of the package.") if (!is(object,'markovchain') ) stop("Error! Object should belong to the markovchain class") if (missing(data) | missing(object)) stop("Error! Required inputs missing") if ( !is.numeric(data) || is.character(data) || is.matrix(data)) stop("Error! Data should be either a raw transition matrix or either a character or a numeric element") if (is.numeric(data) || is.character(data) ) data<-createSequenceMatrix(stringchar = data, possibleStates = states(object)) if (length(setdiff(names(data),names(object))) > 0) stop("Error! Empirical and theoretical tm have different support") # (possibly rearrange columns and rownames) data <- data[match(rownames(data),names(object)),] #matching rows data <- data[,match(colnames(data),names(object))] #matching cols if (sum((data == 0) == (object@transitionMatrix == 0)) == (nrow(data) * ncol(data))) { f_i_dot <-colSums(data) statistic <- 0 for (i in 1:dim(object)) { for (j in 1:dim(object)) { if (data[i, j]>0&object[i, j]>0) statistic <- statistic + data[i, j]*log(data[i, j]/(f_i_dot[i]*object[i, j])) } } statistic <- statistic * 2 null_elements <- sum(object@transitionMatrix == 0) dof <- dim(object) * (dim(object) - 1) - null_elements #r(r-1) - c, c null element ob objects p.value <- 1 - pchisq(q = statistic,df = dof) if (verbose == TRUE) { cat("Testing whether the\n");print(data);cat("transition matrix is compatible with\n");print(object@transitionMatrix);print("theoretical transition matrix") cat("ChiSq statistic is",statistic,"d.o.f are",dof,"corresponding p-value is",p.value,"\n") } out <- list(statistic = statistic, dof = dof,pvalue = p.value) } else { statistic <- NA dof <- NA p.value <- 0 if (verbose == TRUE) { cat("Testing whether the\n");print(data);cat("transition matrix is compatible with\n");print(object@transitionMatrix);print("theoretical transition matrix") cat("ChiSq statistic is",statistic,"d.o.f are",dof,"corresponding p-value is",p.value,"\n") cat("At least one transition is >0 in the data that is 0 in the object. Therefore the null hypothesis is rejected. \n") } out <- list(statistic = statistic, dof = dof,pvalue = p.value) } #return output return(out) } .checkMatrix4Homogeneity<-function(matr) { out<-TRUE if (length(colnames(matr)) == 0) {message("Error! No colnames in input matrix"); out = FALSE} if (length(rownames(matr)) == 0) {message("Error! No rownames in input matrix"); out = FALSE} if (!all.equal(rownames(matr),colnames(matr))) {message("Error! Colnames <> Rownames")} if (any(matr<0)) {message("Error! Negative elements"); out = FALSE} return(out) } .addNamedColumns <- function(matr, fullnames) { if ( length( setdiff(names(matr),fullnames) )>0) stop("Error! Names in matr not in fullnames") fullnames<-sort(fullnames) newMatr<-matrix(0,nrow = length(fullnames),ncol = length(fullnames),dimnames = list(fullnames,fullnames)) current_support = colnames(matr) current_dim = dim(matr) for (i in 1:current_dim[1]) { #cycle on row for (j in 1:current_dim[2]) { #cycle on cols item<-matr[i,j] #take the element which_row_trans<-current_support[i] #define current row and cols which_col_trans<-current_support[j] # lookup element in the pooled table row_to_write <-match(x=which_row_trans,table = fullnames) col_to_write <-match(x=which_col_trans,table = fullnames) # write element into the pooled table newMatr[row_to_write,col_to_write] <- newMatr[row_to_write,col_to_write] + item } } return(newMatr) } #' @title Verify Homogeneity across transition matrices #' #' @description Verifies that the s elements in the input list belongs to the same DTMC #' #' @rdname statisticalTests #' @family statisticalTests #' #' @param inputList A list of items that can coerced to transition matrices #' #' @return a list of transition matrices? #' @export #' #' @examples #' #' data(kullback) #' verifyHomogeneity(inputList=kullback,verbose=TRUE) #' verifyHomogeneity<-function(inputList, verbose = TRUE) { warning("The accuracy of the statistical inference functions has been questioned. It will be thoroughly investigated in future versions of the package.") if (!is.list(inputList) ) stop("Error! inputList should be a string") if (length(inputList) < 2) stop("Error! inputList length lower than 2") #checks whether all inputs can be put as transition matrices for (i in 1:length(inputList)) { if (is.matrix(inputList[[i]]) == TRUE) { checks<-.checkMatrix4Homogeneity(inputList[[i]]) if (!checks) stop("Error! Element ", i, " to be checked") } else { inputList[[i]]<-createSequenceMatrix(stringchar = inputList[[i]]) #convert all elements into transition matrices } } # create the pooled raw transition matrix and the matrix of rowsums all.names<-character() for (i in 1:length(inputList)) { all.names<-c(all.names, rownames(inputList[[i]])) } all.names<-sort(unique(all.names)) ##initialize PooledRawTransitionMatrix <- matrix(0,nrow = length(all.names),ncol = length(all.names),dimnames = list(all.names, all.names)) RowSumsMatrix <- matrix(0, nrow = length(inputList),ncol=length(all.names),dimnames = list(1:length(inputList),all.names)) ##sum for each element in the list for (k in 1:length(inputList)) { current_support = rownames(inputList[[k]]) current_dim = dim(inputList[[k]]) for (i in 1:current_dim[1]) { #cycle on row for (j in 1:current_dim[2]) { #cycle on cols num_trans<-inputList[[k]][i, j] #take the element which_row_trans <- current_support[i] #define current row and cols which_col_trans <- current_support[j] # lookup element in the pooled table row_to_write <-match(x = which_row_trans,table = all.names) col_to_write <-match(x = which_col_trans,table = all.names) # write element into the pooled table PooledRawTransitionMatrix[row_to_write,col_to_write]=PooledRawTransitionMatrix[row_to_write,col_to_write]+num_trans } } } #create the matrix of rowsums fij. for (k in 1:length(inputList)) { my_row_sums <- rowSums(inputList[[k]]) current_support = names(my_row_sums) for (i in 1:length(current_support)) { my_element<-my_row_sums[i] col_to_write<-match(x=current_support[i],table = all.names) RowSumsMatrix[k, col_to_write]<-RowSumsMatrix[k, col_to_write] + my_element } } # compute the chi - square statistic statistic <- 0 # degreesOfFreedomLess <- 0 newInputList <- lapply(inputList, .addNamedColumns,fullnames = all.names) number_of_transitions <- sapply(newInputList,sum) total_transitions <- sum(number_of_transitions) for (s in 1:length(inputList)) { #cycle across inputs for (j in 1:length(all.names)) { #cycle across rows for (k in 1:length(all.names)) { #cycle across cols if (any(newInputList[[s]][j,k] == 0, number_of_transitions[s] == 0, PooledRawTransitionMatrix[j,k] == 0)) { statistic <- statistic + 0 # zero element in log expr does not contribute to statistics # degreesOfFreedomLess <- degreesOfFreedomLess +1 } else { statistic <- statistic + newInputList[[s]][j, k] * log((total_transitions*newInputList[[s]][j, k])/(number_of_transitions[s]*PooledRawTransitionMatrix[j,k])) } } } } statistic <- statistic * 2 #dof (s-1)*(r^2-1)-#zeros degrees_of_freedom <- (length(inputList) - 1)*(length(all.names)^2 - 1)#-degreesOfFreedomLess p.value <- 1 - pchisq(q = statistic,df = degrees_of_freedom) if (verbose == TRUE) { cat("Testing homogeneity of DTMC underlying input list \n") cat("ChiSq statistic is",statistic,"d.o.f are",degrees_of_freedom,"corresponding p-value is",p.value,"\n") } #return output out <- list(statistic = statistic, dof = degrees_of_freedom,pvalue = p.value) return(out) } markovchain/R/classesAndMethods.R0000644000176200001440000012366714714756745016547 0ustar liggesusers#' @title Markov Chain class #' @name markovchain-class #' @aliases markovchain-class *,markovchain,markovchain-method #' *,markovchain,matrix-method *,markovchain,numeric-method #' *,matrix,markovchain-method *,numeric,markovchain-method #' ==,markovchain,markovchain-method !=,markovchain,markovchain-method #' absorbingStates,markovchain-method transientStates,markovchain-method #' recurrentStates,markovchain-method transientClasses,markovchain-method #' recurrentClasses,markovchain-method communicatingClasses,markovchain-method #' steadyStates,markovchain-method meanNumVisits,markovchain-method #' is.regular,markovchain-method is.irreducible,markovchain-method #' is.accessible,markovchain,character,character-method #' is.accessible,markovchain,missing,missing-method #' absorptionProbabilities,markovchain-method #' meanFirstPassageTime,markovchain,character-method #' meanFirstPassageTime,markovchain,missing-method #' meanAbsorptionTime,markovchain-method #' meanRecurrenceTime,markovchain-method #' conditionalDistribution,markovchain-method hittingProbabilities,markovchain-method #' canonicForm,markovchain-method coerce,data.frame,markovchain-method #' coerce,markovchain,data.frame-method coerce,table,markovchain-method #' coerce,markovchain,igraph-method coerce,markovchain,matrix-method #' coerce,markovchain,sparseMatrix-method coerce,sparseMatrix,markovchain-method #' coerce,matrix,markovchain-method coerce,Matrix,markovchain-method #' coerce,msm,markovchain-method #' coerce,msm.est,markovchain-method coerce,etm,markovchain-method #' dim,markovchain-method initialize,markovchain-method #' names<-,markovchain-method plot,markovchain,missing-method #' predict,markovchain-method print,markovchain-method #' show,markovchain-method summary,markovchain-method #' sort,markovchain-method t,markovchain-method #' [,markovchain,ANY,ANY,ANY-method ^,markovchain,numeric-method #' @description The S4 class that describes \code{markovchain} objects. #' #' @param states Name of the states. Must be the same of \code{colnames} and \code{rownames} of the transition matrix #' @param byrow TRUE or FALSE indicating whether the supplied matrix #' is either stochastic by rows or by columns #' @param transitionMatrix Square transition matrix #' @param name Optional character name of the Markov chain #' #' @section Creation of objects: #' #' Objects can be created by calls of the form \code{new("markovchain", states, byrow, transitionMatrix, ...)}. #' #' @section Methods: #' #' \describe{ #' \item{*}{\code{signature(e1 = "markovchain", e2 = "markovchain")}: multiply two \code{markovchain} objects} #' \item{*}{\code{signature(e1 = "markovchain", e2 = "matrix")}: markovchain by matrix multiplication} #' \item{*}{\code{signature(e1 = "markovchain", e2 = "numeric")}: markovchain by numeric vector multiplication } #' \item{*}{\code{signature(e1 = "matrix", e2 = "markovchain")}: matrix by markov chain} #' \item{*}{\code{signature(e1 = "numeric", e2 = "markovchain")}: numeric vector by \code{markovchain} multiplication } #' \item{[}{\code{signature(x = "markovchain", i = "ANY", j = "ANY", drop = "ANY")}: ... } #' \item{^}{\code{signature(e1 = "markovchain", e2 = "numeric")}: power of a \code{markovchain} object} #' \item{==}{\code{signature(e1 = "markovchain", e2 = "markovchain")}: equality of two \code{markovchain} object} #' \item{!=}{\code{signature(e1 = "markovchain", e2 = "markovchain")}: non-equality of two \code{markovchain} object} #' \item{absorbingStates}{\code{signature(object = "markovchain")}: method to get absorbing states } #' \item{canonicForm}{\code{signature(object = "markovchain")}: return a \code{markovchain} object into canonic form } #' \item{coerce}{\code{signature(from = "markovchain", to = "data.frame")}: coerce method from markovchain to \code{data.frame}} #' \item{conditionalDistribution}{\code{signature(object = "markovchain")}: returns the conditional probability of subsequent states given a state} #' \item{coerce}{\code{signature(from = "data.frame", to = "markovchain")}: coerce method from \code{data.frame} to \code{markovchain}} #' \item{coerce}{\code{signature(from = "table", to = "markovchain")}: coerce method from \code{table} to \code{markovchain} } #' \item{coerce}{\code{signature(from = "msm", to = "markovchain")}: coerce method from \code{msm} to \code{markovchain} } #' \item{coerce}{\code{signature(from = "msm.est", to = "markovchain")}: coerce method from \code{msm.est} (but only from a Probability Matrix) to \code{markovchain} } #' \item{coerce}{\code{signature(from = "etm", to = "markovchain")}: coerce method from \code{etm} to \code{markovchain} } #' \item{coerce}{\code{signature(from = "sparseMatrix", to = "markovchain")}: coerce method from \code{sparseMatrix} to \code{markovchain} } #' \item{coerce}{\code{signature(from = "markovchain", to = "igraph")}: coercing to \code{igraph} objects } #' \item{coerce}{\code{signature(from = "markovchain", to = "matrix")}: coercing to \code{matrix} objects } #' \item{coerce}{\code{signature(from = "markovchain", to = "sparseMatrix")}: coercing to \code{sparseMatrix} objects } #' \item{coerce}{\code{signature(from = "matrix", to = "markovchain")}: coercing to \code{markovchain} objects from \code{matrix} one } #' \item{dim}{\code{signature(x = "markovchain")}: method to get the size} #' \item{names}{\code{signature(x = "markovchain")}: method to get the names of states} #' \item{names<-}{\code{signature(x = "markovchain", value = "character")}: method to set the names of states} #' \item{initialize}{\code{signature(.Object = "markovchain")}: initialize method } #' \item{plot}{\code{signature(x = "markovchain", y = "missing")}: plot method for \code{markovchain} objects } #' \item{predict}{\code{signature(object = "markovchain")}: predict method } #' \item{print}{\code{signature(x = "markovchain")}: print method. } #' \item{show}{\code{signature(object = "markovchain")}: show method. } #' \item{sort}{\code{signature(x = "markovchain", decreasing=FALSE)}: sorting the transition matrix. } #' \item{states}{\code{signature(object = "markovchain")}: returns the names of states (as \code{names}. } #' \item{steadyStates}{\code{signature(object = "markovchain")}: method to get the steady vector. } #' \item{summary}{\code{signature(object = "markovchain")}: method to summarize structure of the markov chain } #' \item{transientStates}{\code{signature(object = "markovchain")}: method to get the transient states. } #' \item{t}{\code{signature(x = "markovchain")}: transpose matrix } #' \item{transitionProbability}{\code{signature(object = "markovchain")}: transition probability } #' } #' #' @references #' A First Course in Probability (8th Edition), Sheldon Ross, Prentice Hall 2010 #' #' @author Giorgio Spedicato #' @note #' \enumerate{ #' \item \code{markovchain} object are backed by S4 Classes. #' \item Validation method is used to assess whether either columns or rows totals to one. #' Rounding is used up to \code{.Machine$double.eps * 100}. If state names are not properly #' defined for a probability \code{matrix}, coercing to \code{markovchain} object leads #' to overriding states name with artificial "s1", "s2", ... sequence. In addition, operator #' overloading has been applied for \eqn{+,*,^,==,!=} operators. #' } #' #' @seealso \code{\link{markovchainSequence}},\code{\link{markovchainFit}} #' #' @examples #' #show markovchain definition #' showClass("markovchain") #' #create a simple Markov chain #' transMatr<-matrix(c(0.4,0.6,.3,.7),nrow=2,byrow=TRUE) #' simpleMc<-new("markovchain", states=c("a","b"), #' transitionMatrix=transMatr, #' name="simpleMc") #' #power #' simpleMc^4 #' #some methods #' steadyStates(simpleMc) #' absorbingStates(simpleMc) #' simpleMc[2,1] #' t(simpleMc) #' is.irreducible(simpleMc) #' #conditional distributions #' conditionalDistribution(simpleMc, "b") #' #example for predict method #' sequence<-c("a", "b", "a", "a", "a", "a", "b", "a", "b", "a", "b", "a", "a", "b", "b", "b", "a") #' mcFit<-markovchainFit(data=sequence) #' predict(mcFit$estimate, newdata="b",n.ahead=3) #' #direct conversion #' myMc<-as(transMatr, "markovchain") #' #' #example of summary #' summary(simpleMc) #' \dontrun{plot(simpleMc)} #' #' @keywords classes #' #' @export setClass( # Class name "markovchain", # Define the slots slots = list(states = "character", byrow = "logical", transitionMatrix = "matrix", name = "character"), # Set the default values for the slots prototype = list( states = c("a", "b"), byrow = TRUE, transitionMatrix = matrix( data = c(0, 1, 1, 0), nrow = 2, byrow = TRUE, dimnames = list(c("a", "b"), c("a", "b"))), name = "Unnamed Markov chain") ) # Initializing method for markovchain objects setMethod( "initialize", signature(.Object = "markovchain"), function (.Object, states, byrow, transitionMatrix, name, ...) { # Put the standard markovchain if (missing(transitionMatrix)) { transitionMatrix <- matrix( data = c(0, 1, 1, 0), nrow = 2, byrow = TRUE, dimnames = list(c("a", "b"), c("a", "b"))) } rowNames <- rownames(transitionMatrix) colNames <- colnames(transitionMatrix) # Check names of transition matrix # if all names are missing it initializes them to "1", "2", .... if (all(is.null(rowNames), is.null(colNames)) == TRUE) { if (missing(states)) { numRows <- nrow(transitionMatrix) stateNames <- as.character(seq(1:numRows)) } else { stateNames <- states } rownames(transitionMatrix) <- stateNames colnames(transitionMatrix) <- stateNames # Fix when rownames null } else if (is.null(rowNames)) { rownames(transitionMatrix) <- colNames # Fix when colnames null } else if (is.null(colNames)) { colnames(transitionMatrix) <- rowNames # Fix when different } else if (! setequal(rowNames, colNames)) { colnames(transitionMatrix) <- rowNames } if (missing(states)) states <- rownames(transitionMatrix) if (missing(byrow)) byrow <- TRUE if (missing(name)) name <- "Unnamed Markov chain" callNextMethod( .Object, states = states, byrow = byrow, transitionMatrix = as.matrix(transitionMatrix), name = name, ... ) } ) #' @title Non homogeneus discrete time Markov Chains class #' @name markovchainList-class #' @aliases [[,markovchainList-method dim,markovchainList-method #' predict,markovchainList-method print,markovchainList-method #' show,markovchainList-method #' @description A class to handle non homogeneous discrete Markov chains #' #' @param markovchains Object of class \code{"list"}: a list of markovchains #' @param name Object of class \code{"character"}: optional name of the class #' #' @section Objects from the Class: #' #' A \code{markovchainlist} is a list of \code{markovchain} objects. They can #' be used to model non homogeneous discrete time Markov Chains, when #' transition probabilities (and possible states) change by time. #' @section Methods: #' \describe{ #' \item{[[}{\code{signature(x = "markovchainList")}: extract the #' i-th \code{markovchain} } #' \item{dim}{\code{signature(x = "markovchainList")}: number #' of \code{markovchain} underlying the matrix } #' \item{predict}{\code{signature(object = "markovchainList")}: predict #' from a \code{markovchainList} } #' \item{print}{\code{signature(x = "markovchainList")}: prints the list #' of markovchains } #' \item{show}{\code{signature(object = "markovchainList")}: same as \code{print} } #' } #' #' @references #' A First Course in Probability (8th Edition), Sheldon Ross, Prentice Hall 2010 #' #' @author Giorgio Spedicato #' #' @note #' The class consists in a list of \code{markovchain} objects. #' It is aimed at working with non homogeneous Markov chains. #' #' @seealso \code{\linkS4class{markovchain}} #' @examples #' showClass("markovchainList") #' #define a markovchainList #' statesNames=c("a","b") #' #' mcA<-new("markovchain",name="MCA", #' transitionMatrix=matrix(c(0.7,0.3,0.1,0.9), #' byrow=TRUE, nrow=2, #' dimnames=list(statesNames,statesNames)) #' ) #' #' mcB<-new("markovchain", states=c("a","b","c"), name="MCB", #' transitionMatrix=matrix(c(0.2,0.5,0.3,0,1,0,0.1,0.8,0.1), #' nrow=3, byrow=TRUE)) #' #' mcC<-new("markovchain", states=c("a","b","c","d"), name="MCC", #' transitionMatrix=matrix(c(0.25,0.75,0,0,0.4,0.6, #' 0,0,0,0,0.1,0.9,0,0,0.7,0.3), #' nrow=4, byrow=TRUE) #' ) #' mcList<-new("markovchainList",markovchains=list(mcA, mcB, mcC), #' name="Non - homogeneous Markov Chain") #' #' @keywords classes #' #' @export setClass( "markovchainList", slots = list( markovchains = "list", name = "character") ) # Verifies whether a markovchainList object is valid or not # A markovchainList is valid iff all the slots are markovchain objects # Returns true if the markovchainList is valid, the indexes of the # wrong slots otherwise setValidity( "markovchainList", function(object) { check <- FALSE markovchains <- object@markovchains classes <- sapply(markovchains, class) nonMarkovchain <- which(classes != "markovchain") errors <- sapply(nonMarkovchain, function(i) { paste(i, "-th element class is not 'markovchain'") }) if (length(errors) == 0) TRUE else errors } ) # generic method to print out states #' @name states #' #' @title Defined states of a transition matrix #' #' @description This method returns the states of a transition matrix. #' #' @param object A discrete \code{markovchain} object #' @return The character vector corresponding to states slot. #' #' @references A First Course in Probability (8th Edition), Sheldon Ross, Prentice Hall 2010 #' #' @author Giorgio Spedicato #' #' @seealso \code{\linkS4class{markovchain}} #' #' @examples #' statesNames <- c("a", "b", "c") #' markovB <- new("markovchain", states = statesNames, transitionMatrix = #' matrix(c(0.2, 0.5, 0.3, 0, 1, 0, 0.1, 0.8, 0.1), nrow = 3, #' byrow = TRUE, dimnames=list(statesNames,statesNames)), #' name = "A markovchain Object" #' ) #' states(markovB) #' names(markovB) #' #' @rdname states #' #' @export setGeneric("states", function(object) standardGeneric("states")) #' @rdname states #' @title states setMethod( "states", "markovchain", function(object) { object@states } ) #' @title Returns the states for a Markov chain object #' #' @param x object we want to return states for #' #' @rdname names setMethod( "names", "markovchain", function(x) { x@states } ) #' @title Method to retrieve name of markovchain object #' #' @name name #' #' @description This method returns the name of a markovchain object #' #' @param object A markovchain object #' @rdname getName #' @author Giorgio Spedicato, Deepak Yadav #' #' @examples #' statesNames <- c("a", "b", "c") #' markovB <- new("markovchain", states = statesNames, transitionMatrix = #' matrix(c(0.2, 0.5, 0.3, 0, 1, 0, 0.1, 0.8, 0.1), nrow = 3, #' byrow = TRUE, dimnames=list(statesNames,statesNames)), #' name = "A markovchain Object" #' ) #' name(markovB) #' #' @export setGeneric("name", function(object) standardGeneric("name")) #' @rdname getName setMethod( "name", "markovchain", function(object) { object@name }) #' @title Method to set name of markovchain object #' #' @name name<- #' #' @description This method modifies the existing name of markovchain object #' #' @param object A markovchain object #' @param value New name of markovchain object #' @rdname setName #' @author Giorgio Spedicato, Deepak Yadav #' #' @examples #' statesNames <- c("a", "b", "c") #' markovB <- new("markovchain", states = statesNames, transitionMatrix = #' matrix(c(0.2, 0.5, 0.3, 0, 1, 0, 0.1, 0.8, 0.1), nrow = 3, #' byrow = TRUE, dimnames=list(statesNames,statesNames)), #' name = "A markovchain Object" #' ) #' name(markovB) <- "dangerous mc" #' #' @export setGeneric("name<-", function(object, value) standardGeneric("name<-")) #' @rdname setName setMethod( "name<-", "markovchain", function(object, value) { object@name <- value object } ) setMethod( "names<-", "markovchain", function(x, value) { rownames(x@transitionMatrix) <- value colnames(x@transitionMatrix) <- value x@states <- value x } ) #' @exportMethod dim setGeneric("dim") # Generic methods to get the dim of a markovchain and markovchainList setMethod( "dim", "markovchain", function(x) { nrow(x@transitionMatrix) } ) setMethod( "dim", "markovchainList", function(x) { length(x@markovchains) } ) # method to set the validity of a markovchain object setValidity( "markovchain", function(object) { errors <- character() transitionMatrix <- object@transitionMatrix states <- object@states if (length(setdiff(states, unique(states))) > 0) { msg <- "Error! States must be unique!" errors <- c(errors, msg) } # Performs a set of checks. If any error arises, it ends up concatenated to errors # Check all values of transition matrix belongs to [0, 1] maybeProbabilities <- sapply(as.numeric(transitionMatrix), .isProbability) if (any(maybeProbabilities) == FALSE) { msg <- "Error! Some elements of transitionMatrix are not probabilities" errors <- c(errors, msg) } # Check whether matrix is square matrix or not if (nrow(transitionMatrix) != ncol(transitionMatrix)) { msg <- "Error! transitionMatrix is not a square matrix" errors <- c(errors, msg) } if (!.checkMatrix(transitionMatrix, object@byrow)) { msg <- paste( paste("Error!", ifelse(object@byrow, "Rows", "Cols")), "of transition matrix do not sum to one" ) errors <- c(errors, msg) } # Check whether column names or rows names equal to state names or not if (! setequal(colnames(transitionMatrix), states)) { msg <- "Error! Colnames of transitionMatrix do not match states" errors <- c(errors, msg) } if (! setequal(rownames(transitionMatrix), states)) { msg <- "Error! Rownames of transitionMatrix do not match states" errors <- c(errors, msg) } if (length(errors) > 0) errors else TRUE } ) # generic method to extract transition probability # from state t0 to state t1 #' @name transitionProbability #' @title Function to get the transition probabilities from initial #' to subsequent states. #' @description This is a convenience function to get transition probabilities. #' #' @param object A \code{markovchain} object. #' @param t0 Initial state. #' @param t1 Subsequent state. #' #' @references A First Course in Probability (8th Edition), #' Sheldon Ross, Prentice Hall 2010 #' #' @return Numeric Vector #' #' @author Giorgio Spedicato #' @seealso \code{\linkS4class{markovchain}} #' #' @examples #' statesNames <- c("a", "b", "c") #' markovB <- new("markovchain", states = statesNames, transitionMatrix = #' matrix(c(0.2, 0.5, 0.3, 0, 1, 0, 0.1, 0.8, 0.1), nrow = 3, #' byrow = TRUE, dimnames=list(statesNames,statesNames)), #' name = "A markovchain Object" #' ) #' transitionProbability(markovB,"b", "c") #' @rdname transitionProbability #' #' @exportMethod transitionProbability setGeneric("transitionProbability", function(object, t0, t1) standardGeneric("transitionProbability")) #' @rdname transitionProbability setMethod("transitionProbability", "markovchain", function(object, t0, t1) { fromState <- which(object@states == t0) toState <- which(object@states == t1) out <- ifelse(object@byrow == TRUE, object@transitionMatrix[fromState, toState] , object@transitionMatrix[toState, fromState]) return(out) } ) # print, plot and show methods .showInt <- function(object, verbose = TRUE) { # find the direction if (object@byrow == TRUE) { direction <- "(by rows)" } else { direction <- "(by cols)" } if (verbose == TRUE) { cat(object@name, "\n A ", dim(object), "- dimensional discrete Markov Chain defined by the following states: \n", paste(states(object), collapse=", "), "\n The transition matrix ", direction, " is defined as follows: \n") } print(object@transitionMatrix) cat("\n") } #' @exportMethod show setGeneric("show") # show methods for markovchain and markovchain list objects setMethod("show", "markovchain", function(object){ .showInt(object) } ) setMethod("show", "markovchainList", function(object) { cat(object@name, " list of Markov chain(s)", "\n") for(i in 1:length(object@markovchains)) { cat("Markovchain ",i,"\n") show(object@markovchains[[i]]) } } ) #' @exportMethod print setGeneric("print") # print methods setMethod("print", "markovchainList", function(x) show(x)) setMethod("print", "markovchain", function(x){ object <- x .showInt(object, verbose = FALSE) } ) .getNet <- function(object, round = FALSE) { # function to get the absorbency matrix to plot and export to igraph # # Args: # object: a markovchain object # round: boolean to round # # Returns: # # a graph adjacency if (object@byrow == FALSE) { object <- t(object) } matr <- object@transitionMatrix*100 if(round == TRUE) { matr <- round(matr, 2) } net <- graph.adjacency(adjmatrix = matr, weighted = TRUE, mode = "directed") return(net) } getColorVector <- function(object){ list <- .communicatingClassesRcpp(object) sections <- length(list) colorList <- grDevices::colors() colorList <- sample(colorList,sections) colorvector <- rep("white",length(object@states)) for(i in 1:length(list)){ part <- list[[i]] for(j in 1:length(part)){ colorvector[match(part[j],object@states)] <- colorList[i] } } return(colorvector) } #' @exportMethod plot setGeneric("plot") # Plot methods for markovchain objects # plot method from stat5 setMethod("plot", signature(x = "markovchain", y = "missing"), function(x, y, package = "igraph", ...) { switch(package, diagram = { if (requireNamespace("diagram", quietly = TRUE)) { .plotdiagram(object = x, ...) } else { netMc <- .getNet(object = x, round = TRUE) edgeLabel <- round(E(netMc)$weight / 100, 2) plot.igraph(x = netMc, edge.label = edgeLabel, ...) } }, DiagrammeR = { if (requireNamespace("DiagrammeR", quietly = TRUE)) { .plotDiagrammeR(object = x, ...) } else { netMc <- .getNet(object = x, round = TRUE) edgeLabel <- round(E(netMc)$weight / 100, 2) plot.igraph(x = netMc, edge.label = edgeLabel, ...) } }, { netMc <- .getNet(object = x,round = TRUE) edgeLabel <- round(E(netMc)$weight / 100, 2) plot.igraph(x = netMc, edge.label = edgeLabel, ...) }) } ) ##################################################AS METHODS######################### .checkMatrix <- function(matr, byrow = TRUE, verbose = FALSE) { # firstly, check size if (ncol(matr) != nrow(matr)) { if(verbose) stop("Error! Not a quadratic matrix") return(FALSE) } # secondly, check is stochastic isStochastic <- .isStochasticMatrix(matr, byrow) if (!isStochastic) { if (verbose) stop("Error! Either rows or cols should sum to 1") return(FALSE) } # if all test are passed return(TRUE) } # Internal function to return a markovchain object given a matrix .matrix2Mc <- function(from) { # enforce class matrix from <- as.matrix(from) # whether given matrix is a transition matrix or not # if it is then how probabilities are stored # row-wise or columnwise byrow <- TRUE checkByRows <- .checkMatrix(from, byrow = byrow) if(!checkByRows) { byrow <- FALSE checkByCols <- .checkMatrix(from, byrow = byrow) if(!checkByCols) { #error could be either in rows or in cols if (any(colSums(from) != 1)) cat("columns sums not equal to one are:", which(colSums(from) != 1),"\n") if (any(rowSums(from) != 1)) cat("row sums not equal to one are:", which(rowSums(from) != 1),"\n") stop("Error! Not a transition matrix") } } # extract states names if(byrow) { namesCandidate <- rownames(from) } else { namesCandidate <- colnames(from) } # if states names is not there create it s1, s2, s3, .... if(is.null(namesCandidate)) { namesCandidate <- paste("s", 1:nrow(from), sep = "") } # create markovchain object out <- new("markovchain", transitionMatrix = from, states = namesCandidate, byrow = byrow) invisible(out) } #' @exportMethod coerce NULL # coerce matrix to markovchain object using internal method # example: as("some matrix", "markovchain") setAs(from = "matrix", to = "markovchain", def = .matrix2Mc) setAs(from = "Matrix", to = "markovchain", def = .matrix2Mc) # Function to transform a markovchain into a data.frame # Args: # from: a markovchain object # # returns: # a data.frame .mc2Df <- function(from) { # number of rows or columns nr <- nrow(from@transitionMatrix) for(i in 1:nr){ for(j in 1:nr){ t0 <- from@states[i] t1 <- from@states[j] prob <- transitionProbability(object = from, t0 = t0, t1 = t1) #cope with the new default of R 4.0 (5-3-2020) rowDf <- data.frame(t0 = t0, t1 = t1, prob = prob,stringsAsFactors = TRUE ) # go to else part if first row of data frame is generated if(exists("outDf")) { outDf <- rbind(outDf, rowDf) } else { outDf <- rowDf } } } return(outDf) } # method to convert(coerce) from markovchain to data.frame setAs(from = "markovchain", to = "data.frame", def = .mc2Df) # method to find the column which stores transition probability .whichColProb <- function(df) { # column number which stores transition probability out <- 0 # check for validity of data frame if(ncol(df) > 3) { warning("Warning! More than three columns. Only the first three will be used") } if(ncol(df) < 3) { stop("Error! Three columns needed") } for(i in 1:ncol(df)) { # when found the first numeric and probability col if((is(df[, i], "numeric")) & (all(sapply(df[, i], .isProbability) == TRUE))) { out <- i break } } return(out) } # Function to convert from a data.frame containing initial, ending # and probability columns to a proper markovchain object # # Args: # from: a data.frame # # Returns: # A markovchain object .df2Mc <- function(from) { statesNames <- unique(from[, 1]) colProb <- .whichColProb(from) # what is the use # transition matrix prMatr <- zeros(length(statesNames)) rownames(prMatr) <- statesNames colnames(prMatr) <- statesNames for(i in 1:nrow(from)) { idRow <- which(statesNames == from[i, 1]) # assume first col from idCol <- which(statesNames == from[i, 2]) # assume second col to prMatr[idRow, idCol] <- from[i, 3] # assume third col t-probability } out <- new("markovchain", transitionMatrix = prMatr) return(out) } # method to convert(coerce) data frame to markovchain object setAs(from = "data.frame", to = "markovchain", def = .df2Mc) # example # data <- data.frame(from = c("a", "a", "b", "b", "b", "b"), # to = c("a", "b", "b", "b", "b", "a")) # # from <- table(data) # .table2Mc(from) .table2Mc <- function(from) { # check whether table has square dimension or not if(dim(from)[1] != dim(from)[2]) { stop("Error! Table is not squared") } # rows ond columns name should be same if(!setequal(rownames(from),colnames(from))) { stop("Error! Rows not equal to coulumns") } temp <- unclass(as.matrix(from)) # make same sequence of col / row fromMatr <- temp[, order(rownames(temp))] # obtain transition matrix outMatr <- fromMatr / rowSums(fromMatr) out <- new("markovchain", states = rownames(temp), transitionMatrix = outMatr, byrow=TRUE) return(out) } # coerce table to markovchain object setAs(from = "table", to = "markovchain", def = .table2Mc) # function from msm to markovchain # msm is a package. Use this package to create msm object. # see how to create msm object using ?msm .msm2Mc <- function(from) { if(requireNamespace(package='msm', quietly = TRUE)) { temp <- msm::pmatrix.msm(from) prMatr <- unclass(as.matrix(temp)) out <- new("markovchain", transitionMatrix = prMatr) } else { out <- NULL print("msm unavailable") } return(out) } # coerce msm object to markovchain object setClass("msm") setAs(from = "msm", to = "markovchain", def = .msm2Mc) # function for msm.est to mc. Assume a probability matrix given .msmest2Mc <- function(from) { if (is.matrix(from)) { # central estimate pMatr <- from } if (is.list(from)) { # central estimate pMatr <- from[[1]] } out <- new("markovchain", transitionMatrix = as(pMatr, "matrix")) return(out) } # coerce ms.est to markovchain object setClass("msm.est") setAs(from = "msm.est", to = "markovchain", def = .msmest2Mc) # function from etm to markovchain .etm2Mc<-function(from) { # data frame consists of 'from' and 'to' column df <- from$trans # name of states elements <- from$state.names # number of unique states nelements <- length(elements) # temporary t-matrix prMatr <- zeros(nelements) dimnames(prMatr) <- list(elements, elements) # populate t-matrix for(i in 1:dim(df)[1]) { r <- df[i, ] # each row one by one stateFrom <- r$from stateTo <- r$to prMatr[stateFrom, stateTo] <- prMatr[stateFrom, stateTo] + 1 } # convert freq-matrix to trans-matrix rsums <- rowSums(prMatr) prMatr <- prMatr / rsums # take care of rows with all entries 0 if(any(rsums == 0)) { indicesToBeSanitized <- which(rsums == 0) for(i in indicesToBeSanitized) { for(j in 1:nelements) { prMatr[i, j] <- 1 / nelements } } } # create markovchain object out <- new("markovchain", transitionMatrix = prMatr) return(out) } # coerce etm object to markovchain object setClass("etm") setAs(from = "etm", to = "markovchain", def = .etm2Mc) #sparse matrix from Matrix package .sparseMatrix2markovchain<-function(from){ temp<-as(from,"matrix") out <- as(temp, "markovchain") return(out) } .markovchain2sparseMatrix<-function(from){ temp<-as(from,"matrix") out <- as(temp, "sparseMatrix") return(out) } setAs(from = "sparseMatrix", to = "markovchain", def = .sparseMatrix2markovchain) setAs(from = "markovchain", to = "sparseMatrix", def = .markovchain2sparseMatrix) # functions and methods to return a matrix .mc2matrix <- function(from) { out <- from@transitionMatrix return(out) } # coerce markovchain object to matrix(transition) setAs(from = "markovchain", to = "matrix", def = .mc2matrix) # functions and methods to return a matrix .mc2igraph <- function(from) { # convert the markovchain to data.frame temp <- .mc2Df(from=from) # convert the data frame to igraph graph # need to set only non zero weights out <- graph.data.frame(d=temp[temp$prob>0,]) return(out) } # coerce markovchain object to igraph setClass("igraph") setAs(from = "markovchain", to = "igraph", def = .mc2igraph) #' @exportMethod t setGeneric("t") # transposing method for markovchain objects setMethod("t", "markovchain", function(x) { out <- new("markovchain", byrow = !x@byrow, transitionMatrix = t(x@transitionMatrix)) return(out) } ) #' @exportMethod * setGeneric("*") # function to multiplicate two markov chains # # Args: # e1: first markovchain # e2: second markov chain # # Returns: # if feasible, a markovchain where the transition matrix is e1*e2 setMethod("*", c("markovchain", "markovchain"), function(e1, e2) { # compare states of markovchains if(!setequal(e1@states, e2@states)) { warning("Warning! Different states") } # dimension must be equal if(!setequal(dim(e1@transitionMatrix), dim(e2@transitionMatrix))) { stop("Error! Different size") } # both must be either row wise or col wise if(!(e1@byrow == e2@byrow)) { stop("Error! Both transition matrix should be defined either by row or by column") } newStates <- e1@states newTransMatr <- e1@transitionMatrix %*% e2@transitionMatrix byRow <- e1@byrow # multiplicated matrix takes the first matrix's name mcName <- e1@name out<-new("markovchain", states = newStates, transitionMatrix = newTransMatr, byrow = byRow, name = mcName) return(out) } ) # methods implemented for multiplication of markovchain object with # matrix, 1-D vector, and vice-versa setMethod("*", c("matrix", "markovchain"), function(e1, e2) { out <- e1 %*% e2@transitionMatrix return(out) } ) setMethod("*", c("markovchain", "matrix"), function(e1, e2) { out <- e1@transitionMatrix %*% e2 return(out) } ) setMethod("*", c("numeric", "markovchain"), function(e1, e2) { if(length(e1) != dim(e2)) { stop("Error! Uncompatible dimensions") } else { out <- e1 %*% e2@transitionMatrix } return(out) } ) setMethod("*", c("markovchain", "numeric"), function(e1, e2) { if(length(e2) != dim(e1)) { stop("Error! Uncompatible dimensions") } else { out <- e1@transitionMatrix %*% e2 } return(out) } ) #' @exportMethod == setGeneric("==") # compare two markovchain object setMethod("==", c("markovchain", "markovchain"), function(e1, e2) { out <- .approxEqualMatricesRcpp(e1@transitionMatrix, e2@transitionMatrix) return(out) } ) #' @exportMethod != setGeneric("!=") setMethod("!=", c("markovchain", "markovchain"), function(e1, e2) { out <- FALSE out <- !(e1 == e2) return(out) } ) #'@exportMethod ^ setGeneric("^") # markovchain raise to some power # this method is O(n³ log(m)) where n = {num cols (= rows) of e1} and m = e2 setMethod("^", c("markovchain", "numeric"), function(e1, e2) { out <- new("markovchain", states = e1@states, byrow = e1@byrow, transitionMatrix = e1@transitionMatrix %^% e2, name = paste(e1@name, "^", e2, sep = "") ) return(out) } ) #' @exportMethod [ setGeneric("[") # methods to directly access transition matrix elements setMethod("[", signature(x = "markovchain", i = "ANY", j = "ANY"), function(x, i, j) { out <- x@transitionMatrix[i, j] return(out) } ) #' @exportMethod [[ setGeneric("[[") # methods to directly access markovchain objects composing a markovchainList object setMethod("[[", signature(x = "markovchainList", i = "ANY"), function(x, i) { out <- x@markovchains[[i]] return(out) } ) # transition probabilty vector from a given state #' @title \code{conditionalDistribution} of a Markov Chain #' #' @name conditionalDistribution #' #' @description It extracts the conditional distribution of the subsequent state, #' given current state. #' #' @param object A \code{markovchain} object. #' @param state Subsequent state. #' #' @author Giorgio Spedicato, Deepak Yadav #' #' @return A named probability vector #' @references A First Course in Probability (8th Edition), Sheldon Ross, Prentice Hall 2010 #' #' @seealso \code{\linkS4class{markovchain}} #' #' @examples #' # define a markov chain #' statesNames <- c("a", "b", "c") #' markovB <- new("markovchain", states = statesNames, transitionMatrix = #' matrix(c(0.2, 0.5, 0.3, 0, 1, 0, 0.1, 0.8, 0.1),nrow = 3, #' byrow = TRUE, dimnames = list(statesNames, statesNames))) #' #' conditionalDistribution(markovB, "b") #' #' @exportMethod conditionalDistribution setGeneric("conditionalDistribution", function(object, state) standardGeneric("conditionalDistribution")) setMethod("conditionalDistribution", "markovchain", function(object, state) { # get the states names stateNames <- states(object) # number of unique states out <- numeric(length(stateNames)) # states are assumed to be sorted index2Take <- which(stateNames == state) if(object@byrow == TRUE) { out <- object@transitionMatrix[index2Take, ] } else { out <- object@transitionMatrix[, index2Take] } # names the output and returs it names(out) <- stateNames return(out) } ) # Function to get the mode of a probability vector # # Args: # probVector: the probability vector # ties: specifies if ties are to be sampled, otherwise more than one element is returned # # Returns: # the name of the model element .getMode <- function(probVector, ties = "random") { maxIndex <- which(probVector == max(probVector)) temp <- probVector[maxIndex] # index of maximum probabilty if((ties == "random") & (length(temp) > 1)) { out <- sample(temp, 1) } else { out <- temp } return(names(out)) } #' @exportMethod predict setGeneric("predict") # predict method for markovchain objects # given initial state return a vector of next n.ahead states setMethod("predict", "markovchain", function(object, newdata, n.ahead = 1) { # identify the last state lastState <- newdata[length(newdata)] out <- character() for(i in 1:n.ahead) { # cyclically determine the most probable subsequent state from the conditional distribution newState <- .getMode(probVector = conditionalDistribution(object, lastState), ties = "random") out <- c(out, newState) lastState <- newState } return(out) } ) # predict method for markovchainList objects setMethod("predict", "markovchainList", function(object, newdata, n.ahead = 1, continue = FALSE) { # object a markovchainList # newdata = the actual data # n.ahead = how much ahead # continue = veryfy if that lasts # allocate output out <- character() actualPos <- length(newdata) lastState <- newdata[actualPos] # take last position for(i in 1:n.ahead) { newPos <- actualPos + i - 1 if(newPos <= dim(object)) { newState <- predict(object = object[[newPos]], newdata = lastState, n.ahead = 1) out <- c(out, newState) lastState <- newState } else { if(continue == TRUE) { newState <- predict(object = object[[dim(object)]], newdata = lastState, n.ahead = 1) out <- c(out, newState) lastState <- newState } else break; } } return(out) } ) #sort method for markovchain objects setGeneric("sort", function(x, decreasing=FALSE, ...) standardGeneric("sort")) setMethod("sort", signature(x="markovchain"), function(x, decreasing = FALSE) { #get matrix and state names 2 be sorted matr2besorted<-x@transitionMatrix if (x@byrow) states2besorted <- rownames(matr2besorted) else states2besorted <- colnames(matr2besorted) #sorting sort_index<-order(states2besorted,decreasing = decreasing) #reallocating matr_sorted<-matr2besorted[sort_index,sort_index] states_sorted<-states2besorted[sort_index] out<-x out@transitionMatrix<-matr_sorted out@states<-states_sorted return(out) } ) # method to get stationary states #' @name steadyStates #' @title Stationary states of a \code{markovchain} object #' #' @description This method returns the stationary vector in matricial form of a markovchain object. #' @param object A discrete \code{markovchain} object #' #' @return A matrix corresponding to the stationary states #' #' @references A First Course in Probability (8th Edition), Sheldon Ross, Prentice Hall 2010 #' @author Giorgio Spedicato #' @seealso \code{\linkS4class{markovchain}} #' #' @note The steady states are identified starting from which eigenvectors correspond #' to identity eigenvalues and then normalizing them to sum up to unity. When negative values are found #' in the matrix, the eigenvalues extraction is performed on the recurrent classes submatrix. #' #' @examples #' statesNames <- c("a", "b", "c") #' markovB <- new("markovchain", states = statesNames, transitionMatrix = #' matrix(c(0.2, 0.5, 0.3, 0, 1, 0, 0.1, 0.8, 0.1), nrow = 3, #' byrow = TRUE, dimnames=list(statesNames,statesNames)), #' name = "A markovchain Object" #' ) #' steadyStates(markovB) #' #' @rdname steadyStates #' @exportMethod steadyStates setGeneric("steadyStates", function(object) standardGeneric("steadyStates")) markovchain/R/utils.R0000644000176200001440000000156214714756745014270 0ustar liggesusersprecomputeData <- function(mc) { list( object = mc, transitionMatrix = mc@transitionMatrix, states = mc@states, byrow = mc@byrow, irreducible = is.irreducible(mc), regular = is.regular(mc), canonicForm = canonicForm(mc), recurrentClasses = recurrentClasses(mc), transientClasses = transientClasses(mc), recurrentStates = recurrentStates(mc), transientStates = transientStates(mc), absorbingStates = absorbingStates(mc), hittingProbabilities = hittingProbabilities(mc), meanNumVisits = meanNumVisits(mc), meanRecurrenceTime = meanRecurrenceTime(mc), communicatingClasses = communicatingClasses(mc), steadyStates = steadyStates(mc), reachabilityMatrix = is.accessible(mc) ) } precomputeSteadyStates <- function(mc) { list( object = mc, expected = steadyStates(mc) ) }markovchain/R/probabilistic.R0000644000176200001440000007064614714756745015767 0ustar liggesusers# given a markovchain object is it possible to reach goal state from # a given state #' @name is.accessible #' @title Verify if a state j is reachable from state i. #' @description This function verifies if a state is reachable from another, i.e., #' if there exists a path that leads to state j leaving from state i with #' positive probability #' #' @param object A \code{markovchain} object. #' @param from The name of state "i" (beginning state). #' @param to The name of state "j" (ending state). #' #' @details It wraps an internal function named \code{reachabilityMatrix}. #' @return A boolean value. #' #' @references James Montgomery, University of Madison #' #' @author Giorgio Spedicato, Ignacio Cordón #' @seealso \code{is.irreducible} #' #' @examples #' statesNames <- c("a", "b", "c") #' markovB <- new("markovchain", states = statesNames, #' transitionMatrix = matrix(c(0.2, 0.5, 0.3, #' 0, 1, 0, #' 0.1, 0.8, 0.1), nrow = 3, byrow = TRUE, #' dimnames = list(statesNames, statesNames) #' ) #' ) #' is.accessible(markovB, "a", "c") #' #' @exportMethod is.accessible setGeneric("is.accessible", function(object, from, to) standardGeneric("is.accessible")) setMethod("is.accessible", c("markovchain", "character", "character"), function(object, from, to) { # O(n²) procedure to see if to state is reachable starting at from state return(.isAccessibleRcpp(object, from, to)) } ) setMethod("is.accessible", c("markovchain", "missing", "missing"), function(object, from, to) { .reachabilityMatrixRcpp(object) } ) # a markov chain is irreducible if it is composed of only one communicating class #' @name is.irreducible #' @title Function to check if a Markov chain is irreducible (i.e. ergodic) #' @description This function verifies whether a \code{markovchain} object transition matrix #' is composed by only one communicating class. #' @param object A \code{markovchain} object #' #' @details It is based on \code{.communicatingClasses} internal function. #' @return A boolean values. #' #' @references Feres, Matlab listings for Markov Chains. #' @author Giorgio Spedicato #' #' @seealso \code{\link{summary}} #' #' @examples #' statesNames <- c("a", "b") #' mcA <- new("markovchain", transitionMatrix = matrix(c(0.7,0.3,0.1,0.9), #' byrow = TRUE, nrow = 2, #' dimnames = list(statesNames, statesNames) #' )) #' is.irreducible(mcA) #' #' @exportMethod is.irreducible setGeneric("is.irreducible", function(object) standardGeneric("is.irreducible")) setMethod("is.irreducible", "markovchain", function(object) { .isIrreducibleRcpp(object) }) # what this function will do? # It calculates the probability to go from given state # to all other states in k steps # k varies from 1 to n #' @name firstPassage #' @title First passage across states #' @description This function compute the first passage probability in states #' #' @param object A \code{markovchain} object #' @param state Initial state #' @param n Number of rows on which compute the distribution #' #' @details Based on Feres' Matlab listings #' @return A matrix of size 1:n x number of states showing the probability of the #' first time of passage in states to be exactly the number in the row. #' #' @references Renaldo Feres, Notes for Math 450 Matlab listings for Markov chains #' #' @author Giorgio Spedicato #' @seealso \code{\link{conditionalDistribution}} #' #' @examples #' simpleMc <- new("markovchain", states = c("a", "b"), #' transitionMatrix = matrix(c(0.4, 0.6, .3, .7), #' nrow = 2, byrow = TRUE)) #' firstPassage(simpleMc, "b", 20) #' #' @export firstPassage <- function(object, state, n) { P <- object@transitionMatrix stateNames <- states(object) # row number i <- which(stateNames == state) outMatr <- .firstpassageKernelRcpp(P = P, i = i, n = n) colnames(outMatr) <- stateNames rownames(outMatr) <- 1:n return(outMatr) } #' function to calculate first passage probabilities #' #' @description The function calculates first passage probability for a subset of #' states given an initial state. #' #' @param object a markovchain-class object #' @param state intital state of the process (charactervector) #' @param set set of states A, first passage of which is to be calculated #' @param n Number of rows on which compute the distribution #' #' @return A vector of size n showing the first time proabilities #' @references #' Renaldo Feres, Notes for Math 450 Matlab listings for Markov chains; #' MIT OCW, course - 6.262, Discrete Stochastic Processes, course-notes, chap -05 #' #' @author Vandit Jain #' #' @seealso \code{\link{firstPassage}} #' @examples #' statesNames <- c("a", "b", "c") #' markovB <- new("markovchain", states = statesNames, transitionMatrix = #' matrix(c(0.2, 0.5, 0.3, #' 0, 1, 0, #' 0.1, 0.8, 0.1), nrow = 3, byrow = TRUE, #' dimnames = list(statesNames, statesNames) #' )) #' firstPassageMultiple(markovB,"a",c("b","c"),4) #' #' @export firstPassageMultiple <- function(object,state,set, n){ # gets the transition matrix P <- object@transitionMatrix # character vector of states of the markovchain stateNames <- states(object) k <- -1 k <- which(stateNames == state) if(k==-1) stop("please provide a valid initial state") # gets the set in numeric vector setno <- rep(0,length(set)) for(i in 1:length(set)) { setno[i] = which(set[i] == stateNames) if(setno[i] == 0) stop("please provide proper set of states") } # calls Rcpp implementation outMatr <- .firstPassageMultipleRCpp(P,k,setno,n) #sets column and row names of output colnames(outMatr) <- "set" rownames(outMatr) <- 1:n return(outMatr) } #' @name communicatingClasses #' @rdname structuralAnalysis #' @aliases transientStates recurrentStates absorbingStates communicatingClasses #' transientClasses recurrentClasses #' @title Various function to perform structural analysis of DTMC #' @description These functions return absorbing and transient states of the \code{markovchain} objects. #' #' @param object A \code{markovchain} object. #' #' @return #' \describe{ #' \item{\code{period}}{returns a integer number corresponding to the periodicity of the Markov #' chain (if it is irreducible)} #' \item{\code{absorbingStates}}{returns a character vector with the names of the absorbing #' states in the Markov chain} #' \item{\code{communicatingClasses}}{returns a list in which each slot contains the names of #' the states that are in that communicating class} #' \item{\code{recurrentClasses}}{analogously to \code{communicatingClasses}, but with #' recurrent classes} #' \item{\code{transientClasses}}{analogously to \code{communicatingClasses}, but with #' transient classes} #' \item{\code{transientStates}}{returns a character vector with all the transient states #' for the Markov chain} #' \item{\code{recurrentStates}}{returns a character vector with all the recurrent states #' for the Markov chain} #' \item{\code{canonicForm}}{returns the Markov chain reordered by a permutation of states #' so that we have blocks submatrices for each of the recurrent classes and a collection #' of rows in the end for the transient states} #' } #' #' @references Feres, Matlab listing for markov chain. #' #' @author Giorgio Alfredo Spedicato, Ignacio Cordón #' #' @seealso \code{\linkS4class{markovchain}} #' #' @examples #' statesNames <- c("a", "b", "c") #' mc <- new("markovchain", states = statesNames, transitionMatrix = #' matrix(c(0.2, 0.5, 0.3, #' 0, 1, 0, #' 0.1, 0.8, 0.1), nrow = 3, byrow = TRUE, #' dimnames = list(statesNames, statesNames)) #' ) #' #' communicatingClasses(mc) #' recurrentClasses(mc) #' recurrentClasses(mc) #' absorbingStates(mc) #' transientStates(mc) #' recurrentStates(mc) #' canonicForm(mc) #' #' # periodicity analysis #' A <- matrix(c(0, 1, 0, 0, 0.5, 0, 0.5, 0, 0, 0.5, 0, 0.5, 0, 0, 1, 0), #' nrow = 4, ncol = 4, byrow = TRUE) #' mcA <- new("markovchain", states = c("a", "b", "c", "d"), #' transitionMatrix = A, #' name = "A") #' #' is.irreducible(mcA) #true #' period(mcA) #2 #' #' # periodicity analysis #' B <- matrix(c(0, 0, 1/2, 1/4, 1/4, 0, 0, #' 0, 0, 1/3, 0, 2/3, 0, 0, #' 0, 0, 0, 0, 0, 1/3, 2/3, #' 0, 0, 0, 0, 0, 1/2, 1/2, #' 0, 0, 0, 0, 0, 3/4, 1/4, #' 1/2, 1/2, 0, 0, 0, 0, 0, #' 1/4, 3/4, 0, 0, 0, 0, 0), byrow = TRUE, ncol = 7) #' mcB <- new("markovchain", transitionMatrix = B) #' period(mcB) #' #' @exportMethod communicatingClasses setGeneric("communicatingClasses", function(object) standardGeneric("communicatingClasses")) setMethod("communicatingClasses", "markovchain", function(object) { return(.communicatingClassesRcpp(object)) }) # A communicating class will be a recurrent class if # there is no outgoing edge from this class # Recurrent classes are subset of communicating classes #' @rdname structuralAnalysis #' #' @exportMethod recurrentClasses setGeneric("recurrentClasses", function(object) standardGeneric("recurrentClasses")) setMethod("recurrentClasses", "markovchain", function(object) { return(.recurrentClassesRcpp(object)) }) # A communicating class will be a transient class iff # there is an outgoing edge from this class to an state # outside of the class # Transient classes are subset of communicating classes #' @rdname structuralAnalysis #' #' @exportMethod transientClasses setGeneric("transientClasses", function(object) standardGeneric("transientClasses")) setMethod("transientClasses", "markovchain", function(object) { return(.transientClassesRcpp(object)) }) #' @rdname structuralAnalysis #' #' @exportMethod transientStates setGeneric("transientStates", function(object) standardGeneric("transientStates")) setMethod("transientStates", "markovchain", function(object) { .transientStatesRcpp(object) } ) #' @rdname structuralAnalysis #' #' @exportMethod recurrentStates setGeneric("recurrentStates", function(object) standardGeneric("recurrentStates")) setMethod("recurrentStates", "markovchain", function(object) { .recurrentStatesRcpp(object) } ) # generic function to extract absorbing states #' @rdname structuralAnalysis #' #' @exportMethod absorbingStates setGeneric("absorbingStates", function(object) standardGeneric("absorbingStates")) setMethod("absorbingStates", "markovchain", function(object) { .absorbingStatesRcpp(object) } ) #' @rdname structuralAnalysis #' #' @exportMethod canonicForm setGeneric("canonicForm", function(object) standardGeneric("canonicForm")) setMethod("canonicForm", "markovchain", function(object) { .canonicFormRcpp(object) } ) #' @title Calculates committor of a markovchain object with respect to set A, B #' #' @description Returns the probability of hitting states rom set A before set B #' with different initial states #' #' @usage committorAB(object,A,B,p) #' #' @param object a markovchain class object #' @param A a set of states #' @param B a set of states #' @param p initial state (default value : 1) #' #' @details The function solves a system of linear equations to calculate probaility that the process hits #' a state from set A before any state from set B #' #' @return Return a vector of probabilities in case initial state is not provided else returns a number #' #' @examples #' transMatr <- matrix(c(0,0,0,1,0.5, #' 0.5,0,0,0,0, #' 0.5,0,0,0,0, #' 0,0.2,0.4,0,0, #' 0,0.8,0.6,0,0.5), #' nrow = 5) #' object <- new("markovchain", states=c("a","b","c","d","e"),transitionMatrix=transMatr) #' committorAB(object,c(5),c(3)) #' #' @export committorAB <- function(object,A,B,p=1) { if(!is(object,"markovchain")) stop("please provide a valid markovchain object") matrix <- object@transitionMatrix noofstates <- length(object@states) for(i in length(A)) { if(A[i] <= 0 || A[i] > noofstates) stop("please provide a valid set A") } for(i in length(B)) { if(B[i] <= 0 || B[i] > noofstates) stop("please provide a valid set B") } for(i in 1:noofstates) { if(i %in% A && i %in% B) stop("intersection of set A and B in not null") } if(p <=0 || p > noofstates) stop("please provide a valid initial state") I <- diag(noofstates) matrix <- matrix - I A_size = length(A) B_size = length(B) # sets the matrix according to the provided states for(i in 1:A_size) { for(j in 1:noofstates) { if(A[i]==j) matrix[A[i],j] = 1 else matrix[A[i],j] = 0 } } # sets the matrix according to the provided states for(i in 1:B_size) { for(j in 1:noofstates) { if(B[i]==j) matrix[B[i],j] = 1 else matrix[B[i],j] = 0 } } # initialises b in the equation the system of equation AX =b b <- rep(0,noofstates) for(i in 1:A_size) { b[A[i]] = 1 } # solve AX = b according using solve function from base package out <- solve(matrix,b) if(missing(p)) return(out) else return(out[p]) } #' Expected Rewards for a markovchain #' #' @description Given a markovchain object and reward values for every state, #' function calculates expected reward value after n steps. #' #' @usage expectedRewards(markovchain,n,rewards) #' #' @param markovchain the markovchain-class object #' @param n no of steps of the process #' @param rewards vector depicting rewards coressponding to states #' #' @details the function uses a dynamic programming approach to solve a #' recursive equation described in reference. #' #' @return #' returns a vector of expected rewards for different initial states #' #' @author Vandit Jain #' #' @references Stochastic Processes: Theory for Applications, Robert G. Gallager, #' Cambridge University Press #' #' @examples #' transMatr<-matrix(c(0.99,0.01,0.01,0.99),nrow=2,byrow=TRUE) #' simpleMc<-new("markovchain", states=c("a","b"), #' transitionMatrix=transMatr) #' expectedRewards(simpleMc,1,c(0,1)) #' @export expectedRewards <- function(markovchain, n, rewards) { # gets the transition matrix matrix <- markovchain@transitionMatrix # Rcpp implementation of the function out <- .expectedRewardsRCpp(matrix,n, rewards) noofStates <- length(states(markovchain)) result <- rep(0,noofStates) for(i in 1:noofStates) result[i] = out[i] #names(result) <- states(markovchain) return(result) } #' Expected first passage Rewards for a set of states in a markovchain #' #' @description Given a markovchain object and reward values for every state, #' function calculates expected reward value for a set A of states after n #' steps. #' #' @usage expectedRewardsBeforeHittingA(markovchain, A, state, rewards, n) #' #' @param markovchain the markovchain-class object #' @param A set of states for first passage expected reward #' @param state initial state #' @param rewards vector depicting rewards coressponding to states #' @param n no of steps of the process #' #' @details The function returns the value of expected first passage #' rewards given rewards coressponding to every state, an initial state #' and number of steps. #' #' @return returns a expected reward (numerical value) as described above #' #' @author Sai Bhargav Yalamanchi, Vandit Jain #' #' @export expectedRewardsBeforeHittingA <- function(markovchain, A, state, rewards, n) { ## gets the markovchain matrix matrix <- markovchain@transitionMatrix # gets the names of states stateNames <- states(markovchain) # no of states S <- length(stateNames) # vectors for states in S-A SAno <- rep(0,S-length(A)) rewardsSA <- rep(0,S-length(A)) # for initialisation for set S-A i=1 ini = -1 for(j in 1:length(stateNames)) { if(!(stateNames[j] %in% A)){ SAno[i] = j rewardsSA[i] = rewards[j] if(stateNames[j] == state) ini = i i = i+1 } } ## get the matrix coressponding to S-A matrix <- matrix[SAno,SAno] ## cals the cpp implementation out <- .expectedRewardsBeforeHittingARCpp(matrix, ini, rewardsSA, n) return(out) } #' Mean First Passage Time for irreducible Markov chains #' #' @description Given an irreducible (ergodic) markovchain object, this function #' calculates the expected number of steps to reach other states #' #' @param object the markovchain object #' @param destination a character vector representing the states respect to #' which we want to compute the mean first passage time. Empty by default #' #' @details For an ergodic Markov chain it computes: #' \itemize{ #' \item If destination is empty, the average first time (in steps) that takes #' the Markov chain to go from initial state i to j. (i, j) represents that #' value in case the Markov chain is given row-wise, (j, i) in case it is given #' col-wise. #' \item If destination is not empty, the average time it takes us from the #' remaining states to reach the states in \code{destination} #' } #' #' @return a Matrix of the same size with the average first passage times if #' destination is empty, a vector if destination is not #' #' @author Toni Giorgino, Ignacio Cordón #' #' @references C. M. Grinstead and J. L. Snell. Introduction to Probability. #' American Mathematical Soc., 2012. #' #' @examples #' m <- matrix(1 / 10 * c(6,3,1, #' 2,3,5, #' 4,1,5), ncol = 3, byrow = TRUE) #' mc <- new("markovchain", states = c("s","c","r"), transitionMatrix = m) #' meanFirstPassageTime(mc, "r") #' #' #' # Grinstead and Snell's "Oz weather" worked out example #' mOz <- matrix(c(2,1,1, #' 2,0,2, #' 1,1,2)/4, ncol = 3, byrow = TRUE) #' #' mcOz <- new("markovchain", states = c("s", "c", "r"), transitionMatrix = mOz) #' meanFirstPassageTime(mcOz) #' #' @export meanFirstPassageTime setGeneric("meanFirstPassageTime", function(object, destination) { standardGeneric("meanFirstPassageTime") }) setMethod("meanFirstPassageTime", signature("markovchain", "missing"), function(object, destination) { destination = character() .meanFirstPassageTimeRcpp(object, destination) } ) setMethod("meanFirstPassageTime", signature("markovchain", "character"), function(object, destination) { states <- object@states incorrectStates <- setdiff(destination, states) if (length(incorrectStates) > 0) stop("Some of the states you provided in destination do not match states from the markovchain") result <- .meanFirstPassageTimeRcpp(object, destination) asVector <- as.vector(result) names(asVector) <- colnames(result) asVector } ) #' Mean recurrence time #' #' @description Computes the expected time to return to a recurrent state #' in case the Markov chain starts there #' #' @usage meanRecurrenceTime(object) #' #' @param object the markovchain object #' #' @return For a Markov chain it outputs is a named vector with the expected #' time to first return to a state when the chain starts there. #' States present in the vector are only the recurrent ones. If the matrix #' is ergodic (i.e. irreducible), then all states are present in the output #' and order is the same as states order for the Markov chain #' #' @author Ignacio Cordón #' #' @references C. M. Grinstead and J. L. Snell. Introduction to Probability. #' American Mathematical Soc., 2012. #' #' @examples #' m <- matrix(1 / 10 * c(6,3,1, #' 2,3,5, #' 4,1,5), ncol = 3, byrow = TRUE) #' mc <- new("markovchain", states = c("s","c","r"), transitionMatrix = m) #' meanRecurrenceTime(mc) #' #' @export meanRecurrenceTime setGeneric("meanRecurrenceTime", function(object) { standardGeneric("meanRecurrenceTime") }) setMethod("meanRecurrenceTime", "markovchain", function(object) { .meanRecurrenceTimeRcpp(object) }) #' Mean absorption time #' #' @description Computes the expected number of steps to go from any of the #' transient states to any of the recurrent states. The Markov chain should #' have at least one transient state for this method to work #' #' @usage meanAbsorptionTime(object) #' #' @param object the markovchain object #' #' @return A named vector with the expected number of steps to go from a #' transient state to any of the recurrent ones #' #' @author Ignacio Cordón #' #' @references C. M. Grinstead and J. L. Snell. Introduction to Probability. #' American Mathematical Soc., 2012. #' #' @examples #' m <- matrix(c(1/2, 1/2, 0, #' 1/2, 1/2, 0, #' 0, 1/2, 1/2), ncol = 3, byrow = TRUE) #' mc <- new("markovchain", states = letters[1:3], transitionMatrix = m) #' times <- meanAbsorptionTime(mc) #' #' @export meanAbsorptionTime setGeneric("meanAbsorptionTime", function(object) { standardGeneric("meanAbsorptionTime") }) setMethod("meanAbsorptionTime", "markovchain", function(object) { .meanAbsorptionTimeRcpp(object) }) #' Absorption probabilities #' #' @description Computes the absorption probability from each transient #' state to each recurrent one (i.e. the (i, j) entry or (j, i), in a #' stochastic matrix by columns, represents the probability that the #' first not transient state we can go from the transient state i is j #' (and therefore we are going to be absorbed in the communicating #' recurrent class of j) #' #' @usage absorptionProbabilities(object) #' #' @param object the markovchain object #' #' @return A named vector with the expected number of steps to go from a #' transient state to any of the recurrent ones #' #' @author Ignacio Cordón #' #' @references C. M. Grinstead and J. L. Snell. Introduction to Probability. #' American Mathematical Soc., 2012. #' #' @examples #' m <- matrix(c(1/2, 1/2, 0, #' 1/2, 1/2, 0, #' 0, 1/2, 1/2), ncol = 3, byrow = TRUE) #' mc <- new("markovchain", states = letters[1:3], transitionMatrix = m) #' absorptionProbabilities(mc) #' #' @export absorptionProbabilities setGeneric("absorptionProbabilities", function(object) { standardGeneric("absorptionProbabilities") }) setMethod("absorptionProbabilities", "markovchain", function(object) { .absorptionProbabilitiesRcpp(object) }) #' @title Check if a DTMC is regular #' #' @description Function to check wether a DTCM is regular # #' @details A Markov chain is regular if some of the powers of its matrix has all elements #' strictly positive #' #' @param object a markovchain object #' #' @return A boolean value #' #' @author Ignacio Cordón #' @references Matrix Analysis. Roger A.Horn, Charles R.Johnson. 2nd edition. #' Corollary 8.5.8, Theorem 8.5.9 #' #' #' @examples #' P <- matrix(c(0.5, 0.25, 0.25, #' 0.5, 0, 0.5, #' 0.25, 0.25, 0.5), nrow = 3) #' colnames(P) <- rownames(P) <- c("R","N","S") #' ciao <- as(P, "markovchain") #' is.regular(ciao) #' #' @seealso \code{\link{is.irreducible}} #' #' @exportMethod is.regular setGeneric("is.regular", function(object) standardGeneric("is.regular")) setMethod("is.regular", "markovchain", function(object) { .isRegularRcpp(object) }) #' Hitting probabilities for markovchain #' #' @description Given a markovchain object, #' this function calculates the probability of ever arriving from state i to j #' #' @usage hittingProbabilities(object) #' #' @param object the markovchain-class object #' #' @return a matrix of hitting probabilities #' #' @author Ignacio Cordón #' #' @references R. Vélez, T. Prieto, Procesos Estocásticos, Librería UNED, 2013 #' #' @examples #' M <- markovchain:::zeros(5) #' M[1,1] <- M[5,5] <- 1 #' M[2,1] <- M[2,3] <- 1/2 #' M[3,2] <- M[3,4] <- 1/2 #' M[4,2] <- M[4,5] <- 1/2 #' #' mc <- new("markovchain", transitionMatrix = M) #' hittingProbabilities(mc) #' #' @exportMethod hittingProbabilities setGeneric("hittingProbabilities", function(object) standardGeneric("hittingProbabilities")) setMethod("hittingProbabilities", "markovchain", function(object) { .hittingProbabilitiesRcpp(object) }) #' Mean num of visits for markovchain, starting at each state #' #' @description Given a markovchain object, this function calculates #' a matrix where the element (i, j) represents the expect number of visits #' to the state j if the chain starts at i (in a Markov chain by columns it #' would be the element (j, i) instead) #' #' @usage meanNumVisits(object) #' #' @param object the markovchain-class object #' #' @return a matrix with the expect number of visits to each state #' #' @author Ignacio Cordón #' #' @references R. Vélez, T. Prieto, Procesos Estocásticos, Librería UNED, 2013 #' #' @examples #' M <- markovchain:::zeros(5) #' M[1,1] <- M[5,5] <- 1 #' M[2,1] <- M[2,3] <- 1/2 #' M[3,2] <- M[3,4] <- 1/2 #' M[4,2] <- M[4,5] <- 1/2 #' #' mc <- new("markovchain", transitionMatrix = M) #' meanNumVisits(mc) #' #' @exportMethod meanNumVisits setGeneric("meanNumVisits", function(object) standardGeneric("meanNumVisits")) setMethod("meanNumVisits", "markovchain", function(object) { .minNumVisitsRcpp(object) }) setMethod( "steadyStates", "markovchain", function(object) { .steadyStatesRcpp(object) } ) #' @exportMethod summary setGeneric("summary") # summary method for markovchain class # lists: closed, transient classes, irreducibility, absorbint, transient states setMethod("summary", signature(object = "markovchain"), function(object){ # list of closed, recurrent and transient classes outs <- .summaryKernelRcpp(object) # display name of the markovchain object cat(object@name," Markov chain that is composed by:", "\n") # number of closed classes check <- length(outs$closedClasses) cat("Closed classes:","\n") # display closed classes if(check == 0) cat("NONE", "\n") else { for(i in 1:check) cat(outs$closedClasses[[i]], "\n") } # number of recurrent classes check <- length(outs$recurrentClasses) cat("Recurrent classes:", "\n") # display recurrent classes if(check == 0) cat("NONE", "\n") else { cat("{") cat(outs$recurrentClasses[[1]], sep = ",") cat("}") if(check > 1) { for(i in 2:check) { cat(",{") cat(outs$recurrentClasses[[i]], sep = ",") cat("}") } } cat("\n") } # number of transient classes check <- length(outs$transientClasses) cat("Transient classes:","\n") # display transient classes if(check == 0) cat("NONE", "\n") else { cat("{") cat(outs$transientClasses[[1]], sep = ",") cat("}") if(check > 1) { for(i in 2:check) { cat(",{") cat(outs$transientClasses[[i]], sep = ",") cat("}") } } cat("\n") } # bool to say about irreducibility of markovchain irreducibility <- is.irreducible(object) if(irreducibility) cat("The Markov chain is irreducible", "\n") else cat("The Markov chain is not irreducible", "\n") # display absorbing states check <- absorbingStates(object) if(length(check) == 0) check <- "NONE" cat("The absorbing states are:", check ) cat("\n") # return outs # useful when user will assign the value returned invisible(outs) } ) markovchain/R/ctmcClassesAndMethods.R0000644000176200001440000003314714714756745017347 0ustar liggesusers#' @title Continuous time Markov Chains class #' @name ctmc-class #' @aliases dim,ctmc-method initialize,ctmc_method states,ctmc-method #' steadyStates,ctmc-method plot,ctmc,missing-method #' @description The S4 class that describes \code{ctmc} (continuous #' time Markov chain) objects. #' #' @param states Name of the states. Must be the same of #' \code{colnames} and \code{rownames} of the generator matrix #' @param byrow TRUE or FALSE. Indicates whether the given matrix is #' stochastic by rows or by columns #' @param generator Square generator matrix #' @param name Optional character name of the Markov chain #' #' @section Methods: #' #' \describe{ #' \item{dim}{\code{signature(x = "ctmc")}: method to get the size} #' \item{initialize}{\code{signature(.Object = "ctmc")}: initialize #' method } #' \item{states}{\code{signature(object = "ctmc")}: states method. } #' \item{steadyStates}{\code{signature(object = "ctmc")}: method to get the #' steady state vector. } #' \item{plot}{\code{signature(x = "ctmc", y = "missing")}: plot method #' for \code{ctmc} objects } #' } #' #' @references #' Introduction to Stochastic Processes with Applications in the Biosciences #' (2013), David F. Anderson, University of Wisconsin at Madison. Sai Bhargav #' Yalamanchi, Giorgio Spedicato #' #' @note #' \enumerate{ #' \item \code{ctmc} classes are written using S4 classes #' \item Validation method is used to assess whether either columns or rows totals to zero. #' Rounding is used up to 5th decimal. If state names are not properly defined #' for a generator \code{matrix}, coercing to \code{ctmc} object leads to overriding #' states name with artificial "s1", "s2", ... sequence #' } #' @seealso \code{\link{generatorToTransitionMatrix}},\code{\link{rctmc}} #' #' @examples #' energyStates <- c("sigma", "sigma_star") #' byRow <- TRUE #' gen <- matrix(data = c(-3, 3, #' 1, -1), nrow = 2, #' byrow = byRow, dimnames = list(energyStates, energyStates)) #' molecularCTMC <- new("ctmc", states = energyStates, #' byrow = byRow, generator = gen, #' name = "Molecular Transition Model") #' steadyStates(molecularCTMC) #' \dontrun{plot(molecularCTMC)} #' #' @keywords classes #' #' @export setClass("ctmc", representation(states = "character", byrow = "logical", generator = "matrix", name = "character"), prototype(states = c("a", "b"), byrow = TRUE, generator = matrix(data = c(-1, 1, 1, -1), byrow = TRUE, nrow = 2, dimnames = list(c("a", "b"), c("a", "b"))), name = "Unnamed CTMC") ) setMethod("initialize", signature(.Object = "ctmc"), function (.Object, states, byrow, generator,name,...) { # put the standard markovchain if(missing(generator)) generator=matrix(data=c(-1, 1, 1, -1), #create a naive matrix nrow=2, byrow=TRUE, dimnames=list(c("a", "b"), c("a", "b")) ) # check names of transition matrix if(all(is.null(rownames(generator)), is.null(colnames(generator)))==TRUE) { #if all names are missing it initializes them to "1", "2",... if(missing(states)) { nr=nrow(generator) stateNames<-as.character(seq(1:nr)) } else {stateNames=states} rownames(generator)=stateNames colnames(generator)=stateNames } else if(is.null(rownames(generator))) { #fix when rownames null rownames(generator)=colnames(generator) } else if(is.null(colnames(generator))) { #fix when colnames null colnames(generator)=rownames(generator) } else if(!setequal(rownames(generator),colnames(generator))) colnames(generator)=rownames(generator) #fix when different if(missing(states)) states=rownames(generator) #assign if(missing(byrow)) byrow=TRUE #set byrow as true by default if(missing(name)) name="Unnamed Markov chain" #generic name to the object callNextMethod(.Object, states = states, byrow = byrow, generator=generator,name=name,...) } ) #returns states of the ctmc setMethod("states", "ctmc", function(object) { out <- object@states return(out) } ) #returns states of the ctmc setMethod("dim", "ctmc", function(x) { out <- nrow(x@generator) return(out) } ) setValidity("ctmc", function(object) { check<-NULL # performs a set of check whose results are saved in check if (.isGenRcpp(object@generator)==FALSE) check <- "Error! Not a generator matrix" if (object@byrow==TRUE) { if(any(round(rowSums(object@generator),5)!=0)) check <- "Error! Row sums not equal to zero" } else { if(any(round(colSums(object@generator),5)!=0)) check <- "Error! Col sums not equal to zero" } if (nrow(object@generator)!=ncol(object@generator)) check <- "Error! Not squared matrix" #check if squalre matrix if (!setequal(colnames(object@generator),object@states)) check <- "Error! Colnames <> states" #checks if if (!setequal(rownames(object@generator),object@states)) check <- "Error! Rownames <> states" if ( is.null(check) ) return(TRUE) else return(check) } ) .ctmcEigen<-function(matr, transpose=TRUE) { # Function to extract eigenvalues, core of get steady states # # Args: # matr: the matrix to extract # transpose: boolean indicating whether the matrx shall be transpose # # Results: # a matrix / vector if (transpose) tMatr <- t(matr) else tMatr <- matr #trasposing eigenResults <- eigen(x=tMatr,symmetric=FALSE) #perform the eigenvalue extraction onesIndex <- which(round(eigenResults$values,3)==1) #takes the one eigenvalue #do the following: 1:get eigenvectors whose eigenvalues==1 #2: normalize if (length(onesIndex)==0) { warning("No eigenvalue = 1 found - the embedded Markov Chain must be irreducible, recurrent") return(NULL) } if(length(onesIndex) > 1){ warning("Eigenvalue = 1 multiplicity > 1! - the embedded Markov Chain must be irreducible, recurrent") return(NULL) } if (transpose==TRUE) { eigenTake <- as.matrix(t(eigenResults$vectors[,onesIndex])) if(rowSums(Im(eigenTake)) != 0){ warning("Eigenvector corresponding to largest eigenvalue has a non-zero imaginary part - the embedded Markov Chain must be irreducible, recurrent") return(NULL) } out <- eigenTake } else { eigenTake <- as.matrix(eigenResults$vectors[,onesIndex]) if(colSums(Im(eigenTake)) != 0){ warning("Eigenvector corresponding to largest eigenvalue has a non-zero imaginary part - the embedded Markov Chain must be irreducible, recurrent") return(NULL) } out <- eigenTake } return(out) } setMethod("steadyStates", "ctmc", function(object) { transposeYN <- FALSE if(object@byrow==TRUE) transposeYN <- TRUE transMatr <- generatorToTransitionMatrix(object@generator, byrow = object@byrow) out<-.ctmcEigen(matr=transMatr, transpose=transposeYN) if(is.null(out)) { warning("Warning! No steady state") return(NULL) } if(transposeYN==TRUE) { colnames(out) <- object@states } else { rownames(out) <- object@states } out <- - out / diag(object@generator) if(transposeYN==TRUE){ out <- out / rowSums(out) } else{ out <- out / colSums(out) } return(out) } ) # internal function for plotting ctmc object using igraph .getNetctmc <- function(object, round = FALSE) { # function to get the graph adjacency object to plot and export to igraph # # Args: # object: a ctmc object # round: boolean to round # # Returns: # # a graph adjacency if (object@byrow == FALSE) { object <- t(object) } #gets the generator matrix matr <- object@generator * 100 if(round == TRUE) { matr <- round(matr, 2) } net <- graph.adjacency(adjmatrix = matr, weighted = TRUE, mode = "directed") return(net) } setMethod("plot",signature(x="ctmc",y="missing"), function(x,y,package = "igraph",...){ switch(package, diagram = { if (requireNamespace("diagram", quietly = TRUE)) { .plotdiagram(object = x, ...) } else { netMc <- .getNetctmc(object = x, round = TRUE) edgeLabel <- round(E(netMc)$weight / 100, 2) plot.igraph(x = netMc, edge.label = edgeLabel, ...) } }, DiagrammeR = { if (requireNamespace("DiagrammeR", quietly = TRUE)) { .plotDiagrammeR(object = x, ...) } else { netMc <- .getNetctmc(object = x, round = TRUE) edgeLabel <- round(E(netMc)$weight / 100, 2) plot.igraph(x = netMc, edge.label = edgeLabel, ...) } }, { netMc <- .getNetctmc(object = x,round = TRUE) edgeLabel <- round(E(netMc)$weight / 100, 2) plot.igraph(x = netMc, edge.label = edgeLabel, ...) }) } ) #' An S4 class for representing Imprecise Continuous Time Markovchains #' #' @slot states a vector of states present in the ICTMC model #' @slot Q matrix representing the generator demonstrated in the form of variables #' @slot range a matrix that stores values of range of variables #' @slot name name given to ICTMC #' ictmc <- setClass("ictmc", slots = list(states = "character", Q = "matrix", range = "matrix", name = "character") ) setMethod("initialize", signature(.Object = "ictmc"), function (.Object, states, Q, range, name, ...) { if(missing(Q)) Q=matrix(data=c(-1, 1, 1, -1), #create a naive matrix nrow=2, byrow=TRUE, dimnames=list(c("n", "y"), c("n", "y")) ) if(missing(range)) range = matrix(c(1/52, 3/52, 1/2, 2), nrow = 2, byrow = 2) #if all names are missing it initializes them to "1", "2",... if(all(is.null(rownames(Q)), is.null(colnames(Q)))==TRUE) { if(missing(states)) { nr=nrow(Q) stateNames<-as.character(seq(1:nr)) } else {stateNames=states} rownames(Q)=stateNames colnames(Q)=stateNames } else if(is.null(rownames(Q))) { #fix when rownames null rownames(Q)=colnames(Q) } else if(is.null(colnames(Q))) { #fix when colnames null colnames(Q)=rownames(Q) } else if(!setequal(rownames(Q),colnames(Q))) colnames(Q)=rownames(Q) #fix when different if(missing(states)) states=rownames(Q) #assign if(missing(name)) name="Unnamed imprecise CTMC" #generic name to the object callNextMethod(.Object, states = states, Q = Q, range=range,name=name,...) } ) setValidity("ictmc", function(object) { check<-NULL # performs a set of check whose results are saved in check if (.isGenRcpp(object@Q)==FALSE) check <- "Error! Not a generator matrix" if(any(round(rowSums(object@Q),5)!=0)) check <- "Error! Row sums not equal to zero" if ( nrow(object@Q) != ncol(object@Q )) check <- "Error! Not squared matrix" #check if square matrix if ( !setequal(colnames(object@Q),object@states )) check <- "Error! Colnames <> states" if ( !setequal(rownames(object@Q),object@states )) check <- "Error! Rownames <> states" if(nrow(object@range) != nrow(object@Q) && ncol(object@range) != 2) check <- "Error! dimension of range matrix not correct." for(i in 1:nrow(object@Q)){ if( object@range[i,1] > object@range[i,2] ){ check <- "Error, improper values set in range matrix." } } if(min(object@range) < 0){ check <- "Error, values in the range matrix should be greater than zero." } if ( is.null(check) ) return(TRUE) else return(check) } ) markovchain/R/sysdata.rda0000644000176200001440000000651714715232627015137 0ustar liggesusers\ xE +.A"$GL&LvfATQ9dr>Or.r H5ߪ_u*$?_u^z*3IK,$JP ( AP̦Bٖo-1ɊeHQ)&uiIw*Bf*b nbuƗ٬N҉j-6bWՒ*;l`m(tG~PAdѬS%0>e8'z/$WRJ׍瓭BGDA"Y@$Fn$_: veuaZhmvth'7 d;'C8.uE)_Usk}odd]6>K>{ȯ56_Yz{rN'[[.GN?yƹASI٬嚾[@/( 呕`Ƣjk6ݖ{Oᇬxߪ4r1Yd ހRwK^#["ؖcACg'COн[> ;\(a͔1dY듣I"oɁ-~OK k^5|gul:Za˟忉T%`uOk!_g44䰏g&CcF\{K..]K.l٩wV΋<~`FyȡWH* `>m<)Mđ>Mۓ]7|N[HF^KwErjG+/0hhayr4Ly5HMI8D9p'OuG,SfRFh+MDa=+m$.{? x 0d G';_l{y$ź\, 1/n{ơ>xAI5k& 9yc YCAg`[w88LD?㐻'*MoIWcQnƉDʙG1^?޷B&.6QveXo!csY(Cj-\|P>7Nt(/N< xP`+L<dePxu)\~bOx0vu{xyefMT\AOs)=@-.Ƶl7V}96l|ׄañ.N/ ;BKc}ӗfq6MrїͷIBռdϮ\<|n0i./{ C~ k.>\s& QW+MA._C6S؂6q,[^~s<33Gvs!0 !Fҗ}}Ї8 F>@x&` `5`rna1I)w`!%GDIŚ~aQ%"G ?󀅞")‹E|q0a*" 0 if error in inversion 1 otherwise out<-tryCatch(steadyStates(as(myStochasticMatrix, "markovchain")), error=function(c) return(FALSE) ) if(class(out)=="logical") return(0) else return(1) } checkSparseMInversion<-function(i,num){ #simulate the priors myStochasticMatrix<-createSparseMatrix(matr_size = num) #this code returns FALSE -> 0 if error in inversion 1 otherwise out<-tryCatch(steadyStates(as(myStochasticMatrix, "markovchain")), error=function(c) return(FALSE) ) if(class(out)=="logical") return(0) else return(1) } #performing the simulation successRate<-numeric(length(dimensions2Test)) #using parallel backend no_cores <- detectCores() - 1 cl <- makeCluster(no_cores) clusterExport(cl, "checkInversion") clusterExport(cl, "createMatrix") clusterEvalQ(cl, library(markovchain)) clusterEvalQ(cl, library(MCMCpack)) k=1 for (dimension in dimensions2Test){ simulations<-parSapply(cl=cl,1:numSim,FUN=checkInversion,num=dimension) successRate[k]<-mean(simulations) k=k+1 } stopCluster(cl) #summarising first test: #plot(x=dimensions2Test,y=successRate,type="l",xlab="matrix size",ylab="success rate",main="Steady state computation success rate") #abline(h=0.5,col="red") #text(x=dimensions2Test,y=successRate,labels=round(successRate,digits=2),col="darkred",cex=0.7) #dev.off() dimensions2Test = 2^seq(from=3, to=8) successRate<-numeric(length(dimensions2Test)) #using parallel backend no_cores <- detectCores() - 1 cl <- makeCluster(no_cores) clusterExport(cl, "checkSparseMInversion") clusterExport(cl, "createSparseMatrix") clusterEvalQ(cl, library(markovchain)) clusterEvalQ(cl, library(MCMCpack)) k=1 for (dimension in dimensions2Test){ simulations<-parSapply(cl=cl,1:numSim,FUN=checkSparseMInversion,num=dimension) successRate[k]<-mean(simulations) k=k+1 } stopCluster(cl) # # # plot(x=dimensions2Test,y=successRate,type="l",xlab="matrix size",ylab="success rate",main="Steady state computation success rate ??? sparse matrices") # abline(h=0.5,col="red") # text(x=dimensions2Test,y=successRate,labels=round(successRate,digits=2),col="darkred",cex=0.7) #second test: simulating exponentiation checkExponentiation<-function(i,num){ #simulate the priors myStochasticMatrix<-createMatrix(matr_size = num) #this code returns FALSE -> 0 if error in inversion 1 otherwise out<-tryCatch((as(myStochasticMatrix, "markovchain"))^2, error=function(c) return(FALSE) ) if(class(out)=="logical") return(0) else return(1) } #performing the simulation successRate2<-numeric(length(dimensions2Test)) #using parallel backend no_cores <- detectCores() - 1 cl <- makeCluster(no_cores) clusterExport(cl, "checkExponentiation") clusterExport(cl, "createMatrix") clusterEvalQ(cl, library(markovchain)) clusterEvalQ(cl, library(MCMCpack)) k=1 for (dimension in dimensions2Test){ simulations<-parSapply(cl=cl,1:numSim,FUN=checkExponentiation,num=dimension) successRate2[k]<-mean(simulations) k=k+1 } stopCluster(cl) #summarising first test: #par(mfrow=c(1,2)) # plot(x=dimensions2Test,y=successRate,type="l",xlab="matrix size",ylab="success rate",main="Steady state computation success rate") # abline(h=0.5,col="red") # text(x=dimensions2Test,y=successRate,labels=round(successRate,digits=2),col="darkred",cex=0.7) # plot(x=dimensions2Test,y=successRate2,type="l",xlab="matrix sixe",ylab="success rate",main="Exponentiation computation success rate") # abline(h=0.5,col="red") # text(x=dimensions2Test,y=successRate2,labels=round(successRate2,digits=2),col="darkred",cex=0.7) markovchain/demo/00Index0000644000176200001440000000074514714756745014664 0ustar liggesusersquickStart Quick start for markovchain package examples Various examples of Markov Chain bard Structural analysis of Markov chains from Bard PPT extractMatrices Given a matrix, returns the canonical form, fundamental matrix etc... mathematica Mathematica Markov Chains reliability Simulate reliability in inverting a markovchain quasiBayesian Quasi Bayesian estimator function computationTime Computation time by size of the character sequence markovchain/demo/quickStart.R0000644000176200001440000000301114714756745015774 0ustar liggesusers# TODO: Add comment # # Author: Giorgio Spedicato ############################################################################### #creates some markovchain objects statesNames=c("a","b") mcA<-new("markovchain", transitionMatrix=matrix(c(0.7,0.3,0.1,0.9),byrow=TRUE, nrow=2, dimnames=list(statesNames,statesNames) )) mcB<-new("markovchain", states=c("a","b","c"), transitionMatrix= matrix(c(0.2,0.5,0.3, 0,1,0, 0.1,0.8,0.1),nrow=3, byrow=TRUE)) mcC<-new("markovchain", states=c("a","b","c","d"), transitionMatrix=matrix(c(0.25,0.75,0,0,0.4, 0.6,0,0,0,0,0.1,0.9,0,0,0.7,0.3), nrow=4, byrow=TRUE) ) mcD<-new("markovchain", transitionMatrix=matrix(c(0,1,0,1), nrow=2,byrow=TRUE)) #apply some methods testConversion<-as(mcC, "data.frame") markovD<-t(mcC) steadyStates(mcC) steadyStates(mcC) #perform some fitting sequence<-c("a", "b", "a", "a", "a", "a", "b", "a", "b", "a", "b", "a", "a", "b", "b", "b", "a") mcFit<-markovchainFit(data=sequence,byrow=FALSE) #canonic form #from https://math.dartmouth.edu/archive/m20x06/public_html/Lecture14.pdf P<-zeros(5) P[1,1]<-P[5,5]<-1 P[2,1]<-P[2,3]<-0.5 P[3,2]<-P[3,4]<-0.5 P[4,3]<-P[4,5]<-0.5 mcP<-as(P,"markovchain") mcPCan<-canonicForm(mcP) # coercing markov chains to sparse matrix forth and back require(Matrix) ciauz<-c(0,.5,.5,1,0,0,.2,0,.8) matrix(ciauz, nrow=3, byrow=TRUE) sparse<-as(matrix(ciauz, nrow=3, byrow=TRUE),"sparseMatrix") mc<-as(sparse,"markovchain") sparse2<-as(mc,"sparseMatrix") markovchain/demo/extractMatrices.R0000644000176200001440000000134714714756745017016 0ustar liggesusers#function to extract matrices extractMatrices <- function(mcObj) { require(matlab) mcObj <- canonicForm(object = mcObj) #get the indices of transient and absorbing transIdx <- which(states(mcObj) %in% transientStates(mcObj)) absIdx <- which(states(mcObj) %in% absorbingStates(mcObj)) #get Q, R and I Q <- as.matrix(mcObj@transitionMatrix[transIdx,transIdx]) R <- as.matrix(mcObj@transitionMatrix[transIdx,absIdx]) I <- as.matrix(mcObj@transitionMatrix[absIdx, absIdx]) #get fundamental matrix N <- solve(eye(size(Q)) - Q) #final absorbion probabilities NR <- N %*% R #return out <- list( canonicalForm = mcObj, Q = Q, R = R, I = I, N=N, NR=NR ) return(out) }markovchain/demo/examples.R0000644000176200001440000000122214714756745015462 0ustar liggesusers#up and down markov chains mcUpDown<-new("markovchain", states=c("up","down"), transitionMatrix=matrix(c(0,1,1,0),nrow=2, byrow=TRUE),name="UpDown") #gamblers ruin gamblerRuinMarkovChain<-function(moneyMax, prob=0.5) { require(matlab) matr<-zeros(moneyMax+1) states<-as.character(seq(from=0, to=moneyMax, by=1)) rownames(matr)=states; colnames(matr)=states matr[1,1]=1;matr[moneyMax+1,moneyMax+1]=1 for(i in 2:moneyMax) { matr[i,i-1]=1-prob;matr[i,i+1]=prob } out<-new("markovchain", transitionMatrix=matr, name=paste("Gambler ruin",moneyMax,"dim",sep=" ") ) return(out) }markovchain/vignettes/0000755000176200001440000000000014715232626014574 5ustar liggesusersmarkovchain/vignettes/template.tex0000644000176200001440000000363014714756746017150 0ustar liggesusers\documentclass[ $for(classoption)$ $classoption$$sep$, $endfor$ ]{$documentclass$} \usepackage[utf8]{inputenc} \providecommand{\tightlist}{% \setlength{\itemsep}{0pt}\setlength{\parskip}{0pt}} \author{ $for(author)$$author.name$\\$author.affiliation$$sep$ \And $endfor$ } \title{$title.formatted$} \Plainauthor{$for(author)$$author.name$$sep$, $endfor$} $if(title.plain)$ \Plaintitle{$title.plain$} $endif$ $if(title.short)$ \Shorttitle{$title.short$} $endif$ \Abstract{ $abstract$ } $if(keywords.formatted)$ \Keywords{$for(keywords.formatted)$$keywords.formatted$$sep$, $endfor$} $endif$ $if(keywords.plain)$ \Plainkeywords{$for(keywords.plain)$$keywords.plain$$sep$, $endfor$} $endif$ $if(highlighting-macros)$ $highlighting-macros$ $endif$ %% publication information %% \Volume{50} %% \Issue{9} %% \Month{June} %% \Year{2012} %% \Submitdate{$submitdate$} %% \Acceptdate{2012-06-04} \Address{ $for(author)$ $if(author.address)$ $author.name$\\ $author.affiliation$\\ $author.address$\\ $if(author.email)$E-mail: $author.email$\\$endif$ $if(author.url)$URL: $author.url$\\~\\$endif$ $endif$ $endfor$ } $if(csl-refs)$ \newlength{\cslhangindent} \setlength{\cslhangindent}{1.5em} \newenvironment{cslreferences}% {$if(csl-hanging-indent)$\setlength{\parindent}{0pt}% \everypar{\setlength{\hangindent}{\cslhangindent}}\ignorespaces$endif$}% {\par} $endif$ % Pandoc header $for(header-includes)$ $header-includes$ $endfor$ $preamble$ \begin{document} $body$ $if(natbib)$ $if(bibliography)$ $if(biblio-title)$ $if(book-class)$ \renewcommand\bibname{$biblio-title$} $else$ \renewcommand\refname{$biblio-title$} $endif$ $endif$ \bibliography{$for(bibliography)$$bibliography$$sep$,$endfor$} $endif$ $endif$ $if(biblatex)$ \printbibliography$if(biblio-title)$[title=$biblio-title$]$endif$ $endif$ \end{document} markovchain/vignettes/gsoc_2017_additions.Rmd0000644000176200001440000005244014714756746020724 0ustar liggesusers--- title: "Google Summer of Code 2017 Additions" author: "Vandit Jain" date: "August 2017" output: rmarkdown::html_vignette bibliography: markovchainBiblio.bib vignette: > %\VignetteIndexEntry{Google Summer of Code 2017 Additions} %\VignetteEngine{knitr::rmarkdown} %VignetteEncoding{UTF-8} --- ```{r setup, include=FALSE} knitr::opts_chunk$set(echo = TRUE, collapse = TRUE, comment = "#>") ``` ```{r setup_2, include=FALSE} require(markovchain) ``` # Expected Hitting Time using CTMC The package provides `ExpectedTime` function to calculate average hitting time from one state to another. Let the final state be j, then for every state $i \in I$, where $I$ is the set of all possible states and holding time $q_{i} > 0$ for every $i \neq j$. Assuming the conditions to be true, expected hitting time is equal to minimal non-negative solution vector $p$ to the system of linear equations [@NorrisBook]: \begin{equation} \begin{array}{lcr} p_{k} = 0 & k = j \\ -\sum_{l \in I} q_{kl}p_{k} = 1 & k \neq j \end{array} \label{eq:EHT} \end{equation} For example, consider the continuous time markovchain which is as follows: ``` {r,message = FALSE} library(markovchain) states <- c("a","b","c","d") byRow <- TRUE gen <- matrix(data = c(-1, 1/2, 1/2, 0, 1/4, -1/2, 0, 1/4, 1/6, 0, -1/3, 1/6, 0, 0, 0, 0), nrow = 4,byrow = byRow, dimnames = list(states,states)) ctmc <- new("ctmc",states = states, byrow = byRow, generator = gen, name = "testctmc") ``` The generator matrix of the ctmc is: \[ M = \left(\begin{array}{cccc} -1 & 1/2 & 1/2 & 0\\ 1/4 & -1/2 & 1/4 & 1/6\\ 1/6 & 0 & -1/3 & 1/6\\ 0 & 0 & 0 & 0 \end{array}\right) \] Now if we have to calculate expected hitting time the process will take to hit state $d$ if we start from $a$, we apply the $ExpectedTime$ function. $ExpectedTime$ function takes four inputs namely a $ctmc$ class object, initial state $i$, the final state $j$ that we have to calculate expected hitting time and a logical parameter whether to use RCpp implementation. By default, the function uses RCpp as it is faster and takes lesser time. ``` {r} ExpectedTime(ctmc,1,4) ``` We find that the expected hitting time for process to be hit state $d$ is 7 units in this case. # Calculating Probability at time T using ctmc The package provides a function `probabilityatT` to calculate probability of every state according to given `ctmc` object. The Kolmogorov's backward equation gives us a relation between transition matrix at any time t with the generator matrix[@dobrow2016introduction]: \begin{equation} P'(t) = QP(t) \end{equation} Here we use the solution of this differential equation $P(t) = P(0)e^{tQ}$ for $t \geq 0$ and $P(0) = I$. In this equation, $P(t)$ is the transition function at time t. The value $P(t)[i][j]$ at time $P(t)$ describes the conditional probability of the state at time $t$ to be equal to j if it was equal to i at time $t=0$. It takes care of the case when `ctmc` object has a generator represented by columns. If initial state is not provided, the function returns the whole transition matrix $P(t)$. Also to mention is that the function is also implemented using RCpp and can be used used to lessen the time of computation. It is used by default. Next, We consider both examples where initial state is given and case where initial state is not given. In the first case, the function takes two inputs, first of them is an object of the S4 class 'ctmc' and second is the final time $t$. ``` {r} probabilityatT(ctmc,1) ``` Here we get an output in the form of a transition matrix. If we take the second case i.e. considering some initial input: ``` {r} probabilityatT(ctmc,1,1) ``` In this case we get the probabilities corresponding to every state. this also includes probability that the process hits the same state $a$ after time $t=1$. # Plotting generator matrix of continuous-time markovchains The package provides a `plot` function for plotting a generator matrix $Q$ in the form of a directed graph where every possible state is assigned a node. Edges connecting these nodes are weighted. Weight of the edge going from a state $i$ to state $j$ is equal to the value $Q_{ij}$. This gives a picture of the generator matrix. For example, we build a ctmc-class object to plot it. ``` {r} energyStates <- c("sigma", "sigma_star") byRow <- TRUE gen <- matrix(data = c(-3, 3, 1, -1), nrow = 2, byrow = byRow, dimnames = list(energyStates, energyStates)) molecularCTMC <- new("ctmc", states = energyStates, byrow = byRow, generator = gen, name = "Molecular Transition Model") ``` Now if we plot this function we get the following graph: ``` {r} plot(molecularCTMC) ``` The figure shown is built using the $igraph$ package. The package also provides options of plotting graph using $diagram$ and $DiagrameR$ package. Plot using these packages can be built using these commands: ``` {r} if(requireNamespace(package='ctmcd', quietly = TRUE)) { plot(molecularCTMC,package = "diagram") } else { print("diagram package unavailable") } ``` Similarly, one can easily replace $diagram$ package with $DiagrammeR$. # Imprecise Continuous-Time Markov chains Continuous-time Markov chains are mathematical models that are used to describe the state-evolution of dynamical systems under stochastic uncertainty. However, building models using continuous time markovchains take in consideration a number of assumptions which may not be realistic for the domain of application; in particular; the ability to provide exact numerical parameter assessments, and the applicability of time-homogeneity and the eponymous Markov property. Hence we take ICTMC into consideration. More technically, an ICTMC is a set of “precise” continuous-time finite-state stochastic processes, and rather than computing expected values of functions, we seek to compute lower expectations, which are tight lower bounds on the expectations that correspond to such a set of “precise” models. ## Types of ICTMCs For any non-empty bounded set of rate matrices $L$, and any non-empty set $M$ of probability mass functions on $X$, we define the following three sets of stochastic processes that are jointly consistent with $L$ and $M$: * $P^{W}_{L,M}$ is the consistent set of all well-behaved stochastic processes; * $P^{WM}_{L,M}$ is the consistent set of all well-behaved Markov chains; * $P^{WHM}_{L,M}$ is the consistent set of all well-behaved homogeneous Markov chains[@ictmcpaper]. From a practical point of view, after having specified a (precise) stochastic process, one is typically interested in the expected value of some function of interest, or the probability of some event. Similarly, in this work, our main objects of consideration will be the lower probabilities that correspond to the ICTMCs. ## Lower Transition Rate Operators for ICTMCs A map $Q_{l}$ from $L(X)$ to $L(X)$ is called a lower transition rate operator if, for all $f,g \in L(X)$, all $\lambda \in R_{\geq 0}$, all $\mu \in L(X)$, and all $x \in X$[@ictmcpaper]: 1. $[Q_{l}m](x) = 0$ 2. $[Q_{l}I](x) \geq 0 \forall y \in X$ such that $x \neq y$ 3. $[Q_{l}(f + g)](x)\geq [Q_{l}f](x) + [Q_{l}g](x)$ 4. $[Q_{l}(l f)](x) = \lambda Q_{l}f[(x)]$ ## Lower Transition Operators A map $T_{l}$ from $L (X )$ to $L (X )$ is called a lower transition operator if, for all $f,g \in L(X)$, all $\lambda \in R_{\geq 0}$, all $\mu \in L(X)$, and all $x \in X$[@ictmcpaper]: 1. $[T_{l} f](x) \geq min(f(y) : y \in L)$ 2. $[T_{l}(f +g)](x) \geq [T_{l} f](x)+[T_{l}g](x)$ 3. $[T_{l}(\lambda f)](x) = l [T_{l} f](x)$ ## ImpreciseprobabilityatT function Now I would like to come onto the practical purpose of using ICTMC classes. ICTMC classes in these package are defined to represent a generator that is defined in such a way that every row of the generator corresponding to every state in the process is governed by a separate variable. As defined earlier, an imprecise continuous time markovchain is a set of many precise CTMCs. Hence this representation of set of precise CTMCs can be used to calulate transition probability at some time in future. This can be seen as an analogy with `probabilityatT` function. It is used to calculate the transition function at some later time t using generatoe matrix. For every generator matrix, we have a corresponding transition function. Similarly, for every Lower Transition rate operator of an ICTMC, we have a corresponding lower transition operator denoted by $L_{t}^{s}$. Here $t$ is the initial time and $s$ is the final time. Now we mention a proposition[@ictmcpaper] which states that: Let $Q_{l}$ be a lower transition rate operator, choose any time $t$ and $s$ both greater than 0 such that $t \leq s$, and let $L_{t}^{s}$ be the lower transition operator corresponding to $Q_{l}$. Then for any $f \in L(X)$ and $\epsilon \in R_{>0}$, if we choose any $n \in N$ such that: \[n \geq max((s-t)*||Q||,\frac{1}{2\epsilon}(s-t)^{2}||Q||^{2}||f||_v)\] with $||f||_{v}$ := max $f$ - min $f$, we are guaranteed that[@ictmcpaper] \[ ||L_{t}^{s} - \prod_{i=1}^{n}(I + \Delta Q_{l}) || \leq \epsilon \] with $\Delta := \frac{s-t}{n}$ Simple put this equation tells us that, using $Q_{l}g$ for all $g \in L(X)$ then we can also approximate the quantity $L_{t}^{s}$ to arbitrary precision, for any given $f \in L(X)$. To explain this approximate calculation, I would take a detailed example of a process containing two states healthy and sick, hence $X = (healthy,sick)$. If we represent in form of an ICTMC, we get: \[ Q = \left(\begin{array}{cc} -a & a \\ b & -b \end{array}\right) \] for some $a,b \in R_{\geq 0}$. The parameter $a$ here is the rate at which a healthy person becomes sick. Technically, this means that if a person is healthy at time $t$, the probability that he or she will be sick at time $t +\Delta$, for small $\Delta$, is very close to $\Delta a$. More intuitively, if we take the time unit to be one week, it means that he or she will, on average, become sick after $\frac{1}{a}$ weeks. The parameter $b$ is the rate at which a sick person becomes healthy again, and has a similar interpretation. Now to completely represent the ICTMC we take an example and write the generator as: \[ Q = \left(\begin{array}{cc} -a & a \\ b & -b \end{array}\right) : a \in [\frac{1}{52},\frac{3}{52}],b \in [\frac{1}{2},2] \] Now suppose we know the initial state of the patient to be sick, hence this is represented in the form of a function by: \[ I_{s} = \left(\begin{matrix} 0 \\ 1 \end{matrix}\right) \] We observe that the $||I_{s}|| = 1$. Now to use the proposition mentioned above, we use the definition to calculate the lower transition operator $Q_{l}$ Next we calculate the norm of the lower transition rate operator and use it in the preposition. Also we take value of $\epsilon$ to be 0.001. Using the preposition we can come up to an algorithm for calculating the probability at any time $s$ given state at initial time $t$ and a ICTMC generator[@ictmcpaper]. The algorithm is as follows: **Input**: A lower transition rate operator $Q$, two time points $t,s$ such that $t \leq s$, a function $f \in L(X )$ and a maximum numerical error $\epsilon \in R_{>0}$. **Algorithm**: 1. $n = max((s-t)||Q||,\frac{1}{2\epsilon}(s-t)^{2}||Q||^{2}||f||_v)$ 2. $\Delta = \frac{s-t}{n}$ 3. $g_{0} = I_{s}$ 4. for $i \in (1,.....,n)$ do $g_{i} = g_{i-1} + \Delta Q_{l}g_{i-1}$ 5. end for 6. return $g_{n}$ **Output**: The conditional probability vector after time $t$ with error $\epsilon$. Hence, after applying the algorithm on above example we get the following result: $ g_{n} = 0.0083$ if final state is $healthy$ and $g_{n} = 0.141$ if the final state is $sick$. The probability calculated is with an error equal to $\epsilon$ i.e. $0.001$. Now we run the algorithm on the example through R code. ``` {r} states <- c("n","y") Q <- matrix(c(-1,1,1,-1),nrow = 2,byrow = TRUE,dimnames = list(states,states)) range <- matrix(c(1/52,3/52,1/2,2),nrow = 2,byrow = 2) name <- "testictmc" ictmc <- new("ictmc",states = states,Q = Q,range = range,name = name) impreciseProbabilityatT(ictmc,2,0,1,10^-3,TRUE) ``` The probabilities we get are with an error of $10^{-3}$ # Continuous time markovchain generator using frequency Matrix The package provides `freq2Generator` function. It takes in a matrix representing relative frequency values along with time taken to provide a continuous time markovchain generator matrix. Here, frequency matrix is a 2-D matrix of dimensions equal to relative number of possible states describing the number of transitions from a state $i$ to $j$ in time $t$, which is another parameter to be provided to the function. The function also allows to chose among three methods for calculation of the generator matrix [@freqArticle]. It requires the [@pkg:ctmcd] package. Three methods are as follows: 1. Quasi Optimization - "QO" 2. Diagonal Adjustment - "DA" 3. Weighted Adjustment - "WA" See reference for details about the methods. Here is an example matrix on which `freq2Generator` function is run: ``` {r} if(requireNamespace(package='ctmcd', quietly = TRUE)) { sample <- matrix(c(150,2,1,1,1,200,2,1,2,1,175,1,1,1,1,150),nrow = 4,byrow = TRUE) sample_rel = rbind((sample/rowSums(sample))[1:dim(sample)[1]-1,],c(rep(0,dim(sample)[1]-1),1)) freq2Generator(sample_rel,1) } else { print('ctmcd unavailable') } ``` # Committor of a markovchain Consider set of states A,B comprising of states from a markovchain with transition matrix P. The committor vector of a markovchain with respect to sets A and B gives the probability that the process will hit a state from set A before any state from set B. Committor vector u can be calculated by solving the following system of linear equations[@committorlink]: $$ \begin{array}{l} Lu(x) = 0, x \notin A \cup B \\ u(x) = 1, x \in A \\ u(x) = 0, x \in B \end{array} $$ where $L = P -I$. Now we apply the method to an example: ``` {r eval=FALSE} transMatr <- matrix(c(0,0,0,1,0.5,0.5,0,0,0,0,0.5,0,0,0,0,0,0.2,0.4,0,0,0,0.8,0.6,0,0.5),nrow = 5) object <- new("markovchain", states=c("a","b","c","d","e"),transitionMatrix=transMatr, name="simpleMc") committorAB(object,c(5),c(3)) ``` Here we get probability that the process will hit state "e" before state "c" given different initial states. # First Passage probability for set of states Currently computation of the first passage time for individual states has been implemented in the package. `firstPassageMultiple` function provides a method to get first passage probability for given provided set of states. Consider this example markovchain object: ``` {r} statesNames <- c("a", "b", "c") testmarkov <- new("markovchain", states = statesNames, transitionMatrix = matrix(c(0.2, 0.5, 0.3, 0.5, 0.1, 0.4, 0.1, 0.8, 0.1), nrow = 3, byrow = TRUE, dimnames = list(statesNames, statesNames) )) ``` Now we apply `firstPassageMultiple` function to calculate first passage probabilities for set of states $"b", "c"$ when initial state is $"a"$. ``` {r} firstPassageMultiple(testmarkov,"a",c("b","c"),4) ``` This shows us the probability that the process will hit any of the state from the set after n number of steps for instance, as shown, the probability of the process to hit any of the states among $"b", "c"$ after $2$ steps is $0.6000$. # Joint PDF of number of visits to the various states of a markovchain The package provides a function `noofVisitsDist` that returns the PDF of the number of visits to the various states of the discrete time markovchain during the first N steps, given initial state of the process. We will take an example to see how to use the function on a `markovchain-class` object: ``` {r} transMatr<-matrix(c(0.4,0.6,.3,.7),nrow=2,byrow=TRUE) simpleMc<-new("markovchain", states=c("a","b"), transitionMatrix=transMatr, name="simpleMc") noofVisitsDist(simpleMc,5,"a") ``` The output clearly shows the probabilities related to various states of the process. # Expected Rewards for a markovchain The package provides a function `expectedRewards` that returns a vector of expected rewards for different initial states. The user provides reward values, a vector $r$ of size equal to number of states having a value corresponding to every state. Given a transition matrix $[P]$, we get the vector of expected rewards $v$ after $n$ transitions according to the equation as follows[@GallagerBook]: $v[n] = r + [P]*v[n-1]$ Applying this equation on a markovchain-class object ``` {r} transMatr<-matrix(c(0.99,0.01,0.01,0.99),nrow=2,byrow=TRUE) simpleMc<-new("markovchain", states=c("a","b"), transitionMatrix=transMatr) expectedRewards(simpleMc,1,c(0,1)) ``` ## Expected Rewards for a set of states in a markovchain process The package provides a function `expectedRewardsBeforeHittingA` that returns the value of expected first passage rewards $E$ given rewards corresponding to every state, an initial state. This means the function returns expected reward for given initial state $s_{0}$, number of transitions $n$ and for a set of states $A$ with a constraint such that the process does not hit any of the states that belong to state $A$. $S$ is the set of all possible states. The function uses an equation which is as follows: $$E = \sum_{i=1}^{n}{1_{s_{0}}P_{S-A}^{i}R_{S-A}}$$ here $1_{s_{0}} = [0,0,...0,1,0,...,0,0,0]$, 1 being on $s_{0}$ position and $R_{S-A}$ being the rewards vector for $S-A$ state. # Checking Irreducibly of a CTMC The package provides a function `is.CTMCirreducible` that returns a Boolean value stating whether the ctmc object is irreducible. We know that a continuous time markovchain is irreducible if and only if its embedded chain is irreducible[@Sigman]. We demonstrate an example running the function: ``` {r} energyStates <- c("sigma", "sigma_star") byRow <- TRUE gen <- matrix(data = c(-3, 3, 1, -1), nrow = 2, byrow = byRow, dimnames = list(energyStates, energyStates)) molecularCTMC <- new("ctmc", states = energyStates, byrow = byRow, generator = gen, name = "Molecular Transition Model") is.CTMCirreducible(molecularCTMC) ``` # Simulation of Higher Order Multivariate Markovchains The package provides `predictHommc` function. This function provides a simulation system for higher order multivariate markovchains. The function assumes that the state probability distribution of the jth sequence at time $r+1$ depends on the state probability distribution of all the sequences at n previous mon=ments of time i.e. $t = r$ to $t = r-n+1$ . Hence the proposed model takes the form mathematically as:[@ching2008higher] $$ X_{r+1}^{j} = \sum_{k=1}^{s}\sum_{h=1}^n{\lambda_{jk}^{(h)}P_{h}^{(jk)}X_{r-h+1}^{(k)}}, \ \ \ j = 1,2,....s, \ \ r = n-1,n,... $$ with initals $X_{0}^{(k)},X_{1}^{(k)},......,X_{n-1}^{(k)} \ (k = 1,2,...s)$. Here, $\lambda_{jk}^{(k)}, \ 1 \leq j,k \leq s, \ 1 \leq h \leq n \ \ \ and \ \ \ \sum_{k=1}^{s}\sum_{h=1}^{n}{\lambda_{jk}^{(h)} = 1}, \ \ \ j = 1,2,....s.$ Now we run an example on sample hommc object for simulating next 3 steps using `predictHommc` function. The function provides a choice of entering initial states according to the hommc object. In case the user does not enter initial states, the function takes all initial states to be the first state from the set of states. ``` {r} if (requireNamespace("Rsolnp", quietly = TRUE)) { statesName <- c("a", "b") P <- array(0, dim = c(2, 2, 4), dimnames = list(statesName, statesName)) P[,,1] <- matrix(c(0, 1, 1/3, 2/3), byrow = FALSE, nrow = 2) P[,,2] <- matrix(c(1/4, 3/4, 0, 1), byrow = FALSE, nrow = 2) P[,,3] <- matrix(c(1, 0, 1/3, 2/3), byrow = FALSE, nrow = 2) P[,,4] <- matrix(c(3/4, 1/4, 0, 1), byrow = FALSE, nrow = 2) Lambda <- c(0.8, 0.2, 0.3, 0.7) ob <- new("hommc", order = 1, states = statesName, P = P, Lambda = Lambda, byrow = FALSE, name = "FOMMC") predictHommc(ob,3) } else { print("Rsolnp unavailable") } ``` # Check Time Reversibility of Continuous-time markovchains A Continuous-time markovchain with generator $Q$ and stationary distribution $\pi$ is said to be time reversible if:[@dobrow2016introduction] $$ \pi_{i}q_{ij} = \pi_{j}q_{ji} $$ Intuitively, a continuous-time Markov chain is time reversible if the process in forward time is indistinguishable from the process in reversed time. A consequence is that for all states i and j, the long-term forward transition rate from i to j is equal to the long-term backward rate from j to i. The package provides `is.TimeReversible` function to check if a `ctmc` object is time-reversible. We follow with an example run on a `ctmc` object. ``` {r} energyStates <- c("sigma", "sigma_star") byRow <- TRUE gen <- matrix(data = c(-3, 3, 1, -1), nrow = 2, byrow = byRow, dimnames = list(energyStates, energyStates)) molecularCTMC <- new("ctmc", states = energyStates, byrow = byRow, generator = gen, name = "Molecular Transition Model") is.TimeReversible(molecularCTMC) ``` # References markovchain/vignettes/markovchainBiblio.bib0000644000176200001440000004703414714756746020722 0ustar liggesusers% Encoding: UTF-8 % Formatted with emacs using C-c C-q in BibTeX mode @book{dobrow2016introduction, title = {Introduction to Stochastic Processes with R}, author = {Dobrow, Robert P}, year = {2016}, publisher = {John Wiley \& Sons} } @manual{pkg:ctmcd, title = {ctmcd: Estimating the Parameters of a Continuous-Time Markov Chain from Discrete-Time Data}, author = {Marius Pfeuffer}, year = {2017}, note = {R package version 1.1}, url = {https://CRAN.R-project.org/package=ctmcd} } @article{Hu2002, author = {Hu, Yen Ting and Kiesel, Rudiger and Perraudin, William}, doi = {10.1016/S0378-4266(02)00268-6}, isbn = {0378-4266}, issn = {03784266}, journal = {Journal of Banking and Finance}, keywords = {Credit rating,Credit risk,Ordered probit,Sovereign default}, number = {7}, pages = {1383--1406}, title = {{The estimation of transition matrices for sovereign credit ratings}}, volume = {26}, year = {2002} } @book{de2016assicurazioni, title = {Assicurazioni sulla salute: caratteristiche, modelli attuariali e basi tecniche}, author = {{De Angelis, Paolo} and {Di Falco, L.}}, isbn = {9788815260840}, series = {Il Mulino}, url = {https://books.google.it/books?id=D56bjgEACAAJ}, year = {2016}, publisher = {Il Mulino} } @mastersthesis{skuriat2005statistical, author = "Skuriat-Olechnowska, Monika", title = "Statistical inference and hypothesis testing for Markov chains with Interval Censoring", school = "TUDelft", year = "2005" } @article{kullback1962tests, title = {Tests for Contingency Tables and Marltov Chains}, author = {Kullback, S and Kupperman, Michael and Ku, HH}, journal = {Technometrics}, volume = {4}, number = {4}, pages = {573--608}, year = {1962}, publisher = {Taylor \& Francis} } @article{israel2001finding, title = {Finding generators for Markov chains via empirical transition matrices, with applications to credit ratings}, author = {Israel, Robert B and Rosenthal, Jeffrey S and Wei, Jason Z}, journal = {Mathematical finance}, volume = {11}, number = {2}, pages = {245--265}, year = {2001}, publisher = {Wiley Online Library} } @manual{pkg:RcppParallel, title = {RcppParallel: Parallel Programming Tools for 'Rcpp'}, author = {JJ Allaire and Romain Francois and Kevin Ushey and Gregory Vandenbrouck and Marcus Geelnard and {Intel}}, year = {2016}, note = {R package version 4.3.19}, url = {http://rcppcore.github.io/RcppParallel/} } @manual{pkg:MultinomialCI, title = {MultinomialCI: Simultaneous confidence intervals for multinomial proportions according to the method by Sison and Glaz}, author = {Pablo J. Villacorta}, year = {2012}, note = {R package version 1.0}, url = {http://CRAN.R-project.org/package=MultinomialCI} } @article{sison1995simultaneous, title = {Simultaneous confidence intervals and sample size determination for multinomial proportions}, author = {Sison, Cristina P and Glaz, Joseph}, journal = {Journal of the American Statistical Association}, volume = {90}, number = {429}, pages = {366--369}, year = {1995}, publisher = {Taylor \& Francis} } @article{konstantopoulos2009markov, title = {Markov Chains and Random Walks}, author = {Konstantopoulos, Takis}, journal = {Lecture notes}, year = {2009} } @article{craigSendi, author = {{B. A. Craig} and {A. A. Sendi}}, title = {Estimation of the Transition Matrix of a Discrete-Time Markov Chain}, journal = {Health Economics}, year = {2002}, volume = {11}, pages = {33--42} } @misc{bardPpt, author = {J. F. Bard}, title = {Lecture 12.5 - Additional Issues Concerning Discrete-Time Markov Chains}, month = {April}, year = {2000}, url ={http://www.me.utexas.edu/~jensen%20/ORMM/instruction/powerpoint/or_models_09/12.5_dtmc2.ppt} } @incollection{bremaud1999discrete, author = {Br{\'e}maud, Pierre}, title = {Discrete-Time Markov Models}, booktitle = {Markov Chains}, publisher = {Springer}, year = {1999}, pages = {53--93} } @book{chambers, title = {Software for Data Analysis: Programming with \proglang{R}}, publisher = {Springer-Verlag}, year = {2008}, author = {Chambers, J.M.}, series = {Statistics and computing}, isbn = {9780387759357}, lccn = {2008922937} } @book{ching2006markov, title = {Markov Chains: Models, Algorithms and Applications}, publisher = {Springer-Verlag}, year = {2006}, author = {Ching, W.K. and Ng, M.K.}, series = {International Series in Operations Research \& Management Science}, isbn = {9780387293356}, lccn = {2005933263} } @article{pkg:igraph, author = {Gabor Csardi and Tamas Nepusz}, title = {The \pkg{igraph} Software Package for Complex Network Research}, journal = {InterJournal}, year = {2006}, volume = {Complex Systems}, pages = {1695}, url = {http://igraph.sf.net} } @book{denuit2007actuarial, title = {Actuarial modelling of claim counts: Risk classification, credibility and bonus-malus systems}, publisher = {Wiley}, year = {2007}, author = {Denuit, Michel and Mar{\'e}chal, Xavier and Pitrebois, Sandra and Walhin, Jean-Fran{\c{c}}ois} } @book{deshmukh2012multiple, title = {Multiple Decrement Models in Insurance: An Introduction Using \proglang{R}}, publisher = {Springer-Verlag}, year = {2012}, author = {Deshmukh, S.R.}, series = {SpringerLink : B{\"u}cher}, isbn = {9788132206590}, lccn = {2012942476} } @book{RcppR, title = {Seamless \proglang{R} and \proglang{C++} Integration with \pkg{Rcpp}}, publisher = {Springer-Verlag}, year = {2013}, author = {Dirk Eddelbuettel}, address = {New York}, note = {ISBN 978-1-4614-6867-7} } @misc{renaldoMatlab, author = {Renaldo Feres}, title = {Notes for Math 450 \proglang{MATLAB} Listings for Markov Chains}, year = {2007}, url = {http://www.math.wustl.edu/~feres/Math450Lect04.pdf} } @manual{mcmcR, title = {mcmc: Markov Chain Monte Carlo}, author = {Charles J. Geyer and Leif T. Johnson}, year = {2013}, note = {\proglang{R} package version 0.9-2}, url = {http://CRAN.R-project.org/package=mcmc} } @incollection{glassHall, author = {Glass, D.V. and Hall, J. R.}, title = {Social Mobility in Great Britain: A Study in Intergenerational Change in Status}, booktitle = {Social Mobility in Great Britain}, publisher = {Routledge and Kegan Paul}, year = {1954} } @manual{expmR, title = {\pkg{expm}: Matrix Exponential}, author = {Vincent Goulet and Christophe Dutang and Martin Maechler and David Firth and Marina Shapira and Michael Stadelmann and {expm-developers@lists.R-forge.R-project.org}}, year = {2013}, note = {R package version 0.99-1}, url = {http://CRAN.R-project.org/package=expm} } @manual{hmmR, title = {\pkg{HMM}: HMM - Hidden Markov Models}, author = {Scientific Software Development - Dr. Lin Himmelmann and {www.linhi.com}}, year = {2010}, note = {\proglang{R} package version 1.0}, url = {http://CRAN.R-project.org/package=HMM} } @book{landOfOz, title = {Introduction to Finite Mathematics}, publisher = {Prentice Hall}, year = {1974}, author = {{J. G. Kemeny} and {J. L.Snell} and {G. L. Thompson}} } @article{msmR, author = {Christopher H. Jackson}, title = {Multi-State Models for Panel Data: The \pkg{msm} Package for \proglang{R}}, journal = {Journal of Statistical Software}, year = {2011}, volume = {38}, pages = {1--29}, number = {8}, url = {http://www.jstatsoft.org/v38/i08/} } @misc{manchesterR, author = {Ian Jacob}, month = {May}, year = {2014}, title = {Is R Cost Effective?}, language = {En}, howpublished = {Electronic}, organization = {Manchester Centre for Health Economics}, note = {Presented on Manchester R Meeting}, url ={http://www.rmanchester.org/Presentations/Ian%20Jacob%20-%20Is%20R%20Cost%20Effective.pdf} } @TECHREPORT{blandenEtAlii, author = {Jo Blanden, Paul Gregg and Stephen Machin}, title = {Intergenerational Mobility in Europe and North America}, institution = {Center for Economic Performances}, year = {2005}, owner = {Giorgio Copia}, timestamp = {2014.01.01}, url ={http://cep.lse.ac.uk/about/news/IntergenerationalMobility.pdf} } @misc{Konstantopoulos2009, author = {Konstantopoulos, Takis}, title = {Markov Chains and Random Walks}, year = {2009}, url ={http://www2.math.uu.se/~takis/public_html/McRw/mcrw.pdf} } @misc{montgomery, author = {James Montgomery}, title = {Communication Classes}, year = {2009}, url = {http://www.ssc.wisc.edu/~jmontgom/commclasses.pdf} } @manual{DTMCPackR, title = {\pkg{DTMCPack}: Suite of Functions Related to Discrete-Time Discrete-State Markov Chains}, author = {William Nicholson}, year = {2013}, note = {R package version 0.1-2}, url = {http://CRAN.R-project.org/package=DTMCPack} } @article{averyHenderson, author = {{P. J. Avery} and {D. A. Henderson}}, title = {Fitting Markov Chain Models to Discrete State Series}, journal = {Applied Statistics}, year = {1999}, volume = {48}, pages = {53-61}, number = {1} } @manual{rSoftware, title = {\proglang{R}: A Language and Environment for Statistical Computing}, author = {{R Core Team}}, organization = {R Foundation for Statistical Computing}, address = {Vienna, Austria}, year = {2013}, url = {http://www.R-project.org/} } @manual{pkg:matlab, title = {\pkg{matlab}: \proglang{MATLAB} emulation package}, author = {P. Roebuck}, year = {2011}, note = {R package version 0.8.9}, url = {http://CRAN.R-project.org/package=matlab} } @misc{probBook, author = {Laurie Snell}, title = {Probability Book: chapter 11}, year = {1999}, url ={http://www.dartmouth.edu/~chance/teaching_aids/books_articles/probability_book/Chapter11.pdf} } @article{pkg:markovchain, author = {Giorgio Alfredo Spedicato}, title = {{Discrete Time Markov Chains with R}}, year = {2017}, journal = {{The R Journal}}, url = {https://journal.r-project.org/archive/2017/RJ-2017-036/index.html} } @manual{MAPmcR, title = {Bayesian Inference of First Order Markov Chains}, author = {Sai Bhargav Yalamanchi and Giorgio Alfredo Spedicato}, month = {06}, year = {2015}, note = {R package version 0.2.5} } @misc{wiki:markov, author = {Wikipedia}, title = {Markov chain --- Wikipedia{,} The Free Encyclopedia}, year = {2013}, note = {[Online; accessed 23-August-2013]}, url = {http://en.wikipedia.org/w/index.php?title=Markov_chain&oldid=568910294} } @manual{CreditMetricsR, title = {CreditMetrics: Functions for Calculating the CreditMetrics Risk Model}, author = {Andreas Wittmann}, year = {2007}, note = {\proglang{R} package version 0.0-2} } @manual{mathematica9, title = {\proglang{Mathematica}}, author = {Wolfram Research, Inc.}, organization = {Wolfram Research, Inc.}, edition = {ninth}, year = {2013}, adddress = {Champaign, Illinois} } @misc{mathematica9MarkovChain, author = {Wolfram Research, Inc.}, year = {2013}, organization = {Wolfram Research, Inc.}, url ={http://www.wolfram.com/mathematica/new-in-9/markov-chains-and-queues/structural-properties-of-finite-markov-processes.html} } @article{sch, author = {Christopher C. Strelioff and James P. Crutchfield and Alfred W. Hubler}, title = {Inferring Markov Chains: Bayesian Estimation, Model Comparison, Entropy Rate, and Out-of-class Modeling}, journal = {Sante Fe Working Papers}, year = {2007}, url = {http://arxiv.org/abs/math/0703715/} } @article{mstateR, author = {Liesbeth C. de Wreede and Marta Fiocco and Hein Putter}, title = {\pkg{mstate}: An \proglang{R} Package for the Analysis of Competing Risks and Multi-State Models}, journal = {Journal of Statistical Software}, year = {2011}, volume = {38}, pages = {1--30}, number = {7}, url = {http://www.jstatsoft.org/v38/i07/} } @mastersthesis{MSkuriat, author = {Monika Skuriat-Olechnowska}, title = {Statistical inference and hypothesis testing for Markov chains with Interval Censoring}, school = {Delft University of Technology}, type = {diploma thesis}, year = {2005} } @misc{wiki:CI, author = {Wikipedia}, title = {Confidence interval --- Wikipedia{,} The Free Encyclopedia}, year = {2015}, url = {https://en.wikipedia.org/w/index.php?title=Confidence_interval&oldid=667353161}, note = {[Online; accessed 21-June-2015]} } @book{pardo2005statistical, title = {Statistical inference based on divergence measures}, author = {Pardo, Leandro}, year = {2005}, publisher = {CRC Press} } @article{anderson1957statistical, title = {Statistical inference about Markov chains}, author = {Anderson, Theodore W and Goodman, Leo A}, journal = {The Annals of Mathematical Statistics}, pages = {89--110}, year = {1957}, publisher = {JSTOR} } @article{ching2008higher, title = {Higher-order multivariate Markov chains and their applications}, author = {Ching, Wai-Ki and Ng, Michael K and Fung, Eric S}, journal = {Linear Algebra and its Applications}, volume = {428}, number = {2}, pages = {492--507}, year = {2008}, publisher = {Elsevier} } @incollection{ching2013higher, title = {Higher-order markov chains}, author = {Ching, Wai-Ki and Huang, Ximin and Ng, Michael K and Siu, Tak-Kuen}, booktitle = {Markov Chains}, pages = {141--176}, year = {2013}, publisher = {Springer} } @manual{pkg:Rsolnp, title = {Rsolnp: General Non-linear Optimization Using Augmented Lagrange Multiplier Method}, author = {Alexios Ghalanos and Stefan Theussl}, year = {2014}, note = {R package version 1.15.} } @PhdThesis{YinyuYe, title = {Interior Algorithms for Linear, Quadratic, and Linearly Constrained Non-Linear Programming}, author = {Yinyu Ye}, year = {1987}, school = {Department of {ESS}, Stanford University} } @book{NorrisBook, title = {Markovchains}, author = {J. R. Norris}, year = {1998}, publisher = {Cambridge University Press} } @article{ictmcpaper, author = {Thomas Krak, Jasper De Bock, Arno Siebes}, title = {Imprecise Continuous Time Markov Chains}, journal = {International Journal of Approximate Reasoning}, year = {2017}, volume = {88}, pages = {452-528}, publisher = {arXiv} } @misc{committorlink, author = {StackOverflow}, url = {https://math.stackexchange.com/questions/1450399/probability-that-a-chain-will-enter-state-5-before-it-enters-state-3?newreg=82f90b66b949495a91661caad24db915}, year = {2015} } @book{GallagerBook, title = {Stochastic Processes: Theory for Applications}, author = {Robert G. Gallager}, year = {2013}, publisher = {Cambridge University Press} } @misc{Sigman, title = {Continuous Time markovchains}, author = {Karl Sigman}, year = {2009}, publisher = {Columbia University} } @article{freqArticle, author = {Alexander Kreinin, Marina Sidelnikova}, title = {Regularization Algorithms for Transition Matrices}, journal = {Algo Research Quarterly}, year = {2001}, volume = {4}, number = {1/2}, pages = {23--40}, month = mar, publisher = {ALGO RESEARCH QUARTERLY} } @book{GrinsteadSnell, author = {Grinstead, Charles M. and Snell, Laurie J.}, booktitle = {Introduction to Probability}, edition = {Version dated 4 July 2006}, publisher = {American Mathematical Society}, title = {{Grinstead and Snell's Introduction to Probability}}, url = {http://math.dartmouth.edu/\~{}prob/prob/prob.pdf}, year = {2006} } @article{noe_constructing_2009, title = {Constructing the equilibrium ensemble of folding pathways from short off-equilibrium simulations}, volume = {106}, copyright = {© 2009 . Freely available online through the PNAS open access option.}, issn = {0027-8424, 1091-6490}, url = {https://www.pnas.org/content/106/45/19011}, doi = {10.1073/pnas.0905466106}, language = {en}, number = {45}, urldate = {2019-01-13}, journal = {Proceedings of the National Academy of Sciences}, author = {Noé, Frank and Schütte, Christof and Vanden-Eijnden, Eric and Reich, Lothar and Weikl, Thomas R.}, month = nov, year = {2009}, pmid = {19887634}, keywords = {committor}, pages = {19011--19016} } @article{Tarjan, doi = {10.1137/0201010}, url = {https://doi.org/10.1137/0201010}, year = {1972}, month = jun, publisher = {Society for Industrial {\&} Applied Mathematics ({SIAM})}, volume = {1}, number = {2}, pages = {146--160}, author = {Robert Tarjan}, title = {Depth-First Search and Linear Graph Algorithms}, journal = {{SIAM} Journal on Computing} }markovchain/vignettes/higher_order_markov_chains.Rmd0000644000176200001440000003006614714756746022627 0ustar liggesusers--- title: "Higher order Markov chains" pagetitle: "Higher order Markov chains" output: rmarkdown::html_vignette author: - name: "Deepak Yadav" affiliation: B-Tech student, Computer Science and Engineering address: > Indian Institute of Technology, Varanasi Uttar Pradesh - 221 005, India email: \email{deepakyadav.iitbhu@gmail.com} - name: "Tae Seung Kang" affiliation: Ph.D student, Computer \& Information Science \& Engineering address: > University of Florida Gainesville, FL, USA email: \email{tskang3@gmail.com} - name: "Giorgio Alfredo Spedicato" affiliation: Ph.D FCAS FSA CSPA C.Stat, Unipol Group address: > Via Firenze 11 Paderno Dugnano 20037 Italy email: \email{spedicato\_giorgio@yahoo.it} preamble: > \author{Deepak Yadav, Tae Seung Kang, Giorgio Alfredo Spedicato} \usepackage{graphicx} \usepackage{amsmath} \usepackage{tabularx} \usepackage{longtable} \usepackage{booktabs} \setkeys{Gin}{width=0.8\textwidth} abstract: | The \pkg{markovchain} package contains functions to fit higher (possibly) multivariate order Markov chains. The functions are shown as well as simple exmaples vignette: > %\VignetteIndexEntry{Higher order Markov chains} %\VignetteEngine{knitr::rmarkdown} %VignetteEncoding{UTF-8} keywords: plain: [Higher order Markov chains] formatted: [Higher order Markov chains] bibliography: markovchainBiblio.bib --- ```{r global_options, include=FALSE} knitr::opts_chunk$set(fig.width=8.5, fig.height=6, out.width = "70%") set.seed(123) ``` # Higher Order Markov Chains Continuous time Markov chains are discussed in the CTMC vignette which is a part of the package. An experimental `fitHigherOrder` function has been written in order to fit a higher order Markov chain ([@ching2013higher, @ching2008higher]). `fitHigherOrder` takes two inputs 1. sequence: a categorical data sequence. 2. order: order of Markov chain to fit with default value 2. The output will be a `list` which consists of 1. lambda: model parameter(s). 2. Q: a list of transition matrices. $Q_i$ is the $ith$ step transition matrix stored column-wise. 3. X: frequency probability vector of the given sequence. Its quadratic programming problem is solved using `solnp` function of the Rsolnp package [@pkg:Rsolnp]. ```{r setup, include=FALSE} knitr::opts_chunk$set(echo = TRUE, collapse = TRUE, comment = "#>") ``` ```{r setup_2, include=FALSE, message=FALSE, echo=FALSE} require(markovchain) ``` ```{r higherOrder} if (requireNamespace("Rsolnp", quietly = TRUE)) { library(Rsolnp) data(rain) fitHigherOrder(rain$rain, 2) fitHigherOrder(rain$rain, 3) } ``` # Higher Order Multivariate Markov Chains ## Introduction HOMMC model is used for modeling behaviour of multiple categorical sequences generated by similar sources. The main reference is [@ching2008higher]. Assume that there are s categorical sequences and each has possible states in M. In nth order MMC the state probability distribution of the jth sequence at time $t = r + 1$ depend on the state probability distribution of all the sequences (including itself) at times $t = r, r - 1, ..., r - n + 1$. \[ x_{r+1}^{(j)} = \sum_{k=1}^{s}\sum_{h=1}^{n}\lambda_{jk}^{(h)}P_{h}^{(jk)}x_{r-h+1}^{(k)}, j = 1, 2, ..., s, r = n-1, n, ... \] with initial distribution $x_{0}^{(k)}, x_{1}^{(k)}, ... , x_{n-1}^{(k)} (k = 1, 2, ... , s)$. Here \[ \lambda _{jk}^{(h)} \geq 0, 1\leq j, k\leq s, 1\leq h\leq n \enspace and \enspace \sum_{k=1}^{s}\sum_{h=1}^{n} \lambda_{jk}^{(h)} = 1, j = 1, 2, 3, ... , s. \] Now we will see the simpler representation of the model which will help us understand the result of `fitHighOrderMultivarMC` method. \vspace{5mm} Let $X_{r}^{(j)} = ((x_{r}^{(j)})^{T}, (x_{r-1}^{(j)})^{T}, ..., (x_{r-n+1}^{(j)})^{T})^{T} for \enspace j = 1, 2, 3, ... , s.$ Then \vspace{5mm} \[ \begin{pmatrix} X_{r+1}^{(1)}\\ X_{r+1}^{(2)}\\ .\\ .\\ .\\ X_{r+1}^{(s)} \end{pmatrix} = \begin{pmatrix} B^{11}& B^{12}& .& .& B^{1s}& \\ B^{21}& B^{22}& .& .& B^{2s}& \\ .& .& .& .& .& \\ .& .& .& .& .& \\ .& .& .& .& .& \\ B^{s1}& B^{s2}& .& .& B^{ss}& \\ \end{pmatrix} \begin{pmatrix} X_{r}^{(1)}\\ X_{r}^{(2)}\\ .\\ .\\ .\\ X_{r}^{(s)} \end{pmatrix} \textrm{where} \] \[B^{ii} = \begin{pmatrix} \lambda _{ii}^{(1)}P_{1}^{(ii)}& \lambda _{ii}^{(2)}P_{2}^{(ii)}& .& .& \lambda _{ii}^{(n)}P_{n}^{(ii)}& \\ I& 0& .& .& 0& \\ 0& I& .& .& 0& \\ .& .& .& .& .& \\ .& .& .& .& .& \\ 0& .& .& I& 0& \end{pmatrix}_{mn*mn} \textrm{and} \] \vspace{5mm} \[ B^{ij} = \begin{pmatrix} \lambda _{ij}^{(1)}P_{1}^{(ij)}& \lambda _{ij}^{(2)}P_{2}^{(ij)}& .& .& \lambda _{ij}^{(n)}P_{n}^{(ij)}& \\ 0& 0& .& .& 0& \\ 0& 0& .& .& 0& \\ .& .& .& .& .& \\ .& .& .& .& .& \\ 0& .& .& 0& 0& \end{pmatrix}_{mn*mn} \textrm{when } i\neq j. \] \vspace{5mm} ## Representation of parameters in the code $P_{h}^{(ij)}$ is represented as $Ph(i,j)$ and $\lambda _{ij}^{(h)}$ as Lambdah(i,j). For example: $P_{2}^{(13)}$ as $P2(1,3)$ and $\lambda _{45}^{(3)}$ as Lambda3(4,5). ## Definition of HOMMC class ```{r hommcObject} showClass("hommc") ``` Any element of `hommc` class is comprised by following slots: 1. states: a character vector, listing the states for which transition probabilities are defined. 2. byrow: a logical element, indicating whether transition probabilities are shown by row or by column. 3. order: order of Multivariate Markov chain. 4. P: an array of all transition matrices. 5. Lambda: a vector to store the weightage of each transition matrix. 6. name: optional character element to name the HOMMC ## How to create an object of class HOMMC ```{r hommcCreate} states <- c('a', 'b') P <- array(dim = c(2, 2, 4), dimnames = list(states, states)) P[ , , 1] <- matrix(c(1/3, 2/3, 1, 0), byrow = FALSE, nrow = 2, ncol = 2) P[ , , 2] <- matrix(c(0, 1, 1, 0), byrow = FALSE, nrow = 2, ncol = 2) P[ , , 3] <- matrix(c(2/3, 1/3, 0, 1), byrow = FALSE, nrow = 2, ncol = 2) P[ , , 4] <- matrix(c(1/2, 1/2, 1/2, 1/2), byrow = FALSE, nrow = 2, ncol = 2) Lambda <- c(.8, .2, .3, .7) hob <- new("hommc", order = 1, Lambda = Lambda, P = P, states = states, byrow = FALSE, name = "FOMMC") hob ``` ## Fit HOMMC `fitHighOrderMultivarMC` method is available to fit HOMMC. Below are the 3 parameters of this method. 1. seqMat: a character matrix or a data frame, each column represents a categorical sequence. 2. order: order of Multivariate Markov chain. Default is 2. 3. Norm: Norm to be used. Default is 2. # A Marketing Example We tried to replicate the example found in [@ching2008higher] for an application of HOMMC. A soft-drink company in Hong Kong is facing an in-house problem of production planning and inventory control. A pressing issue is the storage space of its central warehouse, which often finds itself in the state of overflow or near capacity. The company is thus in urgent needs to study the interplay between the storage space requirement and the overall growing sales demand. The product can be classified into six possible states (1, 2, 3, 4, 5, 6) according to their sales volumes. All products are labeled as 1 = no sales volume, 2 = very slow-moving (very low sales volume), 3 = slow-moving, 4 = standard, 5 = fast-moving or 6 = very fast-moving (very high sales volume). Such labels are useful from both marketing and production planning points of view. The data is cointaind in `sales` object. ```{r hommsales} data(sales) head(sales) ``` The company would also like to predict sales demand for an important customer in order to minimize its inventory build-up. More importantly, the company can understand the sales pattern of this customer and then develop a marketing strategy to deal with this customer. Customer's sales demand sequences of five important products of the company for a year. We expect sales demand sequences generated by the same customer to be correlated to each other. Therefore by exploring these relationships, one can obtain a better higher-order multivariate Markov model for such demand sequences, hence obtain better prediction rules. In [@ching2008higher] application, they choose the order arbitrarily to be eight, i.e., n = 8. We first estimate all the transition probability matrices $P_{h}^{ij}$ and we also have the estimates of the stationary probability distributions of the five products:. $\widehat{\boldsymbol{x}}^{(1)} = \begin{pmatrix} 0.0818& 0.4052& 0.0483& 0.0335& 0.0037& 0.4275 \end{pmatrix}^{\boldsymbol{T}}$ $\widehat{\boldsymbol{x}}^{(2)} = \begin{pmatrix} 0.3680& 0.1970& 0.0335& 0.0000& 0.0037& 0.3978 \end{pmatrix}^{\boldsymbol{T}}$ $\widehat{\boldsymbol{x}}^{(3)} = \begin{pmatrix} 0.1450& 0.2045& 0.0186& 0.0000& 0.0037& 0.6283 \end{pmatrix}^{\boldsymbol{T}}$ $\widehat{\boldsymbol{x}}^{(4)} = \begin{pmatrix} 0.0000& 0.3569& 0.1338& 0.1896& 0.0632& 0.2565 \end{pmatrix}^{\boldsymbol{T}}$ $\widehat{\boldsymbol{x}}^{(5)} = \begin{pmatrix} 0.0000& 0.3569& 0.1227& 0.2268& 0.0520& 0.2416 \end{pmatrix}^{\boldsymbol{T}}$ By solving the corresponding linear programming problems, we obtain the following higher-order multivariate Markov chain model: \vspace{3mm} $\boldsymbol{x}_{r+1}^{(1)} = \boldsymbol{P}_{1}^{(12)}\boldsymbol{x}_{r}^{(2)}$ $\boldsymbol{x}_{r+1}^{(2)} = 0.6364\boldsymbol{P}_{1}^{(22)}\boldsymbol{x}_{r}^{(2)} + 0.3636\boldsymbol{P}_{3}^{(22)}\boldsymbol{x}_{r}^{(2)}$ $\boldsymbol{x}_{r+1}^{(3)} = \boldsymbol{P}_{1}^{(35)}\boldsymbol{x}_{r}^{(5)}$ $\boldsymbol{x}_{r+1}^{(4)} = 0.2994\boldsymbol{P}_{8}^{(42)}\boldsymbol{x}_{r}^{(2)} + 0.4324\boldsymbol{P}_{1}^{(45)}\boldsymbol{x}_{r}^{(5)} + 0.2681\boldsymbol{P}_{2}^{(45)}\boldsymbol{x}_{r}^{(5)}$ $\boldsymbol{x}_{r+1}^{(5)} = 0.2718\boldsymbol{P}_{8}^{(52)}\boldsymbol{x}_{r}^{(2)} + 0.6738\boldsymbol{P}_{1}^{(54)}\boldsymbol{x}_{r}^{(4)} + 0.0544\boldsymbol{P}_{2}^{(55)}\boldsymbol{x}_{r}^{(5)}$ \vspace{3mm} According to the constructed 8th order multivariate Markov model, Products A and B are closely related. In particular, the sales demand of Product A depends strongly on Product B. The main reason is that the chemical nature of Products A and B is the same, but they have different packaging for marketing purposes. Moreover, Products B, C, D and E are closely related. Similarly, products C and E have the same product flavor, but different packaging. In this model, it is interesting to note that both Product D and E quite depend on Product B at order of 8, this relationship is hardly to be obtained in conventional Markov model owing to huge amount of parameters. The results show that higher-order multivariate Markov model is quite significant to analyze the relationship of sales demand. ```{r hommcFit, warning = FALSE, message = FALSE} # fit 8th order multivariate markov chain if (requireNamespace("Rsolnp", quietly = TRUE)) { object <- fitHighOrderMultivarMC(sales, order = 8, Norm = 2) } ``` We choose to show only results shown in the paper. We see that $\lambda$ values are quite close, but not equal, to those shown in the original paper. ```{r result, echo = FALSE} if (requireNamespace("Rsolnp", quietly = TRUE)) { i <- c(1, 2, 2, 3, 4, 4, 4, 5, 5, 5) j <- c(2, 2, 2, 5, 2, 5, 5, 2, 4, 5) k <- c(1, 1, 3, 1, 8, 1, 2, 8, 1, 2) if(object@byrow == TRUE) { direction <- "(by rows)" } else { direction <- "(by cols)" } cat("Order of multivariate markov chain =", object@order, "\n") cat("states =", object@states, "\n") cat("\n") cat("List of Lambda's and the corresponding transition matrix", direction,":\n") for(p in 1:10) { t <- 8*5*(i[p]-1) + (j[p]-1)*8 cat("Lambda", k[p], "(", i[p], ",", j[p], ") : ", object@Lambda[t+k[p]],"\n", sep = "") cat("P", k[p], "(", i[p], ",", j[p], ") : \n", sep = "") print(object@P[, , t+k[p]]) cat("\n") } } else { print("package Rsolnp unavailable") } ``` # References markovchain/vignettes/an_introduction_to_markovchain_package.Rmd0000644000176200001440000032063514714756746025224 0ustar liggesusers--- title: plain: "The markovchain Package: A Package for Easily Handling Discrete Markov Chains in R" formatted: "The \\pkg{markovchain} Package: A Package for Easily Handling Discrete Markov Chains in \\proglang{R}" short: "\\pkg{markovchain} package: discrete Markov chains in \\proglang{R}" pagetitle: "The \\pkg{markovchain} Package: A Package for Easily Handling Discrete Markov Chains in \\proglang{R}" author: - name: "Giorgio Alfredo Spedicato" affiliation: Ph.D C.Stat FCAS, FSA, CSPA Unipol Group address: > Via Firenze 11 Paderno Dugnano 20037 Italy email: \email{spedygiorgio@gmail.com} url: www.statisticaladvisor.com - name: "Tae Seung Kang" affiliation: Ph.D student, Computer \& Information Science \& Engineering address: > University of Florida Gainesville, FL, USA email: \email{tskang3@gmail.com} - name: "Sai Bhargav Yalamanchi" affiliation: B-Tech student, Electrical Engineering address: > Indian Institute of Technology, Bombay Mumbai - 400 076, India email: \email{bhargavcoolboy@gmail.com} - name: "Deepak Yadav" affiliation: B-Tech student, Computer Science and Engineering address: > Indian Institute of Technology, Varanasi Uttar Pradesh - 221 005, India email: \email{deepakyadav.iitbhu@gmail.com} - name: "Ignacio Cordón" affiliation: Software Engineer address: > Madrid (Madrid), Spain email: \email{nacho.cordon.castillo@gmail.com} preamble: > \author{\small{Giorgio Alfredo Spedicato, Tae Seung Kang, Sai Bhargav Yalamanchi, Deepak Yadav, Ignacio Cordón}} \Plainauthor{G.A. Spedicato, T.S. Kang, S.B. Yalamanchi, D. Yadav, I. Cordón} \usepackage{graphicx} \usepackage{amsmath} \usepackage{longtable} \usepackage{booktabs} \setkeys{Gin}{width=0.8\textwidth} \usepackage{amsfonts} abstract: | The \pkg{markovchain} package aims to fill a gap within the \proglang{R} framework providing S4 classes and methods for easily handling discrete time Markov chains, homogeneous and simple inhomogeneous ones as well as continuous time Markov chains. The S4 classes for handling and analysing discrete and continuous time Markov chains are presented, as well as functions and method for performing probabilistic and statistical analysis. Finally, some examples in which the package's functions are applied to Economics, Finance and Natural Sciences topics are shown. output: if (rmarkdown::pandoc_version() < "2.7") function(...) { rmarkdown::pdf_document(template = "./template.tex", ...) } else function(...) { bookdown::pdf_book(base_format = rticles::jss_article, ...) } vignette: > %\VignetteIndexEntry{An introduction to markovchain package} %\VignetteEngine{knitr::rmarkdown} %VignetteEncoding{UTF-8} keywords: plain: [discrete time Markov chains, continuous time Markov chains, transition matrices, communicating classes, periodicity, first passage time, stationary distributions] formatted: [discrete time Markov chains, continuous time Markov chains, transition matrices, communicating classes, periodicity, first passage time, stationary distributions] documentclass: jss classoption: nojss bibliography: markovchainBiblio.bib pkgdown: as_is: true extension: pdf --- ```{r global_options, include=FALSE} knitr::opts_chunk$set(fig.width=8.5, fig.height=6, out.width = "70%") set.seed(123) library(knitr) hook_output <- knit_hooks$get("output") knit_hooks$set(output = function(x, options) { lines <- options$output.lines if (is.null(lines)) { return(hook_output(x, options)) # pass to default hook } x <- unlist(strsplit(x, "\n")) more <- "..." if (length(lines)==1) { # first n lines if (length(x) > lines) { # truncate the output, but add .... x <- c(head(x, lines), more) } } else { x <- c(more, x[lines], more) } # paste these lines together x <- paste(c(x, ""), collapse = "\n") hook_output(x, options) }) ``` # Introduction Markov chains represent a class of stochastic processes of great interest for the wide spectrum of practical applications. In particular, discrete time Markov chains (DTMC) permit to model the transition probabilities between discrete states by the aid of matrices.Various \proglang{R} packages deal with models that are based on Markov chains: * \pkg{msm} [@msmR] handles Multi-State Models for panel data. * \pkg{mcmcR} [@mcmcR] implements Monte Carlo Markov Chain approach. * \pkg{hmm} [@hmmR] fits hidden Markov models with covariates. * \pkg{mstate} fits `Multi-State Models based on Markov chains for survival analysis [@mstateR]. Nevertheless, the \proglang{R} statistical environment [@rSoftware] seems to lack a simple package that coherently defines S4 classes for discrete Markov chains and allows to perform probabilistic analysis, statistical inference and applications. For the sake of completeness, \pkg{markovchain} is the second package specifically dedicated to DTMC analysis, being \pkg{DTMCPack} [@DTMCPackR] the first one. Notwithstanding, \pkg{markovchain} package [@pkg:markovchain] aims to offer more flexibility in handling DTMC than other existing solutions, providing S4 classes for both homogeneous and semi-homogeneous Markov chains as well as methods suited to perform statistical and probabilistic analysis. The \pkg{markovchain} package depends on the following \proglang{R} packages: \pkg{expm} [@expmR] to perform efficient matrices powers; \pkg{igraph} [@pkg:igraph] to perform pretty plotting of `markovchain` objects and \pkg{matlab} [@pkg:matlab], that contains functions for matrix management and calculations that emulate those within \proglang{MATLAB} environment. Moreover, other scientific softwares provide functions specifically designed to analyze DTMC, as \proglang{Mathematica} 9 [@mathematica9]. The paper is structured as follows: Section \@ref(sec:mathematics) briefly reviews mathematics and definitions regarding DTMC, Section \@ref(sec:structure) discusses how to handle and manage Markov chain objects within the package, Section \@ref(sec:probability) and Section \@ref(sec:statistics) show how to perform probabilistic and statistical modelling, while Section \@ref(sec:applications) presents some applied examples from various fields analyzed by means of the \pkg{markovchain} package. # Review of core mathematical concepts {#sec:mathematics} ## General Definitions A DTMC is a sequence of random variables $X_{1},\: X_{2}\: ,\ldots,\:X_{n},\ldots$ characterized by the Markov property (also known as memoryless property, see Equation \ref{eq:markovProp}). The Markov property states that the distribution of the forthcoming state $X_{n+1}$ depends only on the current state $X_{n}$ and doesn't depend on the previous ones $X_{n-1},\: X_{n-2},\ldots,\: X_{1}$. \begin{equation} Pr\left(X_{n+1}=x_{n+1}\left|X_{1}=x_{1},X_{2}=x_{2,}...,X_{n}=x_{n}\right.\right)=Pr\left(X_{n+1}=x_{n+1}\left|X_{n}=x_{n}\right.\right). \label{eq:markovProp} \end{equation} The set of possible states $S=\left\{ s_{1},s_{2},...,s_{r}\right\}$ of $X_{n}$ can be finite or countable and it is named the state space of the chain. The chain moves from one state to another (this change is named either 'transition' or 'step') and the probability $p_{ij}$ to move from state $s_{i}$ to state $s_{j}$ in one step is named transition probability: \begin{equation} p_{ij}=Pr\left(X_{1}=s_{j}\left|X_{0}=s_{i}\right.\right). \label{eq:trProp} \end{equation} The probability of moving from state $i$ to $j$ in $n$ steps is denoted by $p_{ij}^{(n)}=Pr\left(X_{n}=s_{j}\left|X_{0}=s_{i}\right.\right)$. A DTMC is called time-homogeneous if the property shown in Equation \ref{eq:mcHom} holds. Time homogeneity implies no change in the underlying transition probabilities as time goes on. \begin{equation} Pr\left(X_{n+1}=s_{j}\left|X_{n}=s_{i}\right.\right)=Pr\left(X_{n}=s_{j}\left|X_{n-1}=s_{i}\right.\right). \label{eq:mcHom} \end{equation} If the Markov chain is time-homogeneous, then $p_{ij}=Pr\left(X_{k+1}=s_{j}\left|X_{k}=s_{i}\right.\right)$ and \newline $p_{ij}^{(n)}=Pr\left(X_{n+k}=s_{j}\left|X_{k}=s_{i}\right.\right)$, where $k>0$. The probability distribution of transitions from one state to another can be represented into a transition matrix $P=(p_{ij})_{i,j}$, where each element of position $(i,j)$ represents the transition probability $p_{ij}$. E.g., if $r=3$ the transition matrix $P$ is shown in Equation \ref{eq:trPropEx} \begin{equation} P=\left[\begin{array}{ccc} p_{11} & p_{12} & p_{13}\\ p_{21} & p_{22} & p_{23}\\ p_{31} & p_{32} & p_{33} \end{array}\right]. \label{eq:trPropEx} \end{equation} The distribution over the states can be written in the form of a stochastic row vector $x$ (the term stochastic means that $\sum_{i}x_{i}=1, x_{i} \geq 0$): e.g., if the current state of $x$ is $s_{2}$, $x=\left(0\:1\:0\right)$. As a consequence, the relation between $x^{(1)}$ and $x^{(0)}$ is $x^{(1)}=x^{(0)}P$ and, recursively, we get $x^{(2)}=x^{(0)}P^{2}$ and $x^{(n)}=x^{(0)}P^{n},\, n>0$. DTMC are explained in most theory books on stochastic processes, see \cite{bremaud1999discrete} and \cite{dobrow2016introduction} for example. Valuable references online available are: \cite{konstantopoulos2009markov}, \cite{probBook} and \cite{bardPpt}. ## Properties and classification of states {#sec:properties} A state $s_{j}$ is said accessible from state $s_{i}$ (written $s_{i}\rightarrow s_{j}$) if a system starting in state $s_{i}$ has a positive probability to reach the state $s_{j}$ at a certain point, i.e., $\exists n>0:\: p_{ij}^{n}>0$. If both $s_{i}\rightarrow s_{j}$ and $s_{j}\rightarrow s_{i}$, then $s_{i}$ and $s_{j}$ are said to communicate. A communicating class is defined to be a set of states that communicate. A DTMC can be composed by one or more communicating classes. If the DTMC is composed by only one communicating class (i.e., if all states in the chain communicate), then it is said irreducible. A communicating class is said to be closed if no states outside of the class can be reached from any state inside it. If $p_{ii}=1$, $s_{i}$ is defined as absorbing state: an absorbing state corresponds to a closed communicating class composed by one state only. The canonical form of a DTMC transition matrix is a matrix having a block form, where the closed communicating classes are shown at the beginning of the diagonal matrix. A state $s_{i}$ has period $k_{i}$ if any return to state $s_{i}$ must occur in multiplies of $k_{i}$ steps, that is $k_{i}=gcd\left\{ n:Pr\left(X_{n}=s_{i}\left|X_{0}=s_{i}\right.\right)>0\right\}$, where $gcd$ is the greatest common divisor. If $k_{i}=1$ the state $s_{i}$ is said to be aperiodic, else if $k_{i}>1$ the state $s_{i}$ is periodic with period $k_{i}$. Loosely speaking, $s_{i}$ is periodic if it can only return to itself after a fixed number of transitions $k_{i}>1$ (or multiple of $k_{i}$), else it is aperiodic. If states $s_{i}$ and $s_{j}$ belong to the same communicating class, then they have the same period $k_{i}$. As a consequence, each of the states of an irreducible DTMC share the same periodicity. This periodicity is also considered the DTMC periodicity. It is possible to classify states according to their periodicity. Let $T^{x\rightarrow x}$ is the number of periods to go back to state $x$ knowing that the chain starts in $x$. * A state $x$ is recurrent if $P(T^{x\rightarrow x}<+\infty)=1$ (equivalently $P(T^{x\rightarrow x}=+\infty)=0$). In addition: 1. A state $x$ is null recurrent if in addition $E(T^{x\rightarrow x})=+\infty$. 2. A state $x$ is positive recurrent if in addition $E(T^{x\rightarrow x})<+\infty$. 3. A state $x$ is absorbing if in addition $P(T^{x\rightarrow x}=1)=1$. * A state $x$ is transient if $P(T^{x\rightarrow x}<+\infty)<1$ (equivalently $P(T^{x\rightarrow x}=+\infty)>0$). It is possible to analyze the timing to reach a certain state. The first passage time (or hitting time) from state $s_{i}$ to state $s_{j}$ is the number $T_{ij}$ of steps taken by the chain until it arrives for the first time to state $s_{j}$, given that $X_{0} = s_{i}$. The probability distribution of $T_{ij}$ is defined by Equation \ref{eq:fpt1} \begin{equation} {h_{ij}}^{\left( n \right)} = Pr\left( {T_{ij} = n} \right) = Pr\left( X_n = s_j,X_{n - 1} \ne s_{j}, \ldots ,X_1 \ne s_j |X_0 = s_i \right) \label{eq:fpt1} \end{equation} and can be found recursively using Equation \ref{eq:ftp2}, given that ${h_{ij}}^{\left( n \right)} = p_{ij}$. \begin{equation} {h_{ij}}^{\left( n \right)} = \sum\limits_{k \in S - \left\{ s_{j} \right\}}^{} {{p_{ik}}{h_{kj}}^{\left( {n - 1} \right)}}. \label{eq:ftp2} \end{equation} A commonly used quantity related to $h$ is its average value, i.e. the \emph{mean first passage time} (also expected hitting time), namely $\bar h_{ij}= \sum_{n=1\dots\infty} n \,h_{ij}^{(n)}$. If in the definition of the first passage time we let $s_{i}=s_{j}$, we obtain the first recurrence time $T_{i}=\inf \{ n\geq1:X_{n}=s_{i}|X_{0}=s_{i} \}$. We could also ask ourselves which is the *mean recurrence time*, an average of the mean first recurrence times: \[ r_i = \sum_{k = 1}^{\infty} k \cdot P(T_i = k) \] Revisiting the definition of recurrence and transience: a state $s_{i}$ is said to be recurrent if it is visited infinitely often, i.e., $Pr(T_{i}<+\infty|X_{0}=s_{i})=1$. On the opposite, $s_{i}$ is called transient if there is a positive probability that the chain will never return to $s_{i}$, i.e., $Pr(T_{i}=+\infty|X_{0}=s_{i})>0$. Given a time homogeneous Markov chain with transition matrix \emph{P}, a stationary distribution \emph{z} is a stochastic row vector such that $z=z\cdot P$, where $0\leq z_{j}\leq 1 \: \forall j$ and $\sum_{j}z_{j}=1$. If a DTMC $\{X_{n}\}$ is irreducible and aperiodic, then it has a limit distribution and this distribution is stationary. As a consequence, if $P$ is the $k\times k$ transition matrix of the chain and $z=\left(z_{1},...,z_{k}\right)$ is the unique eigenvector of $P$ such that $\sum_{i=1}^{k}z_{i}=1$, then we get \begin{equation} \underset{n\rightarrow\infty}{lim}P^{n}=Z, \label{eq:limMc} \end{equation} where $Z$ is the matrix having all rows equal to $z$. The stationary distribution of $\{X_{n}\}$ is represented by $z$. A matrix $A$ is called primitive if all of its entries are strictly positive, and we write it $A > 0$. If the transition matrix $P$ for a DTMC has some primitive power, i.e. it exists $m > 0: P^m > 0$, then the DTMC is said to be regular. In fact being regular is equivalent to being irreducible and aperiodic. All regular DTMCs are irreducible. The counterpart is not true. Given two absorbing states $s_A$ (source) and $s_B$ (sink), the \emph{committor probability} $q_j^{(AB)}$ is the probability that a process starting in state $s_i$ is absorbed in state $s_B$ (rather than $s_A$) [@noe_constructing_2009]. It can be computed via \begin{equation} q_j^{(AB)} = \sum_{k \ni {A, B}} P_{jk}q_k^{(AB)} \quad \mbox{with} \quad q_A^{(AB)} = 0 \quad \mbox{and} \quad q_B^{(AB)} = 1 \end{equation} Note we can also define the hitting probability from $i$ to $j$ as the probability of ever reaching the state $j$ if our initial state is $i$: \begin{equation} h_{i,j} = Pr(T_{ij} < \infty) = \sum_{n = 0}^{\infty} h_{ij}^{(n)} \label{eq:hitting-probs} \end{equation} In a DTMC with finite set of states, we know that a transient state communicates at least with one recurrent state. If the chain starts in a transient element, once it hits a recurrent state, it is going to be caught in its recurrent state, and we cannot expect it would go back to the initial state. Given a transient state $i$ we can define the *absorption probability* to the recurrent state $j$ as the probability that the first recurrent state that the Markov chain visits (and therefore gets absorbed by its recurrent class) is $j$, $f^{*}_ij$. We can also define the *mean absorption time* as the mean number of steps the transient state $i$ would take until it hits any recurrent state, $b_i$. ## A short example Consider the following numerical example. Suppose we have a DTMC with a set of 3 possible states $S=\{s_{1}, s_{2}, s_{3}\}$. Let the transition matrix be: \begin{equation} P=\left[\begin{array}{ccc} 0.5 & 0.2 & 0.3\\ 0.15 & 0.45 & 0.4\\ 0.25 & 0.35 & 0.4 \end{array}\right]. \label{eq:trPropExEx1} \end{equation} In $P$, $p_{11}=0.5$ is the probability that $X_{1}=s_{1}$ given that we observed $X_{0}=s_{1}$ is 0.5, and so on.It is easy to see that the chain is irreducible since all the states communicate (it is made by one communicating class only). Suppose that the current state of the chain is $X_{0}=s_{2}$, i.e., $x^{(0)}=(0\:1\:0)$, then the probability distribution of states after 1 and 2 steps can be computed as shown in Equations \@ref(eq:trPropExEx2) and \@ref(eq:trPropExEx3). \begin{equation} x^{(1)}=\left(0\:1\:0\right)\left[\begin{array}{ccc} 0.5 & 0.2 & 0.3\\ 0.15 & 0.45 & 0.4\\ 0.25 & 0.35 & 0.4 \end{array}\right]=\left(0.15\:0.45\:0.4\right). \label{eq:trPropExEx2} \end{equation} \begin{equation} x^{(n)}=x^{(n-1)}P \to \left(0.15\:0.45\:0.4\right)\left[\begin{array}{ccc} 0.5 & 0.2 & 0.3\\ 0.15 & 0.45 & 0.4\\ 0.25 & 0.35 & 0.4 \end{array}\right]=\left(0.2425\:0.3725\:0.385\right). \label{eq:trPropExEx3} \end{equation} If we were interested in the probability of being in the state $s_{3}$ in the second step, then $Pr\left(X_{2}=s_{3}\left|X_{0}=s_{2}\right.\right)=0.385$. \newpage # The structure of the package {#sec:structure} ## Creating markovchain objects The package is loaded within the \proglang{R} command line as follows: ```{r, load, results='hide', message=FALSE} library("markovchain") ``` The `markovchain` and `markovchainList` S4 classes [@chambers] are defined within the \pkg{markovchain} package as displayed: ```{r, showClass, echo=FALSE} showClass("markovchain") showClass("markovchainList") ``` The first class has been designed to handle homogeneous Markov chain processes, while the latter (which is itself a list of `markovchain` objects) has been designed to handle semi-homogeneous Markov chains processes. Any element of `markovchain` class is comprised by following slots: 1. `states`: a character vector, listing the states for which transition probabilities are defined. 2. `byrow`: a logical element, indicating whether transition probabilities are shown by row or by column. 3. `transitionMatrix`: the probabilities of the transition matrix. 4. `name`: optional character element to name the DTMC. The `markovchainList` objects are defined by following slots: 1. `markovchains`: a list of `markovchain` objects. 2. `name`: optional character element to name the DTMC. The `markovchain` objects can be created either in a long way, as the following code shows ```{r mcInitLong} weatherStates <- c("sunny", "cloudy", "rain") byRow <- TRUE weatherMatrix <- matrix(data = c(0.70, 0.2, 0.1, 0.3, 0.4, 0.3, 0.2, 0.45, 0.35), byrow = byRow, nrow = 3, dimnames = list(weatherStates, weatherStates)) mcWeather <- new("markovchain", states = weatherStates, byrow = byRow, transitionMatrix = weatherMatrix, name = "Weather") ``` or in a shorter way, displayed below ```{r mcInitShort} mcWeather <- new("markovchain", states = c("sunny", "cloudy", "rain"), transitionMatrix = matrix(data = c(0.70, 0.2, 0.1, 0.3, 0.4, 0.3, 0.2, 0.45, 0.35), byrow = byRow, nrow = 3), name = "Weather") ``` When `new("markovchain")` is called alone, a default Markov chain is created. ```{r defaultMc} defaultMc <- new("markovchain") ``` The quicker way to create `markovchain` objects is made possible thanks to the implemented `initialize` S4 method that checks that: * the `transitionMatrix`, either of class matrix or Matrix, to be a transition matrix, i.e., all entries to be probabilities and either all rows or all columns to sum up to one. * the columns and rows names of `transitionMatrix` to be defined and to coincide with `states` vector slot. The `markovchain` objects can be collected in a list within `markovchainList` S4 objects as following example shows. ```{r intromcList} mcList <- new("markovchainList", markovchains = list(mcWeather, defaultMc), name = "A list of Markov chains") ``` ## Handling markovchain objects Table \@ref(tab:methodsToHandleMc) lists which methods handle and manipulate `markovchain` objects. \begin{table}[h] \centering \begin{tabular}{lll} \hline Method & Purpose \\ \hline \hline \code{*} & Direct multiplication for transition matrices.\\ \code{\textasciicircum{}} & Compute the power \code{markovchain} of a given one.\\ \code{[} & Direct access to the elements of the transition matrix.\\ \code{==} & Equality operator between two transition matrices.\\ \code{!=} & Inequality operator between two transition matrices.\\ \code{as} & Operator to convert \code{markovchain} objects into \code{data.frame} and\\ & \code{table} object.\\ \code{dim} & Dimension of the transition matrix.\\ \code{names} & Equal to \code{states}.\\ \code{names<-} & Change the \code{states} name.\\ \code{name} & Get the name of \code{markovchain object}.\\ \code{name<-} & Change the name of \code{markovchain object}.\\ \code{plot} & \code{plot} method for \code{markovchain} objects.\\ \code{print} & \code{print} method for \code{markovchain} objects.\\ \code{show} & \code{show} method for \code{markovchain} objects.\\ \code{sort} & \code{sort} method for \code{markovchain} objects, in terms of their states.\\ \code{states} & Name of the transition states.\\ \code{t} & Transposition operator (which switches \code{byrow} `slot value and modifies \\ & the transition matrix coherently).\\ \hline \end{tabular} \caption{\pkg{markovchain} methods for handling \code{markovchain} objects.} \label{tab:methodsToHandleMc} \end{table} The examples that follow shows how operations on `markovchain` objects can be easily performed. For example, using the previously defined matrix we can find what is the probability distribution of expected weather states in two and seven days, given the actual state to be cloudy. ```{r operations} initialState <- c(0, 1, 0) after2Days <- initialState * (mcWeather * mcWeather) after7Days <- initialState * (mcWeather ^ 7) after2Days round(after7Days, 3) ``` A similar answer could have been obtained defining the vector of probabilities as a column vector. A column - defined probability matrix could be set up either creating a new matrix or transposing an existing `markovchain` object thanks to the `t` method. ```{r operations2} initialState <- c(0, 1, 0) after2Days <- (t(mcWeather) * t(mcWeather)) * initialState after7Days <- (t(mcWeather) ^ 7) * initialState after2Days round(after7Days, 3) ``` The initial state vector previously shown can not necessarily be a probability vector, as the code that follows shows: ```{r fval} fvals<-function(mchain,initialstate,n) { out<-data.frame() names(initialstate)<-names(mchain) for (i in 0:n) { iteration<-initialstate*mchain^(i) out<-rbind(out,iteration) } out<-cbind(out, i=seq(0,n)) out<-out[,c(4,1:3)] return(out) } fvals(mchain=mcWeather,initialstate=c(90,5,5),n=4) ``` Basic methods have been defined for `markovchain` objects to quickly get states and transition matrix dimension. ```{r otherMethods} states(mcWeather) names(mcWeather) dim(mcWeather) ``` Methods are available to set and get the name of `markovchain` object. ```{r otherMethods2} name(mcWeather) name(mcWeather) <- "New Name" name(mcWeather) ``` Also it is possible to alphabetically sort the transition matrix: ```{r sortMethod} markovchain:::sort(mcWeather) ``` A direct access to transition probabilities is provided both by `transitionProbability` method and `"["` method. ```{r transProb} transitionProbability(mcWeather, "cloudy", "rain") mcWeather[2,3] ``` The transition matrix of a `markovchain` object can be displayed using `print` or `show` methods (the latter being less verbose). Similarly, the underlying transition probability diagram can be plotted by the use of `plot` method (as shown in Figure \@ref(fig:mcPlot)) which is based on \pkg{igraph} package [@pkg:igraph]. `plot` method for `markovchain` objects is a wrapper of `plot.igraph` for `igraph` S4 objects defined within the \pkg{igraph} package. Additional parameters can be passed to `plot` function to control the network graph layout. There are also \pkg{diagram} and \pkg{DiagrammeR} ways available for plotting as shown in Figure \@ref(fig:mcPlotdiagram). The `plot` function also uses `communicatingClasses` function to separate out states of different communicating classes. All states that belong to one class have same color. ```{r printAndShow} print(mcWeather) show(mcWeather) ``` ```{r mcPlot, echo=FALSE, fig.cap="Weather example. Markov chain plot"} if (requireNamespace("igraph", quietly = TRUE)) { library(igraph) plot(mcWeather,layout = layout.fruchterman.reingold) } else { message("igraph unavailable") } ``` ```{r mcPlotdiagram, echo=FALSE, fig.cap="Weather example. Markov chain plot with diagram"} if (requireNamespace("diagram", quietly = TRUE)) { library(diagram) plot(mcWeather, package="diagram", box.size = 0.04) } else { message("diagram unavailable") } ``` Import and export from some specific classes is possible, as shown in Figure \@ref(fig:fromAndTo) and in the following code. ```{r exportImport1} mcDf <- as(mcWeather, "data.frame") mcNew <- as(mcDf, "markovchain") mcDf mcIgraph <- as(mcWeather, "igraph") ``` ```{r exportImport2} if (requireNamespace("msm", quietly = TRUE)) { require(msm) Q <- rbind ( c(0, 0.25, 0, 0.25), c(0.166, 0, 0.166, 0.166), c(0, 0.25, 0, 0.25), c(0, 0, 0, 0) ) cavmsm <- msm(state ~ years, subject = PTNUM, data = cav, qmatrix = Q, death = 4) msmMc <- as(cavmsm, "markovchain") msmMc } else { message("msm unavailable") } ``` from etm (now archived as of September 2020): ```{r exporImport3} if (requireNamespace("etm", quietly = TRUE)) { library(etm) data(sir.cont) sir.cont <- sir.cont[order(sir.cont$id, sir.cont$time), ] for (i in 2:nrow(sir.cont)) { if (sir.cont$id[i]==sir.cont$id[i-1]) { if (sir.cont$time[i]==sir.cont$time[i-1]) { sir.cont$time[i-1] <- sir.cont$time[i-1] - 0.5 } } } tra <- matrix(ncol=3,nrow=3,FALSE) tra[1, 2:3] <- TRUE tra[2, c(1, 3)] <- TRUE tr.prob <- etm::etm(sir.cont, c("0", "1", "2"), tra, "cens", 1) tr.prob etm2mc<-as(tr.prob, "markovchain") etm2mc } else { message("etm unavailable") } ``` ```{r fromAndTo, echo=FALSE, fig.cap="The markovchain methods for import and export"} library(igraph) importExportGraph<-graph.formula(dataframe++markovchain,markovchain-+igraph, markovchain++matrix,table-+markovchain,msm-+markovchain,etm-+markovchain, markovchain++sparseMatrix) plot(importExportGraph,main="Import - Export from and to markovchain objects") ``` Coerce from `matrix` method, as the code below shows, represents another approach to create a `markovchain` method starting from a given squared probability matrix. ```{r exportImport4} myMatr<-matrix(c(.1,.8,.1,.2,.6,.2,.3,.4,.3), byrow=TRUE, ncol=3) myMc<-as(myMatr, "markovchain") myMc ``` Semi-homogeneous Markov chains can be created with the aid of `markovchainList` object. The example that follows arises from health insurance, where the costs associated to patients in a Continuous Care Health Community (CCHC) are modeled by a semi-homogeneous Markov Chain, since the transition probabilities change by year. Methods explicitly written for `markovchainList` objects are: `print`, `show`, `dim` and `[`. ```{r cchcMcList} stateNames = c("H", "I", "D") Q0 <- new("markovchain", states = stateNames, transitionMatrix =matrix(c(0.7, 0.2, 0.1,0.1, 0.6, 0.3,0, 0, 1), byrow = TRUE, nrow = 3), name = "state t0") Q1 <- new("markovchain", states = stateNames, transitionMatrix = matrix(c(0.5, 0.3, 0.2,0, 0.4, 0.6,0, 0, 1), byrow = TRUE, nrow = 3), name = "state t1") Q2 <- new("markovchain", states = stateNames, transitionMatrix = matrix(c(0.3, 0.2, 0.5,0, 0.2, 0.8,0, 0, 1), byrow = TRUE,nrow = 3), name = "state t2") Q3 <- new("markovchain", states = stateNames, transitionMatrix = matrix(c(0, 0, 1, 0, 0, 1, 0, 0, 1), byrow = TRUE, nrow = 3), name = "state t3") mcCCRC <- new("markovchainList",markovchains = list(Q0,Q1,Q2,Q3), name = "Continuous Care Health Community") print(mcCCRC) ``` It is possible to perform direct access to `markovchainList` elements, as well as to determine the number of `markovchain` objects by which a `markovchainList` object is composed. ```{r cchcMcList2} mcCCRC[[1]] dim(mcCCRC) ``` The `markovchain` package contains some data found in the literature related to DTMC models (see Section \@ref(sec:applications). Table \@ref(tab:datasets) lists datasets and tables included within the current release of the package. \begin{table}[h] \centering \begin{tabular}{p{0.2\textwidth}p{0.75\textwidth}} \hline Dataset & Description \\ \hline \hline \code{blanden} & Mobility across income quartiles, \cite{blandenEtAlii}.\\ \code{craigsendi} & CD4 cells, \cite{craigSendi}.\\ \code{kullback} & raw transition matrices for testing homogeneity, \cite{kullback1962tests}.\\ \code{preproglucacon} & Preproglucacon DNA basis, \cite{averyHenderson}.\\ \code{rain} & Alofi Island rains, \cite{averyHenderson}.\\ \code{holson} & Individual states trajectories.\\ \code{sales} & Sales of six beverages in Hong Kong \cite{ching2008higher}. \\ \hline \end{tabular} \caption{The \pkg{markovchain} \code{data.frame} and \code{table}.} \label{tab:datasets} \end{table} Finally, Table \@ref(tab:demos) lists the demos included in the demo directory of the package. \begin{table}[h] \centering \begin{tabular}{lll} \hline R Code File & Description \\ \hline \hline \code{bard.R} & Structural analysis of Markov chains from Bard PPT.\\ \code{examples.R} & Notable Markov chains, e.g., The Gambler Ruin chain.\\ \code{quickStart.R} & Generic examples.\\ \code{extractMatrices.R} & Generic examples.\\ \hline \end{tabular} \caption{The \pkg{markovchain} demos.} \label{tab:demos} \end{table} # Probability with markovchain objects {#sec:probability} The \pkg{markovchain} package contains functions to analyse DTMC from a probabilistic perspective. For example, the package provides methods to find stationary distributions and identifying absorbing and transient states. Many of these methods come from \proglang{MATLAB} listings that have been ported into \proglang{R}. For a full description of the underlying theory and algorithm the interested reader can overview the original \proglang{MATLAB} listings, \cite{renaldoMatlab} and \cite{montgomery}. Table \@ref(tab:methodsToStats) shows methods that can be applied on `markovchain` objects to perform probabilistic analysis. \begin{table}[h] \centering \begin{tabular}{lll} \hline Method & Returns \\ \hline \hline \code{absorbingStates} & the absorbing states of the transition matrix, if any.\\ \code{steadyStates} & the vector(s) of steady state(s) in matrix form. \\ \code{meanFirstPassageTime} & matrix or vector of mean first passage times. \\ \code{meanRecurrenceTime} & vector of mean number of steps to return to each recurrent state \\ \code{hittingProbabilities} & matrix of hitting probabilities for a Markov chain. \\ \code{meanAbsorptionTime} & expected number of steps for a transient state to be \\ & absorbed by any recurrent class \\ \code{absorptionProbabilities} & probabilities of transient states of being \\ & absorbed by each recurrent state \\ \code{committorAB} & committor probabilities \\ \code{communicatingClasses} & list of communicating classes. \\ & $s_{j}$, given actual state $s_{i}$. \\ \code{canonicForm} & the transition matrix into canonic form. \\ \code{is.accessible} & checks whether a state j is reachable from state i. \\ \code{is.irreducible} & checks whether a DTMC is irreducible. \\ \code{is.regular} & checks whether a DTMC is regular. \\ \code{period} & the period of an irreducible DTMC. \\ \code{recurrentClasses} & list of recurrent communicating classes. \\ \code{transientClasses} & list of transient communicating classes. \\ \code{recurrentStates} & the recurrent states of the transition matrix. \\ \code{transientStates} & the transient states of the transition matrix, if any. \\ \code{summary} & DTMC summary. \\ \hline \end{tabular} \caption{\pkg{markovchain} methods: statistical operations.} \label{tab:methodsToStats} \end{table} ## Conditional distributions The conditional distribution of weather states, given that current day's weather is sunny, is given by following code. ```{r conditionalDistr} conditionalDistribution(mcWeather, "sunny") ``` ## Stationary states A stationary (steady state, or equilibrium) vector is a probability vector such that Equation \ref{eq:steadystat2} holds \begin{equation} \begin{matrix} 0\leq \pi_j \leq 1\\ \sum_{j \in S} \pi_j = 1\\ \pi \cdot P = \pi \end{matrix} \label{eq:steadystat2} \end{equation} Steady states are associated to $P$ eigenvalues equal to one. We could be tempted to compute them solving the eigen values / vectors of the matrix and taking real parts (since if $u + iv$ is a eigen vector, for the matrix $P$, then $Re(u + iv) = u$ and $Im(u + iv) = v$ are eigen vectors) and normalizing by the vector sum, this carries some concerns: 1. If $u, v \in \mathbb{R}^n$ are linearly independent eigen vectors associated to $1$ eigen value, $u + iv$, $u + iu$ are also linearly independent eigen vectors, and their real parts coincide. Clearly if we took real parts, we would be loosing an eigen vector, because we cannot know in advance if the underlying algorithm to compute the eigen vectors is going to output something similar to what we described. We should be agnostic to the underlying eigen vector computation algorithm. 2. Imagine the identity $P$ of dimensions $2 \times 2$. Its eigen vectors associated to the $1$ eigen value are $u = (1, 0)$ and $v = (0, 1)$. However, the underlying algorithm to compute eigen vectors could return $(1, -2)$ and $(-2, 1)$ instead, that are linear combinations of the aforementioned ones, and therefore eigen vectors. Normalizing by their sum, we would get: $(-1, 2)$ and $(2, -1)$, which obviously are not probability measures. Again, we should be agnostic to the underlying eigen computation algorithm. 3. Algorithms to compute eigen values / vectors are computationally expensive: they are iterative, and we cannot predict a fixed number of iterations for them. Moreover, each iteration takes $\mathcal{O}(m^2)$ or $\mathcal{O}(m^3)$ algorithmic complexity, with $m$ the number of states. We are going to use that every irreducible DTMC has a unique steady state, that is, if $M$ is the matrix for an irreducible DTMC (all states communicate with each other), then it exists a unique $v \in \mathbb{R}^m$ such that: \[ v \cdot M = v, \qquad \sum_{i = 1}^m v_i = 1 \] Also, we'll use that a steady state for a DTMC assigns $0$ to the transient states. The canonical form of a (by row) stochastic matrix looks alike: \[ \left(\begin{array}{c|c|c|c|c} M_1 & 0 & 0 & \ldots & 0 \\ \hline 0 & M_2 & 0 & \ldots & 0 \\ \hline 0 & 0 & M_3 & \ldots & 0 \\ \hline \vdots & \vdots & \vdots & \ddots & \vdots \\ \hline A_1 & A_2 & A_3 & \ldots & R \end{array}\right) \] where $M_i$ corresponds to irreducible sub-chains, the blocks $A_i$ correspond to the transitions from transient states to each of the recurrent classes and $R$ are the transitions from the transient states to themselves. Also, we should note that a Markov chain has exactly the same name of steady states as recurrent classes. Therefore, we have coded the following algorithm ^[We would like to thank Prof. Christophe Dutang for his contributions to the development of this method. He coded a first improvement of the original `steadyStates` method and we could not have reached the current correctness without his previous work]: 1. Identify the recurrent classes $[C_1, \ldots, C_l]$ with \texttt{recurrentClasses} function. 2. Take each class $C_i$, compute the sub-matrix corresponding to it $M_i$. 3. Solve the system $v \cdot C_i = v, \, \sum_{j = 1}^{|C_i|} v_j = 1$ which has a unique solution, for each $i = 1, \ldots, l$. 3. Map each state $v_i$ to the original order in $P$ and assign a $0$ to the slots corresponding to transient states in the matrix. The result is returned in matrix form. ```{r steadyStates} steadyStates(mcWeather) ``` It is possible for a Markov chain to have more than one stationary distribution, as the gambler ruin example shows. ```{r gamblerRuin} gamblerRuinMarkovChain <- function(moneyMax, prob = 0.5) { m <- markovchain:::zeros(moneyMax + 1) m[1,1] <- m[moneyMax + 1,moneyMax + 1] <- 1 states <- as.character(0:moneyMax) rownames(m) <- colnames(m) <- states for(i in 2:moneyMax){ m[i,i-1] <- 1 - prob m[i, i + 1] <- prob } new("markovchain", transitionMatrix = m, name = paste("Gambler ruin", moneyMax, "dim", sep = " ")) } mcGR4 <- gamblerRuinMarkovChain(moneyMax = 4, prob = 0.5) steadyStates(mcGR4) ``` ## Classification of states Absorbing states are determined by means of `absorbingStates` method. ```{r absorbingStates} absorbingStates(mcGR4) absorbingStates(mcWeather) ``` The key function in methods which need knowledge about communicating classes, recurrent states, transient states, is `.commclassKernel`, which is a modification of Tarjan's algorithm from \cite{Tarjan}. This `.commclassKernel` method gets a transition matrix of dimension $n$ and returns a list of two items: 1. `classes`, an matrix whose $(i, j)$ entry is `true` if $s_i$ and $s_j$ are in the same communicating class. 2. `closed`, a vector whose $i$ -th entry indicates whether the communicating class to which $i$ belongs is closed. These functions are used by two other internal functions on which the `summary` method for `markovchain` objects works. The example matrix used in \cite{renaldoMatlab} well exemplifies the purpose of the function. ```{r renaldoMatrix1} P <- markovchain:::zeros(10) P[1, c(1, 3)] <- 1/2; P[2, 2] <- 1/3; P[2,7] <- 2/3; P[3, 1] <- 1; P[4, 5] <- 1; P[5, c(4, 5, 9)] <- 1/3; P[6, 6] <- 1; P[7, 7] <- 1/4; P[7,9] <- 3/4; P[8, c(3, 4, 8, 10)] <- 1/4; P[9, 2] <- 1; P[10, c(2, 5, 10)] <- 1/3; rownames(P) <- letters[1:10] colnames(P) <- letters[1:10] probMc <- new("markovchain", transitionMatrix = P, name = "Probability MC") summary(probMc) ``` All states that pertain to a transient class are named "transient" and a specific method has been written to elicit them. ```{r transientStates} transientStates(probMc) ``` `canonicForm` method that turns a Markov chain into its canonic form, reordering the states to have first the recurrent classes and then the transient states. ```{r probMc2Canonic} probMcCanonic <- canonicForm(probMc) probMc probMcCanonic ``` The function `is.accessible` permits to investigate whether a state $s_{j}$ is accessible from state $s_i$, that is whether the probability to eventually reach $s_j$ starting from $s_{i}$ is greater than zero. ```{r isAccessible} is.accessible(object = probMc, from = "a", to = "c") is.accessible(object = probMc, from = "g", to = "c") ``` In Section \@ref(sec:properties) we observed that, if a DTMC is irreducible, all its states share the same periodicity. Then, the `period` function returns the periodicity of the DTMC, provided that it is irreducible. The example that follows shows how to find if a DTMC is reducible or irreducible by means of the function `is.irreducible` and, in the latter case, the method `period` is used to compute the periodicity of the chain. ```{r periodicity} E <- matrix(0, nrow = 4, ncol = 4) E[1, 2] <- 1 E[2, 1] <- 1/3; E[2, 3] <- 2/3 E[3,2] <- 1/4; E[3, 4] <- 3/4 E[4, 3] <- 1 mcE <- new("markovchain", states = c("a", "b", "c", "d"), transitionMatrix = E, name = "E") is.irreducible(mcE) period(mcE) ``` The example Markov chain found in \proglang{Mathematica} web site \citep{mathematica9MarkovChain} has been used, and is plotted in Figure \@ref(fig:mcMathematics). ```{r mathematica9Mc} mathematicaMatr <- markovchain:::zeros(5) mathematicaMatr[1,] <- c(0, 1/3, 0, 2/3, 0) mathematicaMatr[2,] <- c(1/2, 0, 0, 0, 1/2) mathematicaMatr[3,] <- c(0, 0, 1/2, 1/2, 0) mathematicaMatr[4,] <- c(0, 0, 1/2, 1/2, 0) mathematicaMatr[5,] <- c(0, 0, 0, 0, 1) statesNames <- letters[1:5] mathematicaMc <- new("markovchain", transitionMatrix = mathematicaMatr, name = "Mathematica MC", states = statesNames) ``` ```{r mcMathematics, fig=TRUE, echo=FALSE, fig.align='center', fig.cap="Mathematica 9 example. Markov chain plot."} plot(mathematicaMc, layout = layout.fruchterman.reingold) ``` ```{r mathematica9MC, echo=FALSE} summary(mathematicaMc) ``` ## First passage time distributions and means \cite{renaldoMatlab} provides code to compute first passage time (within $1,2,\ldots, n$ steps) given the initial state to be $i$. The \proglang{MATLAB} listings translated into \proglang{R} on which the `firstPassage` function is based are: ```{r fpTime1, eval=FALSE} .firstpassageKernel <- function(P, i, n){ G <- P H <- P[i,] E <- 1 - diag(size(P)[2]) for (m in 2:n) { G <- P %*% (G * E) H <- rbind(H, G[i,]) } return(H) } ``` We conclude that the probability for the *first* rainy day to be the third one, given that the current state is sunny, is given by: ```{r fpTime2} firstPassagePdF <- firstPassage(object = mcWeather, state = "sunny", n = 10) firstPassagePdF[3, 3] ``` To compute the *mean* first passage times, i.e. the expected number of days before it rains given that today is sunny, we can use the `meanFirstPassageTime` function: ```{r mfpt1} meanFirstPassageTime(mcWeather) ``` indicating e.g. that the average number of days of sun or cloud before rain is 6.67 if we start counting from a sunny day, and 5 if we start from a cloudy day. Note that we can also specify one or more destination states: ```{r mfpt2} meanFirstPassageTime(mcWeather,"rain") ``` The implementation follows the matrix solutions by [@GrinsteadSnell]. We can check the result by averaging the first passage probability density function: ```{r mfpt3} firstPassagePdF.long <- firstPassage(object = mcWeather, state = "sunny", n = 100) sum(firstPassagePdF.long[,"rain"] * 1:100) ``` ## Mean recurrence time The `meanRecurrenceTime` method gives the first mean recurrence time (expected number of steps to go back to a state if it was the initial one) for each recurrent state in the transition probabilities matrix for a DTMC. Let's see an example: ```{r mrt-weather} meanRecurrenceTime(mcWeather) ``` Another example, with not all of its states being recurrent: ```{r mrt-probMc} recurrentStates(probMc) meanRecurrenceTime(probMc) ``` ## Absorption probabilities and mean absorption time We are going to use the Drunkard’s random walk from [@GrinsteadSnell]. We have a drunk person walking through the street. Each move the person does, if they have not arrived to either home (corner 1) or to the bar (corner 5) could be to the left corner or to the right one, with equal probability. In case of arrival to the bar or to home, the person stays there. ```{r data-drunkard} drunkProbs <- markovchain:::zeros(5) drunkProbs[1,1] <- drunkProbs[5,5] <- 1 drunkProbs[2,1] <- drunkProbs[2,3] <- 1/2 drunkProbs[3,2] <- drunkProbs[3,4] <- 1/2 drunkProbs[4,3] <- drunkProbs[4,5] <- 1/2 drunkMc <- new("markovchain", transitionMatrix = drunkProbs) drunkMc ``` Recurrent (in fact absorbing states) are: ```{r rs-drunkard} recurrentStates(drunkMc) ``` Transient states are the rest: ```{r ts-drunkard} transientStates(drunkMc) ``` The probability of either being absorbed by the bar or by the sofa at home are: ```{r ap-drunkard} absorptionProbabilities(drunkMc) ``` which means that the probability of arriving home / bar is inversely proportional to the distance to each one. But we also would like to know how much time does the person take to arrive there, which can be done with `meanAbsorptionTime`: ```{r at-drunkard} meanAbsorptionTime(drunkMc) ``` So it would take `3` steps to arrive to the destiny if the person is either in the second or fourth corner, and `4` steps in case of being at the same distance from home than to the bar. ## Committor probability The committor probability tells us the probability to reach a given state before another given. Suppose that we start in a cloudy day, the probabilities of experiencing a rainy day before a sunny one is 0.5: ```{r} committorAB(mcWeather,3,1) ``` ## Hitting probabilities Rewriting the system \eqref{eq:hitting-probs} as: \begin{equation*} A = \left(\begin{array}{c|c|c|c} A_1 & 0 & \ldots & 0 \\ \hline 0 & A_2 & \ldots & 0 \\ \hline \vdots & \vdots & \ddots & 0 \\ \hline 0 & 0 & \ldots & A_n \end{array}\right) \end{equation*} \begin{eqnarray*} A_1 &= \left(\begin{matrix} -1 & p_{1,2} & p_{1,3} & \ldots & p_{1,n} \\ 0 & (p_{2,2} - 1) & p_{2,3} & \ldots & p_{2,n} \\ \vdots & \vdots & \vdots & \ddots & \vdots \\ 0 & p_{n, 2} & p_{n,3} & \ldots & (p_{n,n} - 1) \end{matrix}\right)\\ A_2 &= \left(\begin{matrix} (p_{1,1} - 1) & 0 & p_{1,3} & \ldots & p_{1,n} \\ p_{2,1} & -1 & p_{2,3} & \ldots & p_{2,n} \\ \vdots & \vdots & \vdots & \ddots & \vdots \\ p_{n,1} & 0 & p_{n,3} & \ldots & (p_{n,n} - 1) \end{matrix}\right)\\ \vdots & \vdots\\ A_n &= \left(\begin{matrix} (p_{1,1} - 1) & p_{1,2} & p_{1,3} & \ldots & 0 \\ p_{2,1} & (p_{2,2} -1) & p_{2,3} & \ldots & 0 \\ \vdots & \vdots & \vdots & \ddots & \vdots \\ p_{n,1} & p_{n,2} & p_{n,3} & \ldots & -1 \end{matrix}\right)\\ \end{eqnarray*} \begin{equation*} \begin{array}{lr} X_j = \left(\begin{array}{c} h_{1,j} \\ h_{2,j} \\ \vdots \\ h_{n,j} \end{array}\right) & C_j = - \left(\begin{array}{c} p_{1,j} \\ p_{2,j} \\ \vdots \\ p_{n,j} \end{array}\right) \end{array} \end{equation*} we end up having to solve the block systems: \begin{equation} A_j \cdot X_j = C_j \end{equation} Let us imagine the $i$ -th state has transition probabilities: $(0, \ldots, 0, \underset{i)}{1}, 0, \ldots, 0)$. Then that same row would turn into $(0,0, \ldots, 0)$ for some block, thus obtaining a singular matrix. Another case which may give us problems could be: state $i$ has the following transition probabilities: $(0, \ldots, 0, \underset{j)}{1}, 0, \ldots, 0)$ and the state $j$ has the following transition probabilities: $(0, \ldots, 0, \underset{i)}{1}, 0, \ldots, 0)$. Then when building some blocks we will end up with rows: \begin{eqnarray*} (0, \ldots, 0, \underset{i)}{-1}, 0, \ldots, 0, \underset{j)}{1}, 0, \ldots, 0) \\ (0, \ldots, 0, \underset{i)}{1}, 0, \ldots, 0, \underset{j)}{-1}, 0, \ldots, 0) \end{eqnarray*} which are linearly dependent. Our hypothesis is that if we treat the closed communicating classes differently, we *might* delete the linearity in the system. If we have a closed communicating class $C_u$, then $h_{i,j} = 1$ for all $i,j \in C_u$ and $h_{k,j} = 0$ for all $k\not\in C_u$. Then we can set $X_u$ appropriately and solve the other $X_v$ using those values. The method in charge of that in `markovchain` package is `hittingProbabilities`, which receives a Markov chain and computes the matrix $(h_{ij})_{i,j = 1,\ldots, n}$ where $S = \{s_1, \ldots, s_n\}$ is the set of all states of the chain. For the following chain: ```{r hitting-data} M <- markovchain:::zeros(5) M[1,1] <- M[5,5] <- 1 M[2,1] <- M[2,3] <- 1/2 M[3,2] <- M[3,4] <- 1/2 M[4,2] <- M[4,5] <- 1/2 hittingTest <- new("markovchain", transitionMatrix = M) hittingProbabilities(hittingTest) ``` we want to compute the hitting probabilities. That can be done with: ```{r hitting-probabilities} hittingProbabilities(hittingTest) ``` In the case of the `mcWeather` Markov chain we would obtain a matrix with all its elements set to $1$. That makes sense (and is desirable) since if today is sunny, we expect it would be sunny again at certain point in the time, and the same with rainy weather (that way we assure good harvests): ```{r hitting-weather} hittingProbabilities(mcWeather) ``` # Statistical analysis {#sec:statistics} Table \@ref(tab:funs4Stats) lists the functions and methods implemented within the package which help to fit, simulate and predict DTMC. \begin{table}[h] \centering \begin{tabular}{lll} \hline Function & Purpose \\ \hline \hline \code{markovchainFit} & Function to return fitted Markov chain for a given sequence.\\ \code{predict} & Method to calculate predictions from \code{markovchain} or \\ & \code{markovchainList} objects.\\ \code{rmarkovchain} & Function to sample from \code{markovchain} or \code{markovchainList} objects.\\ \hline \end{tabular} \caption{The \pkg{markovchain} statistical functions.} \label{tab:funs4Stats} \end{table} ## Simulation Simulating a random sequence from an underlying DTMC is quite easy thanks to the function `rmarkovchain`. The following code generates a year of weather states according to `mcWeather` underlying stochastic process. ```{r simulatingAMarkovChain} weathersOfDays <- rmarkovchain(n = 365, object = mcWeather, t0 = "sunny") weathersOfDays[1:30] ``` Similarly, it is possible to simulate one or more sequences from a semi-homogeneous Markov chain, as the following code (applied on CCHC example) exemplifies. ```{r simulatingAListOfMarkovChain} patientStates <- rmarkovchain(n = 5, object = mcCCRC, t0 = "H", include.t0 = TRUE) patientStates[1:10,] ``` Two advance parameters are available to the `rmarkovchain` method which helps you decide which implementation to use. There are four options available : \proglang{R}, \proglang{R} in parallel, \proglang{C++} and \proglang{C++} in parallel. Two boolean parameters `useRcpp` and `parallel` will decide which implementation will be used. Default is \code{useRcpp = TRUE} and \code{parallel = FALSE} i.e. \proglang{C++} implementation. The \proglang{C++} implementation is generally faster than the `R` implementation. If you have multicore processors then you can take advantage of `parallel` parameter by setting it to `TRUE`. When both `Rcpp=TRUE` and `parallel=TRUE` the parallelization has been carried out using \pkg{RcppParallel} package \citep{pkg:RcppParallel}. ## Estimation A time homogeneous Markov chain can be fit from given data. Four methods have been implemented within current version of \pkg{markovchain} package: maximum likelihood, maximum likelihood with Laplace smoothing, Bootstrap approach, maximum a posteriori. Equation \ref{eq:MLE} shows the maximum likelihood estimator (MLE) of the $p_{ij}$ entry, where the $n_{ij}$ element consists in the number sequences $\left( X_{t}=s_{i}, X_{t+1}=s_{j}\right)$ found in the sample, that is \begin{equation} {\hat p^{MLE}}_{ij} = \frac{n_{ij}}{\sum\limits_{u = 1}^k {n_{iu}}}. \label{eq:MLE} \end{equation} Equation \@ref(eq:SE) shows the `standardError` of the MLE \citep{MSkuriat}. \begin{equation} SE_{ij} = \frac{ {\hat p^{MLE}}_{ij} }{\sqrt{n_{ij}}} \label{eq:SE} \end{equation} ```{r fitMcbyMLE2} weatherFittedMLE <- markovchainFit(data = weathersOfDays, method = "mle",name = "Weather MLE") weatherFittedMLE$estimate weatherFittedMLE$standardError ``` The Laplace smoothing approach is a variation of the MLE, where the $n_{ij}$ is substituted by $n_{ij}+\alpha$ (see Equation \ref{eq:LAPLACE}), being $\alpha$ an arbitrary positive stabilizing parameter. \begin{equation} {\hat p^{LS}}_{ij} = \frac{{{n_{ij}} + \alpha }}{{\sum\limits_{u = 1}^k {\left( {{n_{iu}} + \alpha } \right)} }} \label{eq:LAPLACE} \end{equation} ```{r fitMcbyLAPLACE} weatherFittedLAPLACE <- markovchainFit(data = weathersOfDays, method = "laplace", laplacian = 0.01, name = "Weather LAPLACE") weatherFittedLAPLACE$estimate ``` (NOTE: The Confidence Interval option is enabled by default. Remove this option to fasten computations.) Both MLE and Laplace approach are based on the `createSequenceMatrix` functions that returns the raw counts transition matrix. ```{r fitSequenceMatrix} createSequenceMatrix(stringchar = weathersOfDays) ``` `stringchar` could contain `NA` values, and the transitions containing `NA` would be ignored. An issue occurs when the sample contains only one realization of a state (say $X_{\beta}$) which is located at the end of the data sequence, since it yields to a row of zero (no sample to estimate the conditional distribution of the transition). In this case the estimated transition matrix is corrected assuming $p_{\beta,j}=1/k$, being $k$ the possible states. Create sequence matrix can also be used to obtain raw count transition matrices from a given $n*2$ matrix as the following example shows: ```{r fitSequenceMatrix2} myMatr<-matrix(c("a","b","b","a","a","b","b","b","b","a","a","a","b","a"),ncol=2) createSequenceMatrix(stringchar = myMatr,toRowProbs = TRUE) ``` A bootstrap estimation approach has been developed within the package in order to provide an indication of the variability of ${\hat p}_{ij}$ estimates. The bootstrap approach implemented within the \pkg{markovchain} package follows these steps: 1. bootstrap the data sequences following the conditional distributions of states estimated from the original one. The default bootstrap samples is 10, as specified in `nboot` parameter of `markovchainFit` function. 2. apply MLE estimation on bootstrapped data sequences that are saved in `bootStrapSamples` slot of the returned list. 3. the ${p^{BOOTSTRAP}}_{ij}$ is the average of all ${p^{MLE}}_{ij}$ across the `bootStrapSamples` list, normalized by row. A `standardError` of $\hat{{p^{MLE}}_{ij}}$ estimate is provided as well. ```{r fitMcbyBootStrap1} weatherFittedBOOT <- markovchainFit(data = weathersOfDays, method = "bootstrap", nboot = 20) weatherFittedBOOT$estimate weatherFittedBOOT$standardError ``` The bootstrapping process can be done in parallel thanks to \pkg{RcppParallel} package \citep{pkg:RcppParallel}. Parallelized implementation is definitively suggested when the data sample size or the required number of bootstrap runs is high. ```{r fitMcbyBootStrap2, eval=FALSE} weatherFittedBOOTParallel <- markovchainFit(data = weathersOfDays, method = "bootstrap", nboot = 200, parallel = TRUE) weatherFittedBOOTParallel$estimate weatherFittedBOOTParallel$standardError ``` The parallel bootstrapping uses all the available cores on a machine by default. However, it is also possible to tune the number of threads used. Note that this should be done in R before calling the `markovchainFit` function. For example, the following code will set the number of threads to 4. ```{r fitMcbyBootStrap3, eval=FALSE} RcppParallel::setNumThreads(2) ``` For more details, please refer to \pkg{RcppParallel} web site. For all the fitting methods, the `logLikelihood` \citep{MSkuriat} denoted in Equation \ref{eq:LLH} is provided. \begin{equation} LLH = \sum_{i,j} n_{ij} * log (p_{ij}) \label{eq:LLH} \end{equation} where $n_{ij}$ is the entry of the frequency matrix and $p_{ij}$ is the entry of the transition probability matrix. ```{r fitMcbyMLE1} weatherFittedMLE$logLikelihood weatherFittedBOOT$logLikelihood ``` Confidence matrices of estimated parameters (parametric for MLE, non - parametric for BootStrap) are available as well. The `confidenceInterval` is provided with the two matrices: `lowerEndpointMatrix` and `upperEndpointMatrix`. The confidence level (CL) is 0.95 by default and can be given as an argument of the function `markovchainFit`. This is used to obtain the standard score (z-score). From classical inference theory, if $ci$ is the level of confidence required assuming normal distribution the $zscore(ci)$ solves $\Phi \left ( 1-\left(\frac{1-ci}{2}\right) \right )$ Equations \ref{eq:CIL} and \ref{eq:CIU} \citep{MSkuriat} show the `confidenceInterval` of a fitting. Note that each entry of the matrices is bounded between 0 and 1. \begin{align} LowerEndpoint_{ij} = p_{ij} - zscore (CL) * SE_{ij} \label{eq:CIL} \\ UpperEndpoint_{ij} = p_{ij} + zscore (CL) * SE_{ij} \label{eq:CIU} \end{align} ```{r confint} weatherFittedMLE$confidenceInterval weatherFittedBOOT$confidenceInterval ``` A special function, `multinomialConfidenceIntervals`, has been written in order to obtain multinomial wise confidence intervals. The code has been based on and Rcpp translation of package's \pkg{MultinomialCI} functions \cite{pkg:MultinomialCI} that were themselves based on the \cite{sison1995simultaneous} paper. ```{r multinomial} multinomialConfidenceIntervals(transitionMatrix = weatherFittedMLE$estimate@transitionMatrix, countsTransitionMatrix = createSequenceMatrix(weathersOfDays)) ``` The functions for fitting DTMC have mostly been rewritten in \proglang{C++} using \pkg{Rcpp} \cite{RcppR} since version 0.2. It is also possible to fit a DTMC object from `matrix` or `data.frame` objects as shown in following code. ```{r fitMclists} data(holson) singleMc<-markovchainFit(data=holson[,2:12],name="holson") ``` The same applies for `markovchainList` (output length has been limited). ```{r fitMclistsFit1, output.lines=20} mcListFit<-markovchainListFit(data=holson[,2:6],name="holson") mcListFit$estimate ``` Finally, given a `list` object, it is possible to fit a `markovchain` object or to obtain the raw transition matrix. ```{r fitMclistsFit2} c1<-c("a","b","a","a","c","c","a") c2<-c("b") c3<-c("c","a","a","c") c4<-c("b","a","b","a","a","c","b") c5<-c("a","a","c",NA) c6<-c("b","c","b","c","a") mylist<-list(c1,c2,c3,c4,c5,c6) mylistMc<-markovchainFit(data=mylist) mylistMc ``` The same works for `markovchainFitList`. ```{r fitAMarkovChainListfromAlist, output.lines=15} markovchainListFit(data=mylist) ``` If any transition contains `NA`, it will be ignored in the results as the above example showed. ## Prediction The $n$-step forward predictions can be obtained using the `predict` methods explicitly written for `markovchain` and `markovchainList` objects. The prediction is the mode of the conditional distribution of $X_{t+1}$ given $X_{t}=s_{j}$, being $s_{j}$ the last realization of the DTMC (homogeneous or semi-homogeneous). ### Predicting from a markovchain object The 3-days forward predictions from `markovchain` object can be generated as follows, assuming that the last two days were respectively "cloudy" and "sunny". ```{r markovchainPredict} predict(object = weatherFittedMLE$estimate, newdata = c("cloudy", "sunny"), n.ahead = 3) ``` ### Predicting from a markovchainList object Given an initial two years health status, the 5-year ahead prediction of any CCRC guest is ```{r markovchainListPredict} predict(mcCCRC, newdata = c("H", "H"), n.ahead = 5) ``` The prediction has stopped at time sequence since the underlying semi-homogeneous Markov chain has a length of four. In order to continue five years ahead, the `continue=TRUE` parameter setting makes the `predict` method keeping to use the last `markovchain` in the sequence list. ```{r markovchainListPredict2} predict(mcCCRC, newdata = c("H", "H"), n.ahead = 5, continue = TRUE) ``` ## Statistical Tests In this section, we describe the statistical tests: assessing the Markov property (`verifyMarkovProperty`), the order (`assessOrder`), the stationary (`assessStationarity`) of a Markov chain sequence, and the divergence test for empirically estimated transition matrices (`divergenceTest`). Most of such tests are based on the $\chi ^2$ statistics. Relevant references are \cite{kullback1962tests} and \cite{anderson1957statistical}. All such tests have been designed for small samples, since it is easy to detect departures from Markov property as long as the sample size increases. In addition, the accuracy of the statistical inference functions has been questioned and will be thoroughly investigated in future versions of the package. ### Assessing the Markov property of a Markov chain sequence The `verifyMarkovProperty` function verifies whether the Markov property holds for the given chain. The test implemented in the package looks at triplets of successive observations. If $x_1, x_2, \ldots, x_N$ is a set of observations and $n_{ijk}$ is the number of times $t$ $\left(1 \le t \le N-2 \right)$ such that $x_t=i, x_{t+1}=j, x_{x+2}=k$, then if the Markov property holds $n_{ijk}$ follows a Binomial distribution with parameters $n_{ij}$ and $p_{jk}$. A classical $\chi^2$ test can check this distributional assumption, since $\sum_{i}\sum_{j}\sum_{k}\frac{(n_{ijk}-n_{ij}\hat{p_{jk}})^2}{n_{ij}\hat{p_{jk}}}\sim \chi^2\left(q \right )$ where q is the number of degrees of freedom. The number of degrees of freedom q of the distribution of $\chi^2$ is given by the formula r-q+s-1, where: s denotes the number of states i in the state space such that n_{i} > 0 q denotes the number of pairs (i, j) for which n_{ij} > 0 and r denotes the number of triplets (i, j, k) for which n_{ij}n_{jk} > 0 ```{r test1} sample_sequence<-c("a", "b", "a", "a", "a", "a", "b", "a", "b", "a", "b", "a", "a", "b", "b", "b", "a") verifyMarkovProperty(sample_sequence) ``` ### Assessing the order of a Markov chain sequence The `assessOrder` function checks whether the given chain is of first order or of second order. For each possible present state, we construct a contingency table of the frequency of the future state for each past to present state transition as shown in Table \ref{tab:order}. \begin{table}[h] \centering \begin{tabular}{l | l | l | l} \hline past & present & future & future \\ & & a & b \\ \hline \hline a & a & 2 & 2\\ b & a & 2 & 2\\ \hline \end{tabular} \caption{Contingency table to assess the order for the present state a.} \label{tab:order} \end{table} Using the table, the function performs the $\chi ^2$ test by calling the `chisq.test` function. This test returns a list of the chi-squared value and the p-value. If the p-value is greater than the given significance level, we cannot reject the hypothesis that the sequence is of first order. ```{r test2} data(rain) assessOrder(rain$rain) ``` ### Assessing the stationarity of a Markov chain sequence The `assessStationarity` function assesses if the transition probabilities of the given chain change over time. To be more specific, the chain is stationary if the following condition meets. \begin{equation} p_{ij}(t) = p_{ij} ~\textrm{ for all }~t \label{eq:stationarity} \end{equation} For each possible state, we construct a contingency table of the estimated transition probabilities over time as shown in Table \ref{tab:stationarity}. \begin{table}[h] \centering \begin{tabular}{l | l | l} \hline time (t) & probability of transition to a & probability of transition to b \\ \hline \hline 1 & 0 & 1\\ 2 & 0 & 1\\ . & . & . \\ . & . & . \\ . & . & . \\ 16 & 0.44 & 0.56\\ \hline \end{tabular} \caption{Contingency table to assess the stationarity of the state a.} \label{tab:stationarity} \end{table} Using the table, the function performs the $\chi ^2$ test by calling the `chisq.test` function. This test returns a list of the chi-squared value and the p-value. If the p-value is greater than the given significance level, we cannot reject the hypothesis that the sequence is stationary. ```{r test3} assessStationarity(rain$rain, 10) ``` ### Divergence tests for empirically estimated transition matrices This section discusses tests developed to verify whether: 1. An empirical transition matrix is consistent with a theoretical one. 2. Two or more empirical transition matrices belongs to the same DTMC. The first test is implemented by the `verifyEmpiricalToTheoretical` function. Being $f_{ij}$ the raw transition count, \cite{kullback1962tests} shows that $2*\sum_{i=1}^{r}\sum_{j=1}^{r}f_{ij}\ln\frac{f_{ij}}{f_{i.}P\left( E_j | E_i\right)} \sim \chi^2\left ( r*(r-1) \right )$. The following example is taken from \cite{kullback1962tests}: ```{r divergence1} sequence<-c(0,1,2,2,1,0,0,0,0,0,0,1,2,2,2,1,0,0,1,0,0,0,0,0,0,1,1, 2,0,0,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,0,2,1,0, 0,2,1,0,0,0,0,0,0,1,1,1,2,2,0,0,2,1,1,1,1,2,1,1,1,1,1,1,1,1,1,0,2, 0,1,1,0,0,0,1,2,2,0,0,0,0,0,0,2,2,2,1,1,1,1,0,1,1,1,1,0,0,2,1,1, 0,0,0,0,0,2,2,1,1,1,1,1,2,1,2,0,0,0,1,2,2,2,0,0,0,1,1) mc=matrix(c(5/8,1/4,1/8,1/4,1/2,1/4,1/4,3/8,3/8),byrow=TRUE, nrow=3) rownames(mc)<-colnames(mc)<-0:2; theoreticalMc<-as(mc, "markovchain") verifyEmpiricalToTheoretical(data=sequence,object=theoreticalMc) ``` The second one is implemented by the `verifyHomogeneity` function, inspired by \cite[section~9]{kullback1962tests}. Assuming that $i=1,2, \ldots, s$ DTMC samples are available and that the cardinality of the state space is $r$ it verifies whether the $s$ chains belongs to the same unknown one. \cite{kullback1962tests} shows that its test statistics follows a chi-square law, $2*\sum_{i=1}^{s}\sum_{j=1}^{r}\sum_{k=1}^{r}f_{ijk}\ln\frac{n*f_{ijk}}{f_{i..}f_{.jk}} \sim \chi^2\left ( r*(r-1) \right )$. Also the following example is taken from \cite{kullback1962tests}: ```{r divergence2} data(kullback) verifyHomogeneity(inputList=kullback,verbose=TRUE) ``` ## Continuous Times Markov Chains ### Intro The \pkg{markovchain} package provides functionality for continuous time Markov chains (CTMCs). CTMCs are a generalization of discrete time Markov chains (DTMCs) in that we allow time to be continuous. We assume a finite state space $S$ (for an infinite state space wouldn't fit in memory). We can think of CTMCs as Markov chains in which state transitions can happen at any time. More formally, we would like our CTMCs to satisfy the following two properties: * The Markov property - let $F_{X(s)}$ denote the information about $X$ up to time $s$. Let $j \in S$ and $s \leq t$. Then, $P(X(t) = j|F_{X(s)}) = P(X(t) = j|X(s))$. * Time homogeneity - $P(X(t) = j|X(s) = k) = P(X(t-s) = j|X(0) = k)$. If both the above properties are satisfied, it is referred to as a time-homogeneous CTMC. If a transition occurs at time $t$, then $X(t)$ denotes the new state and $X(t)\neq X(t-)$. Now, let $X(0)=x$ and let $T_x$ be the time a transition occurs from this state. We are interested in the distribution of $T_x$. For $s,t \geq 0$, it can be shown that $ P(T_x > s+t | T_x > s) = P(T_x > t) $ This is the memory less property that only the exponential random variable exhibits. Therefore, this is the sought distribution, and each state $s \in S$ has an exponential holding parameter $\lambda(s)$. Since $\mathrm{E}T_x = \frac{1}{\lambda(x)}$, higher the rate $\lambda(x)$, smaller the expected time of transitioning out of the state $x$. However, specifying this parameter alone for each state would only paint an incomplete picture of our CTMC. To see why, consider a state $x$ that may transition to either state $y$ or $z$. The holding parameter enables us to predict when a transition may occur if we start off in state $x$, but tells us nothing about which state will be next. To this end, we also need transition probabilities associated with the process, defined as follows (for $y \neq x$) - $p_{xy} = P(X(T_s) = y | X(0) = x)$. Note that $\sum_{y \neq x} p_{xy} = 1$. Let $Q$ denote this transition matrix ($Q_{ij} = p_{ij}$). What is key here is that $T_x$ and the state $y$ are independent random variables. Let's define $\lambda(x, y) = \lambda(x) p_{xy}$ We now look at Kolmogorov's backward equation. Let's define $P_{ij}(t) = P(X(t) = j | X(0) = i)$ for $i, j \in S$. The backward equation is given by (it can be proved) $P_{ij}(t) = \delta_{ij}e^{-\lambda(i)t} + \int_{0}^{t}\lambda(i)e^{-\lambda(i)t} \sum_{k \neq i} Q_{ik} P_{kj}(t-s) ds$. Basically, the first term is non-zero if and only if $i=j$ and represents the probability that the first transition from state $i$ occurs after time $t$. This would mean that at $t$, the state is still $i$. The second term accounts for any transitions that may occur before time $t$ and denotes the probability that at time $t$, when the smoke clears, we are in state $j$. This equation can be represented compactly as follows $P'(t) = AP(t)$ where $A$ is the *generator* matrix. \[ A(i, j) = \begin{cases} \lambda(i, j) & \mbox{if } i \neq j \\ -\lambda(i) & \mbox{else.} \end{cases} \] Observe that the sum of each row is 0. A CTMC can be completely specified by the generator matrix. ### Stationary Distributions The following theorem guarantees the existence of a unique stationary distribution for CTMCs. Note that $X(t)$ being irreducible and recurrent is the same as $X_n(t)$ being irreducible and recurrent. Suppose that $X(t)$ is irreducible and recurrent. Then $X(t)$ has an invariant measure $\eta$, which is unique up to multiplicative factors. Moreover, for each $k \in S$, we have \[\eta_k = \frac{\pi_k}{\lambda(k)}\] where $\pi$ is the unique invariant measure of the embedded discrete time Markov chain $Xn$. Finally, $\eta$ satisfies \[0 < \eta_j < \infty, \forall j \in S\] and if $\sum_i \eta_i < \infty$ then $\eta$ can be normalized to get a stationary distribution. ### Estimation Let the data set be $D = \{(s_0, t_0), (s_1, t_1), ..., (s_{N-1}, t_{N-1})\}$ where $N=|D|$. Each $s_i$ is a state from the state space $S$ and during the time $[t_i,t_{i+1}]$ the chain is in state $s_i$. Let the parameters be represented by $\theta = \{\lambda, P\}$ where $\lambda$ is the vector of holding parameters for each state and $P$ the transition matrix of the embedded discrete time Markov chain. Then the probability is given by \[ {Pr(D | \theta) \propto \lambda(s_0)e^{-\lambda(s_0)(t_1-t_0)}Pr(s_1|s_0) \cdot\ldots\cdot \lambda(s_{N-2})e^{-\lambda(s_{N-2})(t_{N-1}-t_{N-2})}Pr(s_{N-1}|s_{N-2})} \] Let $n(j|i)$ denote the number of $i$->$j$ transitions in $D$, and $n(i)$ the number of times $s_i$ occurs in $D$. Let $t(s_i)$ denote the total time the chain spends in state $s_i$. Then the MLEs are given by \[ \hat{\lambda(s)} = \frac{n(s)}{t(s)},\hat{Pr(j|i)}=\frac{n(j|i)}{n(i)} \] ### Expected Hitting Time The package provides a function `ExpectedTime` to calculate average hitting time from one state to another. Let the final state be j, then for every state $i \in S$, where $S$ is the set of all states and holding time $q_{i} > 0$ for every $i \neq j$. Assuming the conditions to be true, expected hitting time is equal to minimal non-negative solution vector $p$ to the system of linear equations: \begin{equation} \begin{cases} p_{k} = 0 & k = j \\ -\sum_{l \in I} q_{kl}p_{k} = 1 & k \neq j \end{cases} \label{eq:EHT} \end{equation} ### Probability at time t The package provides a function `probabilityatT` to calculate probability of every state according to given `ctmc` object. Here we use Kolmogorov's backward equation $P(t) = P(0)e^{tQ}$ for $t \geq 0$ and $P(0) = I$. Here $P(t)$ is the transition function at time t. The value $P(t)[i][j]$ at time $P(t)$ describes the probability of the state at time $t$ to be equal to j if it was equal to i at time $t=0$. It takes care of the case when `ctmc` object has a generator represented by columns. If initial state is not provided, the function returns the whole transition matrix $P(t)$. ### Examples To create a CTMC object, you need to provide a valid generator matrix, say $Q$. The CTMC object has the following slots - states, generator, by row, name (look at the documentation object for further details). Consider the following example in which we aim to model the transition of a molecule from the $\sigma$ state to the $\sigma^*$ state. When in the former state, if it absorbs sufficient energy, it can make the jump to the latter state and remains there for some time before transitioning back to the original state. Let us model this by a CTMC: ```{r rCtmcInit} energyStates <- c("sigma", "sigma_star") byRow <- TRUE gen <- matrix(data = c(-3, 3, 1, -1), nrow = 2, byrow = byRow, dimnames = list(energyStates, energyStates)) molecularCTMC <- new("ctmc", states = energyStates, byrow = byRow, generator = gen, name = "Molecular Transition Model") ``` To generate random CTMC transitions, we provide an initial distribution of the states. This must be in the same order as the dimnames of the generator. The output can be returned either as a list or a data frame. ```{r rctmcRandom0} statesDist <- c(0.8, 0.2) rctmc(n = 3, ctmc = molecularCTMC, initDist = statesDist, out.type = "df", include.T0 = FALSE) ``` $n$ represents the number of samples to generate. There is an optional argument $T$ for `rctmc`. It represents the time of termination of the simulation. To use this feature, set $n$ to a very high value, say `Inf` (since we do not know the number of transitions before hand) and set $T$ accordingly. ```{r ctmcRandom1} statesDist <- c(0.8, 0.2) rctmc(n = Inf, ctmc = molecularCTMC, initDist = statesDist, T = 2) ``` To obtain the stationary distribution simply invoke the `steadyStates` function ```{r rctmcSteadyStates} steadyStates(molecularCTMC) ``` For fitting, use the `ctmcFit` function. It returns the MLE values for the parameters along with the confidence intervals. ```{r rctmcFitting} data <- list(c("a", "b", "c", "a", "b", "a", "c", "b", "c"), c(0, 0.8, 2.1, 2.4, 4, 5, 5.9, 8.2, 9)) ctmcFit(data) ``` One approach to obtain the generator matrix is to apply the `logm` function from the \pkg{expm} package on a transition matrix. Numeric issues arise, see \cite{israel2001finding}. For example, applying the standard `method` ('Higham08') on `mcWeather` raises an error, whilst the alternative method (eigenvalue decomposition) is OK. The following code estimates the generator matrix of the `mcWeather` transition matrix. ```{r mcWeatherQ} mcWeatherQ <- expm::logm(mcWeather@transitionMatrix,method='Eigen') mcWeatherQ ``` Therefore, the "half - day" transition probability for mcWeather DTMC is ```{r mcWeatherHalfDay} mcWeatherHalfDayTM <- expm::expm(mcWeatherQ*.5) mcWeatherHalfDay <- new("markovchain",transitionMatrix=mcWeatherHalfDayTM,name="Half Day Weather Transition Matrix") mcWeatherHalfDay ``` The \pkg{ctmcd} package \citep{pkg:ctmcd} provides various functions to estimate the generator matrix (GM) of a CTMC process using different methods. The following code provides a way to join \pkg{markovchain} and \pkg{ctmcd} computations. ```{r ctmcd1} if(requireNamespace(package='ctmcd', quietly = TRUE)) { require(ctmcd) require(expm) #defines a function to transform a GM into a TM gm_to_markovchain<-function(object, t=1) { if(!(class(object) %in% c("gm","matrix","Matrix"))) stop("Error! Expecting either a matrix or a gm object") if ( class(object) %in% c("matrix","Matrix")) generator_matrix<-object else generator_matrix<-as.matrix(object[["par"]]) #must add importClassesFrom("markovchain",markovchain) in the NAMESPACE #must add importFrom(expm, "expm") transitionMatrix<-expm(generator_matrix*t) out<-as(transitionMatrix,"markovchain") return(out) } #loading ctmcd dataset data(tm_abs) gm0=matrix(1,8,8) #initializing diag(gm0)=0 diag(gm0)=-rowSums(gm0) gm0[8,]=0 gmem=gm(tm_abs,te=1,method="EM",gmguess=gm0) #estimating GM mc_at_2=gm_to_markovchain(object=gmem, t=2) #converting to TM at time 2 } else { warning('package ctmcd unavailable') } ``` ## Pseudo - Bayesian Estimation \cite{Hu2002} shows an empirical quasi-Bayesian method to estimate transition matrices, given an empirical $\hat{P}$ transition matrix (estimated using the classical approach) and an a - priori estimate $Q$. In particular, each row of the matrix is estimated using the linear combination $\alpha \cdot Q+\left(1-1alpha\right) \cdot P$, where $\alpha$ is defined for each row as Equation \ref{eq:pseudobayes} shows \begin{equation} \left\{\begin{matrix} \hat{\alpha_i}=\frac{\hat{K_i}}{v\left(i \right )+\hat{K_i}}\\ \hat{K_i}=\frac{v\left(i \right)^2 - \sum_{j}Y_{ij}^2}{\sum_{j}(Y_{ij}-v\left(i \right)*q_{ij})^2} \end{matrix}\right. \label{eq:pseudobayes} \end{equation} The following code returns the pseudo Bayesian estimate of the transition matrix: ```{r pseudobayes} pseudoBayesEstimator <- function(raw, apriori){ v_i <- rowSums(raw) K_i <- numeric(nrow(raw)) sumSquaredY <- rowSums(raw^2) #get numerator K_i_num <- v_i^2-sumSquaredY #get denominator VQ <- matrix(0,nrow= nrow(apriori),ncol=ncol(apriori)) for (i in 1:nrow(VQ)) { VQ[i,]<-v_i[i]*apriori[i,] } K_i_den<-rowSums((raw - VQ)^2) K_i <- K_i_num/K_i_den #get the alpha vector alpha <- K_i / (v_i+K_i) #empirical transition matrix Emp<-raw/rowSums(raw) #get the estimate out<-matrix(0, nrow= nrow(raw),ncol=ncol(raw)) for (i in 1:nrow(out)) { out[i,]<-alpha[i]*apriori[i,]+(1-alpha[i])*Emp[i,] } return(out) } ``` We then apply it to the weather example: ```{r pseudobayes2} trueMc<-as(matrix(c(0.1, .9,.7,.3),nrow = 2, byrow = 2),"markovchain") aprioriMc<-as(matrix(c(0.5, .5,.5,.5),nrow = 2, byrow = 2),"markovchain") smallSample<-rmarkovchain(n=20,object = trueMc) smallSampleRawTransitions<-createSequenceMatrix(stringchar = smallSample) pseudoBayesEstimator( raw = smallSampleRawTransitions, apriori = aprioriMc@transitionMatrix ) - trueMc@transitionMatrix biggerSample<-rmarkovchain(n=100,object = trueMc) biggerSampleRawTransitions<-createSequenceMatrix(stringchar = biggerSample) pseudoBayesEstimator( raw = biggerSampleRawTransitions, apriori = aprioriMc@transitionMatrix ) - trueMc@transitionMatrix bigSample<-rmarkovchain(n=1000,object = trueMc) bigSampleRawTransitions<-createSequenceMatrix(stringchar = bigSample) pseudoBayesEstimator( raw = bigSampleRawTransitions, apriori = aprioriMc@transitionMatrix ) - trueMc@transitionMatrix ``` ## Bayesian Estimation The \pkg{markovchain} package provides functionality for maximum a posteriori (MAP) estimation of the chain parameters (at the time of writing this document, only first order models are supported) by Bayesian inference. It also computes the probability of observing a new data set, given a (different) data set. This vignette provides the mathematical description for the methods employed by the package. ### Notation and set-up The data is denoted by $D$, the model parameters (transition matrix) by $\theta$. The object of interest is $P(\theta | D)$ (posterior density). $\mathcal{A}$ represents an alphabet class, each of whose members represent a state of the chain. Therefore \[D = s_0 s_1 ... s_{N-1}, s_t \in \mathcal{A}\] where $N$ is the length of the data set. Also, \[\theta = \{p(s|u), s \in \mathcal{A}, u \in \mathcal{A} \}\] where $\sum_{s \in \mathcal{A}} p(s|u) = 1$ for each $u \in \mathcal{A}$. Our objective is to find $\theta$ which maximizes the posterior. That is, if our solution is denoted by $\hat{\theta}$, then \[\hat{\theta} = \underset{\theta}{argmax}P(\theta | D)\] where the search space is the set of right stochastic matrices of dimension $|\mathcal{A}|x|\mathcal{A}|$. $n(u, s)$ denotes the number of times the word $us$ occurs in $D$ and $n(u)=\sum_{s \in \mathcal{A}}n(u, s)$. The hyper-parameters are similarly denoted by $\alpha(u, s)$ and $\alpha(u)$ respectively. ### Methods Given $D$, its likelihood conditioned on the observed initial state in D is given by \[P(D|\theta) = \prod_{s \in \mathcal{A}} \prod_{u \in \mathcal{A}} p(s|u)^{n(u, s)}\] Conjugate priors are used to model the prior $P(\theta)$. The reasons are two fold: 1. Exact expressions can be derived for the MAP estimates, expectations and even variances 2. Model order selection/comparison can be implemented easily (available in a future release of the package) The hyper-parameters determine the form of the prior distribution, which is a product of Dirichlet distributions \[P(\theta) = \prod_{u \in \mathcal{A}} \Big\{ \frac{\Gamma(\alpha(u))}{\prod_{s \in \mathcal{A}} \Gamma(\alpha(u, s))} \prod_{s \in \mathcal{A}} p(s|u)^{\alpha(u, s)) - 1} \Big\}\] where $\Gamma(.)$ is the Gamma function. The hyper-parameters are specified using the `hyperparam` argument in the `markovchainFit` function. If this argument is not specified, then a default value of 1 is assigned to each hyper-parameter resulting in the prior distribution of each chain parameter to be uniform over $[0,1]$. Given the likelihood and the prior as described above, the evidence $P(D)$ is simply given by \[P(D) = \int P(D|\theta) P(\theta) d\theta\] which simplifies to \[ P(D) = \prod_{u \in \mathcal{A}} \Big\{ \frac{\Gamma(\alpha(u))}{\prod_{s \in \mathcal{A}} \Gamma(\alpha(u, s))} \frac{\prod_{s \in \mathcal{A}} \Gamma(n(u, s) + \alpha(u, s))}{\Gamma(\alpha(u) + n(u))} \Big\} \] Using Bayes' theorem, the posterior now becomes (thanks to the choice of conjugate priors) \[ P(\theta | D) = \prod_{u \in \mathcal{A}} \Big\{ \frac{\Gamma(n(u) + \alpha(u))}{\prod_{s \in \mathcal{A}} \Gamma(n(u, s) + \alpha(u, s))} \prod_{s \in \mathcal{A}} p(s|u)^{n(u, s) + \alpha(u, s)) - 1} \Big\} \] Since this is again a product of Dirichlet distributions, the marginal distribution of a particular parameter $P(s|u)$ of our chain is given by \[ P(s|u) \sim Beta(n(u, s) + \alpha(u, s), n(u) + \alpha(u) - n(u, s) - \alpha(u, s)) \] Thus, the MAP estimate $\hat{\theta}$ is given by \[ \hat{\theta} = \Big\{ \frac{n(u, s) + \alpha(u, s) - 1}{n(u) + \alpha(u) - |\mathcal{A}|}, s \in \mathcal{A}, u \in \mathcal{A} \Big\} \] The function also returns the expected value, given by \[ \text{E}_{\text{post}} p(s|u) = \Big\{ \frac{n(u, s) + \alpha(u, s)}{n(u) + \alpha(u)}, s \in \mathcal{A}, u \in \mathcal{A} \Big\} \] The variance is given by \[ \text{Var}_{\text{post}} p(s|u) = \frac{n(u, s) + \alpha(u, s)}{(n(u) + \alpha(u))^2} \frac{n(u) + \alpha(u) - n(u, s) - \alpha(u, s)}{n(u) + \alpha(u) + 1} \] The square root of this quantity is the standard error, which is returned by the function. The confidence intervals are constructed by computing the inverse of the beta integral. ### Predictive distribution Given the old data set, the probability of observing new data is $P(D'|D)$ where $D'$ is the new data set. Let $m(u, s), m(u)$ denote the corresponding counts for the new data. Then, \[ P(D'|D) = \int P(D' | \theta) P(\theta | D) d\theta \] We already know the expressions for both quantities in the integral and it turns out to be similar to evaluating the evidence \[ P(D'|D) = \prod_{u \in \mathcal{A}} \Big\{ \frac{\Gamma(\alpha(u))}{\prod_{s \in \mathcal{A}} \Gamma(\alpha(u, s))} \frac{\prod_{s \in \mathcal{A}} \Gamma(n(u, s) + m(u, s) + \alpha(u, s))}{\Gamma(\alpha(u) + n(u) + m(u))} \Big\} \] ### Choosing the hyper-parameters The hyper parameters model the shape of the parameters' prior distribution. These must be provided by the user. The package offers functionality to translate a given prior belief transition matrix into the hyper-parameter matrix. It is assumed that this belief matrix corresponds to the mean value of the parameters. Since the relation \[ \text{E}_{\text{prior}} p(s | u) = \frac{\alpha(u, s)}{\alpha(u)} \] holds, the function accepts as input the belief matrix as well as a scaling vector (serves as a proxy for $\alpha(.)$) and proceeds to compute $\alpha(., .)$. Alternatively, the function accepts a data sample and infers the hyper-parameters from it. Since the mode of a parameter (with respect to the prior distribution) is proportional to one less than the corresponding hyper-parameter, we set \[ \alpha(u, s) - 1 = m(u, s) \] where $m(u, s)$ is the $u\rightarrow s$ transition count in the data sample. This is regarded as a 'fake count' which helps $\alpha(u, s)$ to reflect knowledge of the data sample. ### Usage and examples ```{r loadAndDoExample} weatherStates <- c("sunny", "cloudy", "rain") byRow <- TRUE weatherMatrix <- matrix(data = c(0.7, 0.2, 0.1, 0.3, 0.4, 0.3, 0.2, 0.4, 0.4), byrow = byRow, nrow = 3, dimnames = list(weatherStates, weatherStates)) mcWeather <- new("markovchain", states = weatherStates, byrow = byRow, transitionMatrix = weatherMatrix, name = "Weather") weathersOfDays <- rmarkovchain(n = 365, object = mcWeather, t0 = "sunny") ``` For the purpose of this section, we shall continue to use the weather of days example introduced in the main vignette of the package (reproduced above for convenience). Let us invoke the fit function to estimate the MAP parameters with 92\% confidence bounds and hyper-parameters as shown below, based on the first 200 days of the weather data. Additionally, let us find out what the probability is of observing the weather data for the next 165 days. The usage would be as follows ```{r MAPFit} hyperMatrix<-matrix(c(1, 1, 2, 3, 2, 1, 2, 2, 3), nrow = 3, byrow = TRUE, dimnames = list(weatherStates,weatherStates)) markovchainFit(weathersOfDays[1:200], method = "map", confidencelevel = 0.92, hyperparam = hyperMatrix) predictiveDistribution(weathersOfDays[1:200], weathersOfDays[201:365],hyperparam = hyperMatrix) ``` The results should not change after permuting the dimensions of the matrix. ```{r MAPFit2} hyperMatrix2<- hyperMatrix[c(2,3,1), c(2,3,1)] markovchainFit(weathersOfDays[1:200], method = "map", confidencelevel = 0.92, hyperparam = hyperMatrix2) predictiveDistribution(weathersOfDays[1:200], weathersOfDays[201:365],hyperparam = hyperMatrix2) ``` Note that the predictive probability is very small. However, this can be useful when comparing model orders. Suppose we have an idea of the (prior) transition matrix corresponding to the expected value of the parameters, and have a data set from which we want to deduce the MAP estimates. We can infer the hyper-parameters from this known transition matrix itself, and use this to obtain our MAP estimates. ```{r inferHyperparam} inferHyperparam(transMatr = weatherMatrix, scale = c(10, 10, 10)) ``` Alternatively, we can use a data sample to infer the hyper-parameters. ```{r inferHyperparam2} inferHyperparam(data = weathersOfDays[1:15]) ``` In order to use the inferred hyper-parameter matrices, we do ```{r inferHyperparam3} hyperMatrix3 <- inferHyperparam(transMatr = weatherMatrix, scale = c(10, 10, 10)) hyperMatrix3 <- hyperMatrix3$scaledInference hyperMatrix4 <- inferHyperparam(data = weathersOfDays[1:15]) hyperMatrix4 <- hyperMatrix4$dataInference ``` Now we can safely use `hyperMatrix3` and `hyperMatrix4` with `markovchainFit` (in the `hyperparam` argument). Supposing we don't provide any hyper-parameters, then the prior is uniform. This is the same as maximum likelihood. ```{r MAPandMLE} data(preproglucacon) preproglucacon <- preproglucacon[[2]] MLEest <- markovchainFit(preproglucacon, method = "mle") MAPest <- markovchainFit(preproglucacon, method = "map") MLEest$estimate MAPest$estimate ``` # Applications {#sec:applications} This section shows applications of DTMC in various fields. ## Weather forecasting {#app:weather} Markov chains provide a simple model to predict the next day's weather given the current meteorological condition. The first application herewith shown is the "Land of Oz example" from \cite{landOfOz}, the second is the "Alofi Island Rainfall" from \cite{averyHenderson}. ### Land of Oz {#sec:wfLandOfOz} The Land of Oz is acknowledged not to have ideal weather conditions at all: the weather is snowy or rainy very often and, once more, there are never two nice days in a row. Consider three weather states: rainy, nice and snowy. Let the transition matrix be as in the following: ```{r weatPred1} mcWP <- new("markovchain", states = c("rainy", "nice", "snowy"), transitionMatrix = matrix(c(0.5, 0.25, 0.25, 0.5, 0, 0.5, 0.25,0.25,0.5), byrow = T, nrow = 3)) ``` Given that today it is a nice day, the corresponding stochastic row vector is $w_{0}=(0\:,1\:,0)$ and the forecast after 1, 2 and 3 days are given by ```{r weatPred2} W0 <- t(as.matrix(c(0, 1, 0))) W1 <- W0 * mcWP; W1 W2 <- W0 * (mcWP ^ 2); W2 W3 <- W0 * (mcWP ^ 3); W3 ``` As can be seen from $w_{1}$, if in the Land of Oz today is a nice day, tomorrow it will rain or snow with probability 1. One week later, the prediction can be computed as ```{r weatPred3} W7 <- W0 * (mcWP ^ 7) W7 ``` The steady state of the chain can be computed by means of the `steadyStates` method. ```{r weatPred4} q <- steadyStates(mcWP) q ``` Note that, from the seventh day on, the predicted probabilities are substantially equal to the steady state of the chain and they don't depend from the starting point, as the following code shows. ```{r weatPred5} R0 <- t(as.matrix(c(1, 0, 0))) R7 <- R0 * (mcWP ^ 7); R7 S0 <- t(as.matrix(c(0, 0, 1))) S7 <- S0 * (mcWP ^ 7); S7 ``` ### Alofi Island Rainfall {#sec:wfAlofi} Alofi Island daily rainfall data were recorded from January 1st, 1987 until December 31st, 1989 and classified into three states: "0" (no rain), "1-5" (from non zero until 5 mm) and "6+" (more than 5mm). The corresponding dataset is provided within the \pkg{markovchain} package. ```{r Alofi1} data("rain", package = "markovchain") table(rain$rain) ``` The underlying transition matrix is estimated as follows. ```{r Alofi2} mcAlofi <- markovchainFit(data = rain$rain, name = "Alofi MC")$estimate mcAlofi ``` The long term daily rainfall distribution is obtained by means of the `steadyStates` method. ```{r Alofi3} steadyStates(mcAlofi) ``` ## Finance and Economics {#app:fin} Other relevant applications of DTMC can be found in Finance and Economics. ### Finance {#fin:fin} Credit ratings transitions have been successfully modeled with discrete time Markov chains. Some rating agencies publish transition matrices that show the empirical transition probabilities across credit ratings. The example that follows comes from \pkg{CreditMetrics} \proglang{R} package \citep{CreditMetricsR}, carrying Standard \& Poor's published data. ```{r ratings1} rc <- c("AAA", "AA", "A", "BBB", "BB", "B", "CCC", "D") creditMatrix <- matrix( c(90.81, 8.33, 0.68, 0.06, 0.08, 0.02, 0.01, 0.01, 0.70, 90.65, 7.79, 0.64, 0.06, 0.13, 0.02, 0.01, 0.09, 2.27, 91.05, 5.52, 0.74, 0.26, 0.01, 0.06, 0.02, 0.33, 5.95, 85.93, 5.30, 1.17, 1.12, 0.18, 0.03, 0.14, 0.67, 7.73, 80.53, 8.84, 1.00, 1.06, 0.01, 0.11, 0.24, 0.43, 6.48, 83.46, 4.07, 5.20, 0.21, 0, 0.22, 1.30, 2.38, 11.24, 64.86, 19.79, 0, 0, 0, 0, 0, 0, 0, 100 )/100, 8, 8, dimnames = list(rc, rc), byrow = TRUE) ``` It is easy to convert such matrices into `markovchain` objects and to perform some analyses ```{r ratings2} creditMc <- new("markovchain", transitionMatrix = creditMatrix, name = "S&P Matrix") absorbingStates(creditMc) ``` ### Economics {#fin:ec} For a recent application of \pkg{markovchain} in Economic, see \cite{manchesterR}. A dynamic system generates two kinds of economic effects \citep{bardPpt}: 1. those incurred when the system is in a specified state, and 2. those incurred when the system makes a transition from one state to another. Let the monetary amount of being in a particular state be represented as a m-dimensional column vector $c^{\rm{S}}$, while let the monetary amount of a transition be embodied in a $C^{R}$ matrix in which each component specifies the monetary amount of going from state i to state j in a single step. Henceforth, Equation \@ref(eq:cost) represents the monetary of being in state $i$. \begin{equation} {c_i} = c_i^{\rm{S}} + \sum\limits_{j = 1}^m {C_{ij}^{\rm{R}}} {p_{ij}}. \label{eq:cost} \end{equation} Let $\bar c = \left[ c_i \right]$ and let $e_i$ be the vector valued 1 in the initial state and 0 in all other, then, if $f_n$ is the random variable representing the economic return associated with the stochastic process at time $n$, Equation \@ref(eq:return) holds: \begin{equation} E\left[ {{f_n}\left( {{X_n}} \right)|{X_0} = i} \right] = {e_i}{P^n}\bar c. \label{eq:return} \end{equation} The following example assumes that a telephone company models the transition probabilities between customer/non-customer status by matrix $P$ and the cost associated to states by matrix $M$. ```{r economicAnalysis1} statesNames <- c("customer", "non customer") P <- markovchain:::zeros(2); P[1, 1] <- .9; P[1, 2] <- .1; P[2, 2] <- .95; P[2, 1] <- .05; rownames(P) <- statesNames; colnames(P) <- statesNames mcP <- new("markovchain", transitionMatrix = P, name = "Telephone company") M <- markovchain:::zeros(2); M[1, 1] <- -20; M[1, 2] <- -30; M[2, 1] <- -40; M[2, 2] <- 0 ``` If the average revenue for existing customer is +100, the cost per state is computed as follows. ```{r economicAnalysis2} c1 <- 100 + conditionalDistribution(mcP, state = "customer") %*% M[1,] c2 <- 0 + conditionalDistribution(mcP, state = "non customer") %*% M[2,] ``` For an existing customer, the expected gain (loss) at the fifth year is given by the following code. ```{r economicAnalysis3} as.numeric((c(1, 0)* mcP ^ 5) %*% (as.vector(c(c1, c2)))) ``` ## Actuarial science {#app:act} Markov chains are widely applied in the field of actuarial science. Two classical applications are policyholders' distribution across Bonus Malus classes in Motor Third Party Liability (MTPL) insurance (Section \@ref(sec:bm)) and health insurance pricing and reserving (Section \@ref(sec:hi)). ### MPTL Bonus Malus {#sec:bm} Bonus Malus (BM) contracts grant the policyholder a discount (enworsen) as a function of the number of claims in the experience period. The discount (enworsen) is applied on a premium that already allows for known (a priori) policyholder characteristics \citep{denuit2007actuarial} and it usually depends on vehicle, territory, the demographic profile of the policyholder, and policy coverage deep (deductible and policy limits).\\ Since the proposed BM level depends on the claim on the previous period, it can be modeled by a discrete Markov chain. A very simplified example follows. Assume a BM scale from 1 to 5, where 4 is the starting level. The evolution rules are shown in Equation \ref{eq:BM}: \begin{equation} bm_{t + 1} = \max \left( {1,bm_{t} - 1} \right)*\left( {\tilde N = 0} \right) + \min \left( {5,bm_{t} + 2*\tilde N} \right)*\left( {\tilde N \ge 1} \right). \label{eq:BM} \end{equation} The number of claim $\tilde N$ is a random variable that is assumed to be Poisson distributed. ```{r bonusMalus1} getBonusMalusMarkovChain <- function(lambda) { bmMatr <- markovchain:::zeros(5) bmMatr[1, 1] <- dpois(x = 0, lambda) bmMatr[1, 3] <- dpois(x = 1, lambda) bmMatr[1, 5] <- 1 - ppois(q = 1, lambda) bmMatr[2, 1] <- dpois(x = 0, lambda) bmMatr[2, 4] <- dpois(x = 1, lambda) bmMatr[2, 5] <- 1 - ppois(q = 1, lambda) bmMatr[3, 2] <- dpois(x = 0, lambda) bmMatr[3, 5] <- 1 - dpois(x=0, lambda) bmMatr[4, 3] <- dpois(x = 0, lambda) bmMatr[4, 5] <- 1 - dpois(x = 0, lambda) bmMatr[5, 4] <- dpois(x = 0, lambda) bmMatr[5, 5] <- 1 - dpois(x = 0, lambda) stateNames <- as.character(1:5) out <- new("markovchain", transitionMatrix = bmMatr, states = stateNames, name = "BM Matrix") return(out) } ``` Assuming that the a-priori claim frequency per car-year is 0.05 in the class (being the class the group of policyholders that share the same common characteristics), the underlying BM transition matrix and its underlying steady state are as follows. ```{r bonusMalus2} bmMc <- getBonusMalusMarkovChain(0.05) as.numeric(steadyStates(bmMc)) ``` If the underlying BM coefficients of the class are 0.5, 0.7, 0.9, 1.0, 1.25, this means that the average BM coefficient applied on the long run to the class is given by ```{r bonusMalus3} sum(as.numeric(steadyStates(bmMc)) * c(0.5, 0.7, 0.9, 1, 1.25)) ``` This means that the average premium paid by policyholders in the portfolio almost halves in the long run. ### Health insurance example {#sec:hi} Actuaries quantify the risk inherent in insurance contracts evaluating the premium of insurance contract to be sold (therefore covering future risk) and evaluating the actuarial reserves of existing portfolios (the liabilities in terms of benefits or claims payments due to policyholder arising from previously sold contracts), see \cite{deshmukh2012multiple} for details. An applied example can be performed using the data from \cite{de2016assicurazioni} that has been saved in the `exdata` folder. ```{r healthIns6} ltcDemoPath<-system.file("extdata", "ltdItaData.txt", package = "markovchain") ltcDemo<-read.table(file = ltcDemoPath, header=TRUE, sep = ";", dec = ".") head(ltcDemo) ``` The data shows the probability of transition between the state of (A)ctive, to (I)ll and Dead. It is easy to complete the transition matrix. ```{r healthIns7} ltcDemo<-transform(ltcDemo, pIA=0, pII=1-pID, pDD=1, pDA=0, pDI=0) ``` Now we build a function that returns the transition during the $t+1$ th year, assuming that the subject has attained year $t$. ```{r healthIns8} possibleStates<-c("A","I","D") getMc4Age<-function(age) { transitionsAtAge<-ltcDemo[ltcDemo$age==age,] myTransMatr<-matrix(0, nrow=3,ncol = 3, dimnames = list(possibleStates, possibleStates)) myTransMatr[1,1]<-transitionsAtAge$pAA[1] myTransMatr[1,2]<-transitionsAtAge$pAI[1] myTransMatr[1,3]<-transitionsAtAge$pAD[1] myTransMatr[2,2]<-transitionsAtAge$pII[1] myTransMatr[2,3]<-transitionsAtAge$pID[1] myTransMatr[3,3]<-1 myMc<-new("markovchain", transitionMatrix = myTransMatr, states = possibleStates, name = paste("Age",age,"transition matrix")) return(myMc) } ``` Cause transitions are not homogeneous across ages, we use a `markovchainList` object to describe the transition probabilities for a guy starting at age 100. ```{r healthIns8-prob} getFullTransitionTable<-function(age){ ageSequence<-seq(from=age, to=120) k=1 myList=list() for ( i in ageSequence) { mc_age_i<-getMc4Age(age = i) myList[[k]]<-mc_age_i k=k+1 } myMarkovChainList<-new("markovchainList", markovchains = myList, name = paste("TransitionsSinceAge", age, sep = "")) return(myMarkovChainList) } transitionsSince100<-getFullTransitionTable(age=100) ``` We can use such transition for simulating ten life trajectories for a guy that begins "active" (A) aged 100: ```{r healthIns9} rmarkovchain(n = 10, object = transitionsSince100, what = "matrix", t0 = "A", include.t0 = TRUE) ``` Lets consider 1000 simulated live trajectories, for a healthy guy aged 80. We can compute the expected time a guy will be disabled starting active at age 80. ```{r healthIns10} transitionsSince80<-getFullTransitionTable(age=80) lifeTrajectories<-rmarkovchain(n=1e3, object=transitionsSince80, what="matrix",t0="A",include.t0=TRUE) temp<-matrix(0,nrow=nrow(lifeTrajectories),ncol = ncol(lifeTrajectories)) temp[lifeTrajectories=="I"]<-1 expected_period_disabled<-mean(rowSums((temp))) expected_period_disabled ``` Assuming that the health insurance will pay a benefit of 12000 per year disabled and that the real interest rate is 0.02, we can compute the lump sum premium at 80. ```{r healthIns11} mean(rowMeans(12000*temp%*%( matrix((1+0.02)^-seq(from=0, to=ncol(temp)-1))))) ``` ## Sociology {#app:sociology} Markov chains have been actively used to model progressions and regressions between social classes. The first study was performed by \cite{glassHall}, while a more recent application can be found in \cite{blandenEtAlii}. The table that follows shows the income quartile of the father when the son was 16 (in 1984) and the income quartile of the son when aged 30 (in 2000) for the 1970 cohort. ```{r blandenEtAlii} data("blanden") mobilityMc <- as(blanden, "markovchain") mobilityMc ``` The underlying transition graph is plotted in Figure \@ref(fig:mobility). ```{r mobility, fig=TRUE, echo=FALSE, fig.align='center', fig.cap="1970 UK cohort mobility data."} plot(mobilityMc, main = '1970 mobility',vertex.label.cex = 2, layout = layout.fruchterman.reingold) ``` The steady state distribution is computed as follows. Since transition across quartiles are shown, the probability function is evenly 0.25. ```{r blandenEtAlii3} round(steadyStates(mobilityMc), 2) ``` ## Genetics and Medicine {#sec:gen} This section contains two examples: the first shows the use of Markov chain models in genetics, the second shows an application of Markov chains in modelling diseases' dynamics. ### Genetics {#sec:genetics} \cite{averyHenderson} discusses the use of Markov chains in model Preprogucacon gene protein bases sequence. The `preproglucacon` dataset in \pkg{markovchain} contains the dataset shown in the package. ```{r preproglucacon1} data("preproglucacon", package = "markovchain") ``` It is possible to model the transition probabilities between bases as shown in the following code. ```{r preproglucacon2} mcProtein <- markovchainFit(preproglucacon$preproglucacon, name = "Preproglucacon MC")$estimate mcProtein ``` ### Medicine {#sec:medicine} Discrete-time Markov chains are also employed to study the progression of chronic diseases. The following example is taken from \cite{craigSendi}. Starting from six month follow-up data, the maximum likelihood estimation of the monthly transition matrix is obtained. This transition matrix aims to describe the monthly progression of CD4-cell counts of HIV infected subjects. ```{r epid1} craigSendiMatr <- matrix(c(682, 33, 25, 154, 64, 47, 19, 19, 43), byrow = T, nrow = 3) hivStates <- c("0-49", "50-74", "75-UP") rownames(craigSendiMatr) <- hivStates colnames(craigSendiMatr) <- hivStates craigSendiTable <- as.table(craigSendiMatr) mcM6 <- as(craigSendiTable, "markovchain") mcM6@name <- "Zero-Six month CD4 cells transition" mcM6 ``` As shown in the paper, the second passage consists in the decomposition of $M_{6}=V \cdot D \cdot V^{-1}$ in order to obtain $M_{1}$ as $M_{1}=V \cdot D^{1/6} \cdot V^{-1}$ . ```{r epid2} eig <- eigen(mcM6@transitionMatrix) D <- diag(eig$values) ``` ```{r epid3} V <- eig$vectors V %*% D %*% solve(V) d <- D ^ (1/6) M <- V %*% d %*% solve(V) mcM1 <- new("markovchain", transitionMatrix = M, states = hivStates) ``` # Discussion, issues and future plans The \pkg{markovchain} package has been designed in order to provide easily handling of DTMC and communication with alternative packages. The package has known several improvements in the recent years: many functions added, porting the software in Rcpp \pkg{Rcpp} package \citep{RcppR} and many methodological improvements that have improved the software reliability. # Acknowledgments {#sec:aknowledgements} The package was selected for Google Summer of Code 2015 support. The authors wish to thank Michael Cole, Tobi Gutman and Mildenberger Thoralf for their suggestions and bug checks. A final thanks also to Dr. Simona C. Minotti and Dr. Mirko Signorelli for their support in drafting this version of the vignettes. \clearpage # References # markovchain/data/0000755000176200001440000000000014714756745013511 5ustar liggesusersmarkovchain/data/rain.rda0000644000176200001440000000131314715232627015115 0ustar liggesusersBZh91AY&SY!2H s@@/'@@ x#Ddd4d0CLF ?JOR4  hdёV;LmwVv;VJY3c67e!Tn7iq;i;[;ZlnN;-v4j% .5`cvLiI1$&L`# R iT\T946 &GXjjI8.˪b%#2jXı֎KE*̷ǟӻ^,ՙM!j,sZƘԉxx0;ө%J1QLU1Eyi͝9ePT_!V Ȁ)wv1]:Y2m']ƒ6`jfv666v;,v63c6v)Cu.4ɕN,c8iծMvvC݌81VecUTZVe5XA&b֓RYYicJɨ4iƴZ*75GN!죰Ixw.:tM+U88bZt嚎rśBFZ*,$SZѭ5Ieii$ml c Pt*UEIUlQTK](~s?q*I!S(8*vXCND2#)„\Amarkovchain/data/tm_abs.rda0000644000176200001440000000036714715232627015441 0ustar liggesusers r0b```b`aab`b24# 'f+ɍOL**A` 8A%͇ ('B0;Bwo {tqBki?9P;//~ct(9%3H2(*KM&!a::P&c0;99d,F8p@"97(markovchain/data/preproglucacon.rda0000644000176200001440000000211414715232627017207 0ustar liggesusersBZh91AY&SYǕu'!3H0,@/ހ@!B$1PhHɦ&OTbd Fƚ 2h 414`U*d i&CFP #@П YgAwxͱa̖THDx@Gg&*&7h܆`@)f2N. 5ʆ`PFuj-!cy!%KKiʈ-=2(RHFdEYyfgEXSjȍJ*[+$*O ,hƑEN3 )MCd+itqIruMM(E֍p@s1ijٵ5\3ƫEZ *p:0Cd1dYnƔyEU6¼Mp8cX ,E,XZLQ0ѓvu~_Vݰ'hP,srf"}SVYFP,5 bÝ՝fC[<`le Lt$eVi!yۉP%klYX*R@O %kIjEnWSWFFMhAq{T9gh u)lheJ+D"# ei1;atkq@)f2N. 5ʆ`PFuj-!acF@ XZzeyPQ.g$ȊL"<՛/*[+$*|lMlN3 )MCd+itqIruMM(E֍p@s1ijٵ5\3ƫEL&Q{FE͉DLJȕ6nƔyEU15tPM4ic47dYLsq`yi1DFNBΔ P 0*( ,PP B (g+T@Y B@C_ = \.N2Q90ןWjJoFoH 򳎠markovchain/data/blanden.rda0000644000176200001440000000034214715232627015570 0ustar liggesusers r0b```b`aab`b24# 'fOIKIc``rond O=t_'RHQm?F~ eo/,e[!a3 M8\Լ=Pys;߂؃<\ PQp%Pu`uy6\Fy)0q_@6װ&$C͂ $&@ƞmarkovchain/data/sales.rda0000644000176200001440000000101014715232627015265 0ustar liggesusersBZh91AY&SYIrH?>@&'Pldhh1Fe$b4a`D@4BUT !Ɋ^1~PD4JhO Irs&VWBdeF /hT9(J|zYesW*duH$ ȹi,(  Kps!}0.U:\,"po:G"(H, $.GR!{,<ݻ}金99!ȝ[ŸdR#B(<9!w* dTTGSDQN*(%O0K EܪND<օsZUr^#'d=Nʨq7"S\ $@*,OV\{' \ ;5ȂO NHi/-$DHF)AKTQ@@ i;fqi 2#_]BB?$markovchain/data/holson.rda0000644000176200001440000000671114715232627015475 0ustar liggesusersBZh91AY&SYTo6wLDUU@@@@@@@@@@@@A`wPPU)I@RT>0x@B=t*JiC#ML'T~?ޢjU T`PU'~FT4`@U?T@4h`0FLF $U*  #Ld&F&CFyT4*PQ#A 2@h 4MUE&P~4ih=S&&LM0&FA' dI$I$I$I$I$}nmmmmmmmmmmmmm/7q]<^3㾠UU[3r=?%~')r~_?|.׶uۯknZcɭ3mflZ5$ ڔ$V̢Fٲmdш2ZUB(I,dPLűj6Y4+"Rh5&ضJMJfYfe5 S-lQXJ`i6ڱlVűbmJ"IVPB5cQMmlbi3 clk1L e #FRe2,V66EF(1f,eY)15Lhd3H%&,mhřhԛF #Y4ŴFkcf2d[Dm6( 4hբFk hF6 TE6Thf"kIi ̖Q ["K#ěS6Jllbm#Pȓ-I6Mdҥfel 2Hղ$*+YRLmT&Z idTZl֌EZѤFŖY2Pj2XS[,IB5j5YFf)ٖ6ZPkh֍% m`C"-E*a6+)ckjL6S)5 Je!4P")XZS-Me4&dҔTѴb,#YI&*6hb55 Tj!jMII3Y%)A*cMMiMYŭ,&XbIQbFXTY bJmEmf1Z-&5#QIFeb5C5d -Z+l%Ic[&ԔI2IZB&3FYlHeP[kD!JIZfبeEZ6IMfm@ȓ6X 5ii2k2ֈ›b2-,l[MF5Jѥ٘ImKVɢAJffSLZ1&5[Lfbe6f&lR&&K,jS5+ BF!n3vw\Z\wWw-_SqpW/s/OuݞobɍyV>O{+d 2=n}[c3at}wB}l m~/Bfٛ6g3v>)nk,m33qͷkZֵkZֵUTUZ^B/YUdDM"""""#1c1c6eR)JR)JJmĶmmB!B {{s9s9mn}kZֵַkZֵkZֵbŋ/ةUYJR)JR+[U`bUXF5+Y,š,VJMTVlhj"6e2ۂ*,bi"kBlJEYab hU l*`kbŋQX"E lj6Ѵm)( XPiIZJQŴJ4XZIh21a6A5L# Y,5emj[#XaF U!hɣlͦbE@djHқTlUm&-&ƬmAi5&,cFTmd+Fƴ&KjM-FԆѢ55hlhZlXԖ"Jh%"`Qh( *5Ɠ`ѴXȲKQ&Mj65V̨ 56UcAUEcX-&iDHe6ͳ5&Tcb-%5m5&lj6!a@ZX IHU,lIL6b5E$QlX4£֐ѨDRbشYF6Q QZ4BĒhfmFƌmCZ*fUE`2hփLI[4bƈhhՊ[&-bl0Clj4b#jm6`Ɍmj55%&5iUDETcIƭV(bBQEѭD" 2mDcTQ \3bɘœj6MZ6ѵ%QA@&̚RƍHXV4°ecl4A3X%0EQZ%LE!MBmŰdIVaaɆaN3Ӝ9s9s9x84)JR)JS /ĄaEQ[ړi,j6ȐRFFƠԛAh*D•3J4&6,Pƀ[ jR,SJlhƋl&6ʼn-FѪMZAj[H ,EE%"`k5cFeRVF &  ѱ2)ljJXEEP526MAPYآh!hiS LH)Fn $* œdQ`4LŴlc`XآƱI1D3"IAhmKb66ѢSl&ɤڄE!lRj 5fA`FAiUaclZ-cDʋS+de6IQAcQQh 5$cIbM(mQhڅ ƭw`1c1c((((((((((( ( ( ( v@@@@@@@BB뮺뮺뮺봈f͛6lmm$I$Ikۃ׽9s9>%UUTc1c1!B!BYeYeYgΝWX~DmşRIN s9sib"RTDz"a TF_!;w"kt};ZֵkZ뮺뮺뮺5UTr~&v>nuͶ]6}[78pÇr˗RDDD[ qDž888* Lvy]uE]u]u]u)JR)JRZ1c1ckI$I$I$f͛6lfffffff9s9s3333333ZֵkZֵkZֵkZֵfffffffg)JR)JRfffuUUTUUUUUUU^uy$I$I$I$|V{c1c=;H  @markovchain/data/craigsendi.rda0000644000176200001440000000025714715232627016302 0ustar liggesusers r0b```b`aab`b24# 'J.JL/NKd``p:0C6f :UJC]!4M)@ Qp%Pu`uy]K(@17 U5ݬ9P#%I9@?) QNmarkovchain/data/kullback.rda0000644000176200001440000000040614715232627015756 0ustar liggesusers͑Mn0'N$SZ T@]VpVl %zgzY;67dXPDxBbqē}:dзOT @C'ܷ_􎨿@=xg"[ #>vvE{5Xޓ"=&gΝĊ+VV.֭45 簏Doػ01x̝}bG37U][Iy~+imarkovchain/src/0000755000176200001440000000000014715232626013353 5ustar liggesusersmarkovchain/src/helpers.h0000644000176200001440000001676114714756746015216 0ustar liggesusers#ifndef HELPERS_H #define HELPERS_H // [[Rcpp::depends(RcppArmadillo)]] #include #include #include using namespace Rcpp; using namespace std; template T sortByDimNames(const T mat){ CharacterVector colNames = colnames(mat); CharacterVector rowNames = rownames(mat); int n = colNames.size(); CharacterVector sortedNames(n); copy(rowNames.begin(), rowNames.end(), sortedNames.begin()); sortedNames.sort(); NumericVector colIdx(n); NumericVector rowIdx(n); for (int i = 0; i < n; i++) { for (int j = 0; j < n; j++) { if (colNames(j) == sortedNames(i)) colIdx(i) = j; if (rowNames(j) == sortedNames(i)) rowIdx(i) = j; } } T sortedMatrix(n); sortedMatrix.attr("dimnames") = List::create(sortedNames, sortedNames); for (int i = 0; i < n; i++) for (int j = 0; j < n; j++) sortedMatrix(i, j) = mat(rowIdx(i), colIdx(j)); return sortedMatrix; } double lbeta(double p, double q){ return lgamma(p) + lgamma(q) - lgamma(p + q); } template T transposeMatrix(T & mat) { int numRows = mat.nrow(); int numCols = mat.ncol(); T transpose(numCols, numRows); // Assign dim names transposed (rows to cols and viceversa) transpose.attr("dimnames") = List::create(colnames(mat), rownames(mat)); for (int i = 0; i < numCols; ++i) { transpose(i, _) = mat(_, i); } return transpose; } /* Purpose: BETAIN computes the incomplete Beta function ratio. Licensing: This code is distributed under the GNU LGPL license. Modified: 25 September 2014 Author: Original FORTRAN77 version by KL Majumder, GP Bhattacharjee. C++ version by John Burkardt. Reference: KL Majumder, GP Bhattacharjee, Algorithm AS 63: The incomplete Beta Integral, Applied Statistics, Volume 22, Number 3, 1973, pages 409-411. Parameters: Input, double X, the argument, between 0 and 1. Input, double P, Q, the parameters, which must be positive. Input, double BETA, the logarithm of the complete beta function. Output, int &IFAULT, error flag. 0, no error. nonzero, an error occurred. Output, double BETAIN, the value of the incomplete Beta function ratio. */ double betain(double x, double p, double q, double beta) { double acu = 0.1E-14; double ai; double cx; bool indx; int ns; double pp; double psq; double qq; double rx; double temp; double term; double value; double xx; value = x; // Special cases. if (x == 0.0 || x == 1.0) { return value; } // Change tail if necessary and determine S. psq = p + q; cx = 1.0 - x; if (p < psq * x){ xx = cx; cx = x; pp = q; qq = p; indx = true; } else { xx = x; pp = p; qq = q; indx = false; } term = 1.0; ai = 1.0; value = 1.0; ns = (int) (qq + cx * psq); // Use the Soper reduction formula. rx = xx / cx; temp = qq - ai; if (ns == 0) { rx = xx; } bool loop = true; while (loop) { term = term * temp * rx / (pp + ai); value = value + term;; temp = fabs(term); if (temp <= acu && temp <= acu * value) { value = value * exp (pp * log(xx) + (qq - 1.0) * log(cx) - beta) / pp; if (indx) value = 1.0 - value; loop = false; } ai = ai + 1.0; ns = ns - 1; if (0 <= ns) { temp = qq - ai; if (ns == 0) rx = xx; } else { temp = psq; psq = psq + 1.0; } } return value; } /* Purpose: XINBTA computes inverse of the incomplete Beta function. Discussion: The accuracy exponent SAE was loosened from -37 to -30, because the code would not otherwise accept the results of an iteration with p = 0.3, q = 3.0, alpha = 0.2. Licensing: This code is distributed under the GNU LGPL license. Modified: 25 September 2014 Author: Original FORTRAN77 version by GW Cran, KJ Martin, GE Thomas. C++ version by John Burkardt. Reference: GW Cran, KJ Martin, GE Thomas, Remark AS R19 and Algorithm AS 109: A Remark on Algorithms AS 63: The Incomplete Beta Integral and AS 64: Inverse of the Incomplete Beta Integeral, Applied Statistics, Volume 26, Number 1, 1977, pages 111-114. Parameters: Input, double P, Q, the parameters of the incomplete Beta function. Input, double BETA, the logarithm of the value of the complete Beta function. Input, double ALPHA, the value of the incomplete Beta function. 0 <= ALPHA <= 1. Output, int &IFAULT, error flag. 0, no error occurred. nonzero, an error occurred. Output, double XINBTA, the argument of the incomplete Beta function which produces the value ALPHA. Local Parameters: Local, double SAE, requests an accuracy of about 10^SAE. */ double xinbta ( double p, double q, double beta, double alpha ) { double a; double acu; double adj; double fpu; double g; double h; int iex; bool indx; double pp; double prev; double qq; double r; double s; double sae = -30.0; double sq; double t; double tx; double value; double w; double xin; double y; double yprev; fpu = pow(10.0, sae); value = alpha; // If the answer is easy to determine, return immediately. if (alpha == 0.0 || alpha == 1) return alpha; // Change tail if necessary. if (0.5 < alpha) { a = 1.0 - alpha; pp = q; qq = p; indx = true; } else { a = alpha; pp = p; qq = q; indx = false; } // Calculate the initial approximation. r = sqrt(- log (a * a)); y = r - (2.30753 + 0.27061 * r) / (1.0 + ( 0.99229 + 0.04481 * r) * r); if (1.0 < pp && 1.0 < qq) { r = (y * y - 3.0) / 6.0; s = 1.0 / (pp + pp - 1.0); t = 1.0 / (qq + qq - 1.0); h = 2.0 / (s + t); w = y * sqrt(h + r) / h - (t - s) * (r + 5.0 / 6.0 - 2.0 / (3.0 * h)); value = pp / (pp + qq * exp(w + w)); } else { r = qq + qq; t = 1.0 / (9.0 * qq); t = r * pow(1.0 - t + y * sqrt ( t ), 3); if (t <= 0.0) { value = 1.0 - exp( (log((1.0 - a) * qq) + beta) / qq ); } else { t = (4.0 * pp + r - 2.0) / t; if (t <= 1.0) value = exp( (log(a * pp) + beta) / pp ); else value = 1.0 - 2.0 / (t + 1.0); } } // Solve for X by a modified Newton-Raphson method, // using the function BETAIN. r = 1.0 - pp; t = 1.0 - qq; yprev = 0.0; sq = 1.0; prev = 1.0; if (value < 0.0001) value = 0.0001; if (0.9999 < value) value = 0.9999; iex = max(- 5.0 / pp / pp - 1.0 / pow (a, 0.2) - 13.0, sae); acu = pow(10.0, iex); // Iteration loop. for ( ; ; ) { y = betain(value, pp, qq, beta); xin = value; y = (y - a) * exp(beta + r * log (xin) + t * log (1.0 - xin)); if (y * yprev <= 0.0) prev = max(sq, fpu); g = 1.0; for ( ; ; ) { for ( ; ; ) { adj = g * y; sq = adj * adj; if (sq < prev) { tx = value - adj; if (0.0 <= tx && tx <= 1.0) break; } g = g / 3.0; } // Check whether the current estimate is acceptable. // The change "VALUE = TX" was suggested by Ivan Ukhov. if (prev <= acu || y * y <= acu) { value = tx; if (indx) value = 1.0 - value; return value; } if (tx != 0.0 && tx != 1.0) break; g = g / 3.0; } if (tx == value) break; value = tx; yprev = y; } if(indx) value = 1.0 - value; return value; } #endif markovchain/src/RcppExports.cpp0000644000176200001440000010676314714756776016405 0ustar liggesusers// Generated by using Rcpp::compileAttributes() -> do not edit by hand // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #include #include using namespace Rcpp; #ifdef RCPP_USE_GLOBAL_ROSTREAM Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); #endif // isGen bool isGen(NumericMatrix gen); RcppExport SEXP _markovchain_isGen(SEXP genSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericMatrix >::type gen(genSEXP); rcpp_result_gen = Rcpp::wrap(isGen(gen)); return rcpp_result_gen; END_RCPP } // generatorToTransitionMatrix NumericMatrix generatorToTransitionMatrix(NumericMatrix gen, bool byrow); RcppExport SEXP _markovchain_generatorToTransitionMatrix(SEXP genSEXP, SEXP byrowSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericMatrix >::type gen(genSEXP); Rcpp::traits::input_parameter< bool >::type byrow(byrowSEXP); rcpp_result_gen = Rcpp::wrap(generatorToTransitionMatrix(gen, byrow)); return rcpp_result_gen; END_RCPP } // ctmcFit List ctmcFit(List data, bool byrow, String name, double confidencelevel); RcppExport SEXP _markovchain_ctmcFit(SEXP dataSEXP, SEXP byrowSEXP, SEXP nameSEXP, SEXP confidencelevelSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< List >::type data(dataSEXP); Rcpp::traits::input_parameter< bool >::type byrow(byrowSEXP); Rcpp::traits::input_parameter< String >::type name(nameSEXP); Rcpp::traits::input_parameter< double >::type confidencelevel(confidencelevelSEXP); rcpp_result_gen = Rcpp::wrap(ctmcFit(data, byrow, name, confidencelevel)); return rcpp_result_gen; END_RCPP } // ExpectedTimeRcpp NumericVector ExpectedTimeRcpp(NumericMatrix x, NumericVector y); RcppExport SEXP _markovchain_ExpectedTimeRcpp(SEXP xSEXP, SEXP ySEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericMatrix >::type x(xSEXP); Rcpp::traits::input_parameter< NumericVector >::type y(ySEXP); rcpp_result_gen = Rcpp::wrap(ExpectedTimeRcpp(x, y)); return rcpp_result_gen; END_RCPP } // probabilityatTRCpp NumericMatrix probabilityatTRCpp(NumericMatrix y); RcppExport SEXP _markovchain_probabilityatTRCpp(SEXP ySEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericMatrix >::type y(ySEXP); rcpp_result_gen = Rcpp::wrap(probabilityatTRCpp(y)); return rcpp_result_gen; END_RCPP } // impreciseProbabilityatTRCpp NumericVector impreciseProbabilityatTRCpp(S4 C, int i, int t, int s, double error); RcppExport SEXP _markovchain_impreciseProbabilityatTRCpp(SEXP CSEXP, SEXP iSEXP, SEXP tSEXP, SEXP sSEXP, SEXP errorSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< S4 >::type C(CSEXP); Rcpp::traits::input_parameter< int >::type i(iSEXP); Rcpp::traits::input_parameter< int >::type t(tSEXP); Rcpp::traits::input_parameter< int >::type s(sSEXP); Rcpp::traits::input_parameter< double >::type error(errorSEXP); rcpp_result_gen = Rcpp::wrap(impreciseProbabilityatTRCpp(C, i, t, s, error)); return rcpp_result_gen; END_RCPP } // seq2freqProb NumericVector seq2freqProb(CharacterVector sequence); RcppExport SEXP _markovchain_seq2freqProb(SEXP sequenceSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< CharacterVector >::type sequence(sequenceSEXP); rcpp_result_gen = Rcpp::wrap(seq2freqProb(sequence)); return rcpp_result_gen; END_RCPP } // seq2matHigh NumericMatrix seq2matHigh(CharacterVector sequence, int order); RcppExport SEXP _markovchain_seq2matHigh(SEXP sequenceSEXP, SEXP orderSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< CharacterVector >::type sequence(sequenceSEXP); Rcpp::traits::input_parameter< int >::type order(orderSEXP); rcpp_result_gen = Rcpp::wrap(seq2matHigh(sequence, order)); return rcpp_result_gen; END_RCPP } // markovchainSequenceRcpp CharacterVector markovchainSequenceRcpp(int n, S4 markovchain, CharacterVector t0, bool include_t0); RcppExport SEXP _markovchain_markovchainSequenceRcpp(SEXP nSEXP, SEXP markovchainSEXP, SEXP t0SEXP, SEXP include_t0SEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< int >::type n(nSEXP); Rcpp::traits::input_parameter< S4 >::type markovchain(markovchainSEXP); Rcpp::traits::input_parameter< CharacterVector >::type t0(t0SEXP); Rcpp::traits::input_parameter< bool >::type include_t0(include_t0SEXP); rcpp_result_gen = Rcpp::wrap(markovchainSequenceRcpp(n, markovchain, t0, include_t0)); return rcpp_result_gen; END_RCPP } // markovchainListRcpp List markovchainListRcpp(int n, List object, bool include_t0, CharacterVector t0); RcppExport SEXP _markovchain_markovchainListRcpp(SEXP nSEXP, SEXP objectSEXP, SEXP include_t0SEXP, SEXP t0SEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< int >::type n(nSEXP); Rcpp::traits::input_parameter< List >::type object(objectSEXP); Rcpp::traits::input_parameter< bool >::type include_t0(include_t0SEXP); Rcpp::traits::input_parameter< CharacterVector >::type t0(t0SEXP); rcpp_result_gen = Rcpp::wrap(markovchainListRcpp(n, object, include_t0, t0)); return rcpp_result_gen; END_RCPP } // markovchainSequenceParallelRcpp List markovchainSequenceParallelRcpp(S4 listObject, int n, bool include_t0, CharacterVector init_state); RcppExport SEXP _markovchain_markovchainSequenceParallelRcpp(SEXP listObjectSEXP, SEXP nSEXP, SEXP include_t0SEXP, SEXP init_stateSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< S4 >::type listObject(listObjectSEXP); Rcpp::traits::input_parameter< int >::type n(nSEXP); Rcpp::traits::input_parameter< bool >::type include_t0(include_t0SEXP); Rcpp::traits::input_parameter< CharacterVector >::type init_state(init_stateSEXP); rcpp_result_gen = Rcpp::wrap(markovchainSequenceParallelRcpp(listObject, n, include_t0, init_state)); return rcpp_result_gen; END_RCPP } // createSequenceMatrix NumericMatrix createSequenceMatrix(SEXP stringchar, bool toRowProbs, bool sanitize, CharacterVector possibleStates); RcppExport SEXP _markovchain_createSequenceMatrix(SEXP stringcharSEXP, SEXP toRowProbsSEXP, SEXP sanitizeSEXP, SEXP possibleStatesSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< SEXP >::type stringchar(stringcharSEXP); Rcpp::traits::input_parameter< bool >::type toRowProbs(toRowProbsSEXP); Rcpp::traits::input_parameter< bool >::type sanitize(sanitizeSEXP); Rcpp::traits::input_parameter< CharacterVector >::type possibleStates(possibleStatesSEXP); rcpp_result_gen = Rcpp::wrap(createSequenceMatrix(stringchar, toRowProbs, sanitize, possibleStates)); return rcpp_result_gen; END_RCPP } // mcListFitForList List mcListFitForList(List data); RcppExport SEXP _markovchain_mcListFitForList(SEXP dataSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< List >::type data(dataSEXP); rcpp_result_gen = Rcpp::wrap(mcListFitForList(data)); return rcpp_result_gen; END_RCPP } // _matr2Mc S4 _matr2Mc(CharacterMatrix matrData, double laplacian, bool sanitize, CharacterVector possibleStates); RcppExport SEXP _markovchain__matr2Mc(SEXP matrDataSEXP, SEXP laplacianSEXP, SEXP sanitizeSEXP, SEXP possibleStatesSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< CharacterMatrix >::type matrData(matrDataSEXP); Rcpp::traits::input_parameter< double >::type laplacian(laplacianSEXP); Rcpp::traits::input_parameter< bool >::type sanitize(sanitizeSEXP); Rcpp::traits::input_parameter< CharacterVector >::type possibleStates(possibleStatesSEXP); rcpp_result_gen = Rcpp::wrap(_matr2Mc(matrData, laplacian, sanitize, possibleStates)); return rcpp_result_gen; END_RCPP } // _list2Mc S4 _list2Mc(List data, double laplacian, bool sanitize); RcppExport SEXP _markovchain__list2Mc(SEXP dataSEXP, SEXP laplacianSEXP, SEXP sanitizeSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< List >::type data(dataSEXP); Rcpp::traits::input_parameter< double >::type laplacian(laplacianSEXP); Rcpp::traits::input_parameter< bool >::type sanitize(sanitizeSEXP); rcpp_result_gen = Rcpp::wrap(_list2Mc(data, laplacian, sanitize)); return rcpp_result_gen; END_RCPP } // inferHyperparam List inferHyperparam(NumericMatrix transMatr, NumericVector scale, CharacterVector data); RcppExport SEXP _markovchain_inferHyperparam(SEXP transMatrSEXP, SEXP scaleSEXP, SEXP dataSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericMatrix >::type transMatr(transMatrSEXP); Rcpp::traits::input_parameter< NumericVector >::type scale(scaleSEXP); Rcpp::traits::input_parameter< CharacterVector >::type data(dataSEXP); rcpp_result_gen = Rcpp::wrap(inferHyperparam(transMatr, scale, data)); return rcpp_result_gen; END_RCPP } // markovchainFit List markovchainFit(SEXP data, String method, bool byrow, int nboot, double laplacian, String name, bool parallel, double confidencelevel, bool confint, NumericMatrix hyperparam, bool sanitize, CharacterVector possibleStates); RcppExport SEXP _markovchain_markovchainFit(SEXP dataSEXP, SEXP methodSEXP, SEXP byrowSEXP, SEXP nbootSEXP, SEXP laplacianSEXP, SEXP nameSEXP, SEXP parallelSEXP, SEXP confidencelevelSEXP, SEXP confintSEXP, SEXP hyperparamSEXP, SEXP sanitizeSEXP, SEXP possibleStatesSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< SEXP >::type data(dataSEXP); Rcpp::traits::input_parameter< String >::type method(methodSEXP); Rcpp::traits::input_parameter< bool >::type byrow(byrowSEXP); Rcpp::traits::input_parameter< int >::type nboot(nbootSEXP); Rcpp::traits::input_parameter< double >::type laplacian(laplacianSEXP); Rcpp::traits::input_parameter< String >::type name(nameSEXP); Rcpp::traits::input_parameter< bool >::type parallel(parallelSEXP); Rcpp::traits::input_parameter< double >::type confidencelevel(confidencelevelSEXP); Rcpp::traits::input_parameter< bool >::type confint(confintSEXP); Rcpp::traits::input_parameter< NumericMatrix >::type hyperparam(hyperparamSEXP); Rcpp::traits::input_parameter< bool >::type sanitize(sanitizeSEXP); Rcpp::traits::input_parameter< CharacterVector >::type possibleStates(possibleStatesSEXP); rcpp_result_gen = Rcpp::wrap(markovchainFit(data, method, byrow, nboot, laplacian, name, parallel, confidencelevel, confint, hyperparam, sanitize, possibleStates)); return rcpp_result_gen; END_RCPP } // noofVisitsDistRCpp NumericVector noofVisitsDistRCpp(NumericMatrix matrix, int i, int N); RcppExport SEXP _markovchain_noofVisitsDistRCpp(SEXP matrixSEXP, SEXP iSEXP, SEXP NSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericMatrix >::type matrix(matrixSEXP); Rcpp::traits::input_parameter< int >::type i(iSEXP); Rcpp::traits::input_parameter< int >::type N(NSEXP); rcpp_result_gen = Rcpp::wrap(noofVisitsDistRCpp(matrix, i, N)); return rcpp_result_gen; END_RCPP } // multinomialCIForRow NumericMatrix multinomialCIForRow(NumericVector x, double confidencelevel); RcppExport SEXP _markovchain_multinomialCIForRow(SEXP xSEXP, SEXP confidencelevelSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericVector >::type x(xSEXP); Rcpp::traits::input_parameter< double >::type confidencelevel(confidencelevelSEXP); rcpp_result_gen = Rcpp::wrap(multinomialCIForRow(x, confidencelevel)); return rcpp_result_gen; END_RCPP } // multinomCI List multinomCI(NumericMatrix transMat, NumericMatrix seqMat, double confidencelevel); RcppExport SEXP _markovchain_multinomCI(SEXP transMatSEXP, SEXP seqMatSEXP, SEXP confidencelevelSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericMatrix >::type transMat(transMatSEXP); Rcpp::traits::input_parameter< NumericMatrix >::type seqMat(seqMatSEXP); Rcpp::traits::input_parameter< double >::type confidencelevel(confidencelevelSEXP); rcpp_result_gen = Rcpp::wrap(multinomCI(transMat, seqMat, confidencelevel)); return rcpp_result_gen; END_RCPP } // commClassesKernel List commClassesKernel(NumericMatrix P); RcppExport SEXP _markovchain_commClassesKernel(SEXP PSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericMatrix >::type P(PSEXP); rcpp_result_gen = Rcpp::wrap(commClassesKernel(P)); return rcpp_result_gen; END_RCPP } // communicatingClasses List communicatingClasses(S4 object); RcppExport SEXP _markovchain_communicatingClasses(SEXP objectSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< S4 >::type object(objectSEXP); rcpp_result_gen = Rcpp::wrap(communicatingClasses(object)); return rcpp_result_gen; END_RCPP } // transientStates CharacterVector transientStates(S4 object); RcppExport SEXP _markovchain_transientStates(SEXP objectSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< S4 >::type object(objectSEXP); rcpp_result_gen = Rcpp::wrap(transientStates(object)); return rcpp_result_gen; END_RCPP } // recurrentStates CharacterVector recurrentStates(S4 object); RcppExport SEXP _markovchain_recurrentStates(SEXP objectSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< S4 >::type object(objectSEXP); rcpp_result_gen = Rcpp::wrap(recurrentStates(object)); return rcpp_result_gen; END_RCPP } // recurrentClasses List recurrentClasses(S4 object); RcppExport SEXP _markovchain_recurrentClasses(SEXP objectSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< S4 >::type object(objectSEXP); rcpp_result_gen = Rcpp::wrap(recurrentClasses(object)); return rcpp_result_gen; END_RCPP } // transientClasses List transientClasses(S4 object); RcppExport SEXP _markovchain_transientClasses(SEXP objectSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< S4 >::type object(objectSEXP); rcpp_result_gen = Rcpp::wrap(transientClasses(object)); return rcpp_result_gen; END_RCPP } // reachabilityMatrix LogicalMatrix reachabilityMatrix(S4 obj); RcppExport SEXP _markovchain_reachabilityMatrix(SEXP objSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< S4 >::type obj(objSEXP); rcpp_result_gen = Rcpp::wrap(reachabilityMatrix(obj)); return rcpp_result_gen; END_RCPP } // isAccessible bool isAccessible(S4 obj, String from, String to); RcppExport SEXP _markovchain_isAccessible(SEXP objSEXP, SEXP fromSEXP, SEXP toSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< S4 >::type obj(objSEXP); Rcpp::traits::input_parameter< String >::type from(fromSEXP); Rcpp::traits::input_parameter< String >::type to(toSEXP); rcpp_result_gen = Rcpp::wrap(isAccessible(obj, from, to)); return rcpp_result_gen; END_RCPP } // summaryKernel List summaryKernel(S4 object); RcppExport SEXP _markovchain_summaryKernel(SEXP objectSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< S4 >::type object(objectSEXP); rcpp_result_gen = Rcpp::wrap(summaryKernel(object)); return rcpp_result_gen; END_RCPP } // firstpassageKernel NumericMatrix firstpassageKernel(NumericMatrix P, int i, int n); RcppExport SEXP _markovchain_firstpassageKernel(SEXP PSEXP, SEXP iSEXP, SEXP nSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericMatrix >::type P(PSEXP); Rcpp::traits::input_parameter< int >::type i(iSEXP); Rcpp::traits::input_parameter< int >::type n(nSEXP); rcpp_result_gen = Rcpp::wrap(firstpassageKernel(P, i, n)); return rcpp_result_gen; END_RCPP } // firstPassageMultipleRCpp NumericVector firstPassageMultipleRCpp(NumericMatrix P, int i, NumericVector setno, int n); RcppExport SEXP _markovchain_firstPassageMultipleRCpp(SEXP PSEXP, SEXP iSEXP, SEXP setnoSEXP, SEXP nSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericMatrix >::type P(PSEXP); Rcpp::traits::input_parameter< int >::type i(iSEXP); Rcpp::traits::input_parameter< NumericVector >::type setno(setnoSEXP); Rcpp::traits::input_parameter< int >::type n(nSEXP); rcpp_result_gen = Rcpp::wrap(firstPassageMultipleRCpp(P, i, setno, n)); return rcpp_result_gen; END_RCPP } // expectedRewardsRCpp NumericVector expectedRewardsRCpp(NumericMatrix matrix, int n, NumericVector rewards); RcppExport SEXP _markovchain_expectedRewardsRCpp(SEXP matrixSEXP, SEXP nSEXP, SEXP rewardsSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericMatrix >::type matrix(matrixSEXP); Rcpp::traits::input_parameter< int >::type n(nSEXP); Rcpp::traits::input_parameter< NumericVector >::type rewards(rewardsSEXP); rcpp_result_gen = Rcpp::wrap(expectedRewardsRCpp(matrix, n, rewards)); return rcpp_result_gen; END_RCPP } // expectedRewardsBeforeHittingARCpp double expectedRewardsBeforeHittingARCpp(NumericMatrix matrix, int s0, NumericVector rewards, int n); RcppExport SEXP _markovchain_expectedRewardsBeforeHittingARCpp(SEXP matrixSEXP, SEXP s0SEXP, SEXP rewardsSEXP, SEXP nSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericMatrix >::type matrix(matrixSEXP); Rcpp::traits::input_parameter< int >::type s0(s0SEXP); Rcpp::traits::input_parameter< NumericVector >::type rewards(rewardsSEXP); Rcpp::traits::input_parameter< int >::type n(nSEXP); rcpp_result_gen = Rcpp::wrap(expectedRewardsBeforeHittingARCpp(matrix, s0, rewards, n)); return rcpp_result_gen; END_RCPP } // gcd int gcd(int a, int b); RcppExport SEXP _markovchain_gcd(SEXP aSEXP, SEXP bSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< int >::type a(aSEXP); Rcpp::traits::input_parameter< int >::type b(bSEXP); rcpp_result_gen = Rcpp::wrap(gcd(a, b)); return rcpp_result_gen; END_RCPP } // period int period(S4 object); RcppExport SEXP _markovchain_period(SEXP objectSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< S4 >::type object(objectSEXP); rcpp_result_gen = Rcpp::wrap(period(object)); return rcpp_result_gen; END_RCPP } // predictiveDistribution double predictiveDistribution(CharacterVector stringchar, CharacterVector newData, NumericMatrix hyperparam); RcppExport SEXP _markovchain_predictiveDistribution(SEXP stringcharSEXP, SEXP newDataSEXP, SEXP hyperparamSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< CharacterVector >::type stringchar(stringcharSEXP); Rcpp::traits::input_parameter< CharacterVector >::type newData(newDataSEXP); Rcpp::traits::input_parameter< NumericMatrix >::type hyperparam(hyperparamSEXP); rcpp_result_gen = Rcpp::wrap(predictiveDistribution(stringchar, newData, hyperparam)); return rcpp_result_gen; END_RCPP } // priorDistribution NumericVector priorDistribution(NumericMatrix transMatr, NumericMatrix hyperparam); RcppExport SEXP _markovchain_priorDistribution(SEXP transMatrSEXP, SEXP hyperparamSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericMatrix >::type transMatr(transMatrSEXP); Rcpp::traits::input_parameter< NumericMatrix >::type hyperparam(hyperparamSEXP); rcpp_result_gen = Rcpp::wrap(priorDistribution(transMatr, hyperparam)); return rcpp_result_gen; END_RCPP } // hittingProbabilities NumericMatrix hittingProbabilities(S4 object); RcppExport SEXP _markovchain_hittingProbabilities(SEXP objectSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< S4 >::type object(objectSEXP); rcpp_result_gen = Rcpp::wrap(hittingProbabilities(object)); return rcpp_result_gen; END_RCPP } // canonicForm S4 canonicForm(S4 obj); RcppExport SEXP _markovchain_canonicForm(SEXP objSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< S4 >::type obj(objSEXP); rcpp_result_gen = Rcpp::wrap(canonicForm(obj)); return rcpp_result_gen; END_RCPP } // steadyStates NumericMatrix steadyStates(S4 obj); RcppExport SEXP _markovchain_steadyStates(SEXP objSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< S4 >::type obj(objSEXP); rcpp_result_gen = Rcpp::wrap(steadyStates(obj)); return rcpp_result_gen; END_RCPP } // absorbingStates CharacterVector absorbingStates(S4 obj); RcppExport SEXP _markovchain_absorbingStates(SEXP objSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< S4 >::type obj(objSEXP); rcpp_result_gen = Rcpp::wrap(absorbingStates(obj)); return rcpp_result_gen; END_RCPP } // isIrreducible bool isIrreducible(S4 obj); RcppExport SEXP _markovchain_isIrreducible(SEXP objSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< S4 >::type obj(objSEXP); rcpp_result_gen = Rcpp::wrap(isIrreducible(obj)); return rcpp_result_gen; END_RCPP } // isRegular bool isRegular(S4 obj); RcppExport SEXP _markovchain_isRegular(SEXP objSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< S4 >::type obj(objSEXP); rcpp_result_gen = Rcpp::wrap(isRegular(obj)); return rcpp_result_gen; END_RCPP } // meanAbsorptionTime NumericVector meanAbsorptionTime(S4 obj); RcppExport SEXP _markovchain_meanAbsorptionTime(SEXP objSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< S4 >::type obj(objSEXP); rcpp_result_gen = Rcpp::wrap(meanAbsorptionTime(obj)); return rcpp_result_gen; END_RCPP } // absorptionProbabilities NumericMatrix absorptionProbabilities(S4 obj); RcppExport SEXP _markovchain_absorptionProbabilities(SEXP objSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< S4 >::type obj(objSEXP); rcpp_result_gen = Rcpp::wrap(absorptionProbabilities(obj)); return rcpp_result_gen; END_RCPP } // meanFirstPassageTime NumericMatrix meanFirstPassageTime(S4 obj, CharacterVector destination); RcppExport SEXP _markovchain_meanFirstPassageTime(SEXP objSEXP, SEXP destinationSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< S4 >::type obj(objSEXP); Rcpp::traits::input_parameter< CharacterVector >::type destination(destinationSEXP); rcpp_result_gen = Rcpp::wrap(meanFirstPassageTime(obj, destination)); return rcpp_result_gen; END_RCPP } // meanRecurrenceTime NumericVector meanRecurrenceTime(S4 obj); RcppExport SEXP _markovchain_meanRecurrenceTime(SEXP objSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< S4 >::type obj(objSEXP); rcpp_result_gen = Rcpp::wrap(meanRecurrenceTime(obj)); return rcpp_result_gen; END_RCPP } // meanNumVisits NumericMatrix meanNumVisits(S4 obj); RcppExport SEXP _markovchain_meanNumVisits(SEXP objSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< S4 >::type obj(objSEXP); rcpp_result_gen = Rcpp::wrap(meanNumVisits(obj)); return rcpp_result_gen; END_RCPP } // isProb bool isProb(double prob); RcppExport SEXP _markovchain_isProb(SEXP probSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< double >::type prob(probSEXP); rcpp_result_gen = Rcpp::wrap(isProb(prob)); return rcpp_result_gen; END_RCPP } // isStochasticMatrix bool isStochasticMatrix(NumericMatrix m, bool byrow); RcppExport SEXP _markovchain_isStochasticMatrix(SEXP mSEXP, SEXP byrowSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericMatrix >::type m(mSEXP); Rcpp::traits::input_parameter< bool >::type byrow(byrowSEXP); rcpp_result_gen = Rcpp::wrap(isStochasticMatrix(m, byrow)); return rcpp_result_gen; END_RCPP } // isProbVector bool isProbVector(NumericVector prob); RcppExport SEXP _markovchain_isProbVector(SEXP probSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericVector >::type prob(probSEXP); rcpp_result_gen = Rcpp::wrap(isProbVector(prob)); return rcpp_result_gen; END_RCPP } // checkIsAccesibleMethod bool checkIsAccesibleMethod(S4 obj); RcppExport SEXP _markovchain_checkIsAccesibleMethod(SEXP objSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< S4 >::type obj(objSEXP); rcpp_result_gen = Rcpp::wrap(checkIsAccesibleMethod(obj)); return rcpp_result_gen; END_RCPP } // approxEqual bool approxEqual(NumericMatrix a, NumericMatrix b); RcppExport SEXP _markovchain_approxEqual(SEXP aSEXP, SEXP bSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericMatrix >::type a(aSEXP); Rcpp::traits::input_parameter< NumericMatrix >::type b(bSEXP); rcpp_result_gen = Rcpp::wrap(approxEqual(a, b)); return rcpp_result_gen; END_RCPP } // isPartition bool isPartition(List commClasses, CharacterVector states); RcppExport SEXP _markovchain_isPartition(SEXP commClassesSEXP, SEXP statesSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< List >::type commClasses(commClassesSEXP); Rcpp::traits::input_parameter< CharacterVector >::type states(statesSEXP); rcpp_result_gen = Rcpp::wrap(isPartition(commClasses, states)); return rcpp_result_gen; END_RCPP } // areHittingProbabilities bool areHittingProbabilities(NumericMatrix probs, NumericMatrix hitting, bool byrow); RcppExport SEXP _markovchain_areHittingProbabilities(SEXP probsSEXP, SEXP hittingSEXP, SEXP byrowSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericMatrix >::type probs(probsSEXP); Rcpp::traits::input_parameter< NumericMatrix >::type hitting(hittingSEXP); Rcpp::traits::input_parameter< bool >::type byrow(byrowSEXP); rcpp_result_gen = Rcpp::wrap(areHittingProbabilities(probs, hitting, byrow)); return rcpp_result_gen; END_RCPP } // areMeanNumVisits bool areMeanNumVisits(NumericMatrix probs, NumericMatrix numVisits, NumericMatrix hitting, bool byrow); RcppExport SEXP _markovchain_areMeanNumVisits(SEXP probsSEXP, SEXP numVisitsSEXP, SEXP hittingSEXP, SEXP byrowSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericMatrix >::type probs(probsSEXP); Rcpp::traits::input_parameter< NumericMatrix >::type numVisits(numVisitsSEXP); Rcpp::traits::input_parameter< NumericMatrix >::type hitting(hittingSEXP); Rcpp::traits::input_parameter< bool >::type byrow(byrowSEXP); rcpp_result_gen = Rcpp::wrap(areMeanNumVisits(probs, numVisits, hitting, byrow)); return rcpp_result_gen; END_RCPP } // recurrentHitting bool recurrentHitting(List recurrentClasses, NumericMatrix hitting, CharacterVector states, bool byrow); RcppExport SEXP _markovchain_recurrentHitting(SEXP recurrentClassesSEXP, SEXP hittingSEXP, SEXP statesSEXP, SEXP byrowSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< List >::type recurrentClasses(recurrentClassesSEXP); Rcpp::traits::input_parameter< NumericMatrix >::type hitting(hittingSEXP); Rcpp::traits::input_parameter< CharacterVector >::type states(statesSEXP); Rcpp::traits::input_parameter< bool >::type byrow(byrowSEXP); rcpp_result_gen = Rcpp::wrap(recurrentHitting(recurrentClasses, hitting, states, byrow)); return rcpp_result_gen; END_RCPP } // hittingProbsAreOne bool hittingProbsAreOne(NumericMatrix matrix); RcppExport SEXP _markovchain_hittingProbsAreOne(SEXP matrixSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericMatrix >::type matrix(matrixSEXP); rcpp_result_gen = Rcpp::wrap(hittingProbsAreOne(matrix)); return rcpp_result_gen; END_RCPP } // absorbingAreRecurrentClass bool absorbingAreRecurrentClass(CharacterVector absorbingStates, List recurrentClasses); RcppExport SEXP _markovchain_absorbingAreRecurrentClass(SEXP absorbingStatesSEXP, SEXP recurrentClassesSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< CharacterVector >::type absorbingStates(absorbingStatesSEXP); Rcpp::traits::input_parameter< List >::type recurrentClasses(recurrentClassesSEXP); rcpp_result_gen = Rcpp::wrap(absorbingAreRecurrentClass(absorbingStates, recurrentClasses)); return rcpp_result_gen; END_RCPP } static const R_CallMethodDef CallEntries[] = { {"_markovchain_isGen", (DL_FUNC) &_markovchain_isGen, 1}, {"_markovchain_generatorToTransitionMatrix", (DL_FUNC) &_markovchain_generatorToTransitionMatrix, 2}, {"_markovchain_ctmcFit", (DL_FUNC) &_markovchain_ctmcFit, 4}, {"_markovchain_ExpectedTimeRcpp", (DL_FUNC) &_markovchain_ExpectedTimeRcpp, 2}, {"_markovchain_probabilityatTRCpp", (DL_FUNC) &_markovchain_probabilityatTRCpp, 1}, {"_markovchain_impreciseProbabilityatTRCpp", (DL_FUNC) &_markovchain_impreciseProbabilityatTRCpp, 5}, {"_markovchain_seq2freqProb", (DL_FUNC) &_markovchain_seq2freqProb, 1}, {"_markovchain_seq2matHigh", (DL_FUNC) &_markovchain_seq2matHigh, 2}, {"_markovchain_markovchainSequenceRcpp", (DL_FUNC) &_markovchain_markovchainSequenceRcpp, 4}, {"_markovchain_markovchainListRcpp", (DL_FUNC) &_markovchain_markovchainListRcpp, 4}, {"_markovchain_markovchainSequenceParallelRcpp", (DL_FUNC) &_markovchain_markovchainSequenceParallelRcpp, 4}, {"_markovchain_createSequenceMatrix", (DL_FUNC) &_markovchain_createSequenceMatrix, 4}, {"_markovchain_mcListFitForList", (DL_FUNC) &_markovchain_mcListFitForList, 1}, {"_markovchain__matr2Mc", (DL_FUNC) &_markovchain__matr2Mc, 4}, {"_markovchain__list2Mc", (DL_FUNC) &_markovchain__list2Mc, 3}, {"_markovchain_inferHyperparam", (DL_FUNC) &_markovchain_inferHyperparam, 3}, {"_markovchain_markovchainFit", (DL_FUNC) &_markovchain_markovchainFit, 12}, {"_markovchain_noofVisitsDistRCpp", (DL_FUNC) &_markovchain_noofVisitsDistRCpp, 3}, {"_markovchain_multinomialCIForRow", (DL_FUNC) &_markovchain_multinomialCIForRow, 2}, {"_markovchain_multinomCI", (DL_FUNC) &_markovchain_multinomCI, 3}, {"_markovchain_commClassesKernel", (DL_FUNC) &_markovchain_commClassesKernel, 1}, {"_markovchain_communicatingClasses", (DL_FUNC) &_markovchain_communicatingClasses, 1}, {"_markovchain_transientStates", (DL_FUNC) &_markovchain_transientStates, 1}, {"_markovchain_recurrentStates", (DL_FUNC) &_markovchain_recurrentStates, 1}, {"_markovchain_recurrentClasses", (DL_FUNC) &_markovchain_recurrentClasses, 1}, {"_markovchain_transientClasses", (DL_FUNC) &_markovchain_transientClasses, 1}, {"_markovchain_reachabilityMatrix", (DL_FUNC) &_markovchain_reachabilityMatrix, 1}, {"_markovchain_isAccessible", (DL_FUNC) &_markovchain_isAccessible, 3}, {"_markovchain_summaryKernel", (DL_FUNC) &_markovchain_summaryKernel, 1}, {"_markovchain_firstpassageKernel", (DL_FUNC) &_markovchain_firstpassageKernel, 3}, {"_markovchain_firstPassageMultipleRCpp", (DL_FUNC) &_markovchain_firstPassageMultipleRCpp, 4}, {"_markovchain_expectedRewardsRCpp", (DL_FUNC) &_markovchain_expectedRewardsRCpp, 3}, {"_markovchain_expectedRewardsBeforeHittingARCpp", (DL_FUNC) &_markovchain_expectedRewardsBeforeHittingARCpp, 4}, {"_markovchain_gcd", (DL_FUNC) &_markovchain_gcd, 2}, {"_markovchain_period", (DL_FUNC) &_markovchain_period, 1}, {"_markovchain_predictiveDistribution", (DL_FUNC) &_markovchain_predictiveDistribution, 3}, {"_markovchain_priorDistribution", (DL_FUNC) &_markovchain_priorDistribution, 2}, {"_markovchain_hittingProbabilities", (DL_FUNC) &_markovchain_hittingProbabilities, 1}, {"_markovchain_canonicForm", (DL_FUNC) &_markovchain_canonicForm, 1}, {"_markovchain_steadyStates", (DL_FUNC) &_markovchain_steadyStates, 1}, {"_markovchain_absorbingStates", (DL_FUNC) &_markovchain_absorbingStates, 1}, {"_markovchain_isIrreducible", (DL_FUNC) &_markovchain_isIrreducible, 1}, {"_markovchain_isRegular", (DL_FUNC) &_markovchain_isRegular, 1}, {"_markovchain_meanAbsorptionTime", (DL_FUNC) &_markovchain_meanAbsorptionTime, 1}, {"_markovchain_absorptionProbabilities", (DL_FUNC) &_markovchain_absorptionProbabilities, 1}, {"_markovchain_meanFirstPassageTime", (DL_FUNC) &_markovchain_meanFirstPassageTime, 2}, {"_markovchain_meanRecurrenceTime", (DL_FUNC) &_markovchain_meanRecurrenceTime, 1}, {"_markovchain_meanNumVisits", (DL_FUNC) &_markovchain_meanNumVisits, 1}, {"_markovchain_isProb", (DL_FUNC) &_markovchain_isProb, 1}, {"_markovchain_isStochasticMatrix", (DL_FUNC) &_markovchain_isStochasticMatrix, 2}, {"_markovchain_isProbVector", (DL_FUNC) &_markovchain_isProbVector, 1}, {"_markovchain_checkIsAccesibleMethod", (DL_FUNC) &_markovchain_checkIsAccesibleMethod, 1}, {"_markovchain_approxEqual", (DL_FUNC) &_markovchain_approxEqual, 2}, {"_markovchain_isPartition", (DL_FUNC) &_markovchain_isPartition, 2}, {"_markovchain_areHittingProbabilities", (DL_FUNC) &_markovchain_areHittingProbabilities, 3}, {"_markovchain_areMeanNumVisits", (DL_FUNC) &_markovchain_areMeanNumVisits, 4}, {"_markovchain_recurrentHitting", (DL_FUNC) &_markovchain_recurrentHitting, 4}, {"_markovchain_hittingProbsAreOne", (DL_FUNC) &_markovchain_hittingProbsAreOne, 1}, {"_markovchain_absorbingAreRecurrentClass", (DL_FUNC) &_markovchain_absorbingAreRecurrentClass, 2}, {NULL, NULL, 0} }; RcppExport void R_init_markovchain(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } markovchain/src/ctmcProbabilistic.cpp0000644000176200001440000000704114714756746017533 0ustar liggesusers#include // [[Rcpp::depends(RcppArmadillo)]] #include #include using namespace Rcpp; using namespace RcppArmadillo; using namespace arma; using namespace std; // [[Rcpp::export(.ExpectedTimeRCpp)]] NumericVector ExpectedTimeRcpp(NumericMatrix x, NumericVector y) { NumericVector out; int size = x.nrow(); arma::mat T = arma::zeros(size, size); for (int i = 0; i < size; i++) for (int j = 0; j < size; j++) T(i, j) = x(i, j); arma::vec c = arma::zeros(size); for (int i = 0; i < size; i++) c[i] = y[i]; out = wrap(solve(T,c)); return out; } // [[Rcpp::export(.probabilityatTRCpp)]] NumericMatrix probabilityatTRCpp(NumericMatrix y) { int size = y.nrow(); NumericMatrix out(size,size); arma::mat T = arma::zeros(size, size); for (int i = 0; i < size; i++) for (int j = 0; j < size; j++) T(i, j) = y(i, j); T = expmat(T); for (int i = 0; i < size; i++) for (int j = 0; j < size; j++) out(i, j) = T(i, j); return out; } // [[Rcpp::export(.impreciseProbabilityatTRCpp)]] NumericVector impreciseProbabilityatTRCpp(S4 C, int i,int t, int s, double error) { CharacterVector states = C.slot("states"); int noOfstates = states.size(); NumericMatrix non_Q = C.slot("Q"); NumericMatrix non_range = C.slot("range"); arma::mat Q = arma::zeros(noOfstates, noOfstates); arma::mat range = arma::zeros(noOfstates, 2); // initialises armadillo matrices for (int p = 0; p < noOfstates; p++) for (int q = 0; q < noOfstates; q++) Q(p, q) = non_Q(p, q); // initialises armadillo matrices for (int p = 0; p < noOfstates; p++) for (int q = 0; q < 2; q++) range(p, q) = non_range(p, q); // initialses value of norm of Q double QNorm = -1.0; // calculates norm of Q for (int p =0; p < noOfstates; p++) { float sum = 0.0; for (int q = 0; q < noOfstates; q++) { if (Q(p, q) >= 0) sum = sum + Q(p, q); else sum = sum + -Q(p, q); } if (sum * range(p, 1) > QNorm) QNorm = sum * range(p, 1); } // calculates no. of iterations according to error rate, QNorm and other parameters int n; if ((s - t) * QNorm > (s - t) * (s - t) * QNorm * QNorm * 1/ (2 * error)) n = (int)(s - t) * QNorm; else n = (int)(s - t) * (s-t) * QNorm * QNorm * 1/(2 * error); // sets delta value float delta = (s - t) * 1.0/n; // declares and initialises initial f arma::vec Ii(noOfstates); for (int p = 0; p < noOfstates; p++) Ii[p] = 0; Ii[i-1] = 1; // calculation of Qgx vector arma::vec values = Q * Ii; arma::vec Qgx(noOfstates); for (int p = 0; p < noOfstates; p++) Qgx[p] = 0; for (int p = 0; p < noOfstates; p++) { if (values[p] * range(p, 0) < values[p] * range(p, 1)) Qgx[p] = values[p] * range(p,0); else Qgx[p] = values[p] * range(p,1); } Qgx = delta * Qgx; // runs n-1 iterations according to the algorithm // Qgx_i = Qgx_{i-1} + delta*Q*Qgx_{i-1} Qgx = Qgx + Ii; for (int iter = 0; iter < n - 1; iter++) { arma::vec temp = Qgx; values = Q * Qgx; for (int p = 0; p < noOfstates; p++) { // calculating keeping in mind the lower opertaotr values if (values[p] * range(p,0) < values[p] * range(p,1)) Qgx[p] = values[p] * range(p,0); else Qgx[p] = values[p] * range(p,1); } Qgx = delta * Qgx; Qgx = temp + Qgx; } NumericVector out; for (int p = 0; p < noOfstates; p++) out.push_back(Qgx[p]); return out; } markovchain/src/utils.cpp0000644000176200001440000002405714714756746015244 0ustar liggesusers// [[Rcpp::depends(RcppArmadillo)]] #include #include #include #include #include #include using namespace Rcpp; using namespace arma; using namespace std; // Defined in probabilistic.cpp bool isAccessible(S4 obj, String from, String to); // Defined in probabilistic.cpp LogicalMatrix reachabilityMatrix(S4 obj); // matrix power function // O(log n * m³) where m is the number of rows / cols of A mat matrixPow(const mat& A, int n) { int m = A.n_rows; mat result = eye(m, m); mat partial = A; // We can decompose n = 2^a + 2^b + 2^c ... with a > b > c >= 0 // Compute last = a + 1 while (n > 0) { if ((n & 1) > 0) result = result * partial; partial = partial * partial; n >>= 1; } return result; } // check if two vectors are intersected bool intersects(CharacterVector x, CharacterVector y) { if (x.size() < y.size()) return intersects(y, x); else { unordered_set values; bool intersect = false; for (auto value : x) values.insert(as(value)); for (auto it = y.begin(); it != y.end() && !intersect; ++it) intersect = values.count(as(*it)) > 0; return intersect; } } bool anyElement(const mat& matrix, bool (*condition)(const double&)) { int numRows = matrix.n_rows; int numCols = matrix.n_cols; bool found = false; for (int i = 0; i < numRows && !found; ++i) for (int j = 0; j < numCols && !found; ++j) found = condition(matrix(i, j)); return found; } bool allElements(const mat& matrix, bool (*condition)(const double&)) { int numRows = matrix.n_rows; int numCols = matrix.n_cols; bool all = true; for (int i = 0; i < numRows && all; ++i) for (int j = 0; j < numCols && all; ++j) all = condition(matrix(i, j)); return all; } bool approxEqual(const double& a, const double& b) { if (a >= b) return (a - b) <= 1E-7; else return approxEqual(b, a); } bool approxEqual(const cx_double& a, const cx_double& b){ double x = a.real() - b.real(); double y = a.imag() - b.imag(); return (x*x - y*y) <= 1E-14; } // check if prob is probability or not // [[Rcpp::export(.isProbability)]] bool isProb(double prob) { return (prob >= 0 && prob <= 1); } // checks if a matrix is stochastic (by rows or by columns), i.e. all // elements are probabilities and the rows (cols, resp.) sum 1 // [[Rcpp::export(.isStochasticMatrix)]] bool isStochasticMatrix(NumericMatrix m, bool byrow) { if (!byrow) m = transpose(m); int nrow = m.nrow(); int ncol = m.ncol(); bool isStochastic = true; double rowSum; for (int i = 0; i < nrow && isStochastic; ++i) { rowSum = 0; for (int j = 0; j < ncol && isStochastic; ++j) { isStochastic = m(i, j) >= 0; rowSum += m(i, j); } isStochastic = approxEqual(rowSum, 1); } return isStochastic; } // [[Rcpp::export(.isProbabilityVector)]] bool isProbVector(NumericVector prob) { bool result = true; double sumProbs = 0; for (int i = 0; i < prob.size() && result; ++i) { result = prob[i] >= 0; sumProbs += prob[i]; } return result && approxEqual(sumProbs, 1); } // [[Rcpp::export(.testthatIsAccesibleRcpp)]] bool checkIsAccesibleMethod(S4 obj) { CharacterVector states = obj.slot("states"); bool byrow = obj.slot("byrow"); LogicalMatrix reachability = reachabilityMatrix(obj); int m = states.size(); bool correct = true; bool reachable; for (int i = 0; i < m && correct; ++i) { for (int j = 0; j < m && correct; ++j) { reachable = (byrow ? reachability(i, j) : reachability(j, i)); correct = isAccessible(obj, states(i), states(j)) == reachable; } } return correct; } // [[Rcpp::export(.approxEqualMatricesRcpp)]] bool approxEqual(NumericMatrix a, NumericMatrix b) { int a_ncol = a.ncol(); int b_ncol = b.ncol(); int a_nrow = a.nrow(); int b_nrow = b.nrow(); if (a_ncol != b_ncol || a_nrow != b_nrow) return false; else { bool equal = true; for (int i = 0; i < a_nrow && equal; ++i) for (int j = 0; j < a_ncol && equal; ++j) equal = approxEqual(a(i, j), b(i, j)); return equal; } } // This method receives the output of communicatingClasses(object) and object@states // and checks that in fact the communicating classes are a partition of states // Is a method agnostic on whether the Markov Chain was given by rows or columns // [[Rcpp::export(.testthatIsPartitionRcpp)]] bool isPartition(List commClasses, CharacterVector states) { int n = states.size(); unordered_set used; unordered_set originalStates; int numClassStates = 0; bool partition = true; for (auto state : states) originalStates.insert((string) state); // Check that the union of the classes is // states and they do not overlap for (int i = 0; i < commClasses.size() && partition; ++i) { CharacterVector currentClass = commClasses(i); numClassStates += currentClass.size(); for (int j = 0; j < currentClass.size() && partition; ++j) { string state = (string) currentClass(j); partition = used.count(state) == 0 && originalStates.count(state) > 0; used.insert(state); } } return partition && numClassStates == n; } // This is simply a method that checks the following recurrence, // naming p = probs, f = hitting, it checks: // // f(i, j) = p(i, j) + ∑_{k ≠ j} p(i, k) f(k, j) // // where p are the transitionMatrix probs and hitting are the // hitting probabilities for the Markov Chain associated to // probs. byrow indicates whether probs is an stochastic matrix // by rows or by columns. // [[Rcpp::export(.testthatAreHittingRcpp)]] bool areHittingProbabilities(NumericMatrix probs, NumericMatrix hitting, bool byrow) { if (!byrow) { probs = transpose(probs); hitting = transpose(hitting); } int numStates = probs.nrow(); bool holds = true; double result; for (int i = 0; i < numStates && holds; ++i) { for (int j = 0; j < numStates && holds; ++j) { result = 0; for (int k = 0; k < numStates; ++k) if (k != j) result -= probs(i, k) * hitting(k, j); result += hitting(i, j) - probs(i, j); holds = approxEqual(result, 0); } } return holds; } // This is simply a method that checks the following recurrence, // naming p = probs, E = mean number of visits, f = hitting // probabilities, it checks: // // E(i, j) = p(i, j) / (1 - f(j, j)) + ∑_{k ≠ j} p(i, k) E(k, j) // // Note this recurrence is similar to the one for hitting probabilities // We have to take care when E(i, j) = 0, because we would have to check // that in either p(i, k) = 0 or E(k, j) = 0. If E(i, j) = ∞ we would have // to check that either p(i, j) > 0 or (p(i, k) != 0 and E(k, j) = ∞) // // where p are the transitionMatrix probs, numVisits are the mean // number of visits for each state, and hitting are the hitting // probabilities for the Markov Chain associated to probs. // byrow indicates whether probs is an stochastic matrix // by rows or by columns. // [[Rcpp::export(.testthatAreMeanNumVisitsRcpp)]] bool areMeanNumVisits(NumericMatrix probs, NumericMatrix numVisits, NumericMatrix hitting, bool byrow) { if (!byrow) { probs = transpose(probs); numVisits = transpose(numVisits); hitting = transpose(hitting); } int numStates = probs.ncol(); bool holds = true; double result; double inverse; for (int j = 0; j < numStates && holds; ++j) { if (!approxEqual(hitting(j, j), 1)) { inverse = 1 / (1 - hitting(j, j)); for (int i = 0; i < numStates && holds; ++i) { result = 0; for (int k = 0; k < numStates; ++k) if (k != j) result -= probs(i, k) * numVisits(k, j); result += numVisits(i, j) - probs(i, j) * inverse; holds = approxEqual(result, 0); } } } return holds; } // [[Rcpp::export(.testthatRecurrentHittingRcpp)]] bool recurrentHitting(List recurrentClasses, NumericMatrix hitting, CharacterVector states, bool byrow) { if (!byrow) hitting = transpose(hitting); unordered_map stateToIndex; bool correct = true; int n = states.size(); for (int i = 0; i < n; ++i) stateToIndex[(string) states(i)] = i; for (CharacterVector recClass : recurrentClasses) { unordered_set classIndexes; for (auto state : recClass) classIndexes.insert(stateToIndex[(string) state]); for (int i : classIndexes) { for (int j = 0; j < n; ++j) { if (classIndexes.count(j) > 0) correct = correct && approxEqual(hitting(i, j), 1); else correct = correct && approxEqual(hitting(i, j), 0); } } } return correct; } // [[Rcpp::export(.testthatHittingAreOneRcpp)]] bool hittingProbsAreOne(NumericMatrix matrix) { bool allOne = true; int nrow = matrix.nrow(); int ncol = matrix.ncol(); for (int i = 0; i < nrow && allOne; ++i) for (int j = 0; j < ncol && allOne; ++j) allOne = approxEqual(matrix(i, j), 1); return allOne; } // [[Rcpp::export(.testthatAbsorbingAreRecurrentClassRcpp)]] bool absorbingAreRecurrentClass(CharacterVector absorbingStates, List recurrentClasses) { unordered_set singletonRecurrent; unordered_set absorbing; string current; bool diffEmpty = true; for (CharacterVector recClass : recurrentClasses) if (recClass.size() == 1) singletonRecurrent.insert((string) (*recClass.begin())); for (auto state : absorbingStates) absorbing.insert((string) state); for (int i = 0; i < absorbingStates.size() && diffEmpty; ++i) { current = (string) absorbingStates(i); diffEmpty = singletonRecurrent.count(current) > 0; } for (auto it = singletonRecurrent.begin(); it != singletonRecurrent.end() && diffEmpty; ++it) { current = (string) (*it); diffEmpty = absorbing.count(current) > 0; } return diffEmpty; } markovchain/src/Makevars.win0000644000176200001440000000033714714756746015663 0ustar liggesusersPKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) #CXX_STD = CXX11 PKG_CXXFLAGS += -DRCPP_PARALLEL_USE_TBB=1 PKG_LIBS += $(shell "${R_HOME}/bin${R_ARCH_BIN}/Rscript.exe" \ -e "RcppParallel::RcppParallelLibs()") markovchain/src/fittingFunctions.cpp0000644000176200001440000015221114714756746017433 0ustar liggesusers#ifndef STRICT_R_HEADERS #define STRICT_R_HEADERS // [[Rcpp::depends(RcppParallel)]] // [[Rcpp::depends(RcppArmadillo)]] #include #include #include using namespace Rcpp; using namespace RcppArmadillo; using namespace RcppParallel; using namespace std; #include "helpers.h" #include "mapFitFunctions.h" #include #include // [[Rcpp::export(.markovchainSequenceRcpp)]] CharacterVector markovchainSequenceRcpp(int n, S4 markovchain, CharacterVector t0, bool include_t0 = false) { // character vector to store the result CharacterVector chain(n); // transition mastrix NumericMatrix transitionMatrix = markovchain.slot("transitionMatrix"); // possible states CharacterVector states = markovchain.slot("states"); // current state CharacterVector state = t0; NumericVector rowProbs(states.size()); CharacterVector outstate; for (int i = 0;i < n;i++) { // extracting row probabilties for the given state from transition matrix int row_no = 0; for (int j = 0;j < states.size();j++) { /* last element of state character vector because of markovchainListRcpp, a seq of length greater than 1 is also passed whose end state is the beginning state here */ if (states[j] == state[state.size()-1]) { row_no = j; break; } } for (int j = 0; j < states.size(); j++) { rowProbs[j] = transitionMatrix(row_no, j); } // calculate next state outstate = sample(states, 1, false, rowProbs); chain[i] = outstate[0]; state = outstate; } if (include_t0) chain.push_front(t0[0]); return chain; } bool checkSequenceRcpp(List object) { bool out = true; int nob = object.size(); // if there is only one markovchain object return true if (nob == 1) return(true); S4 ob0, ob1; CharacterVector statesN1, statesN, intersection; for (int i = 1; i < nob;i++) { CharacterVector statesNm1; ob0 = S4(object[i-1]); ob1 = S4(object[i]); statesN1 = ob0.slot("states"); statesN = ob1.slot("states"); NumericMatrix matr = ob0.slot("transitionMatrix"); double csum = 0; for (int j = 0;j < matr.ncol();j++) { csum = 0; for (int k = 0;k < matr.nrow();k++) { csum += matr(k, j); } if (csum != 0) statesNm1.push_back(statesN1[j]); } intersection = intersect(statesNm1, statesN); if (not setequal(intersection, statesNm1)) { out = false; break; } } return(out); } // [[Rcpp::export(.markovchainListRcpp)]] List markovchainListRcpp(int n, List object, bool include_t0 = false, CharacterVector t0 = CharacterVector()) { bool verify = checkSequenceRcpp(object); if (not verify) { warning("Warning: some states in the markovchain sequences are not contained in the following states!"); } // size of result vector int sz = n*object.size(); if (include_t0) sz += n; int vin = 0; // useful in filling below vectors NumericVector iteration(sz); CharacterVector values(sz); S4 ob(object[0]); CharacterVector sampledValues, newVals; // Initial State selection if not passed //----------------------------------------------------------------------------- CharacterVector ustates = ob.slot("states"); NumericVector rowProbs; for (int i = 0;i < ustates.size();i++) { rowProbs.push_back(1.0 / ustates.size()); } bool rselect = (t0.size() == 0); if (rselect) { t0 = sample(ustates, 1, false, rowProbs); } //------------------------------------------------------------------------------ // check whether t0 is in unique states or not for (int i = 0;i < ustates.size();i++) { if (ustates[i] == t0[0]) break; else if (i == ustates.size()-1) stop("Error! Initial state not defined"); } // generate n sequence for (int i = 0;i < n;i++) { // random selection of initial state if not passed to the function if (rselect) { t0 = sample(ustates, 1, false, rowProbs); } sampledValues = markovchainSequenceRcpp(1, object[0], t0, include_t0); if (object.size() > 1) { for (int j = 1;j < object.size();j++) { newVals = markovchainSequenceRcpp(1, object[j], sampledValues); sampledValues.push_back(newVals[0]); } } for (int k = 0;k < sampledValues.size();k++) { iteration[vin] = i + 1; values[vin++] = sampledValues[k]; } } return(List::create(iteration, values)); } struct MCList : public Worker { // 3-D matrix where each slice is a transition matrix const arma::cube mat; // number of transition matrices const int num_mat; // matrix where ith row vector store the list of states // names present in ith transition matrix const vector > names; // vector whose ith element store the dimension of ith // transition matrix const vector size_emat; // whether to include first state const bool include_t0; // info about initial state const bool init; // whether initial state is passed to the method const string init_state; // if yes what's the name // each element of list is a sequence list > output; // constructor for initialization MCList(const arma::cube &pmat, const int &pnum_mat, const vector > &pnames, const vector psize_emat, const bool &pinclude_t0, const bool &pinit, const string &pinit_state) : mat(pmat), num_mat(pnum_mat), names(pnames), size_emat(psize_emat), include_t0(pinclude_t0), init(pinit), init_state(pinit_state) {} MCList(const MCList& mclist, Split) : mat(mclist.mat), num_mat(mclist.num_mat), names(mclist.names), size_emat(mclist.size_emat), include_t0(mclist.include_t0), init(mclist.init), init_state(mclist.init_state) {} void operator()(std::size_t begin, std::size_t end) { // to take care of include_t0 unsigned int ci = 0; if (include_t0) ci = 1; // to store single sequence generated each time vector temp(num_mat+ci); // initial probability and states indices arma::vec in_probs(size_emat[0]); arma::vec in_states(size_emat[0]); // assume equal chances of selection of states for the first time for (unsigned int i = 0; i < in_probs.size(); i++) { in_probs[i] = 1.0 / size_emat[0]; in_states[i] = i; } // to store the index of the state selected arma::vec istate; string t0; // every time generate one sequence for (unsigned int p = begin; p < end; p++) { if (not init) { // randomly selected state istate = sample(in_states, 1, false, in_probs); t0 = names[0][istate[0]]; } else { t0 = init_state; } // include the state in the sequence if (include_t0) temp[0] = t0; // to generate one sequence for (unsigned int i = 0; i < (unsigned int)num_mat; i++) { // useful for generating rows probabilty vector unsigned int j = 0; for (j = 0; j < (unsigned int)size_emat[i]; j++) { if (names[i][j] == t0) break; } // vector to be passed to sample method arma::vec probs(size_emat[i]); arma::vec states(size_emat[i]); for (unsigned int k=0; k < probs.size(); k++) { probs[k] = mat(j, k, i); states[k] = k; } // new state selected arma::vec elmt = sample(states, 1, false, probs); t0 = names[i][elmt[0]]; // populate sequence temp[i+ci] = t0; } // insert one sequence to the output output.push_back(temp); } } void join(const MCList& rhs) { // constant iterator to the first element of rhs.output list >::const_iterator it = rhs.output.begin(); // merge the result of two parallel computation for (;it != rhs.output.end();it++) { output.push_back(*it); } } }; // Function to generate a list of sequence of states in parallel from non-homogeneous Markov chains. // // Provided any markovchainList object, it returns a list of sequence of states coming // from the underlying stationary distribution. // // @param listObject markovchainList object // @param n Sample size // @param include_t0 Specify if the initial state shall be used // // @return A List // @author Giorgio Spedicato, Deepak Yadav // // @examples // statesNames <- c("a") // mcA <- new("markovchain", states = statesNames, transitionMatrix = // matrix(c(1), nrow = 1, byrow = TRUE, // dimnames = list(statesNames, statesNames))) // // statesNames <- c("a","b") // mcB <- new("markovchain", states = statesNames, transitionMatrix = // matrix(c(0.5, 0.5, 0.3, 0.7), nrow = 2, byrow = TRUE, // dimnames = list(statesNames, statesNames))) // // statesNames <- c("a","b","c") // mcC <- new("markovchain", states = statesNames, transitionMatrix = // matrix(c(0.2, 0.5, 0.3, 0, 0.2, 0.8, 0.1, 0.8, 0.1), nrow = 3, // byrow = TRUE, dimnames = list(statesNames, statesNames))) // // mclist <- new("markovchainList", markovchains = list(mcA, mcB, mcC)) // // markovchainSequenceParallelRcpp(mclist, 99999, TRUE) // // // [[Rcpp::export(.markovchainSequenceParallelRcpp)]] List markovchainSequenceParallelRcpp(S4 listObject, int n, bool include_t0 = false, CharacterVector init_state = CharacterVector()) { // list of markovchain object List object = listObject.slot("markovchains"); bool verify = checkSequenceRcpp(object); if (not verify) { warning("Warning: some states in the markovchain sequences are not contained in the following states!"); } // store number of transition matrices int num_matrix = object.size(); // maximum of dimension of all transition matrices int max_dim_mat = 0; // to store the dimension of each transition matrices vector size_emat(num_matrix); // to store list of states in a transition matrix CharacterVector states; // calculate max_dim_mat and populate size_emat for (int i = 0; i < num_matrix; i++) { // extract ith markovchain object S4 ob = object[i]; // list of states in ith markovchain object states = ob.slot("states"); // keep track of maximun dimension if (states.size() > max_dim_mat) max_dim_mat = states.size(); // size of ith transition matrix size_emat[i] = states.size(); } // Matrix with ith row store the states in ith t-matrix vector > names(num_matrix, vector(max_dim_mat)); // to store all t-matrix arma::cube mat(max_dim_mat, max_dim_mat, num_matrix); mat.fill(0); for (int i = 0; i < num_matrix;i++) { // ith markovchain object S4 ob = object[i]; // t-matrix and states names NumericMatrix tmat = ob.slot("transitionMatrix"); CharacterVector stat_names = ob.slot("states"); // populate 3-D matrix for (int j = 0;j < tmat.nrow();j++) { for (int k = 0; k < tmat.ncol();k++) { mat(j, k, i) = tmat(j, k); } // populate names of states names[i][j] = stat_names[j]; } } // initial state is passed or not bool init = false; string ini_state; if (init_state.size() != 0) { init = true; ini_state = as(init_state[0]); } // create an object of MCList class MCList mcList(mat, num_matrix, names, size_emat, include_t0, init, ini_state); // start parallel computation parallelReduce(0, n, mcList); // list of sequences return wrap(mcList.output); } // convert a frequency matrix to a transition probability matrix NumericMatrix _toRowProbs(NumericMatrix x, bool sanitize = false) { int nrow = x.nrow(), ncol = x.ncol(); NumericMatrix out(nrow); for (int i = 0; i < nrow; i++) { double rowSum = 0; for (int j = 0; j < ncol; j++) rowSum += x(i, j); for (int j = 0; j < ncol; j++) { // not updating out(i,j) outside sanitize condition as it may lead to runtime error(rowSum=0) if (sanitize == true) { if (rowSum == 0) { out(i, j) = 1.0/ncol; } else { out(i, j) = x(i, j) / rowSum; } } else { if (rowSum == 0) { out(i, j) = 0; } else { out(i, j) = x(i, j) / rowSum; } } } } out.attr("dimnames") = List::create(rownames(x), colnames(x)); return out; } // Create a frequency matrix //' @rdname markovchainFit //' //' @export // [[Rcpp::export]] NumericMatrix createSequenceMatrix(SEXP stringchar, bool toRowProbs = false, bool sanitize = false, CharacterVector possibleStates = CharacterVector()) { //--------------------------------------------------------------------- // check whether stringchar is a list or not if (TYPEOF(stringchar) == VECSXP) { List seqs = as(stringchar); CharacterVector pstates; // possiblestates for (int i = 0;i < seqs.size();i++) { CharacterVector tseq = unique(as(seqs[i])); for (int j = 0;j < tseq.size();j++) { if (tseq[j] != "NA") { pstates.push_back(tseq[j]); } } } for (int i = 0;i < possibleStates.size();i++) { pstates.push_back(possibleStates[i]); } pstates = unique(pstates); pstates = pstates.sort(); int sizeMatr = pstates.size(); NumericMatrix freqMatrix(sizeMatr); freqMatrix.attr("dimnames") = List::create(pstates, pstates); for (int i = 0;i < seqs.size();i++) { NumericMatrix temp = createSequenceMatrix(seqs[i], false, false, pstates); freqMatrix += temp; } if (sanitize == true) { for (int i = 0; i < sizeMatr; i++) { double rowSum = 0; for (int j = 0; j < sizeMatr; j++) rowSum += freqMatrix(i, j); if (rowSum == 0) for (int j = 0; j < sizeMatr; j++) freqMatrix(i, j) = 1; } } if (toRowProbs == true) return _toRowProbs(freqMatrix, sanitize); return freqMatrix; } //--------------------------------------------------------------------- CharacterVector stringChar = as(stringchar); // may include missing values CharacterVector elements_na = unique(union_(stringChar, possibleStates)); // free from missing values CharacterVector elements = clean_nas(elements_na); elements = elements.sort(); int sizeMatr = elements.size(); // output matrix of dimensions equal to total possible states NumericMatrix freqMatrix(sizeMatr); freqMatrix.attr("dimnames") = List::create(elements, elements); CharacterVector rnames = rownames(freqMatrix); if (Rf_isMatrix(stringchar)) { // coerce to CharacterMatrix CharacterMatrix seqMat = as(stringchar); // number of columns must be 2 if (seqMat.ncol() != 2) { stop("Number of columns in the matrix must be 2"); } // populate frequency matrix int posFrom = 0, posTo = 0; for (long int i = 0; i < seqMat.nrow(); i ++) { if (seqMat(i, 0) != "NA" && seqMat(i, 1) != "NA") { for (int j = 0; j < rnames.size(); j ++) { if (seqMat(i, 0) == rnames[j]) posFrom = j; if (seqMat(i, 1) == rnames[j]) posTo = j; } freqMatrix(posFrom, posTo)++; } } } else { int posFrom = 0, posTo = 0; for (long int i = 0; i < stringChar.size() - 1; i ++) { if (stringChar[i] != "NA" && stringChar[i+1] != "NA") { for (int j = 0; j < rnames.size(); j ++) { if (stringChar[i] == rnames[j]) posFrom = j; if (stringChar[i + 1] == rnames[j]) posTo = j; } freqMatrix(posFrom, posTo)++; } } } // sanitizing if any row in the matrix sums to zero by posing the corresponding diagonal equal to 1/dim if (sanitize == true) { for (int i = 0; i < sizeMatr; i++) { double rowSum = 0; for (int j = 0; j < sizeMatr; j++) rowSum += freqMatrix(i, j); if (rowSum == 0) for (int j = 0; j < sizeMatr; j++) freqMatrix(i, j) = 1; } } if (toRowProbs == true) return _toRowProbs(freqMatrix, sanitize); return (freqMatrix); } // log-likelihood double _loglikelihood(CharacterVector seq, NumericMatrix transMatr) { // to store the result double out = 0; // states names CharacterVector rnames = rownames(transMatr); // caculate out int from = 0, to = 0; for (long int i = 0; i < seq.size() - 1; i ++) { if (seq[i] != "NA" && seq[i+1] != "NA") { for (int r = 0; r < rnames.size(); r ++) { if (rnames[r] == seq[i]) from = r; if (rnames[r] == seq[i + 1]) to = r; } out += log(transMatr(from, to)); } } return out; } // [[Rcpp::export(.mcListFitForList)]] List mcListFitForList(List data) { int l = data.size(); // length of list // pair of length and index // length of sequence data[index] vector > length_seq(l); for (int i = 0;i < l;i++) { CharacterVector temp = as(data[i]); length_seq[i] = make_pair(temp.size(), i); } // increasing order of the length of sequence in the list sort(length_seq.begin(), length_seq.end()); int i = 1; // ith transition int j = 0; // start from least length sequence List out; // to store result while(j < l) { int len = length_seq[j].first; if (i < len) { // transition from (i-1)th to ith CharacterMatrix temp(l-j, 2); // indicates wheter there is a valid transition for the current time of the // markov chain bool validTransition = false; for (int k = j;k < l;k++) { temp(k-j, 0) = (as(data[length_seq[k].second]))[i-1]; temp(k-j, 1) = (as(data[length_seq[k].second]))[i]; if (temp(k-j,0) != "NA" && temp(k-j, 1) != "NA") validTransition = true; } // frequency matrix if (validTransition) out.push_back(createSequenceMatrix(temp, false, true)); i++; } else { j++; } } return out; } List generateCI(double confidencelevel, NumericMatrix freqMatr) { int sizeMatr = freqMatr.nrow(); // the true confidence level is 1-(1-alpha)/2 float true_confidence_level = 1-(1-confidencelevel)/2.0; // transition matrix NumericMatrix initialMatr(sizeMatr, sizeMatr); // calculation of transition matrix // take care of rows with all entries 0 for (int i = 0; i < sizeMatr; i++) { double rowSum = 0; for (int j = 0; j < sizeMatr; j++) { rowSum += freqMatr(i, j); } // calculate rows probability for (int j = 0; j < sizeMatr; j++) { if (rowSum == 0) { initialMatr(i, j) = 1.0/sizeMatr; } else { initialMatr(i, j) = freqMatr(i, j)/rowSum; } } } // matrices to store end results NumericMatrix lowerEndpointMatr(sizeMatr, sizeMatr); NumericMatrix upperEndpointMatr(sizeMatr, sizeMatr); NumericMatrix standardError(sizeMatr, sizeMatr); // z score for given confidence interval // double zscore = stats::qnorm_0(confidencelevel, 1.0, 0.0); double zscore = stats::qnorm_0(true_confidence_level, 1.0, 0.0); // populate above defined matrix double marginOfError, lowerEndpoint, upperEndpoint; for (int i = 0; i < sizeMatr; i++) { for (int j = 0; j < sizeMatr; j++) { if (freqMatr(i, j) == 0) { // whether entire ith row is zero or not bool notrans = true; for (int k = 0; k < sizeMatr; k++) { // if the entire ith row is not zero then set notrans to false if (freqMatr(i, k) != 0) { standardError(i, j) = lowerEndpointMatr(i, j) = upperEndpointMatr(i, j) = 0; notrans = false; break; } } // if entire ith row is zero if (notrans) standardError(i, j) = lowerEndpointMatr(i, j) = upperEndpointMatr(i, j) = 1; } else { // standard error calculation standardError(i, j) = initialMatr(i, j) / sqrt(freqMatr(i, j)); // marginal error calculation marginOfError = zscore * standardError(i, j); // lower and upper end point calculation lowerEndpoint = initialMatr(i, j) - marginOfError; upperEndpoint = initialMatr(i, j) + marginOfError; // taking care that upper and lower end point should be between 0(included) and 1(included) lowerEndpointMatr(i, j) = (lowerEndpoint > 1.0) ? 1.0 : ((0.0 > lowerEndpoint) ? 0.0 : lowerEndpoint); upperEndpointMatr(i, j) = (upperEndpoint > 1.0) ? 1.0 : ((0.0 > upperEndpoint) ? 0.0 : upperEndpoint); } } } // set the rows and columns name as states names standardError.attr("dimnames") = upperEndpointMatr.attr("dimnames") = lowerEndpointMatr.attr("dimnames") = freqMatr.attr("dimnames"); return List::create(_["standardError"] = standardError, _["confidenceLevel"] = confidencelevel, _["lowerEndpointMatrix"] = lowerEndpointMatr, _["upperEndpointMatrix"] = upperEndpointMatr); } // Fit DTMC using MLE List _mcFitMle(SEXP data, bool byrow, double confidencelevel, bool sanitize = false, CharacterVector possibleStates = CharacterVector()) { NumericMatrix freqMatr = createSequenceMatrix(data, false, false, possibleStates); // matrix size = nrows = ncols int sizeMatr = freqMatr.nrow(); // initial matrix = transition matrix NumericMatrix initialMatr(sizeMatr); // set names of states as rows name and columns name initialMatr.attr("dimnames") = freqMatr.attr("dimnames"); // take care of rows with all entries 0 for (int i = 0; i < sizeMatr; i++) { double rowSum = 0; for (int j = 0; j < sizeMatr; j++) { rowSum += freqMatr(i, j); } // calculate rows probability for (int j = 0; j < sizeMatr; j++) { if (rowSum == 0) { initialMatr(i, j) = (sanitize ? 1.0/sizeMatr : 0); } else { initialMatr(i, j) = freqMatr(i, j)/rowSum; } } } // transpose the matrix if byrow is false if (byrow == false) { initialMatr = transposeMatrix(initialMatr); } // create markov chain object S4 outMc("markovchain"); outMc.slot("transitionMatrix") = initialMatr; outMc.slot("name") = "MLE Fit"; List CI = generateCI(confidencelevel, freqMatr); // return a list of important results return List::create(_["estimate"] = outMc, _["standardError"] = CI[0], _["confidenceLevel"] = CI[1], _["lowerEndpointMatrix"] = CI[2], _["upperEndpointMatrix"] = CI[3] ); } // Fit DTMC using Laplacian smooth List _mcFitLaplacianSmooth(CharacterVector stringchar, bool byrow, double laplacian = 0.01, bool sanitize = false, CharacterVector possibleStates = CharacterVector()) { // create frequency matrix NumericMatrix origNum = createSequenceMatrix(stringchar, false, sanitize, possibleStates); // store dimension of frequency matrix int nRows = origNum.nrow(), nCols = origNum.ncol(); // convert frequency matrix to transition matrix for (int i = 0; i < nRows; i ++) { double rowSum = 0; // add laplacian correction to each entry // also calculate row's sum for (int j = 0; j < nCols; j ++) { origNum(i,j) += laplacian; rowSum += origNum(i,j); } // get a transition matrix and a DTMC for (int j = 0; j < nCols; j ++) { if (rowSum == 0) origNum(i,j) = sanitize ? origNum(i,j)/rowSum : 0; else origNum(i,j) = origNum(i,j)/rowSum; } } // transpose transition matrix = columnwise storage if (byrow == false) { origNum = transposeMatrix(origNum); } // create markovchain object S4 outMc("markovchain"); outMc.slot("transitionMatrix") = origNum; outMc.slot("name") = "Laplacian Smooth Fit"; return List::create(_["estimate"] = outMc); } // bootstrap a sequence to produce a list of sample sequences List _bootstrapCharacterSequences(CharacterVector stringchar, int n, long int size = -1, CharacterVector possibleStates = CharacterVector()) { // store length of sequence if (size == -1) { size = stringchar.size(); } // frequency matrix NumericMatrix contingencyMatrix = createSequenceMatrix(stringchar, true, true, possibleStates); // many samples from a given a sequence :: bootstrap // res list is helper list List samples, res; // state names CharacterVector itemset = rownames(contingencyMatrix); // number of distinct states int itemsetsize = itemset.size(); // access R sample function Function sample("sample"); for (int i = 0; i < n; i ++) { // charseq to store a fresh sequence CharacterVector charseq, resvec; // select a random number between 0 ans itemsize int rnd = (int)(runif (1)(0) * itemsetsize); // random state String ch = itemset[rnd]; // push start state to charseq charseq.push_back(ch); for (long int j = 1; j < size; j ++) { // store row probability NumericVector probsVector; // populate probsVector for (int k = 0; k < itemsetsize; k ++) { if ((std::string)itemset[k] == (std::string) ch) { probsVector = contingencyMatrix(k, _); break; } } // select next state of sequence res = sample(itemset, 1, true, probsVector); resvec = res[0]; // current state ch = resvec[0]; charseq.push_back(ch); } // every add one sequence samples.push_back(charseq); } // return a list of n sequence of same length as of given sequence return samples; } // estimate from the list of bootstrapped matrices List _fromBoot2Estimate(List listMatr) { // number of transition matrices int sampleSize = listMatr.size(); // first transition matrix NumericMatrix firstMat = listMatr[0]; // dimension of matrix int matrDim = firstMat.nrow(); // matrix to store mean and standard deviation NumericMatrix matrMean(matrDim), matrSd(matrDim); // populate mean and sd matrix for (int i = 0; i < matrDim; i ++) { for (int j = 0; j < matrDim; j ++) { NumericVector probsEstimated; for (int k = 0; k < sampleSize; k ++) { NumericMatrix mat = listMatr[k]; probsEstimated.push_back(mat(i,j)); } matrMean(i, j) = mean(probsEstimated); matrSd(i, j) = Rcpp::sd(probsEstimated); } } // set rows and columns names = states names matrMean.attr("dimnames") = List::create(rownames(firstMat), colnames(firstMat)); matrSd.attr("dimnames") = matrMean.attr("dimnames"); // return list of estimated mean transition matrix and estimated sd matrix return List::create(_["estMu"] = matrMean, _["estSigma"] = matrSd); } struct BootstrapList : public Worker { // transition matrix const RMatrix input; // unique states const vector states; // length of sequence const int len; // list of new sequences list > output; // constructor BootstrapList(const NumericMatrix input, const vector states, const int len) : input(input), states(states), len(len) {} BootstrapList(const BootstrapList& bsList, Split) : input(bsList.input), states(bsList.states), len(bsList.len) {} // generate (end-begin) sequences void operator()(std::size_t begin, std::size_t end) { // number of unique states unsigned int n = states.size(); // initial probability vector arma::vec iprobs(n); // probability vector (can be any row of transition matrix) arma::vec probs(n); // unique states indices arma::vec ustates(n); // initialization for (unsigned int i = 0;i < n;i++) { iprobs[i] = 1.0/n; ustates[i] = i; } // to store new state generated arma::vec istate; // every time generate one sequence for (unsigned int p = begin; p < (unsigned int)end;p++) { // randomly select starting state vector result(len); istate = sample(ustates, 1, false, iprobs); result[0] = states[istate[0]]; // given a present state generate a future state for (unsigned int j = 1; j < (unsigned int)len;j++) { // row vector corresponding to state istate[0] for (unsigned int k = 0;k < (unsigned int)n;k++) { probs[k] = input(istate[0], k); } // select future state istate = sample(ustates, 1, false, probs); result[j] = states[istate[0]]; } // populate a sequence output.push_back(result); } } void join(const BootstrapList& rhs) { // constant iterator to the first element of rhs.output list >::const_iterator it = rhs.output.begin(); // merge the result of two parallel computation for (;it != rhs.output.end();it++) { output.push_back(*it); } } }; List _bootstrapCharacterSequencesParallel(CharacterVector stringchar, int n, long int size = -1, CharacterVector possibleStates = CharacterVector()) { // store length of sequence if (size == -1) { size = stringchar.size(); } // frequency matrix NumericMatrix contingencyMatrix = createSequenceMatrix(stringchar, true, true, possibleStates); // state names vector itemset = as >(rownames(contingencyMatrix)); // number of distinct states // int itemsetsize = itemset.size(); BootstrapList bsList(contingencyMatrix, itemset, size); parallelReduce(0, n, bsList); return wrap(bsList.output); } // Fit DTMC using bootstrap method List _mcFitBootStrap(CharacterVector data, int nboot, bool byrow, bool parallel, double confidencelevel, bool sanitize = false, CharacterVector possibleStates = CharacterVector()) { // list of sequence generated using given sequence List theList = (parallel) ? _bootstrapCharacterSequencesParallel(data, nboot, data.size()) : _bootstrapCharacterSequences(data, nboot, data.size()); // number of new sequence int n = theList.size(); // to store frequency matrix for every sequence List pmsBootStrapped(n); // populate pmsBootStrapped if (parallel) for (int i = 0; i < n; i++) pmsBootStrapped[i] = createSequenceMatrix(theList[i], true, sanitize, possibleStates); else for (int i = 0; i < n; i++) pmsBootStrapped[i] = createSequenceMatrix(theList[i], true, sanitize, possibleStates); List estimateList = _fromBoot2Estimate(pmsBootStrapped); // transition matrix NumericMatrix transMatr = _toRowProbs(estimateList["estMu"], sanitize); // markovchain object S4 estimate("markovchain"); estimate.slot("transitionMatrix") = transMatr; estimate.slot("byrow") = byrow; estimate.slot("name") = "BootStrap Estimate"; // z score for given confidence interval double zscore = stats::qnorm_0(confidencelevel, 1.0, 0.0); // store dimension of matrix int nrows = transMatr.nrow(); int ncols = transMatr.ncol(); // matrix to store end results NumericMatrix lowerEndpointMatr(nrows, ncols), upperEndpointMatr(nrows, ncols); NumericMatrix sigma = estimateList["estSigma"], standardError(nrows, ncols); // populate above defined matrix double marginOfError, lowerEndpoint, upperEndpoint; for (int i = 0; i < nrows; i ++) { for (int j = 0; j < ncols; j ++) { // standard error calculation standardError(i, j) = sigma(i, j) / sqrt(double(n)); // marginal error calculation marginOfError = zscore * standardError(i, j); // lower and upper end point calculation lowerEndpoint = transMatr(i, j) - marginOfError; upperEndpoint = transMatr(i, j) + marginOfError; // taking care that upper and lower end point should be between 0(included) and 1(included) lowerEndpointMatr(i, j) = (lowerEndpoint > 1.0) ? 1.0 : ((0.0 > lowerEndpoint) ? 0.0 : lowerEndpoint); upperEndpointMatr(i, j) = (upperEndpoint > 1.0) ? 1.0 : ((0.0 > upperEndpoint) ? 0.0 : upperEndpoint); } } // set the rows and columns name as states names standardError.attr("dimnames") = upperEndpointMatr.attr("dimnames") = lowerEndpointMatr.attr("dimnames") = transMatr.attr("dimnames"); // return a list of important results List out = List::create(_["estimate"] = estimate, _["standardError"] = standardError, _["confidenceInterval"] = List::create(_["confidenceLevel"] = confidencelevel, _["lowerEndpointMatrix"] = lowerEndpointMatr, _["upperEndpointMatrix"] = upperEndpointMatr), _["bootStrapSamples"] = pmsBootStrapped ); return out; } // convert matrix data to transition probability matrix // [[Rcpp::export(.matr2Mc)]] S4 _matr2Mc(CharacterMatrix matrData, double laplacian = 0, bool sanitize = false, CharacterVector possibleStates = CharacterVector()) { // dimension of input matrix long int nRows = matrData.nrow(), nCols = matrData.ncol(); // set of states std::set uniqueVals; // populate uniqueVals set for (long int i = 0; i < nRows; i++) for (long int j = 0; j < nCols; j++) { if (matrData(i,j) != "NA") uniqueVals.insert((std::string)matrData(i, j)); } for (int i = 0;i < possibleStates.size();i++) { uniqueVals.insert((std::string)possibleStates[i]); } // unique states int usize = uniqueVals.size(); // matrix of dimension usize NumericMatrix contingencyMatrix (usize); // state names as rows name and columns name contingencyMatrix.attr("dimnames") = List::create(uniqueVals, uniqueVals); // iterator for set of states std::set::iterator it; // populate contingency matrix int stateBegin = 0, stateEnd = 0; for (long int i = 0; i < nRows; i ++) { for (long int j = 1; j < nCols; j ++) { if (matrData(i,j-1) != "NA" && matrData(i,j) != "NA") { // row and column number of begin state and end state int k = 0; for (it = uniqueVals.begin(); it != uniqueVals.end(); ++it, k++) { if (*it == (std::string)matrData(i, j-1)) { stateBegin = k; } if (*it == (std::string)matrData(i,j)) { stateEnd = k; } } contingencyMatrix(stateBegin,stateEnd)++; } } } // add laplacian correction if needed for (int i = 0; i < usize; i++) { double rowSum = 0; for (int j = 0; j < usize; j++) { contingencyMatrix(i,j) += laplacian; rowSum += contingencyMatrix(i, j); } // get the transition matrix and a DTMC for (int j = 0; j < usize; j ++) { if (sanitize == true) { if (rowSum == 0) { contingencyMatrix(i,j) = 1.0/usize; } else { contingencyMatrix(i,j) /= rowSum; } } else { if (rowSum == 0) { contingencyMatrix(i,j) = 0; } else { contingencyMatrix(i,j) /= rowSum; } } } } // markovchain object S4 outMc("markovchain"); outMc.slot("transitionMatrix") = contingencyMatrix; return(outMc); } // convert matrix data to transition probability matrix // [[Rcpp::export(.list2Mc)]] S4 _list2Mc(List data, double laplacian = 0, bool sanitize = false) { // set of states std::set uniqueVals; // populate uniqueVals set for (long int i = 0; i < data.size(); i++) { CharacterVector temp = as(data[i]); for (long int j = 0; j < temp.size(); j++) { uniqueVals.insert((std::string)temp[j]); } } // unique states int usize = uniqueVals.size(); // matrix of dimension usize NumericMatrix contingencyMatrix (usize); // state names as rows name and columns name contingencyMatrix.attr("dimnames") = List::create(uniqueVals, uniqueVals); // iterator for set of states std::set::iterator it; // populate contingency matrix int stateBegin = 0, stateEnd = 0; for (long int i = 0; i < data.size(); i ++) { CharacterVector temp = as(data[i]); for (long int j = 1; j < temp.size(); j ++) { // row and column number of begin state and end state int k = 0; for (it = uniqueVals.begin(); it != uniqueVals.end(); ++it, k++) { if (*it == (std::string)temp[j-1]) { stateBegin = k; } if (*it == (std::string)temp[j]) { stateEnd = k; } } contingencyMatrix(stateBegin,stateEnd)++; } } // add laplacian correction if needed for (int i = 0; i < usize; i++) { double rowSum = 0; for (int j = 0; j < usize; j++) { contingencyMatrix(i,j) += laplacian; rowSum += contingencyMatrix(i, j); } // get the transition matrix and a DTMC for (int j = 0; j < usize; j ++) { if (sanitize == true) { if (rowSum == 0) { contingencyMatrix(i,j) = 1.0/usize; } else { contingencyMatrix(i,j) /= rowSum; } } else { if (rowSum == 0) { contingencyMatrix(i,j) = 0; } else { contingencyMatrix(i,j) /= rowSum; } } } } // markovchain object S4 outMc("markovchain"); outMc.slot("transitionMatrix") = contingencyMatrix; return(outMc); } //' @name inferHyperparam //' @title Function to infer the hyperparameters for Bayesian inference from an a priori matrix or a data set //' @description Since the Bayesian inference approach implemented in the package is based on conjugate priors, //' hyperparameters must be provided to model the prior probability distribution of the chain //' parameters. The hyperparameters are inferred from a given a priori matrix under the assumption //' that the matrix provided corresponds to the mean (expected) values of the chain parameters. A //' scaling factor vector must be provided too. Alternatively, the hyperparameters can be inferred //' from a data set. //' //' @param transMatr A valid transition matrix, with dimension names. //' @param scale A vector of scaling factors, each element corresponds to the row names of the provided transition //' matrix transMatr, in the same order. //' @param data A data set from which the hyperparameters are inferred. //' //' @details transMatr and scale need not be provided if data is provided. //' @return Returns the hyperparameter matrix in a list. //' //' @note The hyperparameter matrix returned is such that the row and column names are sorted alphanumerically, //' and the elements in the matrix are correspondingly permuted. //' //' @references Yalamanchi SB, Spedicato GA (2015). Bayesian Inference of First Order Markov Chains. R //' package version 0.2.5 //' //' @author Sai Bhargav Yalamanchi, Giorgio Spedicato //' @seealso \code{\link{markovchainFit}}, \code{\link{predictiveDistribution}} //' //' @examples //' data(rain, package = "markovchain") //' inferHyperparam(data = rain$rain) //' //' weatherStates <- c("sunny", "cloudy", "rain") //' weatherMatrix <- matrix(data = c(0.7, 0.2, 0.1, //' 0.3, 0.4, 0.3, //' 0.2, 0.4, 0.4), //' byrow = TRUE, nrow = 3, //' dimnames = list(weatherStates, weatherStates)) //' inferHyperparam(transMatr = weatherMatrix, scale = c(10, 10, 10)) //' //' @export //' // [[Rcpp::export]] List inferHyperparam(NumericMatrix transMatr = NumericMatrix(), NumericVector scale = NumericVector(), CharacterVector data = CharacterVector()) { // stop if there is only one element in the matrix and size of data sequence is zero if (transMatr.nrow() * transMatr.ncol() == 1 && data.size() == 0) stop("Provide the prior transition matrix or the data set in order to infer the hyperparameters"); // to store final result List out; // Number of elements are greater than 1 if (transMatr.nrow() * transMatr.ncol() != 1) { if (scale.size() == 0) { stop("Provide a non-zero scaling factor vector to infer integer hyperparameters"); } // --------begin validity checks for the transition matrix--------- if (transMatr.nrow() != transMatr.ncol()) { stop("Transition matrix dimensions are inconsistent"); } // number of rows in transition matrix int sizeMatr = transMatr.nrow(); // if any element is greater than 1 or less than 0 then raise error // sum of each rows must lie between 1 - eps and 1 + eps for (int i = 0; i < sizeMatr; i++) { double rowSum = 0., eps = 1e-10; for (int j = 0; j < sizeMatr; j++) { if (transMatr(i, j) < 0. || transMatr(i, j) > 1.) stop("The entries in the transition matrix must each belong to the interval [0, 1]"); else rowSum += transMatr(i, j); } if (rowSum <= 1. - eps || rowSum >= 1. + eps) stop("Each rows of the transition matrix must sum to 1"); } // rows and columns name of transition matrix List dimNames = transMatr.attr("dimnames"); CharacterVector colNames = dimNames[1]; CharacterVector rowNames = dimNames[0]; // sorted rows and columns names CharacterVector sortedColNames(sizeMatr), sortedRowNames(sizeMatr); for (int i = 0; i < sizeMatr; i++) { sortedColNames(i) = colNames(i), sortedRowNames(i) = rowNames(i); } sortedColNames.sort(); sortedRowNames.sort(); // rows names vector and columns name vector must be same // and no names in names vectors should be same for (int i = 0; i < sizeMatr; i++) { if (i > 0 && (sortedColNames(i) == sortedColNames(i-1) || sortedRowNames(i) == sortedRowNames(i-1))) stop("The states must all be unique"); else if (sortedColNames(i) != sortedRowNames(i)) stop("The set of row names must be the same as the set of column names"); } // --------end of validity checks for the transition matrix--------- // --------beginning of validity checks for the scale factor vector--------- // length of scale vector must be equal to number of rows in transition matrix if (scale.size() != sizeMatr) stop("The dimensions of the scale vector must match the number of states in the chain"); // if any value in the scale vector is zero for (int i = 0; i < sizeMatr; i++) { if (scale(i) == 0) stop("The scaling factors must be non-zero!"); } // --------end of validity checks for the scale factor vector--------- // Creation of output matrix i.e. hyper param matrix NumericMatrix hpScaled(sizeMatr); hpScaled.attr("dimnames") = List::create(rowNames, colNames); // populate hyper param matrix for (int i = 0; i < sizeMatr; i++) for (int j = 0; j < sizeMatr; j++) hpScaled(i, j) = scale(i) * transMatr(i, j); /* shift rows and columns so that names of rows and columns names will be in sorted order */ hpScaled = sortByDimNames(hpScaled); // store list of hyper param scaled matrix out = List::create(_["scaledInference"] = hpScaled); } else if (data.size() != 0) { // to store unique states in sorted order CharacterVector elements = data; for (int i = 0; i < data.size(); i++) elements.push_back(data[i]); elements = unique(elements).sort(); // size of hyperparam matrix int sizeMatr = elements.size(); // create hyperparam matrix NumericMatrix hpData(sizeMatr); hpData.attr("dimnames") = List::create(elements, elements); std::fill(hpData.begin(), hpData.end(), 1); // populate hyper param matrix int posFrom = 0, posTo = 0; for (long int i = 0; i < data.size() - 1; i ++) { for (int j = 0; j < sizeMatr; j ++) { if (data[i] == elements[j]) posFrom = j; if (data[i + 1] == elements[j]) posTo = j; } hpData(posFrom,posTo)++; } // ouput data out = List::create(_["dataInference"] = hpData); } return out; } //' @name markovchainFit //' @title Function to fit a discrete Markov chain //' @description Given a sequence of states arising from a stationary state, //' it fits the underlying Markov chain distribution using either MLE (also using a //' Laplacian smoother), bootstrap or by MAP (Bayesian) inference. //' //' @param data It can be a character vector or a \deqn{n x n} matrix or a \deqn{n x n} data frame or a list //' @param method Method used to estimate the Markov chain. Either "mle", "map", "bootstrap" or "laplace" //' @param byrow it tells whether the output Markov chain should show the transition probabilities by row. //' @param nboot Number of bootstrap replicates in case "bootstrap" is used. //' @param laplacian Laplacian smoothing parameter, default zero. It is only used when "laplace" method //' is chosen. //' @param name Optional character for name slot. //' @param parallel Use parallel processing when performing Boostrap estimates. //' @param confidencelevel \deqn{\alpha} level for conficence intervals width. //' Used only when \code{method} equal to "mle". //' @param confint a boolean to decide whether to compute Confidence Interval or not. //' @param hyperparam Hyperparameter matrix for the a priori distribution. If none is provided, //' default value of 1 is assigned to each parameter. This must be of size //' \deqn{k x k} where k is the number of states in the chain and the values //' should typically be non-negative integers. //' @param stringchar It can be a \deqn{n x n} matrix or a character vector or a list //' @param toRowProbs converts a sequence matrix into a probability matrix //' @param sanitize put 1 in all rows having rowSum equal to zero //' @param possibleStates Possible states which are not present in the given sequence //' //' @details Disabling confint would lower the computation time on large datasets. If \code{data} or \code{stringchar} //' contain \code{NAs}, the related \code{NA} containing transitions will be ignored. //' //' @return A list containing an estimate, log-likelihood, and, when "bootstrap" method is used, a matrix //' of standards deviations and the bootstrap samples. When the "mle", "bootstrap" or "map" method //' is used, the lower and upper confidence bounds are returned along with the standard error. //' The "map" method also returns the expected value of the parameters with respect to the //' posterior distribution. //' @references A First Course in Probability (8th Edition), Sheldon Ross, Prentice Hall 2010 //' //' Inferring Markov Chains: Bayesian Estimation, Model Comparison, Entropy Rate, //' and Out-of-Class Modeling, Christopher C. Strelioff, James P. Crutchfield, //' Alfred Hubler, Santa Fe Institute //' //' Yalamanchi SB, Spedicato GA (2015). Bayesian Inference of First Order Markov Chains. R //' package version 0.2.5 //' //' @author Giorgio Spedicato, Tae Seung Kang, Sai Bhargav Yalamanchi //' @note This function has been rewritten in Rcpp. Bootstrap algorithm has been defined "heuristically". //' In addition, parallel facility is not complete, involving only a part of the bootstrap process. //' When \code{data} is either a \code{data.frame} or a \code{matrix} object, only MLE fit is //' currently available. //' //' @seealso \code{\link{markovchainSequence}}, \code{\link{markovchainListFit}} //' @examples //' sequence <- c("a", "b", "a", "a", "a", "a", "b", "a", "b", "a", "b", "a", "a", //' "b", "b", "b", "a") //' sequenceMatr <- createSequenceMatrix(sequence, sanitize = FALSE) //' mcFitMLE <- markovchainFit(data = sequence) //' mcFitBSP <- markovchainFit(data = sequence, method = "bootstrap", nboot = 5, name = "Bootstrap Mc") //' //' na.sequence <- c("a", NA, "a", "b") //' # There will be only a (a,b) transition //' na.sequenceMatr <- createSequenceMatrix(na.sequence, sanitize = FALSE) //' mcFitMLE <- markovchainFit(data = na.sequence) //' //' # data can be a list of character vectors //' sequences <- list(x = c("a", "b", "a"), y = c("b", "a", "b", "a", "c")) //' mcFitMap <- markovchainFit(sequences, method = "map") //' mcFitMle <- markovchainFit(sequences, method = "mle") //' @rdname markovchainFit //' //' @export //' // [[Rcpp::export]] List markovchainFit(SEXP data, String method = "mle", bool byrow = true, int nboot = 10, double laplacian = 0, String name = "", bool parallel = false, double confidencelevel = 0.95, bool confint = true, NumericMatrix hyperparam = NumericMatrix(), bool sanitize = false, CharacterVector possibleStates = CharacterVector()) { if (method != "mle" && method != "bootstrap" && method != "map" && method != "laplace") { stop ("method should be one of \"mle\", \"bootsrap\", \"map\" or \"laplace\""); } // list to store the output List out; // if input data is data frame or matrix if (Rf_inherits(data, "data.frame") || Rf_isMatrix(data)) { // store input data in mat CharacterMatrix mat; // if data is a data.frame force it to matrix if (Rf_inherits(data, "data.frame")) { DataFrame df(data); // matrix : no of rows = no of rows in df : same for number of columns mat = CharacterMatrix(df.nrows(), df.size()); for (long int i = 0; i < df.size(); i++) mat(_,i) = CharacterVector(df[i]); } else { mat = data; } // byrow assumes distinct observations (trajectiories) are per row // otherwise transpose if (!byrow) mat = transposeMatrix(mat); S4 outMc = _matr2Mc(mat, laplacian, sanitize, possibleStates); // whether to compute confidence interval or not if (confint) { // convert matrix to list int nrows = mat.nrow(); List manyseq(nrows); for (int i = 0; i < nrows; i++) manyseq[i] = mat(i, _); out = _mcFitMle(manyseq, byrow, confidencelevel, sanitize, possibleStates); out[0] = outMc; } else { out = List::create(_["estimate"] = outMc); } } else if (TYPEOF(data) == VECSXP) { if (method == "mle") { out = _mcFitMle(data, byrow, confidencelevel, sanitize, possibleStates); } else if (method == "map") { out = _mcFitMap(data, byrow, confidencelevel, hyperparam, sanitize, possibleStates); } else stop("method not available for a list"); } else { if (method == "mle") { out = _mcFitMle(data, byrow, confidencelevel, sanitize, possibleStates); } else if (method == "bootstrap") { out = _mcFitBootStrap(data, nboot, byrow, parallel, confidencelevel, sanitize, possibleStates); } else if (method == "laplace") { out = _mcFitLaplacianSmooth(data, byrow, laplacian, sanitize, possibleStates); } else if (method == "map") { out = _mcFitMap(data, byrow, confidencelevel, hyperparam, sanitize, possibleStates); } } // markovchain object S4 estimate = out["estimate"]; if (name != "") { estimate.slot("name") = name; } // transition matrix NumericMatrix transMatr = estimate.slot("transitionMatrix"); // data is neither data frame nor matrix if (!Rf_inherits(data, "data.frame") && !Rf_isMatrix(data) && TYPEOF(data) != VECSXP) out["logLikelihood"] = _loglikelihood(data, transMatr); estimate.slot("states") = rownames(transMatr); out["estimate"] = estimate; return out; } // [[Rcpp::export(.noofVisitsDistRCpp)]] NumericVector noofVisitsDistRCpp(NumericMatrix matrix, int i,int N) { // no of states in the process int noOfStates = matrix.ncol(); arma::vec out = arma::zeros(noOfStates); arma::mat Tmatrix = as(matrix); arma::mat temp = Tmatrix; // initial distribution is in the transition matrix itself for (int j = 0; j < noOfStates; j++) out[j] = Tmatrix(i - 1, j); //The distribution for Nth step is calculates after N multiplication of the transition matrix // and adding everytime the coresponding ratios // finally dividing by N for (int p = 0; p < N - 1; p++) { temp = temp * Tmatrix; for (int j = 0; j < noOfStates; j++) out[j] += temp(i - 1, j); } out = out/N; NumericVector R = wrap(out); return R; } #endif markovchain/src/ctmcClassesAndMethods.cpp0000644000176200001440000000304614714756746020312 0ustar liggesusers#include using namespace Rcpp; //' @name generatorToTransitionMatrix //' @title Function to obtain the transition matrix from the generator //' @description The transition matrix of the embedded DTMC is inferred from the CTMC's generator //' //' @usage generatorToTransitionMatrix(gen, byrow = TRUE) //' //' @param gen The generator matrix //' @param byrow Flag to determine if rows (columns) sum to 0 //' @return Returns the transition matrix. //' //' @references //' Introduction to Stochastic Processes with Applications in the Biosciences (2013), David F. //' Anderson, University of Wisconsin at Madison //' //' @author Sai Bhargav Yalamanchi //' @seealso \code{\link{rctmc}},\code{\link{ctmc-class}} //' @examples //' energyStates <- c("sigma", "sigma_star") //' byRow <- TRUE //' gen <- matrix(data = c(-3, 3, 1, -1), nrow = 2, //' byrow = byRow, dimnames = list(energyStates, energyStates)) //' generatorToTransitionMatrix(gen) //' //' @export // [[Rcpp::export]] NumericMatrix generatorToTransitionMatrix(NumericMatrix gen, bool byrow = true){ NumericMatrix transMatr(gen.nrow()); transMatr.attr("dimnames") = gen.attr("dimnames"); if (byrow) { for (int i = 0; i < gen.nrow(); i++){ for (int j = 0; j < gen.ncol(); j++){ if (i != j) transMatr(i, j) = -gen(i, j) / gen(i, i); } } } else { for (int j = 0; j < gen.ncol(); j++){ for (int i = 0; i < gen.nrow(); i++){ if (i != j) transMatr(i, j) = -gen(i, j) / gen(j, j); } } } return transMatr; } markovchain/src/mapFitFunctions.h0000644000176200001440000001732714714756746016664 0ustar liggesusers/* * Function to remove NA values from a vector */ CharacterVector clean_nas(CharacterVector elements_na){ CharacterVector elements; for(int i = 0; i < elements_na.size();i++) if(elements_na[i] != "NA") elements.push_back(elements_na[i]); return elements; } List _mcFitMap(SEXP data, bool byrow, double confidencelevel, NumericMatrix hyperparam = NumericMatrix(), bool sanitize = false, CharacterVector possibleStates = CharacterVector()) { if(TYPEOF(data) != VECSXP) { data = List::create(as(data)); } List seqs = as(data); CharacterVector elements; for(int i = 0;i < (int)seqs.size();i++) { CharacterVector tseq = unique(as(seqs[i])); for(int j = 0;j < (int)tseq.size();j++) { if(tseq[j] != "NA") { elements.push_back(tseq[j]); } } } elements = unique(union_(elements, possibleStates)).sort(); // number of unique states int sizeMatr = elements.size(); // if no hyperparam argument provided, use default value of 1 for all if(hyperparam.nrow() == 1 && hyperparam.ncol() == 1) { // matrix with all entries 1 NumericMatrix temp(sizeMatr, sizeMatr); temp.attr("dimnames") = List::create(elements, elements); for(int i = 0; i < sizeMatr; i++) for(int j = 0; j < sizeMatr; j++) temp(i, j) = 1; hyperparam = temp; } //-----------beginning of validity checking of hyperparam matrix---------------------- // validity check for hyperparam matrix if(hyperparam.nrow() != hyperparam.ncol()) { stop("Dimensions of the hyperparameter matrix are inconsistent"); } if(hyperparam.nrow() < sizeMatr) { stop("Hyperparameters for all state transitions must be provided"); } // extract rows and columns name out of hyperparam matrix List dimNames = hyperparam.attr("dimnames"); CharacterVector colNames = dimNames[1]; CharacterVector rowNames = dimNames[0]; // size of hyperparam matrix int sizeHyperparam = hyperparam.ncol(); // sorted order of hyperparam rows and columns name CharacterVector sortedColNames(sizeHyperparam), sortedRowNames(sizeHyperparam); for(int i = 0; i < sizeHyperparam; i++) { sortedColNames(i) = colNames(i), sortedRowNames(i) = rowNames(i); } sortedColNames.sort(); sortedRowNames.sort(); // validity of hyperparam matrix for(int i = 0; i < sizeHyperparam; i++){ // columns names must be different // rows names must be different if(i > 0 && (sortedColNames(i) == sortedColNames(i-1) || sortedRowNames(i) == sortedRowNames(i-1))) { stop("The states must all be unique"); } // same states should be present in rows and columns else if(sortedColNames(i) != sortedRowNames(i)) { stop("The set of row names must be the same as the set of column names"); } // chech whether any state in column names exists which is not in the given sequence bool found = false; for(int j = 0; j < sizeMatr; j++) { if(elements(j) == sortedColNames(i)) { found = true; break; } } // hyperparam may contain states not in stringchar if(!found) { elements.push_back(sortedColNames(i)); } } // check for the case where hyperparam has missing data for(int i = 0; i < sizeMatr; i++){ bool found = false; for(int j = 0; j < sizeHyperparam; j++) { if(sortedColNames(j) == elements(i)) { found = true; break; } } if(!found) stop("Hyperparameters for all state transitions must be provided"); } elements = elements.sort(); sizeMatr = elements.size(); for(int i = 0; i < sizeMatr; i++) for(int j = 0; j < sizeMatr; j++) if(hyperparam(i, j) < 1.) stop("The hyperparameter elements must all be greater than or equal to 1"); //-----------end of validity checking of hyperparam matrix---------------------- // permute the elements of hyperparam such that the row, column names are sorted hyperparam = sortByDimNames(hyperparam); // helper matrices which will help in the calculation of transition matrix // other matrices will be returned as a result NumericMatrix mapEstMatr(sizeMatr), expMatr(sizeMatr); NumericMatrix freqMatr(sizeMatr); mapEstMatr.attr("dimnames") = List::create(elements, elements); expMatr.attr("dimnames") = List::create(elements, elements); // matrices to be returned NumericMatrix lowerEndpointMatr = NumericMatrix(mapEstMatr.nrow(), mapEstMatr.ncol()); NumericMatrix upperEndpointMatr = NumericMatrix(mapEstMatr.nrow(), mapEstMatr.ncol()); NumericMatrix stdError = NumericMatrix(mapEstMatr.nrow(), mapEstMatr.ncol()); // populate frequeny matrix for old data; this is used for inference for(int k = 0;k < seqs.size();k++) { CharacterVector stringchar = as(seqs[k]); int posFrom = 0, posTo = 0; for(long int i = 0; i < stringchar.size() - 1; i ++) { if(stringchar[i] != "NA" && stringchar[i+1] != "NA"){ for (int j = 0; j < sizeMatr; j ++) { if(stringchar[i] == elements[j]) posFrom = j; if(stringchar[i + 1] == elements[j]) posTo = j; } freqMatr(posFrom,posTo)++; } } } // sanitize and to row probs for (int i = 0; i < sizeMatr; i++) { // rowsum of frequency matrix and hyperparam matrix double rowSum = 0, paramRowSum = 0; for (int j = 0; j < sizeMatr; j++) { rowSum += freqMatr(i, j), paramRowSum += hyperparam(i, j); } // toRowProbs for (int j = 0; j < sizeMatr; j++) { // confidence intervals and bounds double p = freqMatr(i, j) + hyperparam(i, j), q = rowSum + paramRowSum - freqMatr(i, j) - hyperparam(i, j); // expected value of the transition parameters expMatr(i, j) = p / (p + q); if(p + q == sizeMatr) { mapEstMatr(i, j) = (sanitize ? 1.0 / sizeMatr : 0); } else { // maximum a posteriori estimate mapEstMatr(i, j) = (p - 1) / (p + q - sizeMatr); } // populate lowerEndPoint, upperEndPoint and stand error matrices double beta = lbeta(p, q); double cdf = betain(double(mapEstMatr(i, j)), p, q, beta); if(cdf + confidencelevel / 2 > 1.) { upperEndpointMatr(i, j) = 1.; lowerEndpointMatr(i, j) = xinbta(p, q, beta, 1 - confidencelevel); } else if(cdf - confidencelevel / 2 < 0.) { lowerEndpointMatr(i, j) = 0.; upperEndpointMatr(i, j) = xinbta(p, q, beta, confidencelevel); } else { lowerEndpointMatr(i, j) = xinbta(p, q, beta, cdf - confidencelevel / 2); upperEndpointMatr(i, j) = xinbta(p, q, beta, cdf + confidencelevel / 2); } stdError(i, j) = sqrt(p * q / (p + q) / (p + q) / (1 + p + q)); } } // transpose the matrix if columwise result is required if(byrow == false) { mapEstMatr = transposeMatrix(mapEstMatr); } // markovchain object S4 outMc("markovchain"); outMc.slot("transitionMatrix") = mapEstMatr; outMc.slot("name") = "Bayesian Fit"; // message("\n\'estimate\' is the MAP set of parameters where as \'expectedValue\' \nis the expectation // of the parameters with respect to the posterior.\nThe confidence intervals are given for \'estimate\'."); return List::create(_["estimate"] = outMc, _["expectedValue"] = expMatr, _["standardError"] = stdError, _["confidenceInterval"] = List::create(_["confidenceLevel"] = confidencelevel, _["lowerEndpointMatrix"] = lowerEndpointMatr, _["upperEndpointMatrix"] = upperEndpointMatr)); } markovchain/src/ctmcFittingFunctions.cpp0000644000176200001440000001057114714756746020244 0ustar liggesusers#include #include using namespace Rcpp; #include List markovchainFit(SEXP data, String method = "mle", bool byrow = true, int nboot = 10, double laplacian = 0, String name = "", bool parallel = false, double confidencelevel = 0.95, bool confint = true, NumericMatrix hyperparam = NumericMatrix(), bool sanitize = false, CharacterVector possibleStates = CharacterVector()); //' @name ctmcFit //' @title Function to fit a CTMC //' @description This function fits the underlying CTMC give the state //' transition data and the transition times using the maximum likelihood //' method (MLE) //' @usage ctmcFit(data, byrow = TRUE, name = "", confidencelevel = 0.95) //' @param data It is a list of two elements. The first element is a character //' vector denoting the states. The second is a numeric vector denoting the //' corresponding transition times. //' @param byrow Determines if the output transition probabilities of the //' underlying embedded DTMC are by row. //' @param name Optional name for the CTMC. //' @param confidencelevel Confidence level for the confidence interval //' construnction. //' @return It returns a list containing the CTMC object and the confidence intervals. //' //' @details Note that in data, there must exist an element wise corresponding //' between the two elements of the list and that data[[2]][1] is always 0. //' @references Continuous Time Markov Chains (vignette), Sai Bhargav Yalamanchi, Giorgio Alfredo Spedicato 2015 //' @author Sai Bhargav Yalamanchi //' @seealso \code{\link{rctmc}} //' //' @examples //' data <- list(c("a", "b", "c", "a", "b", "a", "c", "b", "c"), c(0, 0.8, 2.1, 2.4, 4, 5, 5.9, 8.2, 9)) //' ctmcFit(data) //' //' @export //' // [[Rcpp::export]] List ctmcFit(List data, bool byrow=true, String name="", double confidencelevel = 0.95) { CharacterVector stateData(as(data[0]).size()); for (int i = 0; i < as(data[0]).size(); i++) stateData[i] = as(data[0])[i]; NumericVector transData = data[1]; CharacterVector sortedStates = unique(as(data[0])).sort(); NumericVector stateCount(sortedStates.size()); NumericVector stateSojournTime(sortedStates.size()); List dtmcData = markovchainFit(stateData, "mle", byrow, 10, 0, name, false, confidencelevel); for (int i = 0; i < stateData.size() - 1; i++){ int idx = std::find(sortedStates.begin(), sortedStates.end(), stateData[i]) - sortedStates.begin(); stateCount[idx]++; stateSojournTime[idx] += transData[i+1] - transData[i]; } S4 dtmcEst = dtmcData["estimate"]; NumericMatrix gen = dtmcEst.slot("transitionMatrix"); for (int i = 0; i < gen.nrow(); i++){ for (int j = 0; j < gen.ncol(); j++){ if (stateCount[i] > 0) gen(i, j) *= stateCount[i] / stateSojournTime[i]; } if (stateCount[i] > 0) gen(i, i) = - stateCount[i] / stateSojournTime[i]; else gen(i, i) = -1; } double zscore = stats::qnorm_0(confidencelevel, 1.0, 0.0); NumericVector lowerConfVecLambda(sortedStates.size()), upperConfVecLambda(sortedStates.size()); for (int i = 0; i < sortedStates.size(); i++){ if (stateCount[i] > 0){ auto factor = stateCount[i] / stateSojournTime[i] * (1 - zscore / sqrt(stateCount[i])); lowerConfVecLambda(i) = std::max(0., factor); upperConfVecLambda(i) = std::min(1., factor); } else { lowerConfVecLambda(i) = 1; upperConfVecLambda(i) = 1; } } S4 outCtmc("ctmc"); outCtmc.slot("states") = sortedStates; outCtmc.slot("generator") = gen; outCtmc.slot("name") = name; return List::create(_["estimate"] = outCtmc, _["errors"] = List::create( _["dtmcConfidenceInterval"] = List::create( _["confidenceLevel"] = dtmcData["confidenceLevel"], _["lowerEndpointMatrix"] = dtmcData["lowerEndpointMatrix"], _["upperEndpointMatrix"] = dtmcData["upperEndpointMatrix"]), _["lambdaConfidenceInterval"] = List::create( _["lowerEndpointVector"] = lowerConfVecLambda, _["upperEndpointVector"] = upperConfVecLambda)) ); } markovchain/src/Makevars0000644000176200001440000000022214714756746015060 0ustar liggesusersPKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) #CXX_STD = CXX11 PKG_LIBS += $(shell ${R_HOME}/bin/Rscript -e "RcppParallel::RcppParallelLibs()") markovchain/src/fitHigherOrder.cpp0000644000176200001440000000261314714756746017003 0ustar liggesusers// [[Rcpp::depends(RcppArmadillo)]] #include using namespace Rcpp; // sequence to frequency probability vector //' @export // [[Rcpp::export]] NumericVector seq2freqProb(CharacterVector sequence) { int n = sequence.size(); CharacterVector states = unique(sequence).sort(); int nstates = states.length(); NumericVector v(nstates); v.names() = states; for (int i = 0; i < n; i ++) v[std::string(sequence[i])] = v[std::string(sequence[i])] + 1.0; NumericVector out = v/sum(v); out.names() = v.names(); return out; } // sequence to transition matrix for higher order markov chai //' @export // [[Rcpp::export]] NumericMatrix seq2matHigh(CharacterVector sequence, int order) { int n = sequence.size(); CharacterVector states = unique(sequence).sort(); int nstates = states.length(); NumericVector colsums(nstates); NumericMatrix out(nstates); out.attr("dimnames") = List::create(states, states); for (int i = 0; i < n - order; i++) { int from = -1, to = -1; for (int j = 0; j < nstates; j++) { if (sequence[i] == states[j]) from = j; if (sequence[i + order] == states[j]) to = j; } if (from != -1 && to != -1) { out(to, from) ++; colsums[from] ++; } } for (int i = 0; i < nstates; i ++) { for (int j = 0; j < nstates; j ++) out(i, j) /= colsums[j]; } return out; } markovchain/src/multinomCI.cpp0000644000176200001440000001135214714756746016156 0ustar liggesusers// [[Rcpp::depends(RcppArmadillo)]] #include using namespace Rcpp; // returns the column sums of a matrix NumericVector colSums(NumericMatrix m) { NumericVector out; for (int i = 0; i < m.cols(); i ++) out.push_back(sum(m.column(i))); return out; } // poisson distribution double ppois(double n, double lambda) { return R::ppois(n,lambda, true, false); } // moments NumericVector moments(int c, double lambda) { double a = lambda+c; double b = lambda-c; double den = 0, poisA = 0, poisB = 0; if (b < 0) b = 0; if (b > 0) den = ppois(a, lambda) - ppois(b - 1, lambda); if (b == 0) den = ppois(a, lambda); NumericVector mu(4); NumericVector mom(5); for (int r = 1; r <= 4; r ++) { poisA = 0; poisB = 0; if ((a - r) >= 0) poisA = ppois(a, lambda) - ppois(a - r, lambda); if ((a - r) < 0) poisA = ppois(a, lambda); if ((b - r - 1) >= 0) poisB = ppois(b - 1, lambda) - ppois(b - r - 1, lambda); if ((b - r - 1) < 0 && (b - 1) >= 0) poisB = ppois(b - 1, lambda); if ((b - r - 1) < 0 && (b - 1) < 0) poisB = 0; mu[r - 1] = (pow(lambda, r)) * (1 - (poisA - poisB)/den); } mom[0] = mu[0]; mom[1] = mu[1] + mu[0] - pow(mu[0], 2); mom[2] = mu[2] + mu[1] * (3 - 3*mu[0]) + (mu[0] - 3*pow(mu[0], 2) + 2*pow(mu[0], 3)); mom[3] = mu[3] + mu[2] * (6 - 4*mu[0]) + mu[1] * (7 - 12*mu[0] + 6*pow(mu[0], 2)) + mu[0] - 4 * pow(mu[0], 2) + 6 * pow(mu[0], 3) - 3 * pow(mu[0], 4); mom[4] = den; return mom; } // coverage probability for the particular choice of c double truncpoi(int c, NumericVector x, double n, int k) { NumericMatrix m(k,5); for (int i = 0; i < k; i++) { double lambda = x[i]; NumericVector mom = moments(c, lambda); for (int j = 0; j < 5; j ++) m(i, j) = mom[j]; } for (int i = 0; i < k; i ++) m(i, 3) = m(i, 3) - 3 * m(i, 1) * m(i, 1); NumericVector s = colSums(m); double s1 = s[0]; double s2 = s[1]; double s3 = s[2]; double s4 = s[3]; double probn = 1 / (ppois(n, n) - ppois(n - 1, n)); double z = (n - s1) / sqrt(s2); double g1 = s3 / (pow(s2, (3.0 / 2.0))); double g2 = s4 / (pow(s2, 2)); double poly = 1.0 + g1 * (pow(z, 3) - 3 * z) / 6.0 + g2 * (pow(z, 4) - 6.0 * pow(z, 2) + 3.0) / 24.0 + pow(g1, 2) * (pow(z, 6) - 15.0 * pow(z, 4) + 45.0*pow(z, 2) - 15.0)/72.0; double f = poly * exp(-pow(z, 2)/2) / (sqrt(2.0) * R::gammafn(0.5)); double probx=1; for (int i = 0; i < k; i++) probx = probx * m(i, 4); return(probn * probx * f / sqrt(s2)); } // multinomial confidence intervals for a row // [[Rcpp::export(.multinomialCIForRowRcpp)]] NumericMatrix multinomialCIForRow(NumericVector x, double confidencelevel) { double n = std::accumulate(x.begin(), x.end(), 0.0); int k = x.size(); double c = 0; double p = 0, pold = 0; for (int cc = 1; cc <= n; cc ++) { p = truncpoi(cc, x, n, k); if (p > confidencelevel && pold < confidencelevel) { c = cc; break; } pold = p; } NumericMatrix salida(k, 2); double delta = (confidencelevel - pold) / (p - pold); NumericMatrix out(k,5); NumericMatrix num(k,1); c--; double obsp = 0; for (int i = 0; i < k; i++) { num(i, 0) = i; obsp = x[i] / n; out(i, 0) = obsp; out(i, 1) = obsp - c/n; out(i, 2) = obsp + c/n + 2*delta/n; if (out(i, 1) < 0) out(i, 1) = 0; if (out(i, 2) > 1) out(i, 2) = 1; out(i, 3) = obsp - c/n - 1/n; out(i, 4) = obsp + c/n + 1/n; salida(i, 0) = out(i, 1); salida(i, 1) = out(i, 2); } return salida; } // multinomial confidence intervals // [[Rcpp::export(.multinomialCIRcpp)]] List multinomCI(NumericMatrix transMat, NumericMatrix seqMat, double confidencelevel) { NumericMatrix res; NumericVector v; int nrows = transMat.nrow(); int ncols = transMat.ncol(); NumericMatrix lowerEndpointMatr(nrows, ncols); NumericMatrix upperEndpointMatr(nrows, ncols); double lowerEndpoint, upperEndpoint; for (int i = 0; i < nrows; i ++) { v = seqMat.row(i); res = multinomialCIForRow(v, confidencelevel); for (int j = 0; j < res.rows(); j++) { lowerEndpoint = res(j, 0); lowerEndpointMatr(i,j) = lowerEndpoint; upperEndpoint = res(j, 1); upperEndpointMatr(i,j) = upperEndpoint; } } upperEndpointMatr.attr("dimnames") = lowerEndpointMatr.attr("dimnames") = seqMat.attr("dimnames"); List out = List::create(_["confidenceLevel"] = confidencelevel, _["lowerEndpointMatrix"] = lowerEndpointMatr, _["upperEndpointMatrix"] = upperEndpointMatr); return out; } markovchain/src/probabilistic.cpp0000644000176200001440000013202014714756746016720 0ustar liggesusers// [[Rcpp::depends(RcppArmadillo)]] #include #include #include #include #include #include using namespace Rcpp; using namespace std; using namespace arma; template T sortByDimNames(const T m); typedef unsigned int uint; // Returns whether a Markov chain is ergodic // Declared in this same file bool isIrreducible(S4 obj); // Declared in utils.cpp bool anyElement(const mat& matrix, bool (*condition)(const double&)); // Declared in utils.cpp bool allElements(const mat& matrix, bool (*condition)(const double&)); // Declared in utils.cpp bool approxEqual(const cx_double& a, const cx_double& b); // Used in commClassesKernel void strongConnect(int v, vector& disc, vector& low, vector& onStack, int& index, stack& exploring, NumericMatrix& P, vector>& components, int numStates) { disc[v] = index; low[v] = index; ++index; exploring.push(v); onStack[v] = true; // For each edge (v, w) that goes out of v for (int w = 0; w < numStates; ++w) { if (P(v, w) > 0) { // If w has not been visited yet, compute [w], and update // the minimum node we can travel to from v if (disc[w] == -1) { strongConnect(w, disc, low, onStack, index, exploring, P, components, numStates); low[v] = min(low[v], low[w]); // Otherwise, if w is on the stack of nodes been explored, // update the minimum node we can travel to from v } else if (onStack[w]) { low[v] = min(low[v], disc[w]); } // Otherwise, (v, w) is a cross edge between components // in the DFS tree, do nothing } } // If v is the root of [v], unwind the strongly connected // component from the stack if (low[v] == disc[v]) { bool remaining = true; unordered_set component; int w; while (remaining) { w = exploring.top(); exploring.pop(); component.insert(w); onStack[w] = false; remaining = w != v; } components.push_back(component); } } // This method is based on Tarjan's algorithm to find strongly // connected components in a directed graph: // https://en.wikipedia.org/wiki/Tarjan's_strongly_connected_components_algorithm // to compute the communicating classes. // Output: // - classes: a matrix whose entry (i, j) is true iff i and // j are in the same communicating class // - closed: a vector whose i-th entry indicates whether the // class [i] is closed // // [[Rcpp::export(.commClassesKernelRcpp)]] List commClassesKernel(NumericMatrix P) { // The matrix must be stochastic by rows int numStates = P.ncol(); vector disc(numStates, -1); vector low(numStates, -1); vector onStack(numStates, false); vector> components; stack exploring; int index = 0; // If the component [v] has not been computed yet // (disc[v] == -1), compute it for (int v = 0; v < numStates; ++v) { if (disc[v] == -1) strongConnect(v, disc, low, onStack, index, exploring, P, components, numStates); } // Create the output data structures CharacterVector stateNames = rownames(P); LogicalMatrix classes(numStates, numStates); classes.attr("dimnames") = P.attr("dimnames"); std::fill(classes.begin(), classes.end(), false); LogicalVector closed(numStates); closed.names() = stateNames; for (auto component : components) { bool isClosed = true; // The class is closed iff there is no edge going out of the class for (int i : component) { for (int j = 0; j < numStates; ++j) if (P(i, j) > 0 && component.count(j) == 0) isClosed = false; } // Set the communicating matrix and whether it is closed or not for (int i : component) { closed(i) = isClosed; for (int j : component) classes(i, j) = true; } } return List::create(_["classes"] = classes, _["closed"] = closed); } // Wrapper that computes the communicating states from the matrix generated by // commClassesKernel (a matrix where an entry i,j is TRUE iff i and j are in the // same communicating class). It also needs the list of states names from the // Markov Chain List computeCommunicatingClasses(LogicalMatrix& commClasses, CharacterVector& states) { int numStates = states.size(); vector computed(numStates, false); List classesList; for (int i = 0; i < numStates; ++i) { CharacterVector currentClass; if (!computed[i]) { for (int j = 0; j < numStates; ++j) { if (commClasses(i, j)) { currentClass.push_back(states[j]); computed[j] = true; } } classesList.push_back(currentClass); } } return classesList; } // [[Rcpp::export(.communicatingClassesRcpp)]] List communicatingClasses(S4 object) { // Returns the underlying communicating classes // It is indifferent if the matrices are stochastic by rows or columns NumericMatrix transitionMatrix = object.slot("transitionMatrix"); bool byrow = object.slot("byrow"); CharacterVector states = object.slot("states"); if (!byrow) transitionMatrix = transpose(transitionMatrix); List commClassesList = commClassesKernel(transitionMatrix); LogicalMatrix commClasses = commClassesList["classes"]; return computeCommunicatingClasses(commClasses, states); } // Wrapper that computes the transient states from a list of the states and a // vector indicating whether the communicating class for each state is closed CharacterVector computeTransientStates(CharacterVector& states, LogicalVector& closedClass) { CharacterVector transientStates; for (int i = 0; i < states.size(); i++) if (!closedClass[i]) transientStates.push_back(states[i]); return transientStates; } // Wrapper that computes the recurrent states from a list of states and a // vector indicating whether the communicating class for each state is closed CharacterVector computeRecurrentStates(CharacterVector& states, LogicalVector& closedClass) { CharacterVector recurrentStates; for (int i = 0; i < states.size(); i++) if (closedClass[i]) recurrentStates.push_back(states[i]); return recurrentStates; } // [[Rcpp::export(.transientStatesRcpp)]] CharacterVector transientStates(S4 object) { NumericMatrix transitionMatrix = object.slot("transitionMatrix"); bool byrow = object.slot("byrow"); if (!byrow) transitionMatrix = transpose(transitionMatrix); List commKernel = commClassesKernel(transitionMatrix); LogicalVector closed = commKernel["closed"]; CharacterVector states = object.slot("states"); return computeTransientStates(states, closed); } // [[Rcpp::export(.recurrentStatesRcpp)]] CharacterVector recurrentStates(S4 object) { NumericMatrix transitionMatrix = object.slot("transitionMatrix"); bool byrow = object.slot("byrow"); CharacterVector states = object.slot("states"); if (!byrow) transitionMatrix = transpose(transitionMatrix); List commKernel = commClassesKernel(transitionMatrix); LogicalVector closed = commKernel["closed"]; return computeRecurrentStates(states, closed); } // Wrapper that computes the recurrent classes from the matrix given by // commClassesKernel (which entry i,j is TRUE iff i and j are in the same // communicating class), a vector indicating wheter the class for state is // closed and the states of the Markov Chain List computeRecurrentClasses(LogicalMatrix& commClasses, LogicalVector& closedClass, CharacterVector& states) { int numStates = states.size(); vector computed(numStates, false); List recurrentClassesList; bool isRecurrentClass; for (int i = 0; i < numStates; ++i) { CharacterVector currentClass; isRecurrentClass = closedClass(i) && !computed[i]; if (isRecurrentClass) { for (int j = 0; j < numStates; ++j) { if (commClasses(i, j)) { currentClass.push_back(states[j]); computed[j] = true; } } recurrentClassesList.push_back(currentClass); } } return recurrentClassesList; } // returns the recurrent classes // [[Rcpp::export(.recurrentClassesRcpp)]] List recurrentClasses(S4 object) { NumericMatrix transitionMatrix = object.slot("transitionMatrix"); bool byrow = object.slot("byrow"); CharacterVector states = object.slot("states"); if (!byrow) transitionMatrix = transpose(transitionMatrix); List commClassesList = commClassesKernel(transitionMatrix); LogicalMatrix commClasses = commClassesList["classes"]; LogicalVector closed = commClassesList["closed"]; return computeRecurrentClasses(commClasses, closed, states); } // Wrapper that computes the transient classes from the matrix given by // commClassesKernel (which entry i,j is TRUE iff i and j are in the same // communicating class), a vector indicating wheter the class for state is // closed and the states of the Markov Chain List computeTransientClasses(LogicalMatrix& commClasses, LogicalVector& closedClass, CharacterVector& states) { int numStates = states.size(); vector computed(numStates, false); List transientClassesList; bool isTransientClass; for (int i = 0; i < numStates; ++i) { CharacterVector currentClass; isTransientClass = !closedClass(i) && !computed[i]; if (isTransientClass) { for (int j = 0; j < numStates; ++j) { if (commClasses(i, j)) { currentClass.push_back(states[j]); computed[j] = true; } } transientClassesList.push_back(currentClass); } } return transientClassesList; } // returns the transient classes // [[Rcpp::export(.transientClassesRcpp)]] List transientClasses(S4 object) { NumericMatrix transitionMatrix = object.slot("transitionMatrix"); bool byrow = object.slot("byrow"); CharacterVector states = object.slot("states"); if (!byrow) transitionMatrix = transpose(transitionMatrix); List commClassesList = commClassesKernel(transitionMatrix); LogicalMatrix commClasses = commClassesList["classes"]; LogicalVector closed = commClassesList["closed"]; return computeTransientClasses(commClasses, closed, states); } // Defined in probabilistic.cpp mat matrixPow(const mat& A, int n); // [[Rcpp::export(.reachabilityMatrixRcpp)]] LogicalMatrix reachabilityMatrix(S4 obj) { NumericMatrix matrix = obj.slot("transitionMatrix"); // Reachability matrix int m = matrix.nrow(); mat X(matrix.begin(), m, m, true); mat reachability = eye(m, m) + sign(X); reachability = matrixPow(reachability, m - 1); LogicalMatrix result = wrap(reachability > 0); result.attr("dimnames") = matrix.attr("dimnames"); return result; } // [[Rcpp::export(.isAccessibleRcpp)]] bool isAccessible(S4 obj, String from, String to) { NumericMatrix probs = obj.slot("transitionMatrix"); CharacterVector states = obj.slot("states"); int fromPos = -1, toPos = -1; bool byrow = obj.slot("byrow"); int m = probs.ncol(); // Compute indices for states from and pos for (int i = 0; i < m; ++i) { if (states[i] == from) fromPos = i; if (states[i] == to) toPos = i; } if (fromPos == -1 || toPos == -1) stop("Please give valid states method"); stack toExplore; toExplore.push(fromPos); vector visited(m, false); visited[fromPos] = true; bool isReachable = false; // DFS until we hit 'to' state or we cannot traverse to more states while (!toExplore.empty() && !isReachable) { int i = toExplore.top(); toExplore.pop(); visited[i] = true; isReachable = i == toPos; for (int j = 0; j < m; ++j) if (((byrow && !approxEqual(probs(i, j), 0)) || (!byrow && !approxEqual(probs(j, i), 0))) && !visited[j]) toExplore.push(j); } return isReachable; } // summary of markovchain object // [[Rcpp::export(.summaryKernelRcpp)]] List summaryKernel(S4 object) { NumericMatrix transitionMatrix = object.slot("transitionMatrix"); bool byrow = object.slot("byrow"); CharacterVector states = object.slot("states"); if (!byrow) transitionMatrix = transpose(transitionMatrix); List commClassesList = commClassesKernel(transitionMatrix); LogicalMatrix commClasses = commClassesList["classes"]; LogicalVector closed = commClassesList["closed"]; List recurrentClasses = computeRecurrentClasses(commClasses, closed, states); List transientClasses = computeTransientClasses(commClasses, closed, states); List summaryResult = List::create(_["closedClasses"] = recurrentClasses, _["recurrentClasses"] = recurrentClasses, _["transientClasses"] = transientClasses); return(summaryResult); } //here the kernel function to compute the first passage // [[Rcpp::export(.firstpassageKernelRcpp)]] NumericMatrix firstpassageKernel(NumericMatrix P, int i, int n) { arma::mat G = as(P); arma::mat Pa = G; arma::mat H(n, P.ncol()); //here Thoralf suggestion //initializing the first row for (unsigned int j = 0; j < G.n_cols; j++) H(0, j) = G(i-1, j); arma::mat E = 1 - arma::eye(P.ncol(), P.ncol()); for (int m = 1; m < n; m++) { G = Pa * (G%E); for (unsigned int j = 0; j < G.n_cols; j ++) H(m, j) = G(i-1, j); } NumericMatrix R = wrap(H); return R; } // [[Rcpp::export(.firstPassageMultipleRCpp)]] NumericVector firstPassageMultipleRCpp(NumericMatrix P,int i, NumericVector setno, int n) { arma::mat G = as(P); arma::mat Pa = G; arma::vec H = arma::zeros(n); //here Thoralf suggestion unsigned int size = setno.size(); //initializing the first row for (unsigned int k = 0; k < size; k++) { H[0] += G(i-1, setno[k]-1); } arma::mat E = 1 - arma::eye(P.ncol(), P.ncol()); for (int m = 1; m < n; m++) { G = Pa * (G%E); for (unsigned int k = 0; k < size; k++) { H[m] += G(i-1, setno[k]-1); } } NumericVector R = wrap(H); return R; } // [[Rcpp::export(.expectedRewardsRCpp)]] NumericVector expectedRewardsRCpp(NumericMatrix matrix, int n, NumericVector rewards) { // initialises output vector NumericVector out; // gets no of states int no_of_states = matrix.ncol(); // initialises armadillo matrices and vectors arma::vec temp = arma::zeros(no_of_states); arma::mat matr = as(matrix); arma::vec v = arma::zeros(no_of_states); // initialses the vector for the base case of dynamic programming expression for (int i=0;i(matrix); arma::mat temp = as(matrix); arma::vec r = as(rewards); arma::mat I = arma::zeros(1,size); I(0,s0-1) = 1; for (int j = 0; j < n; j++) { arma::mat res = I*(temp*r); result = result + res(0,0); temp = temp*matr; } return result; } // greatest common denominator // [[Rcpp::export(.gcdRcpp)]] int gcd (int a, int b) { int c; a = abs(a); b = abs(b); while ( a != 0 ) { c = a; a = b%a; b = c; } return b; } // function to get the period of a DTMC //' @rdname structuralAnalysis //' //' @export // [[Rcpp::export(period)]] int period(S4 object) { bool irreducible = isIrreducible(object); if (!irreducible) { warning("The matrix is not irreducible"); return 0; } else { NumericMatrix P = object.slot("transitionMatrix"); int n = P.ncol(); std::vector r, T(1), w; int d = 0, m = T.size(), i = 0, j = 0; if (n > 0) { arma::vec v(n); v[0] = 1; while (m>0 && d!=1) { i = T[0]; T.erase(T.begin()); w.push_back(i); j = 0; while (j < n) { if (P(i,j) > 0) { r.insert(r.end(), w.begin(), w.end()); r.insert(r.end(), T.begin(), T.end()); double k = 0; for (std::vector::iterator it = r.begin(); it != r.end(); it ++) if (*it == j) k ++; if (k > 0) { int b = v[i] + 1 - v[j]; d = gcd(d, b); } else { T.push_back(j); v[j] = v[i] + 1; } } j++; } m = T.size(); } } // v = v - floor(v/d)*d; return d; } } //' @title predictiveDistribution //' //' @description The function computes the probability of observing a new data //' set, given a data set //' @usage predictiveDistribution(stringchar, newData, hyperparam = matrix()) //' //' @param stringchar This is the data using which the Bayesian inference is //' performed. //' @param newData This is the data whose predictive probability is computed. //' @param hyperparam This determines the shape of the prior distribution of the //' parameters. If none is provided, default value of 1 is assigned to each //' parameter. This must be of size kxk where k is the number of states in the //' chain and the values should typically be non-negative integers. //' @return The log of the probability is returned. //' //' @details The underlying method is Bayesian inference. The probability is //' computed by averaging the likelihood of the new data with respect to the //' posterior. Since the method assumes conjugate priors, the result can be //' represented in a closed form (see the vignette for more details), which is //' what is returned. //' @references //' Inferring Markov Chains: Bayesian Estimation, Model Comparison, Entropy Rate, //' and Out-of-Class Modeling, Christopher C. Strelioff, James P. //' Crutchfield, Alfred Hubler, Santa Fe Institute //' //' Yalamanchi SB, Spedicato GA (2015). Bayesian Inference of First Order Markov //' Chains. R package version 0.2.5 //' //' @author Sai Bhargav Yalamanchi //' @seealso \code{\link{markovchainFit}} //' @examples //' sequence<- c("a", "b", "a", "a", "a", "a", "b", "a", "b", "a", "b", "a", "a", //' "b", "b", "b", "a") //' hyperMatrix<-matrix(c(1, 2, 1, 4), nrow = 2,dimnames=list(c("a","b"),c("a","b"))) //' predProb <- predictiveDistribution(sequence[1:10], sequence[11:17], hyperparam =hyperMatrix ) //' hyperMatrix2<-hyperMatrix[c(2,1),c(2,1)] //' predProb2 <- predictiveDistribution(sequence[1:10], sequence[11:17], hyperparam =hyperMatrix2 ) //' predProb2==predProb //' @export //' // [[Rcpp::export]] double predictiveDistribution(CharacterVector stringchar, CharacterVector newData, NumericMatrix hyperparam = NumericMatrix()) { // construct list of states CharacterVector elements = stringchar; for (int i = 0; i < newData.size(); i++) elements.push_back(newData[i]); elements = unique(elements).sort(); int sizeMatr = elements.size(); // if no hyperparam argument provided, use default value of 1 for all if (hyperparam.nrow() == 1 && hyperparam.ncol() == 1) { NumericMatrix temp(sizeMatr, sizeMatr); temp.attr("dimnames") = List::create(elements, elements); for (int i = 0; i < sizeMatr; i++) for (int j = 0; j < sizeMatr; j++) temp(i, j) = 1; hyperparam = temp; } // validity check if (hyperparam.nrow() != hyperparam.ncol()) stop("Dimensions of the hyperparameter matrix are inconsistent"); if (hyperparam.nrow() < sizeMatr) stop("Hyperparameters for all state transitions must be provided"); List dimNames = hyperparam.attr("dimnames"); CharacterVector colNames = dimNames[1]; CharacterVector rowNames = dimNames[0]; int sizeHyperparam = hyperparam.ncol(); CharacterVector sortedColNames(sizeHyperparam), sortedRowNames(sizeHyperparam); for (int i = 0; i < sizeHyperparam; i++) sortedColNames(i) = colNames(i), sortedRowNames(i) = rowNames(i); sortedColNames.sort(); sortedRowNames.sort(); for (int i = 0; i < sizeHyperparam; i++) { if (i > 0 && (sortedColNames(i) == sortedColNames(i-1) || sortedRowNames(i) == sortedRowNames(i-1))) stop("The states must all be unique"); else if (sortedColNames(i) != sortedRowNames(i)) stop("The set of row names must be the same as the set of column names"); bool found = false; for (int j = 0; j < sizeMatr; j++) if (elements(j) == sortedColNames(i)) found = true; // hyperparam may contain states not in stringchar if (!found) elements.push_back(sortedColNames(i)); } // check for the case where hyperparam has missing data for (int i = 0; i < sizeMatr; i++) { bool found = false; for (int j = 0; j < sizeHyperparam; j++) if (sortedColNames(j) == elements(i)) found = true; if (!found) stop("Hyperparameters for all state transitions must be provided"); } elements = elements.sort(); sizeMatr = elements.size(); for (int i = 0; i < sizeMatr; i++) for (int j = 0; j < sizeMatr; j++) if (hyperparam(i, j) < 1.) stop("The hyperparameter elements must all be greater than or equal to 1"); // permute the elements of hyperparam such that the row, column names are sorted hyperparam = sortByDimNames(hyperparam); NumericMatrix freqMatr(sizeMatr), newFreqMatr(sizeMatr); double predictiveDist = 0.; // log of the predictive probability // populate frequeny matrix for old data; this is used for inference int posFrom = 0, posTo = 0; for (int i = 0; i < stringchar.size() - 1; i ++) { for (int j = 0; j < sizeMatr; j ++) { if (stringchar[i] == elements[j]) posFrom = j; if (stringchar[i + 1] == elements[j]) posTo = j; } freqMatr(posFrom,posTo)++; } // frequency matrix for new data for (int i = 0; i < newData.size() - 1; i ++) { for (int j = 0; j < sizeMatr; j ++) { if (newData[i] == elements[j]) posFrom = j; if (newData[i + 1] == elements[j]) posTo = j; } newFreqMatr(posFrom,posTo)++; } for (int i = 0; i < sizeMatr; i++) { double rowSum = 0, newRowSum = 0, paramRowSum = 0; for (int j = 0; j < sizeMatr; j++) { rowSum += freqMatr(i, j), newRowSum += newFreqMatr(i, j), paramRowSum += hyperparam(i, j); predictiveDist += lgamma(freqMatr(i, j) + newFreqMatr(i, j) + hyperparam(i, j)) - lgamma(freqMatr(i, j) + hyperparam(i, j)); } predictiveDist += lgamma(rowSum + paramRowSum) - lgamma(rowSum + newRowSum + paramRowSum); } return predictiveDist; } //' @title priorDistribution //' //' @description Function to evaluate the prior probability of a transition //' matrix. It is based on conjugate priors and therefore a Dirichlet //' distribution is used to model the transitions of each state. //' @usage priorDistribution(transMatr, hyperparam = matrix()) //' //' @param transMatr The transition matrix whose probability is the parameter of //' interest. //' @param hyperparam The hyperparam matrix (optional). If not provided, a //' default value of 1 is assumed for each and therefore the resulting //' probability distribution is uniform. //' @return The log of the probabilities for each state is returned in a numeric //' vector. Each number in the vector represents the probability (log) of //' having a probability transition vector as specified in corresponding the //' row of the transition matrix. //' //' @details The states (dimnames) of the transition matrix and the hyperparam //' may be in any order. //' @references Yalamanchi SB, Spedicato GA (2015). Bayesian Inference of First //' Order Markov Chains. R package version 0.2.5 //' //' @author Sai Bhargav Yalamanchi, Giorgio Spedicato //' //' @note This function can be used in conjunction with inferHyperparam. For //' example, if the user has a prior data set and a prior transition matrix, //' he can infer the hyperparameters using inferHyperparam and then compute //' the probability of their prior matrix using the inferred hyperparameters //' with priorDistribution. //' @seealso \code{\link{predictiveDistribution}}, \code{\link{inferHyperparam}} //' //' @examples //' priorDistribution(matrix(c(0.5, 0.5, 0.5, 0.5), //' nrow = 2, //' dimnames = list(c("a", "b"), c("a", "b"))), //' matrix(c(2, 2, 2, 2), //' nrow = 2, //' dimnames = list(c("a", "b"), c("a", "b")))) //' @export // [[Rcpp::export]] NumericVector priorDistribution(NumericMatrix transMatr, NumericMatrix hyperparam = NumericMatrix()) { // begin validity checks for the transition matrix if (transMatr.nrow() != transMatr.ncol()) stop("Transition matrix dimensions are inconsistent"); int sizeMatr = transMatr.nrow(); for (int i = 0; i < sizeMatr; i++) { double rowSum = 0., eps = 1e-10; for (int j = 0; j < sizeMatr; j++) if (transMatr(i, j) < 0. || transMatr(i, j) > 1.) stop("The entries in the transition matrix must each belong to the interval [0, 1]"); else rowSum += transMatr(i, j); if (rowSum <= 1. - eps || rowSum >= 1. + eps) stop("The rows of the transition matrix must each sum to 1"); } List dimNames = transMatr.attr("dimnames"); if (dimNames.size() == 0) stop("Provide dimnames for the transition matrix"); CharacterVector colNames = dimNames[1]; CharacterVector rowNames = dimNames[0]; CharacterVector sortedColNames(sizeMatr), sortedRowNames(sizeMatr); for (int i = 0; i < sizeMatr; i++) sortedColNames(i) = colNames(i), sortedRowNames(i) = rowNames(i); sortedColNames.sort(); sortedRowNames.sort(); for (int i = 0; i < sizeMatr; i++) if (i > 0 && (sortedColNames(i) == sortedColNames(i-1) || sortedRowNames(i) == sortedRowNames(i-1))) stop("The states must all be unique"); else if (sortedColNames(i) != sortedRowNames(i)) stop("The set of row names must be the same as the set of column names"); // if no hyperparam argument provided, use default value of 1 for all if (hyperparam.nrow() == 1 && hyperparam.ncol() == 1) { NumericMatrix temp(sizeMatr, sizeMatr); temp.attr("dimnames") = List::create(sortedColNames, sortedColNames); for (int i = 0; i < sizeMatr; i++) for (int j = 0; j < sizeMatr; j++) temp(i, j) = 1; hyperparam = temp; } // validity check for hyperparam if (hyperparam.nrow() != hyperparam.ncol()) stop("Dimensions of the hyperparameter matrix are inconsistent"); if (hyperparam.nrow() != sizeMatr) stop("Hyperparameter and the transition matrices differ in dimensions"); List _dimNames = hyperparam.attr("dimnames"); if (_dimNames.size() == 0) stop("Provide dimnames for the hyperparameter matrix"); CharacterVector _colNames = _dimNames[1]; CharacterVector _rowNames = _dimNames[0]; int sizeHyperparam = hyperparam.ncol(); CharacterVector _sortedColNames(sizeHyperparam), _sortedRowNames(sizeHyperparam); for (int i = 0; i < sizeHyperparam; i++) _sortedColNames(i) = colNames(i), _sortedRowNames(i) = rowNames(i); _sortedColNames.sort(); _sortedRowNames.sort(); for (int i = 0; i < sizeHyperparam; i++) if (sortedColNames(i) != _sortedColNames(i) || sortedRowNames(i) != _sortedRowNames(i)) stop("Hyperparameter and the transition matrices states differ"); for (int i = 0; i < sizeMatr; i++) for (int j = 0; j < sizeMatr; j++) if (hyperparam(i, j) < 1.) stop("The hyperparameter elements must all be greater than or equal to 1"); transMatr = sortByDimNames(transMatr); hyperparam = sortByDimNames(hyperparam); NumericVector logProbVec; for (int i = 0; i < sizeMatr; i++) { double logProb_i = 0., hyperparamRowSum = 0; for (int j = 0; j < sizeMatr; j++) { hyperparamRowSum += hyperparam(i, j); logProb_i += (hyperparam(i, j) - 1.) * log(transMatr(i, j)) - lgamma(hyperparam(i, j)); } logProb_i += lgamma(hyperparamRowSum); logProbVec.push_back(logProb_i); } logProbVec.attr("names") = sortedColNames; return logProbVec; } // [[Rcpp::export(.hittingProbabilitiesRcpp)]] NumericMatrix hittingProbabilities(S4 object) { NumericMatrix transitionMatrix = object.slot("transitionMatrix"); CharacterVector states = object.slot("states"); bool byrow = object.slot("byrow"); if (!byrow) transitionMatrix = transpose(transitionMatrix); int numStates = transitionMatrix.nrow(); arma::mat transitionProbs = as(transitionMatrix); arma::mat hittingProbs(numStates, numStates); // Compute closed communicating classes List commClasses = commClassesKernel(transitionMatrix); List closedClass = commClasses["closed"]; LogicalMatrix communicating = commClasses["classes"]; for (int j = 0; j < numStates; ++j) { arma::mat coeffs = as(transitionMatrix); arma::vec right_part = -transitionProbs.col(j); for (int i = 0; i < numStates; ++i) { coeffs(i, j) = 0; coeffs(i, i) -= 1; } for (int i = 0; i < numStates; ++i) { if (closedClass(i)) { for (int k = 0; k < numStates; ++k) if (k != i) coeffs(i, k) = 0; else coeffs(i, i) = 1; if (communicating(i, j)) right_part(i) = 1; else right_part(i) = 0; } } hittingProbs.col(j) = arma::solve(coeffs, right_part); } NumericMatrix result = wrap(hittingProbs); colnames(result) = states; rownames(result) = states; if (!byrow) result = transpose(result); return result; } // method to convert into canonic form a markovchain object // [[Rcpp::export(.canonicFormRcpp)]] S4 canonicForm(S4 obj) { NumericMatrix transitions = obj.slot("transitionMatrix"); bool byrow = obj.slot("byrow"); int numRows = transitions.nrow(); int numCols = transitions.ncol(); NumericMatrix resultTransitions(numRows, numCols); CharacterVector states = obj.slot("states"); unordered_map stateToIndex; unordered_set usedIndices; int currentIndex; List recClasses; S4 input("markovchain"); S4 result("markovchain"); vector indexPermutation(numRows); if (!byrow) { input.slot("transitionMatrix") = transpose(transitions); input.slot("states") = states; input.slot("byrow") = true; transitions = transpose(transitions); } else { input = obj; } recClasses = recurrentClasses(input); // Map each state to the index it has for (int i = 0; i < states.size(); ++i) { string state = (string) states[i]; stateToIndex[state] = i; } int toFill = 0; for (CharacterVector recClass : recClasses) { for (auto state : recClass) { currentIndex = stateToIndex[(string) state]; indexPermutation[toFill] = currentIndex; ++toFill; usedIndices.insert(currentIndex); } } for (int i = 0; i < states.size(); ++i) { if (usedIndices.count(i) == 0) { indexPermutation[toFill] = i; ++toFill; } } CharacterVector newStates(numRows); for (int i = 0; i < numRows; ++i) { int r = indexPermutation[i]; newStates(i) = states(r); for (int j = 0; j < numCols; ++j) { int c = indexPermutation[j]; resultTransitions(i, j) = transitions(r, c); } } rownames(resultTransitions) = newStates; colnames(resultTransitions) = newStates; if (!byrow) resultTransitions = transpose(resultTransitions); result.slot("transitionMatrix") = resultTransitions; result.slot("byrow") = byrow; result.slot("states") = newStates; result.slot("name") = input.slot("name"); return result; } // Function to sort a matrix of vectors lexicographically NumericMatrix lexicographicalSort(NumericMatrix m) { int numCols = m.ncol(); int numRows = m.nrow(); if (numRows > 0 && numCols > 0) { vector> x(numRows, vector(numCols)); for (int i = 0; i < numRows; ++i) for (int j = 0; j < numCols; ++j) x[i][j] = m(i,j); sort(x.begin(), x.end()); NumericMatrix result(numRows, numCols); for (int i = 0; i < numRows; ++i) for (int j = 0; j < numCols; ++j) result(i, j) = x[i][j]; colnames(result) = colnames(m); return result; } else { return m; } } // This method computes the *unique* steady state that exists for an // matrix has to be schocastic by rows // ergodic (= irreducible) matrix vec steadyStateErgodicMatrix(const mat& submatrix) { int nRows = submatrix.n_rows; int nCols = submatrix.n_cols; vec rightPart(nRows + 1, fill::zeros); vec result; mat coeffs(nRows + 1, nCols); // If P is Ergodic, the system (I - P)*w = 0 plus the equation // w_1 + ... + w_m = 1 must have a soultion for (int i = 0; i < nRows; ++i) { for (int j = 0; j < nCols; ++j) { // transpose matrix in-place coeffs(i, j) = submatrix(j, i); if (i == j) coeffs(i, i) -= 1; } } for (int j = 0; j < nCols; ++j) coeffs(nRows, j) = 1; rightPart(nRows) = 1; if (!solve(result, coeffs, rightPart)) stop("Failure computing eigen values / vectors for submatrix in steadyStateErgodicMatrix"); return result; } // Precondition: the matrix should be stochastic by rows NumericMatrix steadyStatesByRecurrentClasses(S4 object) { List recClasses = recurrentClasses(object); int numRecClasses = recClasses.size(); NumericMatrix transitionMatrix = object.slot("transitionMatrix"); CharacterVector states = object.slot("states"); int numCols = transitionMatrix.ncol(); NumericMatrix steady(numRecClasses, numCols); unordered_map stateToIndex; int steadyStateIndex = 0; // Map each state to the index it has for (int i = 0; i < states.size(); ++i) { string state = (string) states[i]; stateToIndex[state] = i; } // For each recurrent class, there must be an steady state for (CharacterVector recurrentClass : recClasses) { int recClassSize = recurrentClass.size(); mat subMatrix(recClassSize, recClassSize); // Fill the submatrix corresponding to the current steady class // Note that for that we have to subset the matrix with the indices // the states in the recurrent class ocuppied in the transition matrix for (int i = 0; i < recClassSize; ++i) { int r = stateToIndex[(string) recurrentClass[i]]; for (int j = 0; j < recClassSize; ++j) { int c = stateToIndex[(string) recurrentClass[j]]; subMatrix(i, j) = transitionMatrix(r, c); } } // Compute the steady states for the given submatrix vec steadyState = steadyStateErgodicMatrix(subMatrix); for (int i = 0; i < recClassSize; ++i) { int c = stateToIndex[(string) recurrentClass[i]]; steady(steadyStateIndex, c) = steadyState(i);; } ++steadyStateIndex; } colnames(steady) = states; return steady; } // [[Rcpp::export(.steadyStatesRcpp)]] NumericMatrix steadyStates(S4 obj) { NumericMatrix transitions = obj.slot("transitionMatrix"); CharacterVector states = obj.slot("states"); bool byrow = obj.slot("byrow"); S4 object("markovchain"); if (!byrow) { object.slot("transitionMatrix") = transpose(transitions); object.slot("states") = states; object.slot("byrow") = true; } else { object = obj; } // Compute steady states using recurrent classes (there is // exactly one steady state associated with each recurrent class) NumericMatrix result = lexicographicalSort(steadyStatesByRecurrentClasses(object)); if (!byrow) result = transpose(result); return result; } // This method is agnostic on whether the matrix is stochastic // by rows or by columns, we just need the diagonal // [[Rcpp::export(.absorbingStatesRcpp)]] CharacterVector absorbingStates(S4 obj) { NumericMatrix transitionMatrix = obj.slot("transitionMatrix"); CharacterVector states = obj.slot("states"); CharacterVector absorbing; int numStates = states.size(); for (int i = 0; i < numStates; ++i) if (approxEqual(transitionMatrix(i, i), 1)) absorbing.push_back(states(i)); return absorbing; } // [[Rcpp::export(.isIrreducibleRcpp)]] bool isIrreducible(S4 obj) { List commClasses = communicatingClasses(obj); // The markov chain is irreducible iff has only a single communicating class return commClasses.size() == 1; } // [[Rcpp::export(.isRegularRcpp)]] bool isRegular(S4 obj) { NumericMatrix transitions = obj.slot("transitionMatrix"); int m = transitions.ncol(); mat probs(transitions.begin(), m, m, true); mat reachable; auto arePositive = [](const double& x){ return x > 0; }; // Taken from the book: // Matrix Analysis. Roger A.Horn, Charles R.Johnson. 2nd edition. // Theorem 8.5.9 // A is regular iff A^{m²- 2m + 2} > 0 reachable = matrixPow(probs, m*m - 2*m + 2); return allElements(reachable, arePositive); } NumericMatrix computeMeanAbsorptionTimes(mat& probs, CharacterVector& absorbing, CharacterVector& states) { unordered_set toErase; vector indicesToKeep; CharacterVector newNames; string current; for (auto state : absorbing) toErase.insert((string) state); // Compute the states which are not in absorbing // and subset the sub-probability matrix of those // states which are not considered absorbing, Q for (uint i = 0; i < states.size(); ++i) { current = (string) states(i); if (toErase.count(current) == 0) { indicesToKeep.push_back(i); newNames.push_back(current); } } int n = indicesToKeep.size(); uvec indices(indicesToKeep); // Comppute N = 1 - Q mat coeffs = eye(n, n) - probs(indices, indices); vec rightPart = vec(n, fill::ones); mat meanTimes; // Mean absorbing times A are computed as N * A = 1, // where 1 is a column vector of 1s if (!solve(meanTimes, coeffs, rightPart)) stop("Error solving system in meanAbsorptionTime"); NumericMatrix result = wrap(meanTimes); rownames(result) = newNames; return result; } // [[Rcpp::export(.meanAbsorptionTimeRcpp)]] NumericVector meanAbsorptionTime(S4 obj) { NumericMatrix transitions = obj.slot("transitionMatrix"); CharacterVector states = obj.slot("states"); bool byrow = obj.slot("byrow"); unordered_set allStates; if (!byrow) transitions = transpose(transitions); // Compute recurrent and transient states List commKernel = commClassesKernel(transitions); LogicalVector closed = commKernel["closed"]; CharacterVector transient = computeTransientStates(states, closed); CharacterVector recurrent = computeRecurrentStates(states, closed); // Compute the mean absorption time for the transient states mat probs(transitions.begin(), transitions.nrow(), transitions.ncol(), true); NumericMatrix meanTimes = computeMeanAbsorptionTimes(probs, recurrent, states); NumericVector result; if (meanTimes.ncol() > 0) { result = meanTimes(_, 0); result.attr("names") = transient; } return result; } // [[Rcpp::export(.absorptionProbabilitiesRcpp)]] NumericMatrix absorptionProbabilities(S4 obj) { NumericMatrix transitions = obj.slot("transitionMatrix"); CharacterVector states = obj.slot("states"); string current; bool byrow = obj.slot("byrow"); if (!byrow) transitions = transpose(transitions); unordered_map stateToIndex; // Map each state to the index it has for (int i = 0; i < states.size(); ++i) { current = (string) states[i]; stateToIndex[current] = i; } List commKernel = commClassesKernel(transitions); LogicalVector closed = commKernel["closed"]; CharacterVector transient = computeTransientStates(states, closed); CharacterVector recurrent = computeRecurrentStates(states, closed); vector transientIndxs, recurrentIndxs; // Compute the indexes of the matrix which correspond to transient and recurrent states for (auto state : transient) { current = (string) state; transientIndxs.push_back(stateToIndex[current]); } for (auto state : recurrent) { current = (string) state; recurrentIndxs.push_back(stateToIndex[current]); } int m = transitions.ncol(); int n = transientIndxs.size(); if (n == 0) stop("Markov chain does not have transient states, method not applicable"); // Get the indices in arma::uvec s uvec transientIndices(transientIndxs); uvec recurrentIndices(recurrentIndxs); // Compute N = (1 - Q)^{-1} mat probs(transitions.begin(), m, m, true); mat toInvert = eye(n, n) - probs(transientIndices, transientIndices); mat fundamentalMatrix; if (!inv(fundamentalMatrix, toInvert)) stop("Could not compute fundamental matrix"); // Compute the mean absorption probabilities as F* = N*P[transient, recurrent] mat meanProbs = fundamentalMatrix * probs(transientIndices, recurrentIndices); NumericMatrix result = wrap(meanProbs); rownames(result) = transient; colnames(result) = recurrent; if (!byrow) result = transpose(result); return result; } // [[Rcpp::export(.meanFirstPassageTimeRcpp)]] NumericMatrix meanFirstPassageTime(S4 obj, CharacterVector destination) { bool isErgodic = isIrreducible(obj); if (!isErgodic) stop("Markov chain needs to be ergodic (= irreducile) for this method to work"); else { NumericMatrix transitions = obj.slot("transitionMatrix"); mat probs(transitions.begin(), transitions.nrow(), transitions.ncol(), true); CharacterVector states = obj.slot("states"); bool byrow = obj.slot("byrow"); int numStates = states.size(); NumericMatrix result; if (!byrow) probs = probs.t(); if (destination.size() > 0) { result = computeMeanAbsorptionTimes(probs, destination, states); // This transpose is intentional to return a row always instead of a column result = transpose(result); return result; } else { result = NumericMatrix(numStates, numStates); vec steadyState = steadyStateErgodicMatrix(probs); mat toInvert(numStates, numStates); mat Z; // Compute inverse for (I - P + W), where P = probs, // and W = steadyState pasted row-wise for (int i = 0; i < numStates; ++i) { for (int j = 0; j < numStates; ++j) { toInvert(i, j) = -probs(i, j) + steadyState(j); if (i == j) toInvert(i, i) += 1; } } if (!inv(Z, toInvert)) stop("Problem computing inverse of matrix inside meanFirstPassageTime"); // Set the result matrix for (int j = 0; j < numStates; ++j) { double r_j = 1.0 / steadyState(j); for (int i = 0; i < numStates; ++i) { result(i, j) = (Z(j,j) - Z(i,j)) * r_j; } } colnames(result) = states; rownames(result) = states; if (!byrow) result = transpose(result); return result; } } } // [[Rcpp::export(.meanRecurrenceTimeRcpp)]] NumericVector meanRecurrenceTime(S4 obj) { NumericMatrix steady = steadyStates(obj); bool byrow = obj.slot("byrow"); if (!byrow) steady = transpose(steady); CharacterVector states = obj.slot("states"); NumericVector result; CharacterVector recurrentStates; for (int i = 0; i < steady.nrow(); ++i) { for (int j = 0; j < steady.ncol(); ++j) { // This depends on our imlementation of the steady // states, but we have the guarantee that the entry // corresponding to a state in a recurrent class is // only going to be positive in one vector and the // entries corresponding to transient states are // going to be zero if (!approxEqual(steady(i, j), 0)) { result.push_back(1.0 / steady(i, j)); recurrentStates.push_back(states(j)); } } } result.attr("names") = recurrentStates; return result; } // [[Rcpp::export(.minNumVisitsRcpp)]] NumericMatrix meanNumVisits(S4 obj) { NumericMatrix hitting = hittingProbabilities(obj); CharacterVector states = obj.slot("states"); bool byrow = obj.slot("byrow"); if (!byrow) hitting = transpose(hitting); int n = hitting.ncol(); bool closeToOne; double inverse; NumericMatrix result(n, n); rownames(result) = states; colnames(result) = states; // Lets call the matrix of hitting probabilities as f // Then mean number of visits from i to j are given by // f_{ij} / (1 - f_{jj}) // having care when f_{ij} -> mean num of visits is zero // and when f_{ij} > 0 and f_{jj} = 1 -> infinity mean // num of visits for (int j = 0; j < n; ++j) { closeToOne = approxEqual(hitting(j, j), 1); if (!closeToOne) inverse = 1 / (1 - hitting(j, j)); for (int i = 0; i < n; ++i) { if (hitting(i, j) == 0) result(i, j) = 0; else { if (closeToOne) result(i, j) = R_PosInf; else result(i, j) = hitting(i, j) * inverse; } } } if (!byrow) result = transpose(result); return result; } markovchain/src/classesAndMethods.cpp0000644000176200001440000000073614714756746017506 0ustar liggesusers// [[Rcpp::depends(RcppArmadillo)]] #include #include #include #include using namespace Rcpp; using namespace arma; using namespace std; // TODO meaning of this method // [[Rcpp::export(.isGenRcpp)]] bool isGen(NumericMatrix gen) { for (int i = 0; i < gen.nrow(); i++) for (int j = 0; j < gen.ncol(); j++) if ((i == j && gen(i, j) > 0) || (i != j && gen(i, j) < 0)) return false; return true; } markovchain/NAMESPACE0000644000176200001440000000477414714756745014033 0ustar liggesusersexport("name<-") export(ExpectedTime) export(absorptionProbabilities) export(assessOrder) export(assessStationarity) export(committorAB) export(createSequenceMatrix) export(ctmcFit) export(expectedRewards) export(expectedRewardsBeforeHittingA) export(firstPassage) export(firstPassageMultiple) export(fitHighOrderMultivarMC) export(fitHigherOrder) export(freq2Generator) export(generatorToTransitionMatrix) export(impreciseProbabilityatT) export(inferHyperparam) export(is.CTMCirreducible) export(is.TimeReversible) export(markovchainFit) export(markovchainListFit) export(markovchainSequence) export(meanAbsorptionTime) export(meanFirstPassageTime) export(meanRecurrenceTime) export(multinomialConfidenceIntervals) export(name) export(noofVisitsDist) export(period) export(predictHommc) export(predictiveDistribution) export(priorDistribution) export(probabilityatT) export(rctmc) export(rmarkovchain) export(seq2freqProb) export(seq2matHigh) export(states) export(transition2Generator) export(verifyEmpiricalToTheoretical) export(verifyHomogeneity) export(verifyMarkovProperty) exportClasses(HigherOrderMarkovChain) exportClasses(ctmc) exportClasses(hommc) exportClasses(markovchain) exportClasses(markovchainList) exportMethods("!=") exportMethods("*") exportMethods("==") exportMethods("[") exportMethods("[[") exportMethods("^") exportMethods(absorbingStates) exportMethods(canonicForm) exportMethods(coerce) exportMethods(communicatingClasses) exportMethods(conditionalDistribution) exportMethods(dim) exportMethods(hittingProbabilities) exportMethods(is.accessible) exportMethods(is.irreducible) exportMethods(is.regular) exportMethods(meanNumVisits) exportMethods(plot) exportMethods(predict) exportMethods(print) exportMethods(recurrentClasses) exportMethods(recurrentStates) exportMethods(show) exportMethods(steadyStates) exportMethods(summary) exportMethods(t) exportMethods(transientClasses) exportMethods(transientStates) exportMethods(transitionProbability) import(Matrix) import(igraph) import(methods) import(parallel) importFrom(Rcpp,evalCpp) importFrom(RcppParallel,RcppParallelLibs) importFrom(expm,"%^%") importFrom(expm,logm) importFrom(grDevices,colors) importFrom(stats,aggregate) importFrom(stats,chisq.test) importFrom(stats,pchisq) importFrom(stats,predict) importFrom(stats,rexp) importFrom(stats,sd) importFrom(stats4,plot) importFrom(stats4,summary) importFrom(utils,packageDescription) useDynLib(markovchain, .registration = TRUE)markovchain/LICENSE0000644000176200001440000000006314714756745013604 0ustar liggesusersYEAR: 2023 COPYRIGHT HOLDER: markovchain authors markovchain/NEWS.md0000644000176200001440000001624414715232501013661 0ustar liggesusers# markovchain 0.10.0 - Uptick pandoc requirements and handling of sparse matrices # News for version 0.9.6 - Handling change of pandoc requirements # News for version 0.9.5 - Downtick R requirements # News for version 0.9.4 - Corrected strange characters # News for version 0.9.3 - Generalized application of requireNamespace(..., quietly = TRUE) - Other fixes to comply to newer CRAN requirements - Move to MIT license # News for version 0.9.2 - Add RcppParallel flags to PKG_LIBS # News for version 0.9.1 ## Current changes - Uptick Matrics requirements and modified Changelogs ## old changes - 2022-09-23 0.9.1 Uptick Matrix reqs - 2022-07-01 0.9.0 Bugfix a state classification error in Rcpp - 2022-05-21 0.8.9 Removal of Matlab package dependency - 2021-05-7 0.8.6 Fix a bug in markovchainListFit that made confusion between lists and data.frames - 2020-12-04 0.8.5-2 Fixing unavailable software issues and language glitches - 2020-09-21 0.8.5-1 Coping with etm unavailability - 2020-05-21 0.8.5 Fixed DoF in verify markov property and supported input in compare teorethical - 2020-05-04 0.8.4.1 2022-09-23 0.9.1 - Uptick Matrix reqs 2022-07-01 0.9.0 - Bugfix a state classification error in Rcpp 2022-05-21 - 0.8.9 Removal of Matlab package dependency - 2021-05-7 0.8.6 Fix a bug in markovchainListFit that made confusion between lists and data.frames - 2020-12-04 0.8.5-2 Fixing unavailable software issues and language glitches - 2020-09-21 0.8.5-1 Coping with etm unavailability - 2020-05-21 0.8.5 Fixed DoF in verify markov property and supported input in compare teorethical - 2020-05-04 0.8.4.1 Fixed presentation - 2020-03-16 0.8.4Limiting output lines in vignettes. - 2020-03-15 0.8.3 Add small changes in code to cope with upcoming R 4.0.0 (stringsAsFactor=TRUE in data.frame). - 2019-12-10 0.8.2 Add small changes in code to cope with upcoming R 4.0.0 (no more check class(x)=='matrix') as well as packages' unavailable. - 2019-08-13 0.7.0 Improves performance and refactors `communicatingClasses`, `recurrentClasses`, `transientStates`, `is.irreducible`, `canonicForm`, `summary` and `steadyStates` methods, porting them to C++ whenever possible and improving the algorithmic complexity of the code. Solves a bug with `steadyStates` method. Adds the methods `recurrentStates` and `transientClasses`. Makes the aforementioned methods work on by column Markov chains. Improves tests, adding checking of mathematical structural properties and hundreds of random test cases. Fixes documentation for `roxygen` and NAMESPACE file for automatic generation using `devtools::document()` - Bumps Ignacio Cordón as author (ORCID included) 2019-07-01 0.6.9.15 Fixed confidence interval calculation: true confidence intervals are now 1-(1-confidence_interval)/2 Various code refactoring - 09-12-2018 0.6.9.14 Added plot from MmgraphR Added meanFirstPassageTime (thanks to Toni Giorgino) Add orcid Add more warning to Statistical Inference Functions - 12-08-2018 0.6.9.12 Improved Rcpp performance - 20-04-2018 0.6.9.9 Fixed typo in vignette MAP method now works also with lists (issue #141) Fix valgrid error - 14-08-2017 0.6.9.8-1 Added is.TimeReversible function added gm_to_markovchain example - 10-07-2017 0.6.9.5 Added empirical bayesian estimate Various additions from GSOC 2017 (see the new vignette) - 31-03-2014 Version 0.6.9 Added sort method Revised numeric tolerance when creating markovchains Added suggestion for which row to fix - 16-03-2017 Version 0.6.8 Deep restructuring of statistical tests - Add parameter confint to markovchainFit Fixed bug in markovchainFitList - Handling of NA - 02-02-2017 Version 0.6.6.2 Add parameter confint to markovchainFit - 27-01-2017 Version 0.6.6.1 Fixing bug in markovchainListFit - 22-01-2017 markovchainFit accepts an uneven list now Added confidence intervals when markovchainFit is given a matrix - 08-12-2016 Added patch to divergence test - 20-08-2016 Fully parallelized bootstrapped markovchain fit - 08-08-2016 Version 0.6 Added multivariate higher order markov chains Better handlign of steady state analysis on non - recurrent Markov Chains Fixed an error in the igraph conversion - 08-07-2016 Fixed C++ 11 variables types - 24-06-2016 Version 0.4.5 Speeding up rmarkovchain using parallel and RcppParallel library. - 14-06-2016 Version 0.4.4.4 Bug fixed for markovchainFit when method = bootstrap - 09-06-2016 Version 0.4.4.2 added sanitize=false paramter to markovchainFit - 31-05-2016 Version 0.4.4.1 Improvement of the internal method checkSequence. name method to set and get the names of markovchain object. - 10-05-2016 Version 0.4.4 rmarkovchain in RCpp (thanks to Deepak and GSOC 2016) Various small fixes - 05-03-2016 Version 0.4.3.1 fixed a bug in the states classification added options to save output of random sampler in a matrix - 10-10-2015 Version 0.4.3 fixed an error in plot function - 08-07-2015 Version 0.3.1 Period to Rcpp (thanks to TAE) communicatingClasses and recurrentClasses (thanks to TAE) Various optimization (thanks to TAE) Initial support for Continuous Time Markov Chains (thanks to SAI) Added new methods: names, != - 15-06-2015 Version 0.3 Added a CrashIntro vignette Most probability function rewritten in Rcpp Added standard errors and confidence intervals for MLE (thanks to Tae) Added confidence intervals for bootstap (thanks to Tae) Added bayesian Maximum A Posteriori estimation (thanks to Sai) - 12-05-2015 Version 0.2.1 Fixed a compatibility issue with R 3 development - 12-04-2015 Version 0.2 This is a milestone for markovchain package, since the package project has been selected within the funded GSOC 2015 projects. Thanks to Tae support now the fitting functions have been rewritten in Rcpp. - 20-03-2015 Version 0.1.3 Fastened the firstpassage time code thanks to Thoralf suggestion - 01-03-2015 Version 0.1.2 Add GitHub project url - 17-02-2015 Version 0.1.1 Fasten markovchain sequence thanks to Mildenberger Thoralf suggestion - 04-01-2015 Version 0.1.0 It is now possible to fit a markovchain and a markovchainList object from a matrix or data.frame Updated vignettes Added tests - 21-06-2014 Version 0.0.9.5 Updated vignettes Added a method to convert a square matrix into a markovchain object. - 20-04-2014 Version 0.0.9 Updated vignette Added parallel processing for bootstrap estimation - 09-02-2014 Version 0.0.8 Minor vignette enhancements Added function to find period of a DTMC - 12-01-2014 Version 0.0.7 Deeply improved vignettes Added predict and summary methods Added function to perform probabilistic analysis - 31-12-2013 Version 0.0.5 Improved vignettes Add predict methods Add methods for transitory states - 04-11-2013 Version 0.0.3 Added various method to easily handle markovchain and markovchainList objects Implemented rmarkovchain and bootstrap fit Improved vignettes markovchain/inst/0000755000176200001440000000000014715232625013540 5ustar liggesusersmarkovchain/inst/CITATION0000644000176200001440000000063414714756745014715 0ustar liggesusersnote <- sprintf("R package version %s", meta$Version) bibentry( bibtype = "Article", title = "Discrete Time Markov Chains with R", author = person(given="Giorgio Alfredo", family="Spedicato"), journal = "The R Journal", year = "2017", volume = "9", number = "2", pages = "84--104", url = "https://journal.r-project.org/archive/2017/RJ-2017-036/index.html" )markovchain/inst/doc/0000755000176200001440000000000014715232625014305 5ustar liggesusersmarkovchain/inst/doc/gsoc_2017_additions.html0000644000176200001440000021037014715232601020632 0ustar liggesusers Google Summer of Code 2017 Additions

Google Summer of Code 2017 Additions

Vandit Jain

August 2017

Expected Hitting Time using CTMC

The package provides ExpectedTime function to calculate average hitting time from one state to another. Let the final state be j, then for every state \(i \in I\), where \(I\) is the set of all possible states and holding time \(q_{i} > 0\) for every \(i \neq j\). Assuming the conditions to be true, expected hitting time is equal to minimal non-negative solution vector \(p\) to the system of linear equations (Norris 1998): \[\begin{equation} \begin{array}{lcr} p_{k} = 0 & k = j \\ -\sum_{l \in I} q_{kl}p_{k} = 1 & k \neq j \end{array} \label{eq:EHT} \end{equation}\]

For example, consider the continuous time markovchain which is as follows:

library(markovchain)
states <- c("a","b","c","d")
byRow <- TRUE
gen <- matrix(data = c(-1, 1/2, 1/2, 0, 1/4, -1/2, 0, 1/4, 1/6, 0, -1/3, 1/6, 0, 0, 0, 0),
nrow = 4,byrow = byRow, dimnames = list(states,states))
ctmc <- new("ctmc",states = states, byrow = byRow, generator = gen, name = "testctmc")

The generator matrix of the ctmc is: \[ M = \left(\begin{array}{cccc} -1 & 1/2 & 1/2 & 0\\ 1/4 & -1/2 & 1/4 & 1/6\\ 1/6 & 0 & -1/3 & 1/6\\ 0 & 0 & 0 & 0 \end{array}\right) \]

Now if we have to calculate expected hitting time the process will take to hit state \(d\) if we start from \(a\), we apply the \(ExpectedTime\) function. \(ExpectedTime\) function takes four inputs namely a \(ctmc\) class object, initial state \(i\), the final state \(j\) that we have to calculate expected hitting time and a logical parameter whether to use RCpp implementation. By default, the function uses RCpp as it is faster and takes lesser time.

ExpectedTime(ctmc,1,4)
#> [1] 7

We find that the expected hitting time for process to be hit state \(d\) is 7 units in this case.

Calculating Probability at time T using ctmc

The package provides a function probabilityatT to calculate probability of every state according to given ctmc object. The Kolmogorov’s backward equation gives us a relation between transition matrix at any time t with the generator matrix(Dobrow 2016):

\[\begin{equation} P'(t) = QP(t) \end{equation}\]

Here we use the solution of this differential equation \(P(t) = P(0)e^{tQ}\) for \(t \geq 0\) and \(P(0) = I\). In this equation, \(P(t)\) is the transition function at time t. The value \(P(t)[i][j]\) at time \(P(t)\) describes the conditional probability of the state at time \(t\) to be equal to j if it was equal to i at time \(t=0\). It takes care of the case when ctmc object has a generator represented by columns. If initial state is not provided, the function returns the whole transition matrix \(P(t)\).

Also to mention is that the function is also implemented using RCpp and can be used used to lessen the time of computation. It is used by default. Next, We consider both examples where initial state is given and case where initial state is not given.

In the first case, the function takes two inputs, first of them is an object of the S4 class ‘ctmc’ and second is the final time \(t\).

probabilityatT(ctmc,1)
#>            a          b         c          d
#> a 0.41546882 0.24714119 0.2703605 0.06702946
#> b 0.12357060 0.63939068 0.0348290 0.20220972
#> c 0.09012017 0.02321933 0.7411205 0.14553997
#> d 0.00000000 0.00000000 0.0000000 1.00000000

Here we get an output in the form of a transition matrix.

If we take the second case i.e. considering some initial input:

probabilityatT(ctmc,1,1)
#> [1] 0.41546882 0.24714119 0.27036052 0.06702946

In this case we get the probabilities corresponding to every state. this also includes probability that the process hits the same state \(a\) after time \(t=1\).

Plotting generator matrix of continuous-time markovchains

The package provides a plot function for plotting a generator matrix \(Q\) in the form of a directed graph where every possible state is assigned a node. Edges connecting these nodes are weighted. Weight of the edge going from a state \(i\) to state \(j\) is equal to the value \(Q_{ij}\). This gives a picture of the generator matrix.

For example, we build a ctmc-class object to plot it.

energyStates <- c("sigma", "sigma_star")
byRow <- TRUE
gen <- matrix(data = c(-3, 3,
                       1, -1), nrow = 2,
              byrow = byRow, dimnames = list(energyStates, energyStates))
molecularCTMC <- new("ctmc", states = energyStates, 
                 byrow = byRow, generator = gen, 
                 name = "Molecular Transition Model")

Now if we plot this function we get the following graph:

plot(molecularCTMC)
#> Warning: Non-positive edge weight found, ignoring all weights during graph
#> layout.

The figure shown is built using the \(igraph\) package. The package also provides options of plotting graph using \(diagram\) and \(DiagrameR\) package. Plot using these packages can be built using these commands:

if(requireNamespace(package='ctmcd', quietly = TRUE)) {
plot(molecularCTMC,package = "diagram")
} else {
  print("diagram package unavailable")
}

Similarly, one can easily replace \(diagram\) package with \(DiagrammeR\).

Imprecise Continuous-Time Markov chains

Continuous-time Markov chains are mathematical models that are used to describe the state-evolution of dynamical systems under stochastic uncertainty. However, building models using continuous time markovchains take in consideration a number of assumptions which may not be realistic for the domain of application; in particular; the ability to provide exact numerical parameter assessments, and the applicability of time-homogeneity and the eponymous Markov property. Hence we take ICTMC into consideration.

More technically, an ICTMC is a set of “precise” continuous-time finite-state stochastic processes, and rather than computing expected values of functions, we seek to compute lower expectations, which are tight lower bounds on the expectations that correspond to such a set of “precise” models.

Types of ICTMCs

For any non-empty bounded set of rate matrices \(L\), and any non-empty set \(M\) of probability mass functions on \(X\), we define the following three sets of stochastic processes that are jointly consistent with \(L\) and \(M\):

  • \(P^{W}_{L,M}\) is the consistent set of all well-behaved stochastic processes;
  • \(P^{WM}_{L,M}\) is the consistent set of all well-behaved Markov chains;
  • \(P^{WHM}_{L,M}\) is the consistent set of all well-behaved homogeneous Markov chains(Thomas Krak 2017).

From a practical point of view, after having specified a (precise) stochastic process, one is typically interested in the expected value of some function of interest, or the probability of some event. Similarly, in this work, our main objects of consideration will be the lower probabilities that correspond to the ICTMCs.

Lower Transition Rate Operators for ICTMCs

A map \(Q_{l}\) from \(L(X)\) to \(L(X)\) is called a lower transition rate operator if, for all \(f,g \in L(X)\), all \(\lambda \in R_{\geq 0}\), all \(\mu \in L(X)\), and all \(x \in X\)(Thomas Krak 2017):

  1. \([Q_{l}m](x) = 0\)
  2. \([Q_{l}I](x) \geq 0 \forall y \in X\) such that \(x \neq y\)
  3. \([Q_{l}(f + g)](x)\geq [Q_{l}f](x) + [Q_{l}g](x)\)
  4. \([Q_{l}(l f)](x) = \lambda Q_{l}f[(x)]\)

Lower Transition Operators

A map \(T_{l}\) from \(L (X )\) to \(L (X )\) is called a lower transition operator if, for all \(f,g \in L(X)\), all \(\lambda \in R_{\geq 0}\), all \(\mu \in L(X)\), and all \(x \in X\)(Thomas Krak 2017):

  1. \([T_{l} f](x) \geq min(f(y) : y \in L)\)
  2. \([T_{l}(f +g)](x) \geq [T_{l} f](x)+[T_{l}g](x)\)
  3. \([T_{l}(\lambda f)](x) = l [T_{l} f](x)\)

ImpreciseprobabilityatT function

Now I would like to come onto the practical purpose of using ICTMC classes. ICTMC classes in these package are defined to represent a generator that is defined in such a way that every row of the generator corresponding to every state in the process is governed by a separate variable. As defined earlier, an imprecise continuous time markovchain is a set of many precise CTMCs. Hence this representation of set of precise CTMCs can be used to calulate transition probability at some time in future. This can be seen as an analogy with probabilityatT function. It is used to calculate the transition function at some later time t using generatoe matrix.

For every generator matrix, we have a corresponding transition function. Similarly, for every Lower Transition rate operator of an ICTMC, we have a corresponding lower transition operator denoted by \(L_{t}^{s}\). Here \(t\) is the initial time and \(s\) is the final time.

Now we mention a proposition(Thomas Krak 2017) which states that: Let \(Q_{l}\) be a lower transition rate operator, choose any time \(t\) and \(s\) both greater than 0 such that \(t \leq s\), and let \(L_{t}^{s}\) be the lower transition operator corresponding to \(Q_{l}\). Then for any \(f \in L(X)\) and \(\epsilon \in R_{>0}\), if we choose any \(n \in N\) such that:

\[n \geq max((s-t)*||Q||,\frac{1}{2\epsilon}(s-t)^{2}||Q||^{2}||f||_v)\]

with \(||f||_{v}\) := max \(f\) - min \(f\), we are guaranteed that(Thomas Krak 2017)

\[ ||L_{t}^{s} - \prod_{i=1}^{n}(I + \Delta Q_{l}) || \leq \epsilon \]

with \(\Delta := \frac{s-t}{n}\)

Simple put this equation tells us that, using \(Q_{l}g\) for all \(g \in L(X)\) then we can also approximate the quantity \(L_{t}^{s}\) to arbitrary precision, for any given \(f \in L(X)\).

To explain this approximate calculation, I would take a detailed example of a process containing two states healthy and sick, hence \(X = (healthy,sick)\). If we represent in form of an ICTMC, we get:

\[ Q = \left(\begin{array}{cc} -a & a \\ b & -b \end{array}\right) \]

for some \(a,b \in R_{\geq 0}\). The parameter \(a\) here is the rate at which a healthy person becomes sick. Technically, this means that if a person is healthy at time \(t\), the probability that he or she will be sick at time \(t +\Delta\), for small \(\Delta\), is very close to \(\Delta a\). More intuitively, if we take the time unit to be one week, it means that he or she will, on average, become sick after \(\frac{1}{a}\) weeks. The parameter \(b\) is the rate at which a sick person becomes healthy again, and has a similar interpretation.

Now to completely represent the ICTMC we take an example and write the generator as:

\[ Q = \left(\begin{array}{cc} -a & a \\ b & -b \end{array}\right) : a \in [\frac{1}{52},\frac{3}{52}],b \in [\frac{1}{2},2] \]

Now suppose we know the initial state of the patient to be sick, hence this is represented in the form of a function by: \[ I_{s} = \left(\begin{matrix} 0 \\ 1 \end{matrix}\right) \] We observe that the \(||I_{s}|| = 1\). Now to use the proposition mentioned above, we use the definition to calculate the lower transition operator \(Q_{l}\) Next we calculate the norm of the lower transition rate operator and use it in the preposition. Also we take value of \(\epsilon\) to be 0.001.

Using the preposition we can come up to an algorithm for calculating the probability at any time \(s\) given state at initial time \(t\) and a ICTMC generator(Thomas Krak 2017).

The algorithm is as follows:

Input: A lower transition rate operator \(Q\), two time points \(t,s\) such that \(t \leq s\), a function \(f \in L(X )\) and a maximum numerical error \(\epsilon \in R_{>0}\).

Algorithm:

  1. \(n = max((s-t)||Q||,\frac{1}{2\epsilon}(s-t)^{2}||Q||^{2}||f||_v)\)
  2. \(\Delta = \frac{s-t}{n}\)
  3. \(g_{0} = I_{s}\)
  4. for \(i \in (1,.....,n)\) do \(g_{i} = g_{i-1} + \Delta Q_{l}g_{i-1}\)
  5. end for
  6. return \(g_{n}\)

Output:

The conditional probability vector after time \(t\) with error \(\epsilon\). Hence, after applying the algorithm on above example we get the following result:

$ g_{n} = 0.0083$ if final state is \(healthy\) and \(g_{n} = 0.141\) if the final state is \(sick\). The probability calculated is with an error equal to \(\epsilon\) i.e. \(0.001\).

Now we run the algorithm on the example through R code.

states <- c("n","y")
Q <- matrix(c(-1,1,1,-1),nrow = 2,byrow = TRUE,dimnames = list(states,states))
range <- matrix(c(1/52,3/52,1/2,2),nrow = 2,byrow = 2)
name <- "testictmc"
ictmc <- new("ictmc",states = states,Q = Q,range = range,name = name)
impreciseProbabilityatT(ictmc,2,0,1,10^-3,TRUE)
#> [1] 0.008259774 0.140983476

The probabilities we get are with an error of \(10^{-3}\)

Continuous time markovchain generator using frequency Matrix

The package provides freq2Generator function. It takes in a matrix representing relative frequency values along with time taken to provide a continuous time markovchain generator matrix. Here, frequency matrix is a 2-D matrix of dimensions equal to relative number of possible states describing the number of transitions from a state \(i\) to \(j\) in time \(t\), which is another parameter to be provided to the function. The function also allows to chose among three methods for calculation of the generator matrix (Alexander Kreinin 2001). It requires the (Pfeuffer 2017) package.

Three methods are as follows:

  1. Quasi Optimization - “QO”
  2. Diagonal Adjustment - “DA”
  3. Weighted Adjustment - “WA”

See reference for details about the methods.

Here is an example matrix on which freq2Generator function is run:

if(requireNamespace(package='ctmcd', quietly = TRUE)) {
sample <- matrix(c(150,2,1,1,1,200,2,1,2,1,175,1,1,1,1,150),nrow = 4,byrow = TRUE)
sample_rel = rbind((sample/rowSums(sample))[1:dim(sample)[1]-1,],c(rep(0,dim(sample)[1]-1),1)) 
freq2Generator(sample_rel,1)
} else {
  print('ctmcd unavailable')
}
#>              [,1]        [,2]         [,3] [,4]
#> [1,] -0.024212164  0.01544797  0.008764198    0
#> [2,]  0.006594821 -0.01822834  0.011633520    0
#> [3,]  0.013302567  0.00749703 -0.020799597    0
#> [4,]  0.000000000  0.00000000  0.000000000    0

Committor of a markovchain

Consider set of states A,B comprising of states from a markovchain with transition matrix P. The committor vector of a markovchain with respect to sets A and B gives the probability that the process will hit a state from set A before any state from set B.

Committor vector u can be calculated by solving the following system of linear equations(StackOverflow 2015):

\[ \begin{array}{l} Lu(x) = 0, x \notin A \cup B \\ u(x) = 1, x \in A \\ u(x) = 0, x \in B \end{array} \] where \(L = P -I\).

Now we apply the method to an example:

transMatr <- matrix(c(0,0,0,1,0.5,0.5,0,0,0,0,0.5,0,0,0,0,0,0.2,0.4,0,0,0,0.8,0.6,0,0.5),nrow = 5)
object <- new("markovchain", states=c("a","b","c","d","e"),transitionMatrix=transMatr, name="simpleMc")
committorAB(object,c(5),c(3))

Here we get probability that the process will hit state “e” before state “c” given different initial states.

First Passage probability for set of states

Currently computation of the first passage time for individual states has been implemented in the package. firstPassageMultiple function provides a method to get first passage probability for given provided set of states.

Consider this example markovchain object:

statesNames <- c("a", "b", "c")
testmarkov <- new("markovchain", states = statesNames, transitionMatrix =
matrix(c(0.2, 0.5, 0.3,
0.5, 0.1, 0.4,
0.1, 0.8, 0.1), nrow = 3, byrow = TRUE,
dimnames = list(statesNames, statesNames)
))

Now we apply firstPassageMultiple function to calculate first passage probabilities for set of states \("b", "c"\) when initial state is \("a"\).

firstPassageMultiple(testmarkov,"a",c("b","c"),4)
#>      set
#> 1 0.8000
#> 2 0.6000
#> 3 0.2540
#> 4 0.1394

This shows us the probability that the process will hit any of the state from the set after n number of steps for instance, as shown, the probability of the process to hit any of the states among \("b", "c"\) after \(2\) steps is \(0.6000\).

Joint PDF of number of visits to the various states of a markovchain

The package provides a function noofVisitsDist that returns the PDF of the number of visits to the various states of the discrete time markovchain during the first N steps, given initial state of the process.

We will take an example to see how to use the function on a markovchain-class object:

transMatr<-matrix(c(0.4,0.6,.3,.7),nrow=2,byrow=TRUE)
simpleMc<-new("markovchain", states=c("a","b"),
              transitionMatrix=transMatr, 
              name="simpleMc")   
noofVisitsDist(simpleMc,5,"a")
#>        a        b 
#> 0.348148 0.651852

The output clearly shows the probabilities related to various states of the process.

Expected Rewards for a markovchain

The package provides a function expectedRewards that returns a vector of expected rewards for different initial states. The user provides reward values, a vector \(r\) of size equal to number of states having a value corresponding to every state. Given a transition matrix \([P]\), we get the vector of expected rewards \(v\) after \(n\) transitions according to the equation as follows(Gallager 2013):

\(v[n] = r + [P]*v[n-1]\)

Applying this equation on a markovchain-class object

transMatr<-matrix(c(0.99,0.01,0.01,0.99),nrow=2,byrow=TRUE)
simpleMc<-new("markovchain", states=c("a","b"),
             transitionMatrix=transMatr)
expectedRewards(simpleMc,1,c(0,1))
#> [1] 0.01 1.99

Expected Rewards for a set of states in a markovchain process

The package provides a function expectedRewardsBeforeHittingA that returns the value of expected first passage rewards \(E\) given rewards corresponding to every state, an initial state. This means the function returns expected reward for given initial state \(s_{0}\), number of transitions \(n\) and for a set of states \(A\) with a constraint such that the process does not hit any of the states that belong to state \(A\). \(S\) is the set of all possible states.

The function uses an equation which is as follows:

\[E = \sum_{i=1}^{n}{1_{s_{0}}P_{S-A}^{i}R_{S-A}}\] here \(1_{s_{0}} = [0,0,...0,1,0,...,0,0,0]\), 1 being on \(s_{0}\) position and \(R_{S-A}\) being the rewards vector for \(S-A\) state.

Checking Irreducibly of a CTMC

The package provides a function is.CTMCirreducible that returns a Boolean value stating whether the ctmc object is irreducible. We know that a continuous time markovchain is irreducible if and only if its embedded chain is irreducible(Sigman 2009).

We demonstrate an example running the function:

energyStates <- c("sigma", "sigma_star")
byRow <- TRUE
gen <- matrix(data = c(-3, 3,
                      1, -1), nrow = 2,
             byrow = byRow, dimnames = list(energyStates, energyStates))
molecularCTMC <- new("ctmc", states = energyStates, 
                    byrow = byRow, generator = gen, 
                    name = "Molecular Transition Model")
is.CTMCirreducible(molecularCTMC)
#> [1] TRUE

Simulation of Higher Order Multivariate Markovchains

The package provides predictHommc function. This function provides a simulation system for higher order multivariate markovchains. The function assumes that the state probability distribution of the jth sequence at time \(r+1\) depends on the state probability distribution of all the sequences at n previous mon=ments of time i.e. \(t = r\) to \(t = r-n+1\) . Hence the proposed model takes the form mathematically as:(Ching, Ng, and Fung 2008)

\[ X_{r+1}^{j} = \sum_{k=1}^{s}\sum_{h=1}^n{\lambda_{jk}^{(h)}P_{h}^{(jk)}X_{r-h+1}^{(k)}}, \ \ \ j = 1,2,....s, \ \ r = n-1,n,... \] with initals \(X_{0}^{(k)},X_{1}^{(k)},......,X_{n-1}^{(k)} \ (k = 1,2,...s)\). Here,

\(\lambda_{jk}^{(k)}, \ 1 \leq j,k \leq s, \ 1 \leq h \leq n \ \ \ and \ \ \ \sum_{k=1}^{s}\sum_{h=1}^{n}{\lambda_{jk}^{(h)} = 1}, \ \ \ j = 1,2,....s.\)

Now we run an example on sample hommc object for simulating next 3 steps using predictHommc function. The function provides a choice of entering initial states according to the hommc object. In case the user does not enter initial states, the function takes all initial states to be the first state from the set of states.

if (requireNamespace("Rsolnp", quietly = TRUE)) {
statesName <- c("a", "b")
P <- array(0, dim = c(2, 2, 4), dimnames = list(statesName, statesName))
P[,,1] <- matrix(c(0, 1, 1/3, 2/3), byrow = FALSE, nrow = 2)
P[,,2] <- matrix(c(1/4, 3/4, 0, 1), byrow = FALSE, nrow = 2)
P[,,3] <- matrix(c(1, 0, 1/3, 2/3), byrow = FALSE, nrow = 2)
P[,,4] <- matrix(c(3/4, 1/4, 0, 1), byrow = FALSE, nrow = 2)
Lambda <- c(0.8, 0.2, 0.3, 0.7)
ob <- new("hommc", order = 1, states = statesName, P = P, 
         Lambda = Lambda, byrow = FALSE, name = "FOMMC")
predictHommc(ob,3)
} else {
  print("Rsolnp unavailable")
}
#>      [,1] [,2] [,3]
#> [1,] "a"  "b"  "a" 
#> [2,] "a"  "a"  "a"

Check Time Reversibility of Continuous-time markovchains

A Continuous-time markovchain with generator \(Q\) and stationary distribution \(\pi\) is said to be time reversible if:(Dobrow 2016)

\[ \pi_{i}q_{ij} = \pi_{j}q_{ji} \]

Intuitively, a continuous-time Markov chain is time reversible if the process in forward time is indistinguishable from the process in reversed time. A consequence is that for all states i and j, the long-term forward transition rate from i to j is equal to the long-term backward rate from j to i.

The package provides is.TimeReversible function to check if a ctmc object is time-reversible. We follow with an example run on a ctmc object.

energyStates <- c("sigma", "sigma_star")
byRow <- TRUE
gen <- matrix(data = c(-3, 3,
                        1, -1), nrow = 2,
             byrow = byRow, dimnames = list(energyStates, energyStates))
molecularCTMC <- new("ctmc", states = energyStates, 
                    byrow = byRow, generator = gen, 
                    name = "Molecular Transition Model")
is.TimeReversible(molecularCTMC)
#> [1] TRUE

References

Alexander Kreinin, Marina Sidelnikova. 2001. “Regularization Algorithms for Transition Matrices.” Algo Research Quarterly 4 (1/2): 23–40.
Ching, Wai-Ki, Michael K Ng, and Eric S Fung. 2008. “Higher-Order Multivariate Markov Chains and Their Applications.” Linear Algebra and Its Applications 428 (2): 492–507.
Dobrow, Robert P. 2016. Introduction to Stochastic Processes with r. John Wiley & Sons.
Gallager, Robert G. 2013. Stochastic Processes: Theory for Applications. Cambridge University Press.
Norris, J. R. 1998. Markovchains. Cambridge University Press.
Pfeuffer, Marius. 2017. Ctmcd: Estimating the Parameters of a Continuous-Time Markov Chain from Discrete-Time Data. https://CRAN.R-project.org/package=ctmcd.
Sigman, Karl. 2009. “Continuous Time Markovchains.” Columbia University.
StackOverflow. 2015. https://math.stackexchange.com/questions/1450399/probability-that-a-chain-will-enter-state-5-before-it-enters-state-3?newreg=82f90b66b949495a91661caad24db915.
Thomas Krak, Arno Siebes, Jasper De Bock. 2017. “Imprecise Continuous Time Markov Chains.” International Journal of Approximate Reasoning 88: 452–528.
markovchain/inst/doc/higher_order_markov_chains.html0000644000176200001440000012111614715232625022542 0ustar liggesusers Higher order Markov chains

Higher order Markov chains

Deepak Yadav

B-Tech student, Computer Science and Engineering

Tae Seung Kang

Ph.D student, Computer & Information Science & Engineering

Giorgio Alfredo Spedicato

Ph.D FCAS FSA CSPA C.Stat, Unipol Group

Abstract

The package contains functions to fit higher (possibly) multivariate order Markov chains. The functions are shown as well as simple exmaples

Higher Order Markov Chains

Continuous time Markov chains are discussed in the CTMC vignette which is a part of the package.

An experimental fitHigherOrder function has been written in order to fit a higher order Markov chain (Ching, Ng, and Fung (2008)). fitHigherOrder takes two inputs

  1. sequence: a categorical data sequence.
  2. order: order of Markov chain to fit with default value 2.

The output will be a list which consists of

  1. lambda: model parameter(s).
  2. Q: a list of transition matrices. \(Q_i\) is the \(ith\) step transition matrix stored column-wise.
  3. X: frequency probability vector of the given sequence.

Its quadratic programming problem is solved using solnp function of the Rsolnp package (Ghalanos and Theussl 2014).

if (requireNamespace("Rsolnp", quietly = TRUE)) {
library(Rsolnp)
data(rain)
fitHigherOrder(rain$rain, 2)
fitHigherOrder(rain$rain, 3)
}
#> $lambda
#> [1] 0.3333333 0.3333333 0.3333333
#> 
#> $Q
#> $Q[[1]]
#>             0       1-5        6+
#> 0   0.6605839 0.4625850 0.1976285
#> 1-5 0.2299270 0.3061224 0.3122530
#> 6+  0.1094891 0.2312925 0.4901186
#> 
#> $Q[[2]]
#>             0       1-5        6+
#> 0   0.6021898 0.4489796 0.3412698
#> 1-5 0.2445255 0.2687075 0.3214286
#> 6+  0.1532847 0.2823129 0.3373016
#> 
#> $Q[[3]]
#>             0       1-5        6+
#> 0   0.5693431 0.4455782 0.4183267
#> 1-5 0.2536496 0.2891156 0.2749004
#> 6+  0.1770073 0.2653061 0.3067729
#> 
#> 
#> $X
#>         0       1-5        6+ 
#> 0.5000000 0.2691606 0.2308394

Higher Order Multivariate Markov Chains

Introduction

HOMMC model is used for modeling behaviour of multiple categorical sequences generated by similar sources. The main reference is (Ching, Ng, and Fung 2008). Assume that there are s categorical sequences and each has possible states in M. In nth order MMC the state probability distribution of the jth sequence at time \(t = r + 1\) depend on the state probability distribution of all the sequences (including itself) at times \(t = r, r - 1, ..., r - n + 1\).

\[ x_{r+1}^{(j)} = \sum_{k=1}^{s}\sum_{h=1}^{n}\lambda_{jk}^{(h)}P_{h}^{(jk)}x_{r-h+1}^{(k)}, j = 1, 2, ..., s, r = n-1, n, ... \]

with initial distribution \(x_{0}^{(k)}, x_{1}^{(k)}, ... , x_{n-1}^{(k)} (k = 1, 2, ... , s)\). Here

\[ \lambda _{jk}^{(h)} \geq 0, 1\leq j, k\leq s, 1\leq h\leq n \enspace and \enspace \sum_{k=1}^{s}\sum_{h=1}^{n} \lambda_{jk}^{(h)} = 1, j = 1, 2, 3, ... , s. \]

Now we will see the simpler representation of the model which will help us understand the result of fitHighOrderMultivarMC method.

Let \(X_{r}^{(j)} = ((x_{r}^{(j)})^{T}, (x_{r-1}^{(j)})^{T}, ..., (x_{r-n+1}^{(j)})^{T})^{T} for \enspace j = 1, 2, 3, ... , s.\) Then

\[ \begin{pmatrix} X_{r+1}^{(1)}\\ X_{r+1}^{(2)}\\ .\\ .\\ .\\ X_{r+1}^{(s)} \end{pmatrix} = \begin{pmatrix} B^{11}& B^{12}& .& .& B^{1s}& \\ B^{21}& B^{22}& .& .& B^{2s}& \\ .& .& .& .& .& \\ .& .& .& .& .& \\ .& .& .& .& .& \\ B^{s1}& B^{s2}& .& .& B^{ss}& \\ \end{pmatrix} \begin{pmatrix} X_{r}^{(1)}\\ X_{r}^{(2)}\\ .\\ .\\ .\\ X_{r}^{(s)} \end{pmatrix} \textrm{where} \]

\[B^{ii} = \begin{pmatrix} \lambda _{ii}^{(1)}P_{1}^{(ii)}& \lambda _{ii}^{(2)}P_{2}^{(ii)}& .& .& \lambda _{ii}^{(n)}P_{n}^{(ii)}& \\ I& 0& .& .& 0& \\ 0& I& .& .& 0& \\ .& .& .& .& .& \\ .& .& .& .& .& \\ 0& .& .& I& 0& \end{pmatrix}_{mn*mn} \textrm{and} \]

\[ B^{ij} = \begin{pmatrix} \lambda _{ij}^{(1)}P_{1}^{(ij)}& \lambda _{ij}^{(2)}P_{2}^{(ij)}& .& .& \lambda _{ij}^{(n)}P_{n}^{(ij)}& \\ 0& 0& .& .& 0& \\ 0& 0& .& .& 0& \\ .& .& .& .& .& \\ .& .& .& .& .& \\ 0& .& .& 0& 0& \end{pmatrix}_{mn*mn} \textrm{when } i\neq j. \]

Representation of parameters in the code

\(P_{h}^{(ij)}\) is represented as \(Ph(i,j)\) and \(\lambda _{ij}^{(h)}\) as Lambdah(i,j). For example: \(P_{2}^{(13)}\) as \(P2(1,3)\) and \(\lambda _{45}^{(3)}\) as Lambda3(4,5).

Definition of HOMMC class

showClass("hommc")
#> Class "hommc" [package "markovchain"]
#> 
#> Slots:
#>                                                                   
#> Name:      order    states         P    Lambda     byrow      name
#> Class:   numeric character     array   numeric   logical character

Any element of hommc class is comprised by following slots:

  1. states: a character vector, listing the states for which transition probabilities are defined.
  2. byrow: a logical element, indicating whether transition probabilities are shown by row or by column.
  3. order: order of Multivariate Markov chain.
  4. P: an array of all transition matrices.
  5. Lambda: a vector to store the weightage of each transition matrix.
  6. name: optional character element to name the HOMMC

How to create an object of class HOMMC

states <- c('a', 'b')
P <- array(dim = c(2, 2, 4), dimnames = list(states, states))
P[ , , 1] <- matrix(c(1/3, 2/3, 1, 0), byrow = FALSE, nrow = 2, ncol = 2)

P[ , , 2] <- matrix(c(0, 1, 1, 0), byrow = FALSE, nrow = 2, ncol = 2)

P[ , , 3] <- matrix(c(2/3, 1/3, 0, 1), byrow = FALSE, nrow = 2, ncol = 2)

P[ , , 4] <- matrix(c(1/2, 1/2, 1/2, 1/2), byrow = FALSE, nrow = 2, ncol = 2)

Lambda <- c(.8, .2, .3, .7)

hob <- new("hommc", order = 1, Lambda = Lambda, P = P, states = states, 
           byrow = FALSE, name = "FOMMC")
hob
#> Order of multivariate markov chain = 1 
#> states = a b 
#> 
#> List of Lambda's and the corresponding transition matrix (by cols) :
#> Lambda1(1,1) : 0.8
#> P1(1,1) : 
#>           a b
#> a 0.3333333 1
#> b 0.6666667 0
#> 
#> Lambda1(1,2) : 0.2
#> P1(1,2) : 
#>   a b
#> a 0 1
#> b 1 0
#> 
#> Lambda1(2,1) : 0.3
#> P1(2,1) : 
#>           a b
#> a 0.6666667 0
#> b 0.3333333 1
#> 
#> Lambda1(2,2) : 0.7
#> P1(2,2) : 
#>     a   b
#> a 0.5 0.5
#> b 0.5 0.5

Fit HOMMC

fitHighOrderMultivarMC method is available to fit HOMMC. Below are the 3 parameters of this method.

  1. seqMat: a character matrix or a data frame, each column represents a categorical sequence.
  2. order: order of Multivariate Markov chain. Default is 2.
  3. Norm: Norm to be used. Default is 2.

A Marketing Example

We tried to replicate the example found in (Ching, Ng, and Fung 2008) for an application of HOMMC. A soft-drink company in Hong Kong is facing an in-house problem of production planning and inventory control. A pressing issue is the storage space of its central warehouse, which often finds itself in the state of overflow or near capacity. The company is thus in urgent needs to study the interplay between the storage space requirement and the overall growing sales demand. The product can be classified into six possible states (1, 2, 3, 4, 5, 6) according to their sales volumes. All products are labeled as 1 = no sales volume, 2 = very slow-moving (very low sales volume), 3 = slow-moving, 4 = standard, 5 = fast-moving or 6 = very fast-moving (very high sales volume). Such labels are useful from both marketing and production planning points of view. The data is cointaind in sales object.

data(sales)
head(sales)
#>      A   B   C   D   E  
#> [1,] "6" "1" "6" "6" "6"
#> [2,] "6" "6" "6" "2" "2"
#> [3,] "6" "6" "6" "2" "2"
#> [4,] "6" "1" "6" "2" "2"
#> [5,] "2" "6" "6" "2" "2"
#> [6,] "6" "1" "6" "3" "3"

The company would also like to predict sales demand for an important customer in order to minimize its inventory build-up. More importantly, the company can understand the sales pattern of this customer and then develop a marketing strategy to deal with this customer. Customer’s sales demand sequences of five important products of the company for a year. We expect sales demand sequences generated by the same customer to be correlated to each other. Therefore by exploring these relationships, one can obtain a better higher-order multivariate Markov model for such demand sequences, hence obtain better prediction rules.

In (Ching, Ng, and Fung 2008) application, they choose the order arbitrarily to be eight, i.e., n = 8. We first estimate all the transition probability matrices \(P_{h}^{ij}\) and we also have the estimates of the stationary probability distributions of the five products:.

\(\widehat{\boldsymbol{x}}^{(1)} = \begin{pmatrix} 0.0818& 0.4052& 0.0483& 0.0335& 0.0037& 0.4275 \end{pmatrix}^{\boldsymbol{T}}\)

\(\widehat{\boldsymbol{x}}^{(2)} = \begin{pmatrix} 0.3680& 0.1970& 0.0335& 0.0000& 0.0037& 0.3978 \end{pmatrix}^{\boldsymbol{T}}\)

\(\widehat{\boldsymbol{x}}^{(3)} = \begin{pmatrix} 0.1450& 0.2045& 0.0186& 0.0000& 0.0037& 0.6283 \end{pmatrix}^{\boldsymbol{T}}\)

\(\widehat{\boldsymbol{x}}^{(4)} = \begin{pmatrix} 0.0000& 0.3569& 0.1338& 0.1896& 0.0632& 0.2565 \end{pmatrix}^{\boldsymbol{T}}\)

\(\widehat{\boldsymbol{x}}^{(5)} = \begin{pmatrix} 0.0000& 0.3569& 0.1227& 0.2268& 0.0520& 0.2416 \end{pmatrix}^{\boldsymbol{T}}\)

By solving the corresponding linear programming problems, we obtain the following higher-order multivariate Markov chain model:

\(\boldsymbol{x}_{r+1}^{(1)} = \boldsymbol{P}_{1}^{(12)}\boldsymbol{x}_{r}^{(2)}\)

\(\boldsymbol{x}_{r+1}^{(2)} = 0.6364\boldsymbol{P}_{1}^{(22)}\boldsymbol{x}_{r}^{(2)} + 0.3636\boldsymbol{P}_{3}^{(22)}\boldsymbol{x}_{r}^{(2)}\)

\(\boldsymbol{x}_{r+1}^{(3)} = \boldsymbol{P}_{1}^{(35)}\boldsymbol{x}_{r}^{(5)}\)

\(\boldsymbol{x}_{r+1}^{(4)} = 0.2994\boldsymbol{P}_{8}^{(42)}\boldsymbol{x}_{r}^{(2)} + 0.4324\boldsymbol{P}_{1}^{(45)}\boldsymbol{x}_{r}^{(5)} + 0.2681\boldsymbol{P}_{2}^{(45)}\boldsymbol{x}_{r}^{(5)}\)

\(\boldsymbol{x}_{r+1}^{(5)} = 0.2718\boldsymbol{P}_{8}^{(52)}\boldsymbol{x}_{r}^{(2)} + 0.6738\boldsymbol{P}_{1}^{(54)}\boldsymbol{x}_{r}^{(4)} + 0.0544\boldsymbol{P}_{2}^{(55)}\boldsymbol{x}_{r}^{(5)}\)

According to the constructed 8th order multivariate Markov model, Products A and B are closely related. In particular, the sales demand of Product A depends strongly on Product B. The main reason is that the chemical nature of Products A and B is the same, but they have different packaging for marketing purposes. Moreover, Products B, C, D and E are closely related. Similarly, products C and E have the same product flavor, but different packaging. In this model, it is interesting to note that both Product D and E quite depend on Product B at order of 8, this relationship is hardly to be obtained in conventional Markov model owing to huge amount of parameters. The results show that higher-order multivariate Markov model is quite significant to analyze the relationship of sales demand.

# fit 8th order multivariate markov chain
if (requireNamespace("Rsolnp", quietly = TRUE)) {
object <- fitHighOrderMultivarMC(sales, order = 8, Norm = 2)
}

We choose to show only results shown in the paper. We see that \(\lambda\) values are quite close, but not equal, to those shown in the original paper.

#> Order of multivariate markov chain = 8 
#> states = 1 2 3 4 5 6 
#> 
#> List of Lambda's and the corresponding transition matrix (by cols) :
#> Lambda1(1,2) : 0.9999989
#> P1(1,2) : 
#>            1         2         3         4 5          6
#> 1 0.06060606 0.1509434 0.0000000 0.1666667 0 0.07547170
#> 2 0.44444444 0.4716981 0.4444444 0.1666667 1 0.33018868
#> 3 0.01010101 0.1320755 0.2222222 0.1666667 0 0.02830189
#> 4 0.01010101 0.0754717 0.2222222 0.1666667 0 0.01886792
#> 5 0.01010101 0.0000000 0.0000000 0.1666667 0 0.00000000
#> 6 0.46464646 0.1698113 0.1111111 0.1666667 0 0.54716981
#> 
#> Lambda1(2,2) : 0.4771666
#> P1(2,2) : 
#>            1          2         3         4 5           6
#> 1 0.40404040 0.20754717 0.0000000 0.1666667 1 0.433962264
#> 2 0.11111111 0.47169811 0.3333333 0.1666667 0 0.132075472
#> 3 0.02020202 0.05660377 0.3333333 0.1666667 0 0.009433962
#> 4 0.00000000 0.00000000 0.0000000 0.1666667 0 0.000000000
#> 5 0.00000000 0.00000000 0.1111111 0.1666667 0 0.000000000
#> 6 0.46464646 0.26415094 0.2222222 0.1666667 0 0.424528302
#> 
#> Lambda3(2,2) : 0.3882533
#> P3(2,2) : 
#>            1          2         3         4 5          6
#> 1 0.40404040 0.16981132 0.3333333 0.1666667 0 0.44230769
#> 2 0.18181818 0.33962264 0.2222222 0.1666667 0 0.14423077
#> 3 0.03030303 0.05660377 0.0000000 0.1666667 0 0.02884615
#> 4 0.00000000 0.00000000 0.0000000 0.1666667 0 0.00000000
#> 5 0.00000000 0.00000000 0.1111111 0.1666667 0 0.00000000
#> 6 0.38383838 0.43396226 0.3333333 0.1666667 1 0.38461538
#> 
#> Lambda1(3,5) : 0.672876
#> P1(3,5) : 
#>           1          2         3         4          5          6
#> 1 0.1666667 0.09473684 0.1515152 0.1639344 0.07142857 0.21538462
#> 2 0.1666667 0.18947368 0.2727273 0.2295082 0.14285714 0.18461538
#> 3 0.1666667 0.04210526 0.0000000 0.0000000 0.00000000 0.01538462
#> 4 0.1666667 0.00000000 0.0000000 0.0000000 0.00000000 0.00000000
#> 5 0.1666667 0.01052632 0.0000000 0.0000000 0.00000000 0.00000000
#> 6 0.1666667 0.66315789 0.5757576 0.6065574 0.78571429 0.58461538
#> 
#> Lambda8(4,2) : 0.2745626
#> P8(4,2) : 
#>            1          2         3         4 5          6
#> 1 0.00000000 0.00000000 0.0000000 0.1666667 0 0.00000000
#> 2 0.34343434 0.18867925 0.6666667 0.1666667 0 0.42424242
#> 3 0.10101010 0.16981132 0.0000000 0.1666667 1 0.14141414
#> 4 0.20202020 0.22641509 0.1111111 0.1666667 0 0.17171717
#> 5 0.08080808 0.09433962 0.1111111 0.1666667 0 0.03030303
#> 6 0.27272727 0.32075472 0.1111111 0.1666667 0 0.23232323
#> 
#> Lambda1(4,5) : 0.2310635
#> P1(4,5) : 
#>           1          2          3          4          5          6
#> 1 0.1666667 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
#> 2 0.1666667 0.47368421 0.21212121 0.03278689 0.00000000 0.64615385
#> 3 0.1666667 0.10526316 0.21212121 0.19672131 0.07142857 0.09230769
#> 4 0.1666667 0.00000000 0.24242424 0.54098361 0.57142857 0.03076923
#> 5 0.1666667 0.01052632 0.03030303 0.18032787 0.28571429 0.00000000
#> 6 0.1666667 0.41052632 0.30303030 0.04918033 0.07142857 0.23076923
#> 
#> Lambda2(4,5) : 0.298032
#> P2(4,5) : 
#>           1          2          3          4          5          6
#> 1 0.1666667 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
#> 2 0.1666667 0.55319149 0.36363636 0.06557377 0.00000000 0.41538462
#> 3 0.1666667 0.13829787 0.09090909 0.21311475 0.28571429 0.04615385
#> 4 0.1666667 0.05319149 0.24242424 0.40983607 0.64285714 0.06153846
#> 5 0.1666667 0.02127660 0.06060606 0.16393443 0.07142857 0.03076923
#> 6 0.1666667 0.23404255 0.24242424 0.14754098 0.00000000 0.44615385
#> 
#> Lambda8(5,2) : 0.2303975
#> P8(5,2) : 
#>            1          2         3         4 5          6
#> 1 0.00000000 0.00000000 0.0000000 0.1666667 0 0.00000000
#> 2 0.35353535 0.20754717 0.6666667 0.1666667 1 0.39393939
#> 3 0.10101010 0.15094340 0.0000000 0.1666667 0 0.13131313
#> 4 0.22222222 0.30188679 0.2222222 0.1666667 0 0.20202020
#> 5 0.09090909 0.03773585 0.0000000 0.1666667 0 0.03030303
#> 6 0.23232323 0.30188679 0.1111111 0.1666667 0 0.24242424
#> 
#> Lambda1(5,4) : 0.2263456
#> P1(5,4) : 
#>           1          2          3          4          5          6
#> 1 0.1666667 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
#> 2 0.1666667 0.48421053 0.16666667 0.01960784 0.05882353 0.60869565
#> 3 0.1666667 0.10526316 0.16666667 0.15686275 0.05882353 0.11594203
#> 4 0.1666667 0.00000000 0.44444444 0.62745098 0.64705882 0.02898551
#> 5 0.1666667 0.01052632 0.02777778 0.15686275 0.23529412 0.00000000
#> 6 0.1666667 0.40000000 0.19444444 0.03921569 0.00000000 0.24637681
#> 
#> Lambda2(5,5) : 0.5369816
#> P2(5,5) : 
#>           1          2          3          4          5          6
#> 1 0.1666667 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
#> 2 0.1666667 0.52127660 0.42424242 0.04918033 0.07142857 0.43076923
#> 3 0.1666667 0.12765957 0.03030303 0.19672131 0.21428571 0.07692308
#> 4 0.1666667 0.05319149 0.33333333 0.54098361 0.50000000 0.07692308
#> 5 0.1666667 0.02127660 0.03030303 0.11475410 0.21428571 0.01538462
#> 6 0.1666667 0.27659574 0.18181818 0.09836066 0.00000000 0.40000000

References

Ching, Wai-Ki, Ximin Huang, Michael K Ng, and Tak-Kuen Siu. 2013. “Higher-Order Markov Chains.” In Markov Chains, 141–76. Springer.
Ching, Wai-Ki, Michael K Ng, and Eric S Fung. 2008. “Higher-Order Multivariate Markov Chains and Their Applications.” Linear Algebra and Its Applications 428 (2): 492–507.
Ghalanos, Alexios, and Stefan Theussl. 2014. Rsolnp: General Non-Linear Optimization Using Augmented Lagrange Multiplier Method.
markovchain/inst/doc/an_introduction_to_markovchain_package.R0000644000176200001440000010163014715232571024367 0ustar liggesusers## ----global_options, include=FALSE-------------------------------------------- knitr::opts_chunk$set(fig.width=8.5, fig.height=6, out.width = "70%") set.seed(123) library(knitr) hook_output <- knit_hooks$get("output") knit_hooks$set(output = function(x, options) { lines <- options$output.lines if (is.null(lines)) { return(hook_output(x, options)) # pass to default hook } x <- unlist(strsplit(x, "\n")) more <- "..." if (length(lines)==1) { # first n lines if (length(x) > lines) { # truncate the output, but add .... x <- c(head(x, lines), more) } } else { x <- c(more, x[lines], more) } # paste these lines together x <- paste(c(x, ""), collapse = "\n") hook_output(x, options) }) ## ----load, results='hide', message=FALSE-------------------------------------- library("markovchain") ## ----showClass, echo=FALSE---------------------------------------------------- showClass("markovchain") showClass("markovchainList") ## ----mcInitLong--------------------------------------------------------------- weatherStates <- c("sunny", "cloudy", "rain") byRow <- TRUE weatherMatrix <- matrix(data = c(0.70, 0.2, 0.1, 0.3, 0.4, 0.3, 0.2, 0.45, 0.35), byrow = byRow, nrow = 3, dimnames = list(weatherStates, weatherStates)) mcWeather <- new("markovchain", states = weatherStates, byrow = byRow, transitionMatrix = weatherMatrix, name = "Weather") ## ----mcInitShort-------------------------------------------------------------- mcWeather <- new("markovchain", states = c("sunny", "cloudy", "rain"), transitionMatrix = matrix(data = c(0.70, 0.2, 0.1, 0.3, 0.4, 0.3, 0.2, 0.45, 0.35), byrow = byRow, nrow = 3), name = "Weather") ## ----defaultMc---------------------------------------------------------------- defaultMc <- new("markovchain") ## ----intromcList-------------------------------------------------------------- mcList <- new("markovchainList", markovchains = list(mcWeather, defaultMc), name = "A list of Markov chains") ## ----operations--------------------------------------------------------------- initialState <- c(0, 1, 0) after2Days <- initialState * (mcWeather * mcWeather) after7Days <- initialState * (mcWeather ^ 7) after2Days round(after7Days, 3) ## ----operations2-------------------------------------------------------------- initialState <- c(0, 1, 0) after2Days <- (t(mcWeather) * t(mcWeather)) * initialState after7Days <- (t(mcWeather) ^ 7) * initialState after2Days round(after7Days, 3) ## ----fval--------------------------------------------------------------------- fvals<-function(mchain,initialstate,n) { out<-data.frame() names(initialstate)<-names(mchain) for (i in 0:n) { iteration<-initialstate*mchain^(i) out<-rbind(out,iteration) } out<-cbind(out, i=seq(0,n)) out<-out[,c(4,1:3)] return(out) } fvals(mchain=mcWeather,initialstate=c(90,5,5),n=4) ## ----otherMethods------------------------------------------------------------- states(mcWeather) names(mcWeather) dim(mcWeather) ## ----otherMethods2------------------------------------------------------------ name(mcWeather) name(mcWeather) <- "New Name" name(mcWeather) ## ----sortMethod--------------------------------------------------------------- markovchain:::sort(mcWeather) ## ----transProb---------------------------------------------------------------- transitionProbability(mcWeather, "cloudy", "rain") mcWeather[2,3] ## ----printAndShow------------------------------------------------------------- print(mcWeather) show(mcWeather) ## ----mcPlot, echo=FALSE, fig.cap="Weather example. Markov chain plot"--------- if (requireNamespace("igraph", quietly = TRUE)) { library(igraph) plot(mcWeather,layout = layout.fruchterman.reingold) } else { message("igraph unavailable") } ## ----mcPlotdiagram, echo=FALSE, fig.cap="Weather example. Markov chain plot with diagram"---- if (requireNamespace("diagram", quietly = TRUE)) { library(diagram) plot(mcWeather, package="diagram", box.size = 0.04) } else { message("diagram unavailable") } ## ----exportImport1------------------------------------------------------------ mcDf <- as(mcWeather, "data.frame") mcNew <- as(mcDf, "markovchain") mcDf mcIgraph <- as(mcWeather, "igraph") ## ----exportImport2------------------------------------------------------------ if (requireNamespace("msm", quietly = TRUE)) { require(msm) Q <- rbind ( c(0, 0.25, 0, 0.25), c(0.166, 0, 0.166, 0.166), c(0, 0.25, 0, 0.25), c(0, 0, 0, 0) ) cavmsm <- msm(state ~ years, subject = PTNUM, data = cav, qmatrix = Q, death = 4) msmMc <- as(cavmsm, "markovchain") msmMc } else { message("msm unavailable") } ## ----exporImport3------------------------------------------------------------- if (requireNamespace("etm", quietly = TRUE)) { library(etm) data(sir.cont) sir.cont <- sir.cont[order(sir.cont$id, sir.cont$time), ] for (i in 2:nrow(sir.cont)) { if (sir.cont$id[i]==sir.cont$id[i-1]) { if (sir.cont$time[i]==sir.cont$time[i-1]) { sir.cont$time[i-1] <- sir.cont$time[i-1] - 0.5 } } } tra <- matrix(ncol=3,nrow=3,FALSE) tra[1, 2:3] <- TRUE tra[2, c(1, 3)] <- TRUE tr.prob <- etm::etm(sir.cont, c("0", "1", "2"), tra, "cens", 1) tr.prob etm2mc<-as(tr.prob, "markovchain") etm2mc } else { message("etm unavailable") } ## ----fromAndTo, echo=FALSE, fig.cap="The markovchain methods for import and export"---- library(igraph) importExportGraph<-graph.formula(dataframe++markovchain,markovchain-+igraph, markovchain++matrix,table-+markovchain,msm-+markovchain,etm-+markovchain, markovchain++sparseMatrix) plot(importExportGraph,main="Import - Export from and to markovchain objects") ## ----exportImport4------------------------------------------------------------ myMatr<-matrix(c(.1,.8,.1,.2,.6,.2,.3,.4,.3), byrow=TRUE, ncol=3) myMc<-as(myMatr, "markovchain") myMc ## ----cchcMcList--------------------------------------------------------------- stateNames = c("H", "I", "D") Q0 <- new("markovchain", states = stateNames, transitionMatrix =matrix(c(0.7, 0.2, 0.1,0.1, 0.6, 0.3,0, 0, 1), byrow = TRUE, nrow = 3), name = "state t0") Q1 <- new("markovchain", states = stateNames, transitionMatrix = matrix(c(0.5, 0.3, 0.2,0, 0.4, 0.6,0, 0, 1), byrow = TRUE, nrow = 3), name = "state t1") Q2 <- new("markovchain", states = stateNames, transitionMatrix = matrix(c(0.3, 0.2, 0.5,0, 0.2, 0.8,0, 0, 1), byrow = TRUE,nrow = 3), name = "state t2") Q3 <- new("markovchain", states = stateNames, transitionMatrix = matrix(c(0, 0, 1, 0, 0, 1, 0, 0, 1), byrow = TRUE, nrow = 3), name = "state t3") mcCCRC <- new("markovchainList",markovchains = list(Q0,Q1,Q2,Q3), name = "Continuous Care Health Community") print(mcCCRC) ## ----cchcMcList2-------------------------------------------------------------- mcCCRC[[1]] dim(mcCCRC) ## ----conditionalDistr--------------------------------------------------------- conditionalDistribution(mcWeather, "sunny") ## ----steadyStates------------------------------------------------------------- steadyStates(mcWeather) ## ----gamblerRuin-------------------------------------------------------------- gamblerRuinMarkovChain <- function(moneyMax, prob = 0.5) { m <- markovchain:::zeros(moneyMax + 1) m[1,1] <- m[moneyMax + 1,moneyMax + 1] <- 1 states <- as.character(0:moneyMax) rownames(m) <- colnames(m) <- states for(i in 2:moneyMax){ m[i,i-1] <- 1 - prob m[i, i + 1] <- prob } new("markovchain", transitionMatrix = m, name = paste("Gambler ruin", moneyMax, "dim", sep = " ")) } mcGR4 <- gamblerRuinMarkovChain(moneyMax = 4, prob = 0.5) steadyStates(mcGR4) ## ----absorbingStates---------------------------------------------------------- absorbingStates(mcGR4) absorbingStates(mcWeather) ## ----renaldoMatrix1----------------------------------------------------------- P <- markovchain:::zeros(10) P[1, c(1, 3)] <- 1/2; P[2, 2] <- 1/3; P[2,7] <- 2/3; P[3, 1] <- 1; P[4, 5] <- 1; P[5, c(4, 5, 9)] <- 1/3; P[6, 6] <- 1; P[7, 7] <- 1/4; P[7,9] <- 3/4; P[8, c(3, 4, 8, 10)] <- 1/4; P[9, 2] <- 1; P[10, c(2, 5, 10)] <- 1/3; rownames(P) <- letters[1:10] colnames(P) <- letters[1:10] probMc <- new("markovchain", transitionMatrix = P, name = "Probability MC") summary(probMc) ## ----transientStates---------------------------------------------------------- transientStates(probMc) ## ----probMc2Canonic----------------------------------------------------------- probMcCanonic <- canonicForm(probMc) probMc probMcCanonic ## ----isAccessible------------------------------------------------------------- is.accessible(object = probMc, from = "a", to = "c") is.accessible(object = probMc, from = "g", to = "c") ## ----periodicity-------------------------------------------------------------- E <- matrix(0, nrow = 4, ncol = 4) E[1, 2] <- 1 E[2, 1] <- 1/3; E[2, 3] <- 2/3 E[3,2] <- 1/4; E[3, 4] <- 3/4 E[4, 3] <- 1 mcE <- new("markovchain", states = c("a", "b", "c", "d"), transitionMatrix = E, name = "E") is.irreducible(mcE) period(mcE) ## ----mathematica9Mc----------------------------------------------------------- mathematicaMatr <- markovchain:::zeros(5) mathematicaMatr[1,] <- c(0, 1/3, 0, 2/3, 0) mathematicaMatr[2,] <- c(1/2, 0, 0, 0, 1/2) mathematicaMatr[3,] <- c(0, 0, 1/2, 1/2, 0) mathematicaMatr[4,] <- c(0, 0, 1/2, 1/2, 0) mathematicaMatr[5,] <- c(0, 0, 0, 0, 1) statesNames <- letters[1:5] mathematicaMc <- new("markovchain", transitionMatrix = mathematicaMatr, name = "Mathematica MC", states = statesNames) ## ----mcMathematics, fig=TRUE, echo=FALSE, fig.align='center', fig.cap="Mathematica 9 example. Markov chain plot."---- plot(mathematicaMc, layout = layout.fruchterman.reingold) ## ----mathematica9MC, echo=FALSE----------------------------------------------- summary(mathematicaMc) ## ----fpTime1, eval=FALSE------------------------------------------------------ # .firstpassageKernel <- function(P, i, n){ # G <- P # H <- P[i,] # E <- 1 - diag(size(P)[2]) # for (m in 2:n) { # G <- P %*% (G * E) # H <- rbind(H, G[i,]) # } # return(H) # } ## ----fpTime2------------------------------------------------------------------ firstPassagePdF <- firstPassage(object = mcWeather, state = "sunny", n = 10) firstPassagePdF[3, 3] ## ----mfpt1-------------------------------------------------------------------- meanFirstPassageTime(mcWeather) ## ----mfpt2-------------------------------------------------------------------- meanFirstPassageTime(mcWeather,"rain") ## ----mfpt3-------------------------------------------------------------------- firstPassagePdF.long <- firstPassage(object = mcWeather, state = "sunny", n = 100) sum(firstPassagePdF.long[,"rain"] * 1:100) ## ----mrt-weather-------------------------------------------------------------- meanRecurrenceTime(mcWeather) ## ----mrt-probMc--------------------------------------------------------------- recurrentStates(probMc) meanRecurrenceTime(probMc) ## ----data-drunkard------------------------------------------------------------ drunkProbs <- markovchain:::zeros(5) drunkProbs[1,1] <- drunkProbs[5,5] <- 1 drunkProbs[2,1] <- drunkProbs[2,3] <- 1/2 drunkProbs[3,2] <- drunkProbs[3,4] <- 1/2 drunkProbs[4,3] <- drunkProbs[4,5] <- 1/2 drunkMc <- new("markovchain", transitionMatrix = drunkProbs) drunkMc ## ----rs-drunkard-------------------------------------------------------------- recurrentStates(drunkMc) ## ----ts-drunkard-------------------------------------------------------------- transientStates(drunkMc) ## ----ap-drunkard-------------------------------------------------------------- absorptionProbabilities(drunkMc) ## ----at-drunkard-------------------------------------------------------------- meanAbsorptionTime(drunkMc) ## ----------------------------------------------------------------------------- committorAB(mcWeather,3,1) ## ----hitting-data------------------------------------------------------------- M <- markovchain:::zeros(5) M[1,1] <- M[5,5] <- 1 M[2,1] <- M[2,3] <- 1/2 M[3,2] <- M[3,4] <- 1/2 M[4,2] <- M[4,5] <- 1/2 hittingTest <- new("markovchain", transitionMatrix = M) hittingProbabilities(hittingTest) ## ----hitting-probabilities---------------------------------------------------- hittingProbabilities(hittingTest) ## ----hitting-weather---------------------------------------------------------- hittingProbabilities(mcWeather) ## ----simulatingAMarkovChain--------------------------------------------------- weathersOfDays <- rmarkovchain(n = 365, object = mcWeather, t0 = "sunny") weathersOfDays[1:30] ## ----simulatingAListOfMarkovChain--------------------------------------------- patientStates <- rmarkovchain(n = 5, object = mcCCRC, t0 = "H", include.t0 = TRUE) patientStates[1:10,] ## ----fitMcbyMLE2-------------------------------------------------------------- weatherFittedMLE <- markovchainFit(data = weathersOfDays, method = "mle",name = "Weather MLE") weatherFittedMLE$estimate weatherFittedMLE$standardError ## ----fitMcbyLAPLACE----------------------------------------------------------- weatherFittedLAPLACE <- markovchainFit(data = weathersOfDays, method = "laplace", laplacian = 0.01, name = "Weather LAPLACE") weatherFittedLAPLACE$estimate ## ----fitSequenceMatrix-------------------------------------------------------- createSequenceMatrix(stringchar = weathersOfDays) ## ----fitSequenceMatrix2------------------------------------------------------- myMatr<-matrix(c("a","b","b","a","a","b","b","b","b","a","a","a","b","a"),ncol=2) createSequenceMatrix(stringchar = myMatr,toRowProbs = TRUE) ## ----fitMcbyBootStrap1-------------------------------------------------------- weatherFittedBOOT <- markovchainFit(data = weathersOfDays, method = "bootstrap", nboot = 20) weatherFittedBOOT$estimate weatherFittedBOOT$standardError ## ----fitMcbyBootStrap2, eval=FALSE-------------------------------------------- # weatherFittedBOOTParallel <- markovchainFit(data = weathersOfDays, # method = "bootstrap", nboot = 200, # parallel = TRUE) # weatherFittedBOOTParallel$estimate # weatherFittedBOOTParallel$standardError ## ----fitMcbyBootStrap3, eval=FALSE-------------------------------------------- # RcppParallel::setNumThreads(2) ## ----fitMcbyMLE1-------------------------------------------------------------- weatherFittedMLE$logLikelihood weatherFittedBOOT$logLikelihood ## ----confint------------------------------------------------------------------ weatherFittedMLE$confidenceInterval weatherFittedBOOT$confidenceInterval ## ----multinomial-------------------------------------------------------------- multinomialConfidenceIntervals(transitionMatrix = weatherFittedMLE$estimate@transitionMatrix, countsTransitionMatrix = createSequenceMatrix(weathersOfDays)) ## ----fitMclists--------------------------------------------------------------- data(holson) singleMc<-markovchainFit(data=holson[,2:12],name="holson") ## ----fitMclistsFit1, output.lines=20------------------------------------------ mcListFit<-markovchainListFit(data=holson[,2:6],name="holson") mcListFit$estimate ## ----fitMclistsFit2----------------------------------------------------------- c1<-c("a","b","a","a","c","c","a") c2<-c("b") c3<-c("c","a","a","c") c4<-c("b","a","b","a","a","c","b") c5<-c("a","a","c",NA) c6<-c("b","c","b","c","a") mylist<-list(c1,c2,c3,c4,c5,c6) mylistMc<-markovchainFit(data=mylist) mylistMc ## ----fitAMarkovChainListfromAlist, output.lines=15---------------------------- markovchainListFit(data=mylist) ## ----markovchainPredict------------------------------------------------------- predict(object = weatherFittedMLE$estimate, newdata = c("cloudy", "sunny"), n.ahead = 3) ## ----markovchainListPredict--------------------------------------------------- predict(mcCCRC, newdata = c("H", "H"), n.ahead = 5) ## ----markovchainListPredict2-------------------------------------------------- predict(mcCCRC, newdata = c("H", "H"), n.ahead = 5, continue = TRUE) ## ----test1-------------------------------------------------------------------- sample_sequence<-c("a", "b", "a", "a", "a", "a", "b", "a", "b", "a", "b", "a", "a", "b", "b", "b", "a") verifyMarkovProperty(sample_sequence) ## ----test2-------------------------------------------------------------------- data(rain) assessOrder(rain$rain) ## ----test3-------------------------------------------------------------------- assessStationarity(rain$rain, 10) ## ----divergence1-------------------------------------------------------------- sequence<-c(0,1,2,2,1,0,0,0,0,0,0,1,2,2,2,1,0,0,1,0,0,0,0,0,0,1,1, 2,0,0,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,0,2,1,0, 0,2,1,0,0,0,0,0,0,1,1,1,2,2,0,0,2,1,1,1,1,2,1,1,1,1,1,1,1,1,1,0,2, 0,1,1,0,0,0,1,2,2,0,0,0,0,0,0,2,2,2,1,1,1,1,0,1,1,1,1,0,0,2,1,1, 0,0,0,0,0,2,2,1,1,1,1,1,2,1,2,0,0,0,1,2,2,2,0,0,0,1,1) mc=matrix(c(5/8,1/4,1/8,1/4,1/2,1/4,1/4,3/8,3/8),byrow=TRUE, nrow=3) rownames(mc)<-colnames(mc)<-0:2; theoreticalMc<-as(mc, "markovchain") verifyEmpiricalToTheoretical(data=sequence,object=theoreticalMc) ## ----divergence2-------------------------------------------------------------- data(kullback) verifyHomogeneity(inputList=kullback,verbose=TRUE) ## ----rCtmcInit---------------------------------------------------------------- energyStates <- c("sigma", "sigma_star") byRow <- TRUE gen <- matrix(data = c(-3, 3, 1, -1), nrow = 2, byrow = byRow, dimnames = list(energyStates, energyStates)) molecularCTMC <- new("ctmc", states = energyStates, byrow = byRow, generator = gen, name = "Molecular Transition Model") ## ----rctmcRandom0------------------------------------------------------------- statesDist <- c(0.8, 0.2) rctmc(n = 3, ctmc = molecularCTMC, initDist = statesDist, out.type = "df", include.T0 = FALSE) ## ----ctmcRandom1-------------------------------------------------------------- statesDist <- c(0.8, 0.2) rctmc(n = Inf, ctmc = molecularCTMC, initDist = statesDist, T = 2) ## ----rctmcSteadyStates-------------------------------------------------------- steadyStates(molecularCTMC) ## ----rctmcFitting------------------------------------------------------------- data <- list(c("a", "b", "c", "a", "b", "a", "c", "b", "c"), c(0, 0.8, 2.1, 2.4, 4, 5, 5.9, 8.2, 9)) ctmcFit(data) ## ----mcWeatherQ--------------------------------------------------------------- mcWeatherQ <- expm::logm(mcWeather@transitionMatrix,method='Eigen') mcWeatherQ ## ----mcWeatherHalfDay--------------------------------------------------------- mcWeatherHalfDayTM <- expm::expm(mcWeatherQ*.5) mcWeatherHalfDay <- new("markovchain",transitionMatrix=mcWeatherHalfDayTM,name="Half Day Weather Transition Matrix") mcWeatherHalfDay ## ----ctmcd1------------------------------------------------------------------- if(requireNamespace(package='ctmcd', quietly = TRUE)) { require(ctmcd) require(expm) #defines a function to transform a GM into a TM gm_to_markovchain<-function(object, t=1) { if(!(class(object) %in% c("gm","matrix","Matrix"))) stop("Error! Expecting either a matrix or a gm object") if ( class(object) %in% c("matrix","Matrix")) generator_matrix<-object else generator_matrix<-as.matrix(object[["par"]]) #must add importClassesFrom("markovchain",markovchain) in the NAMESPACE #must add importFrom(expm, "expm") transitionMatrix<-expm(generator_matrix*t) out<-as(transitionMatrix,"markovchain") return(out) } #loading ctmcd dataset data(tm_abs) gm0=matrix(1,8,8) #initializing diag(gm0)=0 diag(gm0)=-rowSums(gm0) gm0[8,]=0 gmem=gm(tm_abs,te=1,method="EM",gmguess=gm0) #estimating GM mc_at_2=gm_to_markovchain(object=gmem, t=2) #converting to TM at time 2 } else { warning('package ctmcd unavailable') } ## ----pseudobayes-------------------------------------------------------------- pseudoBayesEstimator <- function(raw, apriori){ v_i <- rowSums(raw) K_i <- numeric(nrow(raw)) sumSquaredY <- rowSums(raw^2) #get numerator K_i_num <- v_i^2-sumSquaredY #get denominator VQ <- matrix(0,nrow= nrow(apriori),ncol=ncol(apriori)) for (i in 1:nrow(VQ)) { VQ[i,]<-v_i[i]*apriori[i,] } K_i_den<-rowSums((raw - VQ)^2) K_i <- K_i_num/K_i_den #get the alpha vector alpha <- K_i / (v_i+K_i) #empirical transition matrix Emp<-raw/rowSums(raw) #get the estimate out<-matrix(0, nrow= nrow(raw),ncol=ncol(raw)) for (i in 1:nrow(out)) { out[i,]<-alpha[i]*apriori[i,]+(1-alpha[i])*Emp[i,] } return(out) } ## ----pseudobayes2------------------------------------------------------------- trueMc<-as(matrix(c(0.1, .9,.7,.3),nrow = 2, byrow = 2),"markovchain") aprioriMc<-as(matrix(c(0.5, .5,.5,.5),nrow = 2, byrow = 2),"markovchain") smallSample<-rmarkovchain(n=20,object = trueMc) smallSampleRawTransitions<-createSequenceMatrix(stringchar = smallSample) pseudoBayesEstimator( raw = smallSampleRawTransitions, apriori = aprioriMc@transitionMatrix ) - trueMc@transitionMatrix biggerSample<-rmarkovchain(n=100,object = trueMc) biggerSampleRawTransitions<-createSequenceMatrix(stringchar = biggerSample) pseudoBayesEstimator( raw = biggerSampleRawTransitions, apriori = aprioriMc@transitionMatrix ) - trueMc@transitionMatrix bigSample<-rmarkovchain(n=1000,object = trueMc) bigSampleRawTransitions<-createSequenceMatrix(stringchar = bigSample) pseudoBayesEstimator( raw = bigSampleRawTransitions, apriori = aprioriMc@transitionMatrix ) - trueMc@transitionMatrix ## ----loadAndDoExample--------------------------------------------------------- weatherStates <- c("sunny", "cloudy", "rain") byRow <- TRUE weatherMatrix <- matrix(data = c(0.7, 0.2, 0.1, 0.3, 0.4, 0.3, 0.2, 0.4, 0.4), byrow = byRow, nrow = 3, dimnames = list(weatherStates, weatherStates)) mcWeather <- new("markovchain", states = weatherStates, byrow = byRow, transitionMatrix = weatherMatrix, name = "Weather") weathersOfDays <- rmarkovchain(n = 365, object = mcWeather, t0 = "sunny") ## ----MAPFit------------------------------------------------------------------- hyperMatrix<-matrix(c(1, 1, 2, 3, 2, 1, 2, 2, 3), nrow = 3, byrow = TRUE, dimnames = list(weatherStates,weatherStates)) markovchainFit(weathersOfDays[1:200], method = "map", confidencelevel = 0.92, hyperparam = hyperMatrix) predictiveDistribution(weathersOfDays[1:200], weathersOfDays[201:365],hyperparam = hyperMatrix) ## ----MAPFit2------------------------------------------------------------------ hyperMatrix2<- hyperMatrix[c(2,3,1), c(2,3,1)] markovchainFit(weathersOfDays[1:200], method = "map", confidencelevel = 0.92, hyperparam = hyperMatrix2) predictiveDistribution(weathersOfDays[1:200], weathersOfDays[201:365],hyperparam = hyperMatrix2) ## ----inferHyperparam---------------------------------------------------------- inferHyperparam(transMatr = weatherMatrix, scale = c(10, 10, 10)) ## ----inferHyperparam2--------------------------------------------------------- inferHyperparam(data = weathersOfDays[1:15]) ## ----inferHyperparam3--------------------------------------------------------- hyperMatrix3 <- inferHyperparam(transMatr = weatherMatrix, scale = c(10, 10, 10)) hyperMatrix3 <- hyperMatrix3$scaledInference hyperMatrix4 <- inferHyperparam(data = weathersOfDays[1:15]) hyperMatrix4 <- hyperMatrix4$dataInference ## ----MAPandMLE---------------------------------------------------------------- data(preproglucacon) preproglucacon <- preproglucacon[[2]] MLEest <- markovchainFit(preproglucacon, method = "mle") MAPest <- markovchainFit(preproglucacon, method = "map") MLEest$estimate MAPest$estimate ## ----weatPred1---------------------------------------------------------------- mcWP <- new("markovchain", states = c("rainy", "nice", "snowy"), transitionMatrix = matrix(c(0.5, 0.25, 0.25, 0.5, 0, 0.5, 0.25,0.25,0.5), byrow = T, nrow = 3)) ## ----weatPred2---------------------------------------------------------------- W0 <- t(as.matrix(c(0, 1, 0))) W1 <- W0 * mcWP; W1 W2 <- W0 * (mcWP ^ 2); W2 W3 <- W0 * (mcWP ^ 3); W3 ## ----weatPred3---------------------------------------------------------------- W7 <- W0 * (mcWP ^ 7) W7 ## ----weatPred4---------------------------------------------------------------- q <- steadyStates(mcWP) q ## ----weatPred5---------------------------------------------------------------- R0 <- t(as.matrix(c(1, 0, 0))) R7 <- R0 * (mcWP ^ 7); R7 S0 <- t(as.matrix(c(0, 0, 1))) S7 <- S0 * (mcWP ^ 7); S7 ## ----Alofi1------------------------------------------------------------------- data("rain", package = "markovchain") table(rain$rain) ## ----Alofi2------------------------------------------------------------------- mcAlofi <- markovchainFit(data = rain$rain, name = "Alofi MC")$estimate mcAlofi ## ----Alofi3------------------------------------------------------------------- steadyStates(mcAlofi) ## ----ratings1----------------------------------------------------------------- rc <- c("AAA", "AA", "A", "BBB", "BB", "B", "CCC", "D") creditMatrix <- matrix( c(90.81, 8.33, 0.68, 0.06, 0.08, 0.02, 0.01, 0.01, 0.70, 90.65, 7.79, 0.64, 0.06, 0.13, 0.02, 0.01, 0.09, 2.27, 91.05, 5.52, 0.74, 0.26, 0.01, 0.06, 0.02, 0.33, 5.95, 85.93, 5.30, 1.17, 1.12, 0.18, 0.03, 0.14, 0.67, 7.73, 80.53, 8.84, 1.00, 1.06, 0.01, 0.11, 0.24, 0.43, 6.48, 83.46, 4.07, 5.20, 0.21, 0, 0.22, 1.30, 2.38, 11.24, 64.86, 19.79, 0, 0, 0, 0, 0, 0, 0, 100 )/100, 8, 8, dimnames = list(rc, rc), byrow = TRUE) ## ----ratings2----------------------------------------------------------------- creditMc <- new("markovchain", transitionMatrix = creditMatrix, name = "S&P Matrix") absorbingStates(creditMc) ## ----economicAnalysis1-------------------------------------------------------- statesNames <- c("customer", "non customer") P <- markovchain:::zeros(2); P[1, 1] <- .9; P[1, 2] <- .1; P[2, 2] <- .95; P[2, 1] <- .05; rownames(P) <- statesNames; colnames(P) <- statesNames mcP <- new("markovchain", transitionMatrix = P, name = "Telephone company") M <- markovchain:::zeros(2); M[1, 1] <- -20; M[1, 2] <- -30; M[2, 1] <- -40; M[2, 2] <- 0 ## ----economicAnalysis2-------------------------------------------------------- c1 <- 100 + conditionalDistribution(mcP, state = "customer") %*% M[1,] c2 <- 0 + conditionalDistribution(mcP, state = "non customer") %*% M[2,] ## ----economicAnalysis3-------------------------------------------------------- as.numeric((c(1, 0)* mcP ^ 5) %*% (as.vector(c(c1, c2)))) ## ----bonusMalus1-------------------------------------------------------------- getBonusMalusMarkovChain <- function(lambda) { bmMatr <- markovchain:::zeros(5) bmMatr[1, 1] <- dpois(x = 0, lambda) bmMatr[1, 3] <- dpois(x = 1, lambda) bmMatr[1, 5] <- 1 - ppois(q = 1, lambda) bmMatr[2, 1] <- dpois(x = 0, lambda) bmMatr[2, 4] <- dpois(x = 1, lambda) bmMatr[2, 5] <- 1 - ppois(q = 1, lambda) bmMatr[3, 2] <- dpois(x = 0, lambda) bmMatr[3, 5] <- 1 - dpois(x=0, lambda) bmMatr[4, 3] <- dpois(x = 0, lambda) bmMatr[4, 5] <- 1 - dpois(x = 0, lambda) bmMatr[5, 4] <- dpois(x = 0, lambda) bmMatr[5, 5] <- 1 - dpois(x = 0, lambda) stateNames <- as.character(1:5) out <- new("markovchain", transitionMatrix = bmMatr, states = stateNames, name = "BM Matrix") return(out) } ## ----bonusMalus2-------------------------------------------------------------- bmMc <- getBonusMalusMarkovChain(0.05) as.numeric(steadyStates(bmMc)) ## ----bonusMalus3-------------------------------------------------------------- sum(as.numeric(steadyStates(bmMc)) * c(0.5, 0.7, 0.9, 1, 1.25)) ## ----healthIns6--------------------------------------------------------------- ltcDemoPath<-system.file("extdata", "ltdItaData.txt", package = "markovchain") ltcDemo<-read.table(file = ltcDemoPath, header=TRUE, sep = ";", dec = ".") head(ltcDemo) ## ----healthIns7--------------------------------------------------------------- ltcDemo<-transform(ltcDemo, pIA=0, pII=1-pID, pDD=1, pDA=0, pDI=0) ## ----healthIns8--------------------------------------------------------------- possibleStates<-c("A","I","D") getMc4Age<-function(age) { transitionsAtAge<-ltcDemo[ltcDemo$age==age,] myTransMatr<-matrix(0, nrow=3,ncol = 3, dimnames = list(possibleStates, possibleStates)) myTransMatr[1,1]<-transitionsAtAge$pAA[1] myTransMatr[1,2]<-transitionsAtAge$pAI[1] myTransMatr[1,3]<-transitionsAtAge$pAD[1] myTransMatr[2,2]<-transitionsAtAge$pII[1] myTransMatr[2,3]<-transitionsAtAge$pID[1] myTransMatr[3,3]<-1 myMc<-new("markovchain", transitionMatrix = myTransMatr, states = possibleStates, name = paste("Age",age,"transition matrix")) return(myMc) } ## ----healthIns8-prob---------------------------------------------------------- getFullTransitionTable<-function(age){ ageSequence<-seq(from=age, to=120) k=1 myList=list() for ( i in ageSequence) { mc_age_i<-getMc4Age(age = i) myList[[k]]<-mc_age_i k=k+1 } myMarkovChainList<-new("markovchainList", markovchains = myList, name = paste("TransitionsSinceAge", age, sep = "")) return(myMarkovChainList) } transitionsSince100<-getFullTransitionTable(age=100) ## ----healthIns9--------------------------------------------------------------- rmarkovchain(n = 10, object = transitionsSince100, what = "matrix", t0 = "A", include.t0 = TRUE) ## ----healthIns10-------------------------------------------------------------- transitionsSince80<-getFullTransitionTable(age=80) lifeTrajectories<-rmarkovchain(n=1e3, object=transitionsSince80, what="matrix",t0="A",include.t0=TRUE) temp<-matrix(0,nrow=nrow(lifeTrajectories),ncol = ncol(lifeTrajectories)) temp[lifeTrajectories=="I"]<-1 expected_period_disabled<-mean(rowSums((temp))) expected_period_disabled ## ----healthIns11-------------------------------------------------------------- mean(rowMeans(12000*temp%*%( matrix((1+0.02)^-seq(from=0, to=ncol(temp)-1))))) ## ----blandenEtAlii------------------------------------------------------------ data("blanden") mobilityMc <- as(blanden, "markovchain") mobilityMc ## ----mobility, fig=TRUE, echo=FALSE, fig.align='center', fig.cap="1970 UK cohort mobility data."---- plot(mobilityMc, main = '1970 mobility',vertex.label.cex = 2, layout = layout.fruchterman.reingold) ## ----blandenEtAlii3----------------------------------------------------------- round(steadyStates(mobilityMc), 2) ## ----preproglucacon1---------------------------------------------------------- data("preproglucacon", package = "markovchain") ## ----preproglucacon2---------------------------------------------------------- mcProtein <- markovchainFit(preproglucacon$preproglucacon, name = "Preproglucacon MC")$estimate mcProtein ## ----epid1-------------------------------------------------------------------- craigSendiMatr <- matrix(c(682, 33, 25, 154, 64, 47, 19, 19, 43), byrow = T, nrow = 3) hivStates <- c("0-49", "50-74", "75-UP") rownames(craigSendiMatr) <- hivStates colnames(craigSendiMatr) <- hivStates craigSendiTable <- as.table(craigSendiMatr) mcM6 <- as(craigSendiTable, "markovchain") mcM6@name <- "Zero-Six month CD4 cells transition" mcM6 ## ----epid2-------------------------------------------------------------------- eig <- eigen(mcM6@transitionMatrix) D <- diag(eig$values) ## ----epid3-------------------------------------------------------------------- V <- eig$vectors V %*% D %*% solve(V) d <- D ^ (1/6) M <- V %*% d %*% solve(V) mcM1 <- new("markovchain", transitionMatrix = M, states = hivStates) markovchain/inst/doc/higher_order_markov_chains.R0000644000176200001440000000513014715232624021773 0ustar liggesusers## ----global_options, include=FALSE-------------------------------------------- knitr::opts_chunk$set(fig.width=8.5, fig.height=6, out.width = "70%") set.seed(123) ## ----setup, include=FALSE----------------------------------------------------- knitr::opts_chunk$set(echo = TRUE, collapse = TRUE, comment = "#>") ## ----setup_2, include=FALSE, message=FALSE, echo=FALSE------------------------ require(markovchain) ## ----higherOrder-------------------------------------------------------------- if (requireNamespace("Rsolnp", quietly = TRUE)) { library(Rsolnp) data(rain) fitHigherOrder(rain$rain, 2) fitHigherOrder(rain$rain, 3) } ## ----hommcObject-------------------------------------------------------------- showClass("hommc") ## ----hommcCreate-------------------------------------------------------------- states <- c('a', 'b') P <- array(dim = c(2, 2, 4), dimnames = list(states, states)) P[ , , 1] <- matrix(c(1/3, 2/3, 1, 0), byrow = FALSE, nrow = 2, ncol = 2) P[ , , 2] <- matrix(c(0, 1, 1, 0), byrow = FALSE, nrow = 2, ncol = 2) P[ , , 3] <- matrix(c(2/3, 1/3, 0, 1), byrow = FALSE, nrow = 2, ncol = 2) P[ , , 4] <- matrix(c(1/2, 1/2, 1/2, 1/2), byrow = FALSE, nrow = 2, ncol = 2) Lambda <- c(.8, .2, .3, .7) hob <- new("hommc", order = 1, Lambda = Lambda, P = P, states = states, byrow = FALSE, name = "FOMMC") hob ## ----hommsales---------------------------------------------------------------- data(sales) head(sales) ## ----hommcFit, warning = FALSE, message = FALSE------------------------------- # fit 8th order multivariate markov chain if (requireNamespace("Rsolnp", quietly = TRUE)) { object <- fitHighOrderMultivarMC(sales, order = 8, Norm = 2) } ## ----result, echo = FALSE----------------------------------------------------- if (requireNamespace("Rsolnp", quietly = TRUE)) { i <- c(1, 2, 2, 3, 4, 4, 4, 5, 5, 5) j <- c(2, 2, 2, 5, 2, 5, 5, 2, 4, 5) k <- c(1, 1, 3, 1, 8, 1, 2, 8, 1, 2) if(object@byrow == TRUE) { direction <- "(by rows)" } else { direction <- "(by cols)" } cat("Order of multivariate markov chain =", object@order, "\n") cat("states =", object@states, "\n") cat("\n") cat("List of Lambda's and the corresponding transition matrix", direction,":\n") for(p in 1:10) { t <- 8*5*(i[p]-1) + (j[p]-1)*8 cat("Lambda", k[p], "(", i[p], ",", j[p], ") : ", object@Lambda[t+k[p]],"\n", sep = "") cat("P", k[p], "(", i[p], ",", j[p], ") : \n", sep = "") print(object@P[, , t+k[p]]) cat("\n") } } else { print("package Rsolnp unavailable") } markovchain/inst/doc/gsoc_2017_additions.Rmd0000644000176200001440000005244014714756746020436 0ustar liggesusers--- title: "Google Summer of Code 2017 Additions" author: "Vandit Jain" date: "August 2017" output: rmarkdown::html_vignette bibliography: markovchainBiblio.bib vignette: > %\VignetteIndexEntry{Google Summer of Code 2017 Additions} %\VignetteEngine{knitr::rmarkdown} %VignetteEncoding{UTF-8} --- ```{r setup, include=FALSE} knitr::opts_chunk$set(echo = TRUE, collapse = TRUE, comment = "#>") ``` ```{r setup_2, include=FALSE} require(markovchain) ``` # Expected Hitting Time using CTMC The package provides `ExpectedTime` function to calculate average hitting time from one state to another. Let the final state be j, then for every state $i \in I$, where $I$ is the set of all possible states and holding time $q_{i} > 0$ for every $i \neq j$. Assuming the conditions to be true, expected hitting time is equal to minimal non-negative solution vector $p$ to the system of linear equations [@NorrisBook]: \begin{equation} \begin{array}{lcr} p_{k} = 0 & k = j \\ -\sum_{l \in I} q_{kl}p_{k} = 1 & k \neq j \end{array} \label{eq:EHT} \end{equation} For example, consider the continuous time markovchain which is as follows: ``` {r,message = FALSE} library(markovchain) states <- c("a","b","c","d") byRow <- TRUE gen <- matrix(data = c(-1, 1/2, 1/2, 0, 1/4, -1/2, 0, 1/4, 1/6, 0, -1/3, 1/6, 0, 0, 0, 0), nrow = 4,byrow = byRow, dimnames = list(states,states)) ctmc <- new("ctmc",states = states, byrow = byRow, generator = gen, name = "testctmc") ``` The generator matrix of the ctmc is: \[ M = \left(\begin{array}{cccc} -1 & 1/2 & 1/2 & 0\\ 1/4 & -1/2 & 1/4 & 1/6\\ 1/6 & 0 & -1/3 & 1/6\\ 0 & 0 & 0 & 0 \end{array}\right) \] Now if we have to calculate expected hitting time the process will take to hit state $d$ if we start from $a$, we apply the $ExpectedTime$ function. $ExpectedTime$ function takes four inputs namely a $ctmc$ class object, initial state $i$, the final state $j$ that we have to calculate expected hitting time and a logical parameter whether to use RCpp implementation. By default, the function uses RCpp as it is faster and takes lesser time. ``` {r} ExpectedTime(ctmc,1,4) ``` We find that the expected hitting time for process to be hit state $d$ is 7 units in this case. # Calculating Probability at time T using ctmc The package provides a function `probabilityatT` to calculate probability of every state according to given `ctmc` object. The Kolmogorov's backward equation gives us a relation between transition matrix at any time t with the generator matrix[@dobrow2016introduction]: \begin{equation} P'(t) = QP(t) \end{equation} Here we use the solution of this differential equation $P(t) = P(0)e^{tQ}$ for $t \geq 0$ and $P(0) = I$. In this equation, $P(t)$ is the transition function at time t. The value $P(t)[i][j]$ at time $P(t)$ describes the conditional probability of the state at time $t$ to be equal to j if it was equal to i at time $t=0$. It takes care of the case when `ctmc` object has a generator represented by columns. If initial state is not provided, the function returns the whole transition matrix $P(t)$. Also to mention is that the function is also implemented using RCpp and can be used used to lessen the time of computation. It is used by default. Next, We consider both examples where initial state is given and case where initial state is not given. In the first case, the function takes two inputs, first of them is an object of the S4 class 'ctmc' and second is the final time $t$. ``` {r} probabilityatT(ctmc,1) ``` Here we get an output in the form of a transition matrix. If we take the second case i.e. considering some initial input: ``` {r} probabilityatT(ctmc,1,1) ``` In this case we get the probabilities corresponding to every state. this also includes probability that the process hits the same state $a$ after time $t=1$. # Plotting generator matrix of continuous-time markovchains The package provides a `plot` function for plotting a generator matrix $Q$ in the form of a directed graph where every possible state is assigned a node. Edges connecting these nodes are weighted. Weight of the edge going from a state $i$ to state $j$ is equal to the value $Q_{ij}$. This gives a picture of the generator matrix. For example, we build a ctmc-class object to plot it. ``` {r} energyStates <- c("sigma", "sigma_star") byRow <- TRUE gen <- matrix(data = c(-3, 3, 1, -1), nrow = 2, byrow = byRow, dimnames = list(energyStates, energyStates)) molecularCTMC <- new("ctmc", states = energyStates, byrow = byRow, generator = gen, name = "Molecular Transition Model") ``` Now if we plot this function we get the following graph: ``` {r} plot(molecularCTMC) ``` The figure shown is built using the $igraph$ package. The package also provides options of plotting graph using $diagram$ and $DiagrameR$ package. Plot using these packages can be built using these commands: ``` {r} if(requireNamespace(package='ctmcd', quietly = TRUE)) { plot(molecularCTMC,package = "diagram") } else { print("diagram package unavailable") } ``` Similarly, one can easily replace $diagram$ package with $DiagrammeR$. # Imprecise Continuous-Time Markov chains Continuous-time Markov chains are mathematical models that are used to describe the state-evolution of dynamical systems under stochastic uncertainty. However, building models using continuous time markovchains take in consideration a number of assumptions which may not be realistic for the domain of application; in particular; the ability to provide exact numerical parameter assessments, and the applicability of time-homogeneity and the eponymous Markov property. Hence we take ICTMC into consideration. More technically, an ICTMC is a set of “precise” continuous-time finite-state stochastic processes, and rather than computing expected values of functions, we seek to compute lower expectations, which are tight lower bounds on the expectations that correspond to such a set of “precise” models. ## Types of ICTMCs For any non-empty bounded set of rate matrices $L$, and any non-empty set $M$ of probability mass functions on $X$, we define the following three sets of stochastic processes that are jointly consistent with $L$ and $M$: * $P^{W}_{L,M}$ is the consistent set of all well-behaved stochastic processes; * $P^{WM}_{L,M}$ is the consistent set of all well-behaved Markov chains; * $P^{WHM}_{L,M}$ is the consistent set of all well-behaved homogeneous Markov chains[@ictmcpaper]. From a practical point of view, after having specified a (precise) stochastic process, one is typically interested in the expected value of some function of interest, or the probability of some event. Similarly, in this work, our main objects of consideration will be the lower probabilities that correspond to the ICTMCs. ## Lower Transition Rate Operators for ICTMCs A map $Q_{l}$ from $L(X)$ to $L(X)$ is called a lower transition rate operator if, for all $f,g \in L(X)$, all $\lambda \in R_{\geq 0}$, all $\mu \in L(X)$, and all $x \in X$[@ictmcpaper]: 1. $[Q_{l}m](x) = 0$ 2. $[Q_{l}I](x) \geq 0 \forall y \in X$ such that $x \neq y$ 3. $[Q_{l}(f + g)](x)\geq [Q_{l}f](x) + [Q_{l}g](x)$ 4. $[Q_{l}(l f)](x) = \lambda Q_{l}f[(x)]$ ## Lower Transition Operators A map $T_{l}$ from $L (X )$ to $L (X )$ is called a lower transition operator if, for all $f,g \in L(X)$, all $\lambda \in R_{\geq 0}$, all $\mu \in L(X)$, and all $x \in X$[@ictmcpaper]: 1. $[T_{l} f](x) \geq min(f(y) : y \in L)$ 2. $[T_{l}(f +g)](x) \geq [T_{l} f](x)+[T_{l}g](x)$ 3. $[T_{l}(\lambda f)](x) = l [T_{l} f](x)$ ## ImpreciseprobabilityatT function Now I would like to come onto the practical purpose of using ICTMC classes. ICTMC classes in these package are defined to represent a generator that is defined in such a way that every row of the generator corresponding to every state in the process is governed by a separate variable. As defined earlier, an imprecise continuous time markovchain is a set of many precise CTMCs. Hence this representation of set of precise CTMCs can be used to calulate transition probability at some time in future. This can be seen as an analogy with `probabilityatT` function. It is used to calculate the transition function at some later time t using generatoe matrix. For every generator matrix, we have a corresponding transition function. Similarly, for every Lower Transition rate operator of an ICTMC, we have a corresponding lower transition operator denoted by $L_{t}^{s}$. Here $t$ is the initial time and $s$ is the final time. Now we mention a proposition[@ictmcpaper] which states that: Let $Q_{l}$ be a lower transition rate operator, choose any time $t$ and $s$ both greater than 0 such that $t \leq s$, and let $L_{t}^{s}$ be the lower transition operator corresponding to $Q_{l}$. Then for any $f \in L(X)$ and $\epsilon \in R_{>0}$, if we choose any $n \in N$ such that: \[n \geq max((s-t)*||Q||,\frac{1}{2\epsilon}(s-t)^{2}||Q||^{2}||f||_v)\] with $||f||_{v}$ := max $f$ - min $f$, we are guaranteed that[@ictmcpaper] \[ ||L_{t}^{s} - \prod_{i=1}^{n}(I + \Delta Q_{l}) || \leq \epsilon \] with $\Delta := \frac{s-t}{n}$ Simple put this equation tells us that, using $Q_{l}g$ for all $g \in L(X)$ then we can also approximate the quantity $L_{t}^{s}$ to arbitrary precision, for any given $f \in L(X)$. To explain this approximate calculation, I would take a detailed example of a process containing two states healthy and sick, hence $X = (healthy,sick)$. If we represent in form of an ICTMC, we get: \[ Q = \left(\begin{array}{cc} -a & a \\ b & -b \end{array}\right) \] for some $a,b \in R_{\geq 0}$. The parameter $a$ here is the rate at which a healthy person becomes sick. Technically, this means that if a person is healthy at time $t$, the probability that he or she will be sick at time $t +\Delta$, for small $\Delta$, is very close to $\Delta a$. More intuitively, if we take the time unit to be one week, it means that he or she will, on average, become sick after $\frac{1}{a}$ weeks. The parameter $b$ is the rate at which a sick person becomes healthy again, and has a similar interpretation. Now to completely represent the ICTMC we take an example and write the generator as: \[ Q = \left(\begin{array}{cc} -a & a \\ b & -b \end{array}\right) : a \in [\frac{1}{52},\frac{3}{52}],b \in [\frac{1}{2},2] \] Now suppose we know the initial state of the patient to be sick, hence this is represented in the form of a function by: \[ I_{s} = \left(\begin{matrix} 0 \\ 1 \end{matrix}\right) \] We observe that the $||I_{s}|| = 1$. Now to use the proposition mentioned above, we use the definition to calculate the lower transition operator $Q_{l}$ Next we calculate the norm of the lower transition rate operator and use it in the preposition. Also we take value of $\epsilon$ to be 0.001. Using the preposition we can come up to an algorithm for calculating the probability at any time $s$ given state at initial time $t$ and a ICTMC generator[@ictmcpaper]. The algorithm is as follows: **Input**: A lower transition rate operator $Q$, two time points $t,s$ such that $t \leq s$, a function $f \in L(X )$ and a maximum numerical error $\epsilon \in R_{>0}$. **Algorithm**: 1. $n = max((s-t)||Q||,\frac{1}{2\epsilon}(s-t)^{2}||Q||^{2}||f||_v)$ 2. $\Delta = \frac{s-t}{n}$ 3. $g_{0} = I_{s}$ 4. for $i \in (1,.....,n)$ do $g_{i} = g_{i-1} + \Delta Q_{l}g_{i-1}$ 5. end for 6. return $g_{n}$ **Output**: The conditional probability vector after time $t$ with error $\epsilon$. Hence, after applying the algorithm on above example we get the following result: $ g_{n} = 0.0083$ if final state is $healthy$ and $g_{n} = 0.141$ if the final state is $sick$. The probability calculated is with an error equal to $\epsilon$ i.e. $0.001$. Now we run the algorithm on the example through R code. ``` {r} states <- c("n","y") Q <- matrix(c(-1,1,1,-1),nrow = 2,byrow = TRUE,dimnames = list(states,states)) range <- matrix(c(1/52,3/52,1/2,2),nrow = 2,byrow = 2) name <- "testictmc" ictmc <- new("ictmc",states = states,Q = Q,range = range,name = name) impreciseProbabilityatT(ictmc,2,0,1,10^-3,TRUE) ``` The probabilities we get are with an error of $10^{-3}$ # Continuous time markovchain generator using frequency Matrix The package provides `freq2Generator` function. It takes in a matrix representing relative frequency values along with time taken to provide a continuous time markovchain generator matrix. Here, frequency matrix is a 2-D matrix of dimensions equal to relative number of possible states describing the number of transitions from a state $i$ to $j$ in time $t$, which is another parameter to be provided to the function. The function also allows to chose among three methods for calculation of the generator matrix [@freqArticle]. It requires the [@pkg:ctmcd] package. Three methods are as follows: 1. Quasi Optimization - "QO" 2. Diagonal Adjustment - "DA" 3. Weighted Adjustment - "WA" See reference for details about the methods. Here is an example matrix on which `freq2Generator` function is run: ``` {r} if(requireNamespace(package='ctmcd', quietly = TRUE)) { sample <- matrix(c(150,2,1,1,1,200,2,1,2,1,175,1,1,1,1,150),nrow = 4,byrow = TRUE) sample_rel = rbind((sample/rowSums(sample))[1:dim(sample)[1]-1,],c(rep(0,dim(sample)[1]-1),1)) freq2Generator(sample_rel,1) } else { print('ctmcd unavailable') } ``` # Committor of a markovchain Consider set of states A,B comprising of states from a markovchain with transition matrix P. The committor vector of a markovchain with respect to sets A and B gives the probability that the process will hit a state from set A before any state from set B. Committor vector u can be calculated by solving the following system of linear equations[@committorlink]: $$ \begin{array}{l} Lu(x) = 0, x \notin A \cup B \\ u(x) = 1, x \in A \\ u(x) = 0, x \in B \end{array} $$ where $L = P -I$. Now we apply the method to an example: ``` {r eval=FALSE} transMatr <- matrix(c(0,0,0,1,0.5,0.5,0,0,0,0,0.5,0,0,0,0,0,0.2,0.4,0,0,0,0.8,0.6,0,0.5),nrow = 5) object <- new("markovchain", states=c("a","b","c","d","e"),transitionMatrix=transMatr, name="simpleMc") committorAB(object,c(5),c(3)) ``` Here we get probability that the process will hit state "e" before state "c" given different initial states. # First Passage probability for set of states Currently computation of the first passage time for individual states has been implemented in the package. `firstPassageMultiple` function provides a method to get first passage probability for given provided set of states. Consider this example markovchain object: ``` {r} statesNames <- c("a", "b", "c") testmarkov <- new("markovchain", states = statesNames, transitionMatrix = matrix(c(0.2, 0.5, 0.3, 0.5, 0.1, 0.4, 0.1, 0.8, 0.1), nrow = 3, byrow = TRUE, dimnames = list(statesNames, statesNames) )) ``` Now we apply `firstPassageMultiple` function to calculate first passage probabilities for set of states $"b", "c"$ when initial state is $"a"$. ``` {r} firstPassageMultiple(testmarkov,"a",c("b","c"),4) ``` This shows us the probability that the process will hit any of the state from the set after n number of steps for instance, as shown, the probability of the process to hit any of the states among $"b", "c"$ after $2$ steps is $0.6000$. # Joint PDF of number of visits to the various states of a markovchain The package provides a function `noofVisitsDist` that returns the PDF of the number of visits to the various states of the discrete time markovchain during the first N steps, given initial state of the process. We will take an example to see how to use the function on a `markovchain-class` object: ``` {r} transMatr<-matrix(c(0.4,0.6,.3,.7),nrow=2,byrow=TRUE) simpleMc<-new("markovchain", states=c("a","b"), transitionMatrix=transMatr, name="simpleMc") noofVisitsDist(simpleMc,5,"a") ``` The output clearly shows the probabilities related to various states of the process. # Expected Rewards for a markovchain The package provides a function `expectedRewards` that returns a vector of expected rewards for different initial states. The user provides reward values, a vector $r$ of size equal to number of states having a value corresponding to every state. Given a transition matrix $[P]$, we get the vector of expected rewards $v$ after $n$ transitions according to the equation as follows[@GallagerBook]: $v[n] = r + [P]*v[n-1]$ Applying this equation on a markovchain-class object ``` {r} transMatr<-matrix(c(0.99,0.01,0.01,0.99),nrow=2,byrow=TRUE) simpleMc<-new("markovchain", states=c("a","b"), transitionMatrix=transMatr) expectedRewards(simpleMc,1,c(0,1)) ``` ## Expected Rewards for a set of states in a markovchain process The package provides a function `expectedRewardsBeforeHittingA` that returns the value of expected first passage rewards $E$ given rewards corresponding to every state, an initial state. This means the function returns expected reward for given initial state $s_{0}$, number of transitions $n$ and for a set of states $A$ with a constraint such that the process does not hit any of the states that belong to state $A$. $S$ is the set of all possible states. The function uses an equation which is as follows: $$E = \sum_{i=1}^{n}{1_{s_{0}}P_{S-A}^{i}R_{S-A}}$$ here $1_{s_{0}} = [0,0,...0,1,0,...,0,0,0]$, 1 being on $s_{0}$ position and $R_{S-A}$ being the rewards vector for $S-A$ state. # Checking Irreducibly of a CTMC The package provides a function `is.CTMCirreducible` that returns a Boolean value stating whether the ctmc object is irreducible. We know that a continuous time markovchain is irreducible if and only if its embedded chain is irreducible[@Sigman]. We demonstrate an example running the function: ``` {r} energyStates <- c("sigma", "sigma_star") byRow <- TRUE gen <- matrix(data = c(-3, 3, 1, -1), nrow = 2, byrow = byRow, dimnames = list(energyStates, energyStates)) molecularCTMC <- new("ctmc", states = energyStates, byrow = byRow, generator = gen, name = "Molecular Transition Model") is.CTMCirreducible(molecularCTMC) ``` # Simulation of Higher Order Multivariate Markovchains The package provides `predictHommc` function. This function provides a simulation system for higher order multivariate markovchains. The function assumes that the state probability distribution of the jth sequence at time $r+1$ depends on the state probability distribution of all the sequences at n previous mon=ments of time i.e. $t = r$ to $t = r-n+1$ . Hence the proposed model takes the form mathematically as:[@ching2008higher] $$ X_{r+1}^{j} = \sum_{k=1}^{s}\sum_{h=1}^n{\lambda_{jk}^{(h)}P_{h}^{(jk)}X_{r-h+1}^{(k)}}, \ \ \ j = 1,2,....s, \ \ r = n-1,n,... $$ with initals $X_{0}^{(k)},X_{1}^{(k)},......,X_{n-1}^{(k)} \ (k = 1,2,...s)$. Here, $\lambda_{jk}^{(k)}, \ 1 \leq j,k \leq s, \ 1 \leq h \leq n \ \ \ and \ \ \ \sum_{k=1}^{s}\sum_{h=1}^{n}{\lambda_{jk}^{(h)} = 1}, \ \ \ j = 1,2,....s.$ Now we run an example on sample hommc object for simulating next 3 steps using `predictHommc` function. The function provides a choice of entering initial states according to the hommc object. In case the user does not enter initial states, the function takes all initial states to be the first state from the set of states. ``` {r} if (requireNamespace("Rsolnp", quietly = TRUE)) { statesName <- c("a", "b") P <- array(0, dim = c(2, 2, 4), dimnames = list(statesName, statesName)) P[,,1] <- matrix(c(0, 1, 1/3, 2/3), byrow = FALSE, nrow = 2) P[,,2] <- matrix(c(1/4, 3/4, 0, 1), byrow = FALSE, nrow = 2) P[,,3] <- matrix(c(1, 0, 1/3, 2/3), byrow = FALSE, nrow = 2) P[,,4] <- matrix(c(3/4, 1/4, 0, 1), byrow = FALSE, nrow = 2) Lambda <- c(0.8, 0.2, 0.3, 0.7) ob <- new("hommc", order = 1, states = statesName, P = P, Lambda = Lambda, byrow = FALSE, name = "FOMMC") predictHommc(ob,3) } else { print("Rsolnp unavailable") } ``` # Check Time Reversibility of Continuous-time markovchains A Continuous-time markovchain with generator $Q$ and stationary distribution $\pi$ is said to be time reversible if:[@dobrow2016introduction] $$ \pi_{i}q_{ij} = \pi_{j}q_{ji} $$ Intuitively, a continuous-time Markov chain is time reversible if the process in forward time is indistinguishable from the process in reversed time. A consequence is that for all states i and j, the long-term forward transition rate from i to j is equal to the long-term backward rate from j to i. The package provides `is.TimeReversible` function to check if a `ctmc` object is time-reversible. We follow with an example run on a `ctmc` object. ``` {r} energyStates <- c("sigma", "sigma_star") byRow <- TRUE gen <- matrix(data = c(-3, 3, 1, -1), nrow = 2, byrow = byRow, dimnames = list(energyStates, energyStates)) molecularCTMC <- new("ctmc", states = energyStates, byrow = byRow, generator = gen, name = "Molecular Transition Model") is.TimeReversible(molecularCTMC) ``` # References markovchain/inst/doc/an_introduction_to_markovchain_package.pdf0000644000176200001440000135512414715232626024752 0ustar liggesusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 5575 /Filter /FlateDecode /N 89 /First 764 >> stream x\sF rNm g">N\ II!@~_ LTEQx zzz{(D,щ0:KL"M&qt%2x'JIbs 26yD E]s[8!q=K<y2.x ƠGƁO!-V@L`IXE;l 4р0(ʎFj@IH5,lAet3UbA91 [&,a0Uv@9W ʹ:E+L,v0[Ol0 `S-8U3LA9HLC$qNNg@Y; (K[2R @Y R PV@ 栬LvZEh̓={G?` ܣM~¥i;Fe`'u+׏$mzjbEKN9ڼ+{mr/vPvJN¬LmRoQpTR|lr|R|0uK[W"d0zȻW>V2mOҹ,8}&lñG[ߢ "n؋зacHWw~]KuC;e}*t.ǑhAFm؎^F:6c; |Lc&n}?Q:bnۛ<1mcm'Ө8qzlF"NOj@֏FuKqh"MġȲ,Ȳ,Ȳ,Ȣ,8"XĩQ"N"Nt\ףIm~Uܯ?mjmrdgZQ?'8geSO'=cEK~04(t6Mދm#HEOɨQ~G5Z8n$M#Ѵx4Mg䡾\~_2xݙX8_4}ٓӿb$zЇ6zu]&2'M{|UL(l=?(ÒttR&F_;EE^io(A[/#nYc NAbY I)BޏLJ5e*,LW?!5oc0qCǪ;}os4Z ZO3jzXn)<?)˫' =`#=aO){ vzW볒yB]\T}(]+~UXޱlljVJ6fUgְFM%kk6e5~"!$F<qyK*dO)\T JTtN}W ˭[ջ7pN>{Ń ̋~j.(j鼢2-Pwؠ-}=m>oǹʟ=]2FLRZu9E+'tfN]=?Ɨw!~:K9f k0ef%m?ڹ"XO9lɷoU-}j*%TeJ މ,UXUR K-TSo i } ̩uӌmDJe6urHNDKm)iSir,oBTQahKW=6ө9~qs)1{w[I)Ӝx3ҧ7D융ɶreq(5K)'srAxd-"6yJ+hLJa 4O߶0\,Lis|񴔞K}l*}ȜyW ?3A >!gy"dZЋ݁>58W=d-c7>3"aΞx Swv7&VjiU3z^L|rŚSz <$ nߍ˝{1&5BD+SSJWtXӶX4iٟ{Wrgg5doe "P4oy.~;tJtT8T;z>ʧ$߉̞&k@jU?0{}Gp&lJw]}=34u(hZsw`!#y״EmZO.=ܙћk((%oE{^Ovc8 ?SܸbL)a\]kDU2z *EK {vgKώƓޤ4.zް>&KRJ`ܤ"*}&F"͑ɰ8!C,=pZ"1>tkqz=9Ots@c}u@zKgFчTX2Le4܁Gq*=9=ٔ^)| %k2:쁱vcگ+4²F?#sR#X.P bos  szMVM0!&H&'SΩRm`foɰJJ{Οci-GE=-(3|>ټаzz C?xkFߖC; fn,tДiKYqF5F9/Q9.y5_\~y%Jr{HT7Q\̜J({}h^z]_ŇMS6{NNǩp|n$ܠ5GG xU~^? 1b -A';4ԼttY$*0pGEdVA$ >+^9A3e0s!ˎAzg0)yun@{!׽ MN֣%0CIsYG9 RzbsICw ς@PAW界dƱv 0,)j1h?Lr7;ʲj/?WpGY N1yD#SKz&hiru>{yjaRBB ykyJXD mp} ?jTbptN/\Ca&~ zp1)) ,!U''Gpwը9*F-:b@rpzesT_]T-⍸+}I k˰"P;܂K +L3zcVL-@?8%p!/o ]Ӗ7Ur_goxAuAEEGKh8Y}> stream GPL Ghostscript 10.04.0 discrete time Markov chains, continuous time Markov chains, transition matrices, communicating classes, periodicity, first passage time, stationary distributions 2024-11-14T00:26:13+01:00 2024-11-14T00:26:13+01:00 LaTeX with hyperref The markovchain Package: A Package for Easily Handling Discrete Markov Chains in RG.A. Spedicato, T.S. Kang, S.B. Yalamanchi, D. Yadav, I. Cordón endstream endobj 92 0 obj << /Type /ObjStm /Length 3592 /Filter /FlateDecode /N 89 /First 823 >> stream x\n}W;_C$G18vba;vʰU=ݳ}YR&ː/( `ipEFg :y@lYhD0tk|6x;ơ-L|%x;G.^loGD"߮`Y {~ py$\LxO/;+ᩅ8'rGe82w{ȗ%c1 ؆c5qIB1jOx&8P}7o;nX5nà#Vo~x͍Njc>^f] <yO*TlHC7wliyFtC|(Q)XߥzF#uG[)z2R#`QnO&'+Ej\#@؊ΩD@fs?=7f8pMp:[`RR&\=0fx60Ώ^l44S25M9=7qw 6QH U4N&|a|t!"ºB57'ǠCU _-ѫ@Tl$TcYAr77TvEsU>*֏?{Ku<[qu2wq+WUXzL3\%ğ ]xv65nE*U7dm3m/uF:Ij1ɒ,,ŴHI{TxUi`jh'eA"6kQ4e AFx7늩 "CVg =oř]MfN>Gc VqHyy? M66"rjm\wGT% 3Tefi*PxzL~̦NtkOf:\{?we%2I4K8W DOϟn=wHq[VBi[S>]a)]q̦BrU/^O]#ZB5r/bOt˻J4_Q K6Š1JwT¾SYE;5w+gHʚAE< 8RTe\WF9M[~mUsFʷJ־Vv`I/.4DYuQRw<9*rd@*[E6m6ʦV>әUdu%/{hpzcfLZSoqU/Y{>#rɍjt]7֢[En2)(Gfeo!NNuWz zƘSaJ-b 煆2UAw>g zц]knGIVR"ZʚnϚX5GNப-4ַasP6t`w- ,CVE/ I^1 }^U/1ڐJW,Eo0B53_e7+;` p-&!;N풜kCSM"4nN+qdX;_k>")Q8iS%9_PLɺ촢 Mz@=[{x~ӿ~jwg nlwW=# q0&`f +Χ7ÛcX?9Kq}f"䧇5^z^MÑ|v@x8WWmxgÍUP_ƿ^ĨC߭ s}s\]oOwWx^>kT327&"byNZ%- M&kAPհ5u6G0APpʠ%sʷݯ n#8т C5Ns/b NARP3pQEeNhHK?QCF|' u>[R+2BfĢ A_8ײA?#5@?.4mC AN `& JpP=bTIA$DǏqTg5P<PEAAcs-KÁ{AË28(8墥PK24(hma4 uNXi3p cO '4_%p>sU%8~fK 8N<.8IwRwyʏM҅..nl)OM]~+;g~Kv8ڴ~VSz'Z$׭+ۍס[ I_Խh ]8"i8 pYB[rngx{ml_] pWL\xwqaj_A޿xlCa@6T[}<]Af 4a[}}~f^`15h8= կWot=y>+ 5 p<0`nn~7W^[B"@2n ~[2y)endstream endobj 182 0 obj << /Type /ObjStm /Length 4611 /Filter /FlateDecode /N 89 /First 844 >> stream x\Ys6~֔ b{Xc9^2EIty~6l8 48Lxͤrx-sގH=}-TLJ 1 VGL )˔7D^ Tk2AA01L%]1`M5s&A'SX,93g XS&!ɼR%y0Q)3AM)R , NcR)1P O"EBĒbWEFʄK,P , sExGIvBZ A*!V!Q_̡TC)짤T=JC9`YjLbUB@b<9"4zbv= 03`"isB4J%6K9Q"LaDBV`%6t5H9a(9/lu`$RKaG,-p%C%ТD)Q%rsxLH#BX?'z-e"oYUTo[];oY+Ou>,EEdqy+ ! y-+z͖|YN#_`4&}9:\LN5o`}~_s2GXY-JVfp(`}eaYaXU;SՎjqZvLU;T5xOWj<]6\pd=]<]g= +ɢR {(,‘]RVe J׆W?Z!]WuG1Ÿg95??'gg뫌 \|2~:9ĸW)fOՊ/5Η_w+*.1jh/8Q"4\"U=)ql)hk@HY~'<_Ns'jv!?]dpti2[߽y -fNxQxNV4;XQ(Ie/>o]`Ḡ6.…!\"I.-ɦ|15i~.KK̯7Dce |!+أ5Ο>+ۧmޗ͋Wo~ a {x%nrD|.fN|00yf|΅z=Z]$Iwup ->%;yX1DV+ʷFװ EJ 1(Cƀ1і'ȯ;RMGnkMtR 싾X&JoaD0JAV[*w_~ö'|ϪN u0Cb_~i_ G)>Ӯ!~/gR۠o3!?˖lM(c ?00/żXb50/uTsczY(<&6}>rKw&FBxj3l׮n}ږiۋmsRtRpi -p}>W#+Jm0C.,4x9 <[n/:fd1]y^K4.EG/BSLfdwYWyie9ˋAƒ}}yLx&xnΒi,ۑismsշE]ݫl4 ަkvηTG\u_uJ~[(Te*Fِ[Tt]\OOixrqXR3:.b3~3k.WٴO=O[]4/W齹O+{LEbWLm"\|C>SMq㣮W?c3 4])YTBe4<26xR\nT:u[me}azJQjV٦VkU|\.X]O/M[=F4NlUwMRA7L5U5&>yCa5&5 fedr:8y"F'N'f:D:_DJ>n ~pb[ a0* tv:! XҸ$8` ta __Dv>!D 4X8ZD(;آNA" K[:7i"Mk"OTDX 4q`Zc/ɳ4h :HRxk:"S{U T:+8ѴPBT5CRR4?bH]31u-ԏFi9N\-lmT(cM0L4q t`]b֩Ī.80a̿8 ig)cf8b> F]I5<MHP=pbFw55 )8mq0wHh1gI(~ 6pZB 1jS%P&DB(ma"-Wt#7$H[59(};ao\P ?I}],|OK(m,+J{!(]?[h,i6_yc + -_m5{ {[<ﵫ׭[:o]r 1r#M/#\q̮)4?jRe8,:3qrSnCS ]Av2fn՗|T։#b HC#A|Ik2M(F;fϦe2y波cS@{ Z 9DjXmrv[6#x͖$n}W;eB]$vEԘ?Ud<7 %JTGY)R Nu#Un0Yc>Yn |t,g7[7^Hb4ǂrmbCL\O(oQ6_ JĄЋzF*awްQfPRltpf.Z߬1 uOt4A}i#7 (b"I)@%d)շN;0tbcxZBXznƥo MFz ߨLpmĺ. \y[8!G: q5a+j!!ƌ8 $Oo6nٰ_׽Uw:,N&R;[:vTUEd%,= )Ҟ㝨nw\b6GT? y?NNDbx*,VЄ)d)s+-Fb~щwtMPHh7Ce6̮TJ##44J7G>'"t}ۼ3[A*Nt}E(=ˡ# V!p!h1'<=9rE;y鏧?|jR@壒f6bu[L01;JMMIN/x*XM2Cޕ1UD# AC,euK9ͽ}I#wUZgbV.bA6]˫> stream x[mo_[Yp8I.͵I/|ٌƖ K}Y%Q2%I!%evٙٵ V(a NXc)gGU,Dl:|uy9=~A{KN0HKB:ZE9< 5";^s T>!/s(q[PW%kDbMP "{ T1IH"ҙȚîsDG'/GSzY/ug|P:I@ _SE6~Qjl\k5FQAmFlDFIQ`>Fy:y1wzz4|t=Oʫ7^'WWr>#Lvfrvq7O[Սxofcv2%_Y1"r)1*|rG$LJfF/'T"s)>xzQ0'xq= [ *XCncWoYfW'jxhl5;ƻ:؝ܰ2$!h0 c?9CkPqzix5@NCC"7M9{r6MZ(d6^2emEͦ$ey{9_$'dnC6!ȒK2?O—"~k&H_b&!f)jDۣ iV@PON/۹ W;èтh)#jh[,C`8zviP M֛C^&M1ɸO/*Q]=;N2+kl%*xnMCm\g7z?OPiVw6XM6x|e7Qd @Mn]c!!M} Txpڇ)HVǭF"0ᩍ4pR}Я{isr63N-څΩ@ s]֬,gvu8duR\E1mut2qisJB\G^M{#-my5%_5!|8eEDR- =hu<Թ{֯ zԀi1(mzؚ 8{|[* +硗g׺E6\[ L̓=.vsF>ڼZI#qtbfEKk*$q,8앏#ADX`m=Ԣ~ Y  w8dDŽj@\z i;8K<;9@ӞmJ /-: >Awuvï1y6 QJ^OID~j7mD^Džm02P|'BF dāsANrm }Y؀-ˎ$Ǐ%Vq(nƓ"p8q<`|ʂu?*4endstream endobj 362 0 obj << /Type /ObjStm /Length 2542 /Filter /FlateDecode /N 89 /First 815 >> stream x[[~c"@w]z IF~g3]]*FHjxxxr`e,^gA@(Q&2+""&IFK)JFxE9TX'Fem>IY 蜌G"e3c-gF%,cZ s sugO%KE&2*+) vr[lsKdVGv#r #8a g=Z壏tƪ`@ڌSA`:U B.I*:Q5xɪ&Ėbd*9*sPɐt*QReQ*yF(K` bU6N>'czTTʁU `dUF'Jbz2c&0ِٟ`421$P`?v#"`@XOrk֠(DYf5,qddְ㜋R R`;i |THM;{VglPleMJܔ.ߪѷ鲚btͷE~2>}||M46/s P}Y-fWB }Y~r9^Vhα@-u|vZbыjĤ|*BW=[ Dp YejSR)m)yayHŠ+rp~l؀ 7›[υ\ϛ3cL,te6/ ?gs|a[qҰr7v6O jϫLdʲє3AM?H{%c(e]0mzuܣ5'jNm]zRjȶ 源iY 0kdԶĆeZV] r7Q|eam'20~w:A[={b^̌f3/z9n +Z:w4\]ohqCʼn– GLdqY'86`< ]!=! D䃈6!ZҔsJOrLE"mǤECGiDn&nZ5[φk"e5c/p )au |)O Ph-5Ӂ|%rNI"ޤ|@y?["5TVt* c.+Tftɟb"x}} D+X@2/MɥtPa4*̓K3^FZfM|}̵&ҨYpqxldRt`)n .D'_8xԒ䘵_<"{̓@[o5jwƂ9S71I\K$)| 8f_1’$1%IRFI)%bJ *rd)j>Fi_FI=&@!5 l$!p/ڄuܽ1ZFx[ +yxkJrfᩉ)~,@I:V!} p6!f88168˭[Z&™0-8A;lAm\w-y ak!`ڟvC#6P w:vm(jhaW%\?1(҆F\Z/c H7TT8o`Μ<`W'~/V:e;Z{܆=Fѥ[`Ƌ&ٛWggx?ߌ5W2>.&'RCh0|i9/uNXJM(fN0_.[oΡAhnjŕ{L3}56Gi5Z{6O5zW f| 6>g-gIdoo瓛ţ\9??V;Hr|3z60ft1Y,@zOƲZ%t)-p )_yfyOÚ$)t $65L<z6AV7>6k|@ݵM[?BGh+4owlEr,ô&;M!E86QնRƭqXIx qK.nܷ!E0B'{? ߉Ԗ5cD$XgPañ!2MIcZ-qޏ 5)#b-o=:p:rNŬ<"l LO^#sKC}0#c(/ #sO7P,R朖G9߁РИO\nhffI*+GF`3(ؒ|^t"f9Ͽ% ao.'k+p+/ǘp ղ^̝[RJ}6v~Ì OeOtwldw4/?bS Ȼ5^3rOyr=T$1o,r7wbG߫y5o6$ [endstream endobj 452 0 obj << /Type /ObjStm /Length 2287 /Filter /FlateDecode /N 89 /First 811 >> stream x[[[~cg 8)-"I[AY+kkXiz%y%Q°Ip$U\pQ( WŢ(KPsAY]b (b`"G"vaIe؜I::'lxvű}SŗW/$,"fщT 1''I SqRuFVA 641UsT$`FN"pXJNcˆӄbN;Vuڱ&T@ HOť@Жbd!8HɆv(sjP TFr:cJ+D@G X ~W P`*J.+%WBUV 6 j gr5g®!!}VN(+jl4bm bDrFM+sA-K  l>Q c?ď:. !bh#&%԰b#B( *F(P?1(_d:te'ptnt2M4Ǿ .Fo×ӏGzU"yFaޗz4sw_͇Q']S\¢nz}5cWsL7adߌo`ӱ@4 ҔI%>`-Ŗ`˧aVX@֚P{ 4 5YOiԆ]ܗҗ/u fO"" K_.xb|Qo!"5s/S_61&F܃<[khiDS^bWA:x1Vytt[@rkrvm2?7w;σ+7x5ZXvx3nk4_ߎ"µ}^.pMog鯗m>_܎ll6<~;j>z]eSqa1nA8zrj 9bR-$T{dV慸?MآO)@}[h^Z//}3Qӻ~Ah@Fm/74g]IE0d6B4{G`ٜYϡyKl g=8y .ɒޭ(gO]*Ϟ-P=|B3(! Z >AY۴6-ۙ-zx$S]ԗX~}@`%z8DTE-=Rc^젉P]͐h>쓝hAl:qDm$8'OUKВ>0K]8f&E>BHks-gjק;$O/zI( n*ÎE`D=6k}wMCj4srJX Oء&9l7>C9"4.D}F%%vvKI);%P}yaBNM3AVAE\E^.E;Ӝ|]% S$^5,ؠ(X~^pƲ |Zp3F}\sޕp̾&Of9_Rw-d7ثjb去,GaQXQ03}==n\7 e0a|{* = |/>A5JMWZ3)*0vvb,fy:Uf_ ؓ ZU{vXU^- Wl] vt0ֻ{a0NCΜ> stream x[msοjJ;7xΑl'Nr$VTݐ$'f9pu7실Hrifh4~Y]Yo6~n6?\]YOM5ۋ8G΂|%+ejs񋸺_U][i溮qJZV!4^l7S-Fܷݖ扟cPZY%uUഅV&%YL \kw05 NWߵj+H SW֩0[ %vwij/:ظٯAJJ\@J I,6J1H yBREZV(N_ƘH)Cn*¨ q#?tĎ^saeojIr,>30e"X#n~G؏WsFJSoWO$Fs{VuNmbC+^1=[2M%O<:yA}AD.i`p=ԡn ݟq Zj__TwW% f`?\x0Ek_)5\X3[:jBe9 `d@^?iJH*"'8!B6>(4/4{#lP lR PM6K *2>L롍Sq(zvwYJb 7@4- kVmINIYJQJ%A v*L;ւ~%yPy/Kke\ᦤGVRE{b]Kkf Rb n{"Ol g\im@݃ę&Ͷ/u!y,gEmV*uI@kL@5E#}XSnc؂V*ힲ|*fP_..nFblvr 4܉?D!1{8BPJ B?E3 QnɾKϠΧcv ®%,lkk&HFObЉ*ڑtDl*eTFʈ@U.b@Wvl <0FG1bnepS9!%OabT9s*E`NvJ/*Ex1d"6ne}2~=.H ($|KIۛ2nR. (OG mT? 40jCʦin5Wzݤ!&)v&~ob-c+Hdd #G ڬoȵA#w>\$}A&28548RH_iˑEGr]@)jP"PMp$UeTΩ&mXuڴcJ S5{ 6l0v<25ޔj}DqkZbn,a!i¡%l!vh!%/.\',^j}1ـ KJ Sq@q: NJ?t7wcu\u"ք@QWF0 'Siu\QpAPIrlH62bm ;*k ]>t. d5N1!Q^ГM##`ܝ@ ܦvu Pg1B1Rxnⵎmt_O;l^Npx15WYiQtqZܔ lrc/8x>PںB-jQsOFٙB˰^f?uilˊ,C9uI9Wi'q$7E/IGpjxL$._:RQ9P6]F)ABYF,Y[JpLYSN0F#!j7qkN0i`~׉&MRQ{/}ޫt@RH,*!lJ鮉 ŰR\^-H|V:Qmە:*JcWp a[l~Sz([*9$69]fSf3s,Yʰ~L3L3!a9+G"Q_,aT,S(E2? >ۢ'd0Ԇo{`rЗe6C9p'em_4$ W{J9h7JV611x3x+ ?:6j(ѥ%ܷzbufeY2nL6UlZ\@+gD֏cZSTNBs2X۷1/\?Y(JH$,a>w4O`a f.Tl(P6' 62Z_bjU_r ֩|N^S=13ct_Wt[419y еѱNx_/}sXY.O7yAT1*rjL.C"gANvEOs2L!m->Lͳ^@t?BQ(ju51"6aDȣy-=t[3ұ8;Yt 8:W\eۿ@L ٲ RhU;6M]in`"q5MίH,A~N3$v0X}iۋ $M4;؀)0Ny&Fѷ2sER9pyZ̽˴ƫ(5ucBeeq3Tf4 ōxO)i6: 6$ђȃZAo`vX(\-Pe*MIg:ѕk܏bAOtEE 2x:eMۏb1iT-kaU;=`Q NGLq My-[|T&8.Tޥ:%?ceIT<8Qxiw:^M,~C>֧]XϽ" Nw'|L_qX a7\+* W*jᶔ;]Cu` 0tC6_%QP ,M{XyOZRocIx4=nC::V;9޲2Xf'L\O}&!fDMMSδ>y@Nipsf2qog;^̙&ipf$뢜ԨowE\]ڌ\i렧SM?amzLld<;2/Rgsꈒ.ipѤs Re1 #OAlǜQ*Y.Kiz< ,ӃFGvhtweg`)˨!)s> stream x\7r`4ߤ A+ 7igf=;+YקHvlc&bկ,eQ7>ѯ|1ѿeZ969:}IJQuBMNG ?>y%w798:mcqͪxu9sqvJֹf6_ws_G=wig?)<ҝ6R"Hzϩj۬/ӻ !ygf d۱Cfck=USʸiX9gټ ϗFsUf2Z{lVSn8Lsn+Yf̮Y_ l`F"/<{Բ`+Y36f\A$1@Py}zqRr.Vkea~P?3O5XP{Ӽk?뉚܉p&P:r>b bhqA;0@9ii638xA5a&]v^"rՕ8^RěEkMf4]mDTH”Hy/uЮN6(2_L.Z">ߠEVKeuaR絲Ʋ|n\oEkXOe[>zY ~G{L+͇xس$NH`QU\jlnf6$ H%%\%kTsvl#+kaTFt_e?bͧ&H4EH̰s[(o~8hĄhN~U1E]]2=Vz\aMXǛM{<մhy GUH"}`%67yc4n52zMGHeX`V}`JICܭT +01 (Y8kFϝeS `-꥕7E9d딪]Di26t 8zxZW͟OU\fv4ʰdHmnSCRjX fub:EwO"'T g=ڴ+)#SWgbD7[l_X"-~s+Z.) |6e7HL<l]:YaAF6XlڛCɳ:"I00>eK%#cFYۡ/ 3ܺ% ۓVxڜa rp8tSQicDs  I@lqYt/2<rbʙ)`p{fQ>TG//jھ 8r3´FZQW逧żf Mܓ!<pos~0/:rn` EL;&r|!_7v:RH}d+1zqSNʍ2Dd!w Ex]1-c`U9AB&#d\xZqqrG Vw:z>)1ϧL sn')G'F*jRjЁTSt@k@* tK,U$snokT)M*+s荚{q^7F?K7,!X:i\[a 3 Ds\^ns|Мlqw; Xp@ jZ~c1+gzl^IW }˳^>GYe%L%X^YfsS-}& J` 2eY@d+BfT`?oա5l(Fdcv Bb'C-1 /Q(\Ы$@bGb2! _)OQ-n0IN\WHb/{dP޵tt+#5Pfюpׇٽ2uFXJ s1+lJO!o!otZ-hIԒ=l4;1IZ6ߡFzoQ 0J4 xbLӮF[L+r_K$ZDB Ve- I6!4vȘ%I,w2\w# v{=gSTk-l78!833Ҽ'!7LL?V}9RE>֔ ʁ~Zޮ>21ĕ@A →!,*!n/4>{qU̲ Bs<V xJ T$iڡ n~4|}92;_ f&V'Q'ѶF#.Y/> zROBitV)؋CG%62m^-;&<C90xPB(XWG Q_YuC F+0OtSM#,dk-;,^`M \y"i> {-dU~3܉'̗BBc| tɈ!m&#}>ɤ񷛘-FG0jm//`c9i*5P(K|o/< IW{Mv&{\0??4Ӹ?HI:YG|@\v8S(g-^nwөȘ]M[sk>\xJuOJ TJwz\߉Y}_ 0A1m 3h(h{_M wv_1['5Cy+'Ҙ{+Ch)ÖE5BO^rb5Vus5M]08إa/sD=ϖ@2ZV_߄.P7*<Ӈc"LB6R ڴc2\)ӣh6OUQYUt1^Wm&8=cM%yp)6E\:LR""1━p3?#3mn *-}gE3c42Z_ޡ&E44W[:RI>(ᮆ $ȌEMCRdq]LC*o!Vk!Im!f׫<%RY"[Ba7YԈyVRśl~պ& U Cpݩ"S'4~-p3u*"ق"+xhtj$oSG,e TTWGQX(l %};G=+\jqZ4l0)Gn X\"djldKb*,!"`q*-+;SӔoo\E u07|So#'H={><-Z H-޷$n{~uX޳|GbN ax!yb [23tO2axwd:ɮ@[Nф(C(/]`}*Tt"UQx]W!q}]kQS#Lfo}Tb1[Lq2J [ũ$]t\n<@Mf{9 ғG0iHqU_I"qno^Qiϫ$HTwyO;"] w /Z,g* { ?}5]DpqTȈ͓:Yt}R%4P rcW_A l.W[]#-gUk퐴ib"Y֨-~[~2 3@ .,> X\ 6-bګGfG; '"΀?B= c@p^&.T%',бaRZcl i59V9ۑτk6fX]ołTC|!:XWw-p .Csɼ`FRQ}yj.jaU_/kK; YrP^~x ;/J6hi/uoegO9: *8rt}/9&F?O3R{LYdYA.CYBjk pvURzW,ptJT#TS;Sղ&Vrx/qG,T@ ;̓66_y~ssw#5ݻr=Q:w:IN^j ?GKEgxt$x6D *>Iny%Y8ëMng bekTHYKQvaGJH/`Y-dHư凚g2`t/HΜd:tOB E H.Q !e~l;_"[1,W%1:ڭ^š+y>;lWPGy_8qlZfMGH;숐]J,.Iq|ˣ6HG N2ddzCO@ӣͺxZQQAzyv:!, jlYA`ŗ x4m2R'LD|-L'~oX*r.ըb%~8 I*uhg~>1f5-I0Pv^iV֕\%Gnۖ1=MP@-NďI .9~)kAG_J>H_ {P8rVoX>65q5`~k:[}Q/Fҗ("#/J@}6k*0>C:U\A67uB<):Qkŋ8C(5\/-nŶs%/g8VJ _K6M2*s$"ޕ0<pp4J0 appLpOtGM Րc\(c*&eUNA8x/i ~R v@RYf<ٱɭ~zU, ':TT*LH:6g@?~tLA ٶF<g@?~tL* 9#S葪 eZ =Ho VruZendstream endobj 544 0 obj << /Filter /FlateDecode /Length 2215 >> stream xYK۸7%P*b&T%N.);UGghK,t7S>1,y!_.~Yu,Q~*wb{IJҔSf9.]mb-fĎum%aSU:OWٖ~S±/Qi|yoR9VLܧշ>Y֨edGs*SVۧo=)}82k`.x5쌫%4lJyw[>s.׬fVQjm8G6whA f Q"DIiwblq`Tù.7AuTKV%UR(Q3.ٻn_6HX^ɁQ3B7k5ko4b_W (.~۟רjp) Gܼ_l) #nWdJ y`Ebޥ`tb,{l;:W22"O3+*F!=S"}+Mafuiކ > KRe֢Y%NPxro{"[ ϫll1ă}cYY[FE_xrR^zߜYq+4QO\*ۡ\}Ne5Zό<Džfٽ+-ZTK056O2NGa,{H<N#`u)Jz6Jm*k5ۅ EޜHi^*](P=a(3)0(I1O6 Zʭ* l6B[A}ph]Vm%&(&8ISP4ƐMCMAEP9v1'_ECZ>gLp4}U@ &i`w ӡ?*ZUs_sxy *Uէs7CwͯNDQF@ eV]H?f[4d<}RkQ?EI AtXRY9_eVsM.cW!Kڦ4$yc y3^N^Ɨvq*, $PGP]vx>@ D=9O=e*ZtD:J+"s% tZ_"TN==~P0 (9 r<Ǭ\>I4x7(]!^TZbRJx@(P GV=$A<( Qa`i*}ͼ#:f~aH%'o֏ w(96k0 B{HR`L+$}= hD_ *6ʍg`K*b i=i,+H-ae/V7;7\PF &}箹]RH"0kFFZ? ˁ ,( fpgH|-Th,G^E 4=CV 8"I#cʫ=EEpk. H΋ B> stream xXXT׶>0sh8J3 K{DQQ ҋ`IҥJAF DhD1׼FM}sI޻}9mֿ_[Ƙ12l+Ca&+):fjayd,`i~l+i%; b2ז9[c";Nts4v,8{"@GmqK9EO:9l І99ܲqW,[9jܿ_ üV9[΋p}(mO楾[<Vz  O)|=eoh``d{v4Z&_gn&qc4%]VIe}`.i"Rap1APp [ 3  %Q6: gscLQ=J- .taF9p#l<%>9Kf h'3*49&k*psp@͎*"g /H}׈U&:@˻vR0*k݆S)7du͓N'FnQMWysH?*\|T1cZ:aEoRlT[f61In_1%\p:@&)b{,N)w@,USpDEl>7 'Lp/3&3apF0$ČVyWFJ3v'$@|HXQrᣋĎWq.MI9yqfN:2{Z_)q%Ќ ~lX48*v.|x̫Χ|P .&,1YpZ+ƷϺVcJԑQ~3l 7l1gY тo`\TL٪ E/tR4] o T?BΖwg=r%L#o-XŘ'>i'p>Ɲ55.Xi:OֳIH2RP^uT1@Oc9M{5{JaJ5&&وeMWp8 *8Us$0{UepT<{^AȈ͕WUorٝBjZ|RJZx_?pPp6Ř͉tݚ%%B ml4$pDY(sR!K>K*ohm ΖN;B0YA戨ؐ-|OD~h J?=%'_w_KԨai8[{(5g(ӶN:^аeIGp GO-Q E+noz4 )'LX֗h'mcr;0`z8BRnNMD#,ɀ0?CI,Rhbj*ʓvƼj(J˖i,H&m"r7䢮ֶj~h!++rRMj씘u>ƓGOPL>9fcǒA ~&v> 4nװ4')zz(h}PXE4FVP')i*g7ф7ErrQrjՆO(uC"dU픂@0^2;2Doyh`O/j?Z7SAg*[T`6ŠH 0N$~虲V_Yo?2*Q&d>9$4Ħ%IG^z 4=n甸=a)q  >ېQ_M1"4$RM(jr/FƶQD |4e+==.EH޺`<7JcN\@[͹Ot>]"8푝5MO&l*> a< ˡ)7=R<%><  u$I&R,(aRD ;ӷcۮQVq _VCdfXVzTr kN(RW]fv)k =CT%ZKl% [*E7N6;7չӐ 18a^Csʍ^,?9_vML\eUm1MRʖQG:|h-9-7q}nHޕ,l[PMrNGj<Ғ 5I76Rk[=/kĚ8>r8ēRxWD%xEcyJ%< ʵX{Fex|9ſuo!:y*M#%C>[؝t憘m0=~ ;z]B'yj1A̘4{L(('&ӿ8,)d@؁j%i4Ѐh G^g?ɾms*WU4h5>[3>yky!>15U~8W\9{uwb R249qMr3 v:?Ou%Yr+U' |.3< W j*JUˉύ'v._b5*>R6E%+}~/}шusC%c__E+u&-Ơv:6W9V}3|]_/^ kΛh>֙K*w"e酺.GLڹȨ +&+|1DI[ \MB2!aQha D\_읙Y4'gZ;ӭsec]N!pl̤9s -M7}i+%}vQ7Yj, !^Im?ȯ6_1j:DITE 5jrϩP@j.nrLV]=r _SueYYBzxii[%&dp_8;U'>do?W 1?n<ӻO_r B.FўgxCb"v5ʣБݼ$j /}Iv_ Vii$ {fn$+)GWWG{p1M7Vl OvdUwm֜h$D%$RcS|>z_nm>t:f/|_m—܍9Ox}]뎖J8>Ghm >m[qQ4HTng6N+yo'fVSk Yڰ0p NK*Cy1*֤gEaw@:)4xH& *oG%iW^E@)3|iI3h2C9҆u<ZMKlp˛3{B/g|r ڑ8R) qǮ =Vw$C! 8Hة&mT:2s¢ƶi`s`跤Bwd:7Wq[_hP_N8 uAGb<G:UTmFޖFBGbxmP:[~#jӪ# Ҷ70Df E #]{h&|[q67Uc3}EMԤv٩2 Ȩ}q,}>*P) /+rPI]!K[S?'G_B6Eh~||0{^M|z P5=x|=Fd~LUˮ D6hГ ݛH4~͊ ]TAx}ͧOo\(Tv[O'O (a6E~3G>yf58wag/PC>΢ӗĆRkۖmȈJRm*4q6xn< |޻qfi>V+=pӁBe 23233 97,-fVendstream endobj 546 0 obj << /Filter /FlateDecode /Length 427 >> stream x]N@D{ Kh(@>#8I IK/ܭ7t7/+za-_ڗX>ڶ0vKxW~>5~^P/k740*/kjgi;TRM'p%f wY%=K@'e xGg Yd DM,$D$DZDS9&rMarZ9l\VN+OY&"Nup9`\<1\c`|Wguye>d 8K8f 86t % & % & % & % & % & ?!a(g< v_ֵg}x.4f9-;endstream endobj 547 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4474 >> stream xXiTTWeYuAí(b68R eeP E"2(2 uDc /ѧ)1Q#m:/9>C:k{?: jqoqo>2?F&Y/^90rGԦ`#GiLO!;=`!LJo1r;$rNTtа&5A "c#5L,5c"5A!a6j6jVhVRl1 2;#j[b=n{?.pQBPa+WEl^g[х%=ԪQ;=#{%gUS3|" oA3h2%U6~6hР P%*Fa[Em Ҏ8ٿnv'F@otjryE!,R_7K /^oYoo"QNhqGKUxg\dJ]SnB|-28j⁷U.qBew~#*2Z (KA@X Ee8sp\jHM2Fk 9!<{p^(9~4;ar$E5={xDW`&NVe LYFh)t#x%;t\ć*&."^dĵB8U@d)k"zNޱ8(=@Gmy >=a%fˆV;ʎ+->\]=o[T|/yW^?V a{dPm|uumY@Xj#a6M_`v|45*ho;\o9 ]~%_5E+eU (6@Bs0l6 @6FnW5nl} 9mdLW[Y ;V5 V ^_UqJ':!ֻPjQ.쾋4S VXM YH1I S]L_z37?|8'ϛ1L$Nd1d"{}&RLppX㹷] &xԊ8PH68HևZW+KqrZ7v Qjm ] >N+]jaɢ#=7;Ym?U} 7;M䒓HtJ ;dQIԲT":x z~뻙8i(ʥH-Ȭ-fײ%t2KM8b"[8֘W \=I2So'},RC!MLⳡ$2V \P<#5ߓRH*opETn{A&5+AÙS^%l]Ȉl8g1cB&qO_0gbܫI琘ai}\K7\8ۃrZ'GS7g=YE `э,&vi{B(#w@v~a?bF! G`v8XDd K K8Zӫ C/*&82/5A]8i8U Z~qtm.ҳ#Zd_1ְiNQgf0e#n ;`L7(.2<*2!G t Gr L4~N\ni! p$l?UNؕeHb&PMW:u|h"_6sn /#V9x:\ʛEINq6*5Bk=+˷ě]sI5$ߏDZ<\^GGVF-Ub^ \H3UfE[\3Mh\J,N:!+b!]gd:Uc<֞Qol\S<2e4L>sV/E8TEҕeuU--Հ  Zctryr}Gu"}3aBpt~Es{H,Yu{#$'@АPuU5s>i6ro3R'R$>_ૢf#W͜TTU iϺdG,|:)+ ~yѕ`ܰ*F&(=x؎pt►B²FC! t?0zKQbUUQI@"ƫÂ1z2|ݿ ֫Qk ^MlźKW@T+9?n!ۄ,|cn٬W?#VV\"9a=I.u^=Z$Mv ~D.}*JȘ +g aO,^\Wӳv Wt,̥zF7ja_6u(OEyܡ48o7g.dm|>_MPt#]+8˨V[Rpo"0]8){22yq4p7zoWrc:yڻJ7fM{'(;E~ip 鎭 %(P{.8YՏ1x a͂/~:YA%?%&-VWWZMlsS Aϥ%zee3FϪ7pMkMySDZ2g/[5fgW |cǟ$|:{_h)Ŝ{/חǿKqdqM5?_X),`ÑE&Nd %2zwQmF)JJp׫/UO0.95Ìlz*ڡexxf]ig/sUqhM(/#aī2ڊAՖ:4ŖC^L2҄FSⵥB4~\=iN ̓lm.֠`IEUHչ*NJ\[{;W"adSI-g&+4w}~缹C0@C"gHfjuV34#mn8p/K@wiN^ur7f] 1s;5Mk_\}`Qh8zr pߚ}Eԩ ̬]Y]fĜT }0=|uC+ǟg#jâ}&=Y*0;u(;fMeODi:{İ7*.++)E }_V"#͖{}7T(xMk> stream xzXTK,LF5gލFwĊ"0aY3Cu`(`{DI,Khbb!/߷xs8s׻z2B l|}&Nk:/t>`XS!&&7^hmoJ(l_#r҄ ǎ%gZn ?rohKgǭg7r6Wg/7K_7u-lZ.[c;r_|6ݴoBE- ^㗙|R60ʖNFPvHj=5@6R1&j5L-Q[Exj15ZBMR˨rj JQjjP;(ՕQTʛC}@P=)_5MYQ}({ʌJ ʁP}PʜRm՟2P"XA7Awʉ2©ׂ. MĘ2u6'Z.D3=ۻ6[q5ݿUnp}J 3g+.tWm.07HYfU~s)oh@Gv*-i-?j򏁽1נA/48c!k =0ȡ#F?~1c{Ƃm2r[C}5DʫW4!;15"@H.mK7S3^:DLCN#sSxFUX/Vw?D,B&i2ZG35fuz\\U5 {dK#0zF,Z w+-MievRrdC& ŕ h%6J uOBB]ZVͮr(t]Rj&ܤh*uJPY@t.'-AY;GF3$kFi.>*C+$xXy<>˶u*em{6Ћ !o[dXH-֦aQoieYp!,#OL2hT֓S irh}852uE#3$v> P p`# .s*sʼMzHj)1^.j?4n + 2t4>lQlH:iw(?4y?rK7Pju7&c ?QeːЧu'UA *:(8#l"%%EÃ-gb0ƽ @^D xXL `@W,C1t>ʕJc7Yn<>,5'c'삦h5#!F"xsH(\ܛ+@^$qv ex7S6nC6l:Nh D6/`t+ע?64PĠ@ZaSʦ.NƦI\P iYT$ aYXt '~O$?jPmHM Tdk4p͢ A qE7TgG^ Elp4} wوE#𾀅aClfXGrj~)׃X>=TG{Qu!WK:QӮ*]$4 }C̍z^^<}"=쁙Ѩ/5NYCW`|dDIZfm(]V- cU` >\.Lh YIЇ?ԅB*( mi-@@$CgSEVc}5oO&EgݩWixvh ln+;W%tH˕t}RUCA7܀>EqF2$HGQoـuRx"#lăI;%@m9RbC\)½EެyhoG q:5ҟUŕҵlQ䡲"恇*۫G(D5/Ƞ_B {\tƣFtV,o"R?d1=e˒ӕGN!-nx&(zL@cTN ;-Bџ^y-#M#+:#Sg3S\K憐 JQ~4֩3 bJP&&J IeP@#E%2$))ڄl W'e stG^*XY2YL~"IJsmXrJJA^bFT";5l*NAE YIo%#N,U'2ÿI#uq<"ڔ䜟Pg\$_RW1D4~}{ToVu\E' m (;YdOC#Իmߔy*((*JުˬdnF"Jy;6##zpG Y|r#/|-7IĚ1 v8lVstc3B vN$8=*-d׼Wyi6T!)A 11q>!E7/[q-)QmὝ^TöL0eqs&GpmP%{;VZfm=«nDo?xzm[lYя<*AjtO0L" #&T!`hG_`m]ʴFM| g}eϿ.MgGf*23)]9ԫ$Za5iv;ҩF9N,AwHvji{fk/5n,h4}B\w#vs:"tPm4&3R8et6(hSeh(7s$ZRWC>4D irg";̰?Qr<=h4+|@_ȨEl]:1!zVKI( (jH],ķ +0&!) vht?~R-]n]p̟dO%ކBn2.ɈDE"3ny0'@S'/kdT ob B+ʊ|6gYh:C}էw2wSc Tp3+?]U+߯O6Ư,&W(ԹF aL[=NNШܘh:H-qr8}[`h~YaqڄDE\"1d"&pT}A-Dz{N?|(zBB2d!14a/02p.kae+a+z*ANx4<Oۈ'h9&#vH}rPYc4x!N?sKs1-¹mά˫u-^"<+j \/֡/Mwj"6V+jBjNL 1BW%E B`]~..DV6 tj2A̮輌/ĔԞ⢃|]/K5U<+b0/s0?`<şS bjC sgמR]Qת3@ƧڷT63%U4B@{?. >.M-#|6I89Nƒv"!ܤ(g‹|}C7=+OX񇭃LQ!hQPk@i-( l6Jorj4 2 Tĺxt?a HЃ g/?Is 2D\ݙ<]ڗIt\II,FKjmB [I7/d]njGD/F³P!(&zy )hqJC]+m!"l2mP$b56]23[^ߎn*/iF@えS3$guEtCSNix>XKǞ~y؄KvuH4O[[}nxAxB]OTPJ+Bؖ*rjY0ot1U^mKSÒUِ=ԕW~;T?=Rh'cwF>tx ' OK4^!܏cѬ@sHy'z䖄h' UAjT6)ESsڑZ#Փ\<,C~ڬTN{',7d*b!Ih&,ER:^x@܃2U6)nJ{-@+B{$x#?߯('#V`@_r,:h8Ll uc{r^م >ףyq]1 NLTTK,޳ԄuÁ2Xj搰u9I +.YքrQx? yzlN ,G.LNK,=}w9!z%;qd h>4B};)b&.5F% IqƦpG3IIҥ|0CБ'[|7;6O=KqO%\n㑘Zd9+0oGId Z8 FX]&vÚe jƁEV654 7kq~ز-GRXSXYYZZC(ȃxG>XLQWcQ( $~qOLjp>YTGA()~&% ӑuգfg i^s"EO+(<ok?A'^aRPb3!EF5e\XbMh"Zl`4@ VL&xM2KԚ vYF 3aǽ:uq,cÉ}|7v+R(#CWnT"GFĔ<; TD<>/q#Y?_$QNTrmҐ?rcE嵎 Akt?At0RN Ur04q5eO aEEPâjTEB읧HR?@C/۝d|,6B7E:"yLE_STnKTB,$ouVpXb? h}85j "pB@rB6~<2SA Q2yI$y1陝"`e5+ .o17'%#]hPՠlgw;܎;;A+Z ϜmD0vEINϾ:+ޞPO۝w (d}N YKႵ4 i}2 ^>^x275f\sKU8IAxAn\dq<6?A=S2ynl.)X#ɌMG*cbT, Q@g }~2Qvc#ַJf,- Kf956sq%Ml{`֭cp *>};p%!ro|16_pSk#2la.d:"JH^ 8N Nv;[G5 EhJ̈l{&궗ز -sЗ JJo$%k Ɍ6.Hd BodJRꘘPpoa-8vj4{PtnH<`Ӽ1~E>-CɓhD\0MUfJù-ZR"bUR|m*oEFuEvn !մ=Vh7/ѷ"D 5;"e $i1؛V >%8Exh-fEUQOST2qW LPn] [StJx߈cDju)Ilf^ݩi@n[9<#7Oө3WJKwvFzoSB&$nE|Ou<'HrJ75~\FjIē~%n4JAkJ;np*ݭۓ^ !%!f34~&j$6rޚ+"7܃No*#[a3πĒ=]Eje!)V+E'$f+ N _JMDI 4߉e0"Cl uN%<:x G6t[{Nj#q?fKV~ȵ18"c뎝kIg' e5.\hfFvj #?/~,[=p{ҭ{{!x+mռ 3.|#,5"7x;\of_OV,}}|%zJxys_lҺN6 g>ߌD&ϕ4u.;^?`Ze1078;vS"  O;FMf ^8Hq]}5pw;0bLZi|; 1T!yz=x8Ld.6Y hvhMw9螾%A%CQ\[&QC\haweIV cN nK.F{㚢DONoNS'S^XX^RpI"pҽ4]e8ںK*{: LmZ*œVqvvmlAt]hŀf]B6ޝ8ٺS$+MK͇EʰDX~H.msN]dGBNȮOɘQKkbl.#6#CrVEJV)m5Ӈm 6,,B_.>d5ۆK7;Q&Q(OoؼrWLzqճ1(w<>l 1Uu8#O]+B#Z79eA$v(~`g1c[8JB|Vj`<>w״h.hD@fM :F 0Ҷ, Uz~뽵NVnsb?_pu,o_v¶D0W}' ^oBͶ}'r?ޘ%{; 1pMʴz]L`}l v> stream x]n@ D|BNȗCDCICc遽̰.4ny+m0Nm)y1nbvɊ[|,)GC^RQysKNB0X߫Jh_ XFQ3PQ4<4*T  B6sYlcqT3 s_gqQ4D$LQ@̓"2z^}e #(+#GP1 (A߅iڸ0\߃qJ;̋OP endstream endobj 550 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2964 >> stream x}V{TSw>!$ Cx=BUow-R X!@0QD / I}|%BGubkةQkm}5sA5묕?䜽d#Ǭ6mJ6F6eΝZߚ9yJ IS'@{9x}`2ٺHœL}F9s慇Фj^,MN5͆LM1M4"&B”Oofjf]FrvƔYKE,Y2>67_d&hcj^rAJjL.V:s!{ìdb*f&Ǭa♵:e5&b"hf13yy,e3˙f3bx3zYlk]T~{N\]@bmrk=~ u|g?q2 ^_4o_@et&P\{<2!eQWȢ2PijraE'[Yסxf_ˮy99%k[]+1@.Ф©nDsd&1"|jP-+,IKC:,o c3eHhC (}/i?+1_Rn/Q E6O_>?*k0]7#^J{P-%]&h0_ PWw[ݹ@hu|%j=KfXI-1\[ue;B@VL%3dQ ѲG5XdJǎګ|)J@]1R W=v 9ϺLdҊ7g >1rGbOmfqBU `WQ\_+2S4l簕9ѿ\pܨk̂8H~Ι[szEIriS%ŕBye/ m)4TY emÇ/u' ?hȬ tw0 nbgF}(K#"Ic9$ny l >tss(Q:`3[9bݚZ%} ނY>#'ء޴;zM]5v7bt?>pC(o/wLߏJJg),WQ !Hc~ezSfȄdx7),ڛsMI`gys޽C:+C]kYރ/m?Rj]w R' ѩ쨱ScΣ$z>wiU*Rgkw"{=6鹞Q|q<Ea8bxRکB _{>_aD_Xn}wN ѻ;'r ދ 뭙:N}J|c#Tk:ZۘmkrWO^s8x #4 Jű qu g˛\8CW[ҠnmSmV.gagY;[+/ gEKpgW0=Lwa0r(Ic`x GnEfW`C)u%c|酢C].#j8C눪lae6P1?D]lN`km;?qoV _>&WA7upZQ8k1b`9Tl="KvAMKOC4yRX]4~1DyjAS(8LD&b=&1$}z+֠KM՟> stream x]n0D|CIh/%VU{8X9;$=0+=t9_Ҽ,W3)/،|Sմ&a}prUކO7?v;jD!pҕt&8mj;ZL`$0Tb[R[;@*`MVX99u:R;G /A^8{G*ܓ < xD\/=Bz ”F^.HͯVMxiշЮ9s%˖_?endstream endobj 552 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1420 >> stream x]S{LSW? Ӷ"&Dp,C^`+FGSB6"F񁀀d̩`p"RVRuqQ{whmI~_9G!Q4:.)k@IٮL*x>_ί`wOtzA'|1DOB4EŧÌs[4A&9WaR Ff^^Dhb&!2fiS3244͊U]\Dlfq26nvIBö$-MN͈կ?BhC:Q8 @( #}b;@U$FI=EKD54CCѭ?bR|<މkщmE[&3d%}(L?Ĭ213-0#WNth'd_mPebG캁f-h{ӏ>=ikgWEv9Y8ȳ1/#+ԧȠ"$x9A*U0ތ,T ߍNnvܣKY.!?PYmHnY۱۰v㧖.\kV}vǙ\C %%" Rlt!s";؁܀9&SfnzKPb{ǦmL˫bN<-D*,w{ZNV Q4 amߘ*x+iJYNOy%V-xly^t]. > 9YXf =Ł\&w3Qυ-%$y '"7L M;Rtyr~\q=ե]z$d"q# <[[[xDi4_ͳo,#0LOP2ߟٸKydfJ M:f+}3~'BIijAsA`TBɷbcN' 3 o:ki|[r!^ro _Wves\VNe=&[V'_sEڽ)^lPAgʻ찏>=?j7EA5C=V(kF9jx=<|Id8a Gb+—hA1 ֆ -C/G\&uxmV!Z> stream xY TSw!KjS{.:.*QB,KBQ Uqi.v:d.yC!}.GX)6oOKN]dd~Ź,,?#L&o?Ld1gΜ& 6&-=/lɒ8pCt -aŁ[ri1=40x{H=Ͽtuiker 8k] 1b7m߿5!q;?t ,9eެ?GbxFF, vOē.eb!A!bbDx&rb4XAl&$B<@L"&3e*_5c w?%MF;efLrI&M~yNY<廩-⧽Pw,_f@ /iƚ͌o#h*Munٛ:}]WuA4h(/GDJQ,en}R*Q#jH^l  NAu zpV !<{0JZB:ꀃv MHe9h Ϸl%!uyXig+؞OM h T<=}6 seK]}s;\"P(H,Q0VYfSsʷNlTH-TUiMV jRP0WC)Tct@W\Z{= #s6c&ci _]9侦ߴF s_apn7;sYƅOI~ oo̰(2G$@ՠQif!9X+i Fcdwŋ3 \DA3ܰ'ۘwOcq;Xhdf03*hd7-Aom^vAt:3!u#=ɫ1ܳ<=å+  ">ʦWvqak*bk(IkYGF2}k O7%w ԘYE6J,t?? E m<\]hݠ,_CmF}2/g{=ܻnq}ܢ Խ@ZE e,}I} ?\DV5ZWL*#NF:OIeb޽3wW+Bui s,&_GObAY|M}y-g/TXL 8B ^o)J2Rjʯhp^όy2+bꨬWa DzOSF8P%qdGn9'Dԇ?_ݞG5NJ\XWHCr JPF[8N:5jĠPM^E(ro ޹:#Wb3T#W􏏢_L[``?BLzQ vl|FX9.g A'Įd:ԗDNTG{</)=ndMQ),_ɿM5!J%1/-NHF>8  ,VKIfz,%XҮ+cGB!bɽ3 ^Y01@7}zi8)>5r3տ>o;β=nY.ġM| 3to rSr 2ӫM'LKMddѶ/iKȓIʼnЗPwi3qtFPj':zt{KKUv :]0"W2=1b {WU\r7`iLd l#Ulb23#͸o5#O*^NIOGz8> ]Ғҳhl3QNʒ&Ua蓶)aƆIOkmXn*$ ˩7P< M1.0t]loFtQ Bs6EUaYt6TfQ,* ݐZFTPb!/I1}di5V1D(δ @_ntR-x jƞӧ>, Xo8uHI? dn~NGJ_;<C8Vȷ3ĩmI2*nK&˜Y]nS*+@tцC_bCِcdf$;RAUo?!mShF"ftx~OFjV R-yR+djCV-x3Ac8,NǙI5׎Z;6ׁPW{w'[~yw rqTjB%XŐ_+X;Lg1L)"Uцp\q8ix pO4L Uh&ӧų\CL{="56d+fs:x"#2Non=f,+ W?gH'Qׇ#_M'GQnZZh*Ȱsp>xdG/^MYLD1Da:W׉΍e(&uv)|y j1 ] Ӹ4AѢj\"]i#11 2 *_E.nd}иͲ/ O ҲciT<(3371HN=hA3}cNm/pZ KAYF( ̮WwP?o%7lo{#xxv>= ?ME3G\-X/1.B73Gwer:!otyftb&.by6 T2 *JܜބHf 3/vo,NHt{QC*#/Yۙwo^%B8#my?Lx Ws?s3rZ-7w\Lzϴ_*T8+Z=+[[\z7d..C/O&|5kLVYCS)C6B M<>8C~Uf T 6%3FoLw:rDpֈEPZW%!9gҍ,B~.Fd9enzY U@^RmA?4=tkӧnsRӟu 6g'}dk_Yֶo^u@)+ǫ0Iyqu1߶'JiDnM+E Hd4[Myۻ } ͊LwaaИlUeC~7m ^U)Z޵Pj"*24͵\,y.6]e".gCyV:c`1^ O+I8Qh8/U&NoPvGCvH]6.a,; Mᶠ`] |+j١8o+-@ECI  ^GjvN- MACEEX[F#0:mSt?Q^UeP@pDWCAYX1 OGE@X+ތGRVZ#>X@G.|G/?d0ZsHk@N jd-it; dh2Ó!=rgTt,ھ^$J޳0`}ɪN}9 Pء8g9yVe\]`uf E8s vdIO>d;ڿr[.on{raAc&My5R_yF|7÷[LW/0 l6Z}e1(Ք"3?H+0SpPQBoǻTEG ^ƶAPU>:zGM# "z=ou#  9? TAjQҐ$" =&q6fފι> stream xZsJrwise+*U[{m[``O9C{f߮Ub~w_wϯ<˃|t}_Gr+ ?e6|tyuW"ӹȬԣ/E6H)2kYes K neK66ֲzЏUjvţ$*sVMᚺ,lUjqZO٫a3ZW45%V;;:-?/E|ರx엳fD)>HpjN, ^^3V^W{saZ}JMᧂ=hAj%nW3/Z9;k?'< R!REIeԖՍc8U}Xa/GXGNu:zvYQѱ6AxcDd^RCWu-<$FXo\C8쒳p>uA#Ձ.6}կUleIHp{^Oxjy( ɦ$-vQZ">|SN|Ij%?/;ʪK(-O'W񉷃' tB}NvU`CqsX{AwiT76ݐ0ݘp|fn,K.Yځcpɘu0z B1g]8 sO!fa7)tUTyӮR#;bxFZjnk#`?MLhdJ{OE0Jo#N`@!ȊcҜ;l[>*7s!EFx2E@@Sa>ap^d~[F.p!>20CSD.$$Ɍ,cYP,)uUG"<ćyzhSK`}Y\7ӥ]\"6}o "вT1KޮQvR7-Ѻ|vMRj o*~E|ԓŻ:L&;2a>-1P@ 0h`9 OA༓bn2xq91!DSCݮ,p=Y@~>wDВo4K[.ݦn1P~m璴XAaUr!Q߂@cPt`n tc9 TW\z+H.q hAYyy= UoB'`#~IJB,ZR]ʑ*͵X$n qs#:*. :̓?<8FLjD;Y<2@phٮvnQ4 UaCms&"]/-/p7 9h^Ҙ(":Ms,|R~o'f- &Hq_b햰wpīy-[VE*~C9#*E:rЧZ\]~wbtl"Eqx(P4'\7ȍg 1tHEw ;t@HUr EkYn*ށn;.Kᙫo%9x`WgLW]ȍH%.fRuڡDnGv/Q \.Fna5e!»s wBgB$DCjp+|[ЁN,n ZOziCP82ʧ + zl%b(y)[.m:yVMQ]G @(u̿B4f.+wz @ *81[灀M9@k Mj dZKހchzwp[ѻUL\w7Ils|CTEnT۝-gy۬(nHχ"~_;"M1+\?BbK(Sj4IŸ *Jz nɴ`Hg` {`vDTҝx4ռh /3HD r7y Y*`-Ms`;0GX=;nKUϢQ$7(d)dD+3j5; "-Rj˶<™Laʶ2F}=dбv HlqbX8JH -|<ŚEbWgL%-2Nh쥫Мg$ːڌS|r_X`Z$_J`B(+hZLf"XA.Zw;PFƵK=fy']z X/(k&;P#"^ Nwv{u0@OT8JRjݝo \TB_ӡ{FM2nM_ܠGmW9]0>Uɾ=LN8)>0&NtaiaȫЀ9] ۅ? CU#)8߁j ABn̞_k 0o I N: jO1 ia9SyGwM?LT֤SLvoY$X`KGJTgoXL ;endstream endobj 555 0 obj << /Filter /FlateDecode /Length 4292 >> stream xZMsHr=/ޭUOTMĆ43IYKr,;fP7HBn?̬*#9x ШϬ/3oyƏs gˣoG~=fG'BzyČ\֊'Y=G?eOcMD#o;v7ɳ\˂玕jx4cdӬ} j2O&WBYdܰGQ+m57)%'dhͰ S}ԉ0 .]p*(eh3FdPS3k%mPU74j56/aЧ܊.e膽~a\o'srE+ ӣTFlMb3͸]rÄp'd>e s 8Uxv8iY[t jQKgf;jL vOS~`%kH^EAˋgثQQ ~b$ڲ(2QȈˉoNzl'0'JXU**N%\&L>kV Rû" )61& i`_}>,<3 7xxxȖU_MVͷ'Zm?./.Ntvy8lM++[7UnUwҴ?/yDn9z} `d,ӗT H`9r.4->iB"< (<~ңƛDuV8"r<@V 4aa`*TZv6D0@tl{r)pY"-:IDwnAD͂H\fIa',P"G:<O#;fF>V*窹b^H< ۋ+t'qY;<ԛoHKBHcG48ϧoOXn K>7;L_aDq*WNl#31y؄uEͼJHКLI I$1ߒڀjSɅי W ?WW j 5()NFǠrAO^&~v?8;u˫Sa:5ҔOoFN1lуKIL=7 3]t/"++ۺDcEtm۞@1Jnѩ'AjWw1,v⭁DrhTzUy݄͕mNQ4*XV.ckԆ&C^GG=C ךNY@:qۀ&bP28:J,5|?%2&2D*R)ɅT$= : Z9'{Tƈt$ַm WRpG.#I=a>P/)}K-̅Ic &牨H0z8_(I @Gp`!pvY\cRai'Δ[9߱umTV8WeVjy`K#%[AYʞ_}L6U \BDO@4AK=JH3*GbL=M*pvRdу $Z=Z$ie]zz0)EgPh/0]! rw,)vQC>a,񱫯0Ө62|d@lEɳ<1jz+QgBF@!>DD`9Zy [򳻒hۛSRifS̲/UMQyܭLAv f'I)vȑ' ʤ/mErHۃx|^?5V0;lwTV'I;Xմh=yӤ; v3^,YBQfJ>Wfyz9>?}(˼.t[7K v;XFAAs<;t)ǯq.rb p/Dst j Jd~^:bx@c.Acb ИF`w >*u1og!l0I݁%p{d$]fSx̄6l9CʠuڐۭE\Yu* ;,7KGC=$H>oXX"dU Y2q[?t*ڲlZEU(1go)]fhna˿tw]K: ף* ^endstream endobj 556 0 obj << /Filter /FlateDecode /Length 3421 >> stream xZMsd|eP%,v>wFU9В%K%%2I;+ZKaE  )!==3dbv6* >*_:+G~;(7[:^𲂟 W:>>}QI=Z_}֊gY=gU e+ǺX#o;EeKv}xKGYj4RMO)P=OEY6OzҖ[cٶIzxR;{76 TQg3l&uf̊ dL$Hr>H]XcA, :xx~JfBkXNCܯl1dEEp&(LeVcEeOb X+lߎEK7 ZYJ^GVHK!8 o#NZZKP.qm̳*8kXh Mκ^5}ծ=C'ɩtkxwV419AˬMVrh`kaeu+#~3R2XɕG}}\4Kd ae|ȥ/U ,<f0H%-BS&ޓ%!`d4é [fx:}rqb"С݇f[]TplRM^7EauȑQNɵ'.8(Dzu[ǮV!E{Uh E&roJ[8UaC I)$A"@ZY~'HOˆcu>Bj:0he Eg͞\$EAL'X&}aڇ^ 4QJ])/KHڌs?M% (|sfuP>;fΆTlKQmkLJRr0S)r sp8O> Y?e^bI)%5j*>KOjb ׯ)vGĨSʩ1,L;Ը_n1݂G>k [ >'[@l٫NgHCoVPl(lo2RDs!"Mh\ct#p)24 K-/l %e{oҰ'o}#+҆FiR ƐkZi=lW>e_ԥ )V '/y4:5q*Y|0Gb{9 b,f׆=}Z('‡>gv|'@FBADγ y{}inb^6m0 V$~ uG~kB<./=C'/#\5ې)ƐmX3k)OuܽpF]yzQqL 2EGE<،]!,3F棝H-?_r1OJ VF $*1N ĵ,GxIoĺAҬBbs»`)Wrb7I D0f$Vsn?",^{`נXJd0tFE e3LQ GI%K,aãh0_f۽3Z.q{W$!rϪj&e¹(` CMq-ٜV:%ɔmhY3 ڗP_v뺛ݯ0@;[6솶+~>ahNmH:`&|B/oW9U ~QI55C˞4U_@Tu_]QcWoifwFCH8y9M!bU|ȊiajFX9Rb} sC,[tY\ 0ҀB#8w؟>t^9?N?[$D.-c3ţ^$:Lڗp>zXa)n$+ID"וoVd!A(ѭ[%ISe3pgɳvKn}Rea0S@r]ګ6p4Pmi\Η!)W#y!R(@I֗DΉ8~/u|x<" (crs,uW}ZhW6?9(iAiX|MY> stream x]An@ E9En!%7tâUAY0BX@]> stream xV{Tw3DbJ`=ݶ X @ѠDH!7Lx)EVmӵkkVju]wi7vkOəw}TREE/^dO[9}ZusӔ7OɁ*ywY`g4 a|u,p[Z.?,{C~NfƚMMJ?O׿'ta% +] _N?sۜ@Jgk{Q~qJ] /߬-2ns.iu:.ђ%zS=LaxįtNը NbPOX"~=.,j)`]$: ZU!&Rٷ)J|Dʁܵ΍kg]M#.i@ÃJyalObi~kh+N$ڼpP=/pIV9}YWHJ(jOԅ"r G ׷:Lr\ 8 w8]%RVe-thwT|źYO/A}Si{5 3:CƑ-BGmzݣ0+j]%~*AGÀ#$S?Qb+D5uDR BhI66d|ZJS/X3Mt0 N`S#;;@V3͹$֒LF ٯ[ -Gpcg!V^} 2 {ud&s ԡťίRDX!x2AMG?XR$H&*gpp3 dHTfؖC Ve+$4Iڐ3T-Ǫ\X^D_8JRy&n^O~]k V(&:s?7O| ۔"wCKEJEW%4@2C0CHGmDc+UoBF rMml+Qn"+2cdKq1Mk?ƇC\js,QZigIc~m:NA#5gibQew9;0N..fendstream endobj 559 0 obj << /Filter /FlateDecode /Length 362 >> stream x]1n0 Ew7lGT\%ClY*<6gt <[>)Vyz_2Ӱ|[c*=NEݔ1K[~T@w~.mO=)C.]Lk7}s"Mÿ_mshr&`)bqJ9l6RppgÃRa7@UY[e23) bzC3){{C\"Hx =yLQ8II [kA0T`+Y) `&j` 6~` ZB(`ÈϧeznQo뚦ݲ˼XV Jendstream endobj 560 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3887 >> stream x Tgǫi-7D*_QcL\8F\Ѹh4"64,]ݷzA6DF&hĸʼn'y9N3qb>ޛZIޙ3sp[{$AI ʈĴS&EǪSD?8C7o7\ä0̳m3GpoJ*lJس8)935>6.ڔ)'M"go_4eDΤ];#WN^=MR9?>){t\2?)C[!K Y/R(i%Hx3ruTtl\|ʄCQj5K^ x*zD-&RKRjHVRfPj85IQ/lQTD.`=:<kqȜ!{lx#F4x3R94jeHz#^dk׵`^˗{`赅9R7l[!F}" 9oum:k=Pb2_E,y#z֨t vc8 T*9nɼ1A%\42N RrkF{\m"z=,Օ?5Rz'$HDڻ(%&{.ݨv1xl,5[O z>#$8ъ^ Q4 ,AS@{2*BijUU䝓Rq$zAQ|6@^irstʲ-G򀼩z%(3Y**Ln:t`l^;C6`/+MU54hoQ/.x+"r>3! cђ`,3Ue,c`2VIΪN QIRn_!%({"Obe##H V)k?0&Mv7/'J!m4C>ǯ{BbO>t Hi=78xZ< (}OcZ"b05Eb /|@i TB2|ug2)V_ʙ ꀘŢ1r"0#'?$d~W_ȷt<6+ŏ\#Ɏw<0L fBmF 2[Kt-{k\&Y(ϓO,wdmA[YQ[GbolXUBPUଶ֛Ke`NAWT4Z_/Oo* ͜S?놳NH:℟>ػ.w)~[ `wCslnb_(q7c^F(&RN2p;b6 =Bw|=,][hXدݏE36Svю$|!nhBY<(s j2DA{hMRR|^=p/+_Fym@u lԣhfѳP H8KC.e_F#Cmt^u,XnJ# f.q5hZXuw]ߤn|3۟z:/O0eK,/jx 0?3Y}h͢[T~>P[{饶;- ή - N K~ :Z`ة!vIG7q ,gŷяjр%cX:1hWTyĨ^{P O@ Ŋעjյ>z3g6@g/!+ mP43j.&Üe hf0<ڙk6NG7fʊ FB]XpCCyvݲumm4/ z&elXj[U5ܹVv֞߮=n S0j}Ơr(]FL)ڝyHbPRK3F`k+)ml< _B֫4dPE~ͯ8XU|XBco{r_=!g|q[LY;<{2DqJQE>e`VowpE&[P\3Ah59ҐY񐚤O%WVk 9iK] e(yxE*65?[GصΕ\,[2Z?mk! 6)4 /:)GYM51)%τDxvr~f*) ? Eغ=@GDtMR&m$^/C!ס@zM[*!yVȢ3ق&Wޠ!0Fbٺx>g4pY ǁ;N۲#AkmXyB• ȭwMh(AQk/sW,"ŀ rFf8ܽTZtDB3JX13I󙁽;b0I~"'rK03%d~ċ8;Loc;r8'6kt* _{r{eWŎuq>[Pexa: y*A+j(̤p\:BvHK֧SJ`쳕EٴPk4Ph[]|*m;6eO$H'%w5I~kE^:ZÜݗ)Beve&Y  Óؽh!r؋9x|tSbvH7NF\\kHЗxnH6i"l*6 Zqendstream endobj 561 0 obj << /Filter /FlateDecode /Length 254 >> stream x]1n0 EwB7XJ \%Cd4DgCIx>sZuYSˣ^SVmc d/9~[P76_nS^|h sw1ͯ"choAd MDD;"AD -x-{m"žQ A:x "$qBD+x+kQ+UʗrӔ}RإI $endstream endobj 562 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1546 >> stream xmSPSW/ɻRHL\FSw; 팻v, HH[ EQTI\ɪ@U0VaJA"%lvUvnw¸7ξμs޹w{>(dDe}VB\VFš/iLzMK~!\ኳhEg_H"%K SI]bBBR\+ڦK fcIWXN[iIR+*.-ܸ^gY+^]K7*Y&nrʖť9MoCXOII%$d$'o$D>Qa!{UT=gO*^V(bx.&X'Y3y0*AD8p,db6Y- b9ssNYKCʙ/Gdئ'&&Kb@vQc`XȇOzGl>+i/Q0ʞUo_F6#<G]Opo埖 _onҖ,u@k6]6 o6z?\<5 ǫڶ)?RV@s јgk5!RE7]g:z(L8,G5 ű1#|Ԯv l,az}po/4ڎ*1V32*gkّ\5hG=9x@|GV붯*\;w.Aq}l^-wu.֔hF}RQl۰عցQ\u! _8 I@.9#e`8saOP0'~߭>x3˘c_%`kyOp:k.uXJ`U6[L%SFVV>=ѸO!}ȾOHfk8|8GQ$"CsLi5P4^T5b̈́EEJճ8$.{h=uYڕ.pƲ=!bC>n~4sɯmIbyM1,6*>>UWc`aXڇ "RTB*3'?17X1&6{sTDŽǒs2Pn9PCNx]P>= 5?r{Xڹ#P{)N+EmP!VxⰓ'"nNp]hɃt=d@ٖ&!rJK4)ͩU3yn]P)i#tdVH7pm]-6s:5t7[Akm=ujX' V;J<7ܼP ͰEM246:xy~"ZԹw_endstream endobj 563 0 obj << /Filter /FlateDecode /Length 663 >> stream x]ԽnQ7`aɺݸH%yeX^E>3"YiXǠ~zy~YNazp<-k?\>iYm4>tYM.}Oo}KC/ܯWǶ[??~uiqq4[FoDgA j7C 4is ΌA<0AǦAѠ#ИDFAcEfMhFgMrV5XM^`5y^4 84hL"ȡq"%r)rh\"ȡq"%r)rh\"ȡq"%r)rj٠: :s5lauyހ5 z0 B 0 . 0 B 0~$; 9ohΉ}9J(Qb!IH"$ S$!~$$O)B'Q{OdG \ &p)`'Q5Mz֔7MXSޤ`-uT`-yނ-z ֒-XKޢ`-yނ-z ֒-XKޢ`-yނ-z ֒-J"+Od\yV~<6yqSZ0O _jendstream endobj 564 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 7490 >> stream xZgXT>C9s,09R4g'[( Pf(C "*vXh^M$7I6y=3g3gkwk%|4wG~ix?AO?6D#H#cq4lC k%^!Ν?{6y]bnf>`/ͭ1 %zoA͠Nj 5EfSN:jZO}HYRs GFʊOYS MBʆZDRSC ̩DjICFQwUhj55R{(#JD9SR.K)J2)3jr"fa|W.-gFdD*ӆ z8ER%M{v" 3l7yq|Bc1C|)5QGinp_/N9/mr;?=Ėf^9PdtڥO_[7p7})D5^(LʭMBxʇT`z88NHPa͞KP(O{P"3AF,T dp‚0rصRqM@BQG@$ׄC'4ai]Fhz`L(ү`Lu`l"`N.7p2=}>@wa!q}XAbi~6l {׸S{4 1xZT?9 a6 =xa@hӮTU` C0o3G{sh) #WU`O5$j_3a&. &X{}9 OL\TnQ%2T^itRe|r(Lߞ-4LdšL|-aD Ԩ4eE+$d`Dx:ߜ,1|6THM}}l?JK*h ,Z{sM5WCtJyb˛MFxT0дDe*]wf,˅4 )Z gOy<>h#v6O'wv>I1ZOE$qr5l3݈>M.,{;dEe+rEd| 9E Z3֙&S Akp :3Qyl}{ekd-&MKA:ʏkrP*e9s 缥0ͣ] /IXǼ{׉&Nɏs}eρYQ7;a º8qh H L7 )њ"/e(rʽ ϸ{ڐr^7XA7ͣҏ>CJ.9`[UmYSnQARVB+X&\lދWv쳜MNZВR zwèLmkm׌Ec(>7ake-cҼrTag׭^ܻT& P?3Y"ɏ!3m5[fxkNdal_b (%dhF4)6$ԣ!yynX4o5R7G4Ue* S^[,>k}KVS.^>gƬ}ӧ>y"С*,CL}iyq }l~K-B!lޯ"{{tDeq ̥OP^|-R-/dD}^0fS>9u5ĒtV;/)5E/^x߼yFszҍyx\y6Ǒ>r=Q`hdqfSufT6J|=zlbF%ǷMMDڪlmJ^?B[^Vi#D`W\w*s Fh~E|V>ypD)\pQ*2'T) Ca}\[26E=g;jK"9,_wUF c+@#+4Y>hMfcZqO=_I'Eqۃ$ᇲ*ywhBtnogv*OTUAUfe:N,8<=5WҀrIXU&}F*}dCvWenn:P|,eℤ$ɄK~W&j;JYExW{zs`mYanxyIUAx6xęvq<'!*O7ЋQwO |.ym9<ާ.( )G\t6b~9#gW欆MƳ\[ 7=hߴ@fF@4RJUfs #fEŊtkNJvj.2m=MF"䏳/Hb?^QxfނmQu=M=;Vu~ >n__weС--e'`ut"\NTD!`^QU[ZX斥#Ygam"%he{GkEC]OHC\2ϩ̼q^v|n):chT0z`_10kβ[+VXpx_߿w<]8+l$=2B!OpP/mMgDCxf^mɩʩ#) G.|$D(##jWZb~ui4dlgR!CO\QCLE@MQR$[6|9хĘ$mc,52-,,$H*9z]:W8(4D]!O9`Yiј~xp8#zIי`x|"r[rgζ\AӇ{wf Axs|Bbj8Q6ELkIq\p:Hb`5ӎͻl<AJpPe2Q(\*7 I݃l)$ OMպ,Y't51/$fGʎKŦDMpRS'Xâ;{[)4]Ek>BATT( epghQ m{`e qvvn8L6"A~J:eQeI / (RNBB~tQt Ȑi( g"K# ssr9eSCY * TqLqtUaԈj˫JkPE_7Owuu(Zy`-2I|4J%靯h SCo ԣ}kZX,A|ۢ*s5 ʟpOE+vFW&p0.uT\#:zٺ-lʻ@KRpWƾ~n yg#Y@z\ Lstf'D iC}U f`kN?}#ŖZ٭>ةrquuqO.mЬ__#@}U{wЄQbPLl⠜ "ȑw[yya3 0֨WUddtDNDn%׬x\.5bdzee YW%=)d`/AWf@Eӝ*t#<xR3DwVmںlƫ0^>[ Y;[5u鮋]xtuc-s"V]jյO}yfn>^d3zE#t).&QaMC+FtC;c,D X_= O[LbH?z/w$#=,+;;3uUAiO:xhdoN܊vKw|vٝ'BĘCet#o_7x[ɼvT 9x^Ţ΀xj#e;A i: vm$EoZ,Pp`/95Qr P-\.H޻J`b9wMߢDeQ! h8.sw0טE;le_iIgS0Rar07*`n'mW?yd>X!#7k}r\jR"+r+ 8hcCVAF65;{][-,ڷ?~>{V&@^ sPi(2>%-^@|bt"2@`74BeEZX:~JLoĶ#״ܝhV.j%Z2h?or]3K5:'_[+ ipnCaGr5?UY9#GRbY6endstream endobj 565 0 obj << /Filter /FlateDecode /Length 161 >> stream x]O10 X @p' aKtp'w'ezv =(ul"-~H0XT5 㬃]'l3Uj75O$V?p^@Tr48o1Ҵ4CN-,S,endstream endobj 566 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 352 >> stream xcd`ab`dd N+64uIf!CO/nn /}M1<%9(3=DXWHZ*$U*8)x%&ggg*$(x)34R3sBR#B]܃C5P\0000103012_i eO_^Pw*ˋ T\)S^m. =wnw6/ i^O mӺvKc?{oi~}/.cA<_qsg.a][%${z{&00Շendstream endobj 567 0 obj << /Filter /FlateDecode /Length 1277 >> stream xWMo6G:THJTN",]; ۑRVQ{@(m  ~p8sH0 u@<P3ux< ~@9)۠!1$ S⌉p@o&8b4&d>zL2!22T/) !T,ƄaB1vRZ{H(br&0N/fVEH.ԍk [p giy>[(/ @ 40e}G?j:=4 e0p+&/>HQy\TRT韺DP ʑ6eX,]?A';U (`I@bt-X I* JaGg{]BF87MXߛ?ʂOaF򷻲])ATp M1TϐAYsXz BVpmSP 9LmhU5Ag*lF*ER`E$ K"u@6XkzzD"ic!RtbC5I%(T;,ouxmrɟI&#e䣻⡚[RSA#բPVh A%>S1JX]3ԥxnɜ.s[8޹ 7(t8!c&ib=rx.}Z'fuySo_MG\RL tj)dxsuX$;J8ܿ\!u}M?η4m{$-lw ~?e/1!,U 6s+l߇Fendstream endobj 568 0 obj << /Filter /FlateDecode /Length 6277 >> stream x]Ks9rܓ"cވ#^ʇ(5j54/_ @Uu73;Pxd&e3q_ ?>DЯ鿷_ 'xW'q*dSg ʜߞ\tb`3$ Av]pƍrLbCow3=(n|wIm!tr~;geo4f˻5k6 ]*-W Mc2 &o^dezI]Oy]| + \`: /O:8Lkqz ;1HEm?4n7mK/5MއBz56RM0x^xv}W~i׽-_Ş2ݛ()ޅ[M=g`bR_NwWmz$DʯXS\Jhgq(JfYit@yDy,)IYo:,B0\bOX䃏m.qHgB1M2:mUG6٘ 7Feݞ=vn+A^C!టmhd"Hu꘣#M^%83W˙a6LթdΈ`*2W]Z&UYe4C,9yZiIai^ LXKJ/ԋ{=3NCMN4$o|R -Ziq"ήj>Q;vUqike7}7}q$jJPZ&o&0A43/|DL2Q MhfNI*a.YiV%Y#Y| L>@͂`G ^,&L p,!KL8pwkKu60֭:رR?76fjrlpVw2D|jBc [?GMmЈsD( )(hNGƃE`bP6&Hڙ*ggr Dv$itfK_MԖAf#;%_M g~%JaTab _~Sy('2ٞ74]޸quM3%@һ8Be"gΊֳ2B/+QjWzXynZ{Nj* WZ V9(35T_`dGy)Hd&ڊGx L4g"gF. } t9uxI zUu Ο );d,o ǸM(CgΣ' ڠQlm;E qoWK7Pv 8wڪxI .? t٥p (,rNP#w?LzoE&jx#/+kʤ'S>o|ҿi/jlwYoK̀)%+jnu2̑ktϏ׊\'<)I030hH<$K1#%I3k 89eS1uNieb55sԬH:Dhwi oc#PԴ baTb(‚+wS7F0͆K|2GDdR@Ou4:Rsz uǨg ubU8WS%Os@lNh^D"3I*kf}{ */8!*VH[Y CJ_w=Kimd03j_/Gr$ ƝwWebsC͟&RLm.tqM",h]n7OU&>n OQiN|*׺H< yC \LG#ؚd|җG(f—_!f$]ٛ /AVKOr{:Ǫ3d2{=8Ff߬|KϕPe o{?v\ww)HPmAz/Hbӹ( MԾHgEWQi=,Ϝ0KNf !'qZ wUXmӧ/ $f:󏁆& ] EWkkL5pǤ]>8cd/cSvT߱u ^DjR,9ỳ fd) Zꂏ[toGpu>MvSXe1g?uದXB Q;V${0y =9>W ^#1Jn-DI:yO-l^~7־ . SIpe@;Rlt&r8[22çd䀞B-fC Ixnۇs}f1rlv醈 P敇ʑtp~ZMDtFLQB% w1`^o3%jPpdb a* =Վ?"v=ZR\*0 2C L bv>_`~C{D^Q9$]2*?X]|b躿u^^癈>hco$XkEb^喏W|`ֶ._SV6 C@K*`WbA1pG;MqZLөx@}ܻsp4-5:THty+Mt9Vӻջ'9`퇋n-'./V9ow9Gݤ*͏+jMh@NnXK`M. n 9ΌMƛD{FGy Iyy=Rۦ*T, ?AxMSպ?qtUNTKڀA ^VgZI% 'o`E cwg2 Bq{/)NhS ,8ڒ`,uM-vՖ͍+,] od夆MA9Iy̪ µ 3yv4Ckt!s>8} 5s։f/ϴu4S_Cuv7*a0O 28\Bo)Y>*RSbu f+5{8zΔ;f+Xpѽ+}\g1T$GAE-Tҹ!ZvֺhrCH0jIcebz'\Pv{&QiݕXXeQTA5å$&@o9I8ϧ!T*t+%uI ~c(o6,2o:Q 1,hcYjK @v1 SZnٗ9􋘄 a'tFm v:.x _e=f4@'v/| eF΄lєeek[ v?e"Pxͺ:ZtSvgq.>{n i `eCHaZx mt34r d̑EHm³P|;% 濑dd'th8_U Q~d3 Ʉi[:#%zӇeMs\E *iR $jg%:Ih"\`450\eJX ǞCqMrHuH:u~nx3H&hwq1vb< %ݛd4͹ ^6g61}ѺVIC%AOF]]xz4$(zw uyX_L.!NHg}"3PqD>m`Y* %$ܤHˎO~#c8ClWg4[Ksv+i Wy 2k=z>QhMgii't]Q.HE$g 'cmUȀ?o몌>Nr ty$ޯip_Nendstream endobj 569 0 obj << /Filter /FlateDecode /Length 2199 >> stream xYK۸7#Z1xC]ut43J,űw} T0_w %[R 7]-~]0vm˟֋|`R˖ۅaˊ-2j>,3Ζ, RsXoPw*cI;<}).-<{'%-QK8>>ZM!KJx+"?+)UI&D9m,UJWۥFBEf L%e/1p6IET3 + $ól*\ UVZ{bmy<.p#&J%ad}3ޮ>iUp}VUHnFzX_Svww[|~gvNd_nÙUA%$К №bT<*zm*I/JVQK/l2tjQUes(\(׽;(Ez&pmwxH ;1ja'}xIi2ghr5;">?x7rsG˞G D3wM 0X)E#{ߐI0eRgI0!iq ڹ=iwū I{Jf6hn %۸w kȐ8rJBg0Eݢ1)p^c! p}לsUVX萍|2%JbTQaM{tX>DG+@/\7Cϴ75ɴ.]eUNX@*a5$@`0|K-6l,5<PO[i(_U22WRS}QR }ⳜB2clmLP]3pVf1_6WW٧Oޘ1L^IԴv%$eK͐.s:ktNb.uܼ } _^, zFΗHyg%f|2SPI$ۜ$>GpW$}MBz!TS%Z&4k7@ mB†&QqHAM(} ͌XƊ^_$9WIۧYϡҥ1zsDԎH瑕M:pQmy;q쾻gZrJp.5a`.xMbuQA A<7MPtQweG67jߜ{,.;mH=A{O1n)t1ʢ/ }ARϝle#9F<s~˷fP리3 CдZWH jYq753J2Vk4{2 L3i Q'Y(\f)-+ +~d-AdA.!DCF"hs{&C29E7{ʘ:V.80^\^e|(KRlBö(c=$$6ESg7 BP4:o__q/0qb@)5|q0{x^閡wgFKX 0%+)Y ⢔bqxL5=ū6ݻWP3 g\[r:$4'4Ǐυ|{<]kfihʷ]{ߠE#yڛ$9q ͠[!Sv^a$'ڕ*5>}7-9BدeM 5Aѓ (Z̜+5   {ŗf;-nMAv1-iJ@A+'p1%AvMzҏ(7m'LCjtM`ȋSN[/1ۿ hZȋ+7 {-VkDŽϜw &8S\+dt |_^iB 0,`}ŲeeU[_y(x^4ISrQ| 7rS>#c G !¢9AخfmYquldg?)':.AP ʰ7η0@zpЪpW1Ky6?e.H3zM8F/ݭwm> stream x[KoF< /MwD[eDr}På~t2H!ܝzU5z7(T_;_Uѻ#NҟzL xD]Q&Lr*71P'd}tJЇt:S8y5ha# &әD,Y5rH3/wU䄖!V&M2lbtv1^k{>wT\0F;*$(VׁӖϷΞv ym ..ϓ+S \Gb?Yf'}wrKX'˫#|%>9<#MG K랬^V3>5jee2WQWYt7)[U=E嗶5Mx$sƋ!paR@Mz⹉+FnVZ.pKVfqbߗRND)y=kV.U|,ʝRs0ZiQ /`$Jv}wŪ5r)i'j 猗9%?nㅜVq)tMaUdy;0^w_PjEHI296-W*H~Q n.;Ұd%Vl2c*xnWEs||,sHبV7.eL+ `]ް<\_!D{Fh(w%LYs* HJq  bj{ #y2w]H~Z8CzȮ8/ µwD!,wK 5T`pzAZ} 6EC?\mW0OɭC Ŀ0BD'$K,MSfMNy*A/h=٧dW{WUY=gFb$}e#KYRik uT0&_ Eݶm8]4$@I^_݆W%^KD7lƆ5렀\c,8?l7?:#[#cI{1*<(|З* VM6;/xOnk5J"P>ػ`FF:3uh'gbI7QRdIgr ~'K͍5W!@eTeܾf'vѹ`\͠[`mw5}Qc R-]} AK c>X1QJZ&@n}= 2_$@ٹ|3EQ(Pt)}{%Wz/ T3گbZ|F+t킾<v}v/me#^}m1)PR>φ`S-K@M]0Sxփ'a@O?KH]v}Lzһod a8#%s0 E98^OTpn3l62K \w+!fH}\K藨8+t[k`.]3&@Wr =7hKIګA ޢNS $g5``0zcLċ4 Sv'}t)S/Ww J >nzI*A({47(Q}4.(aaOx LAlpJYvCǓ>@gyϪAb5ߴG+>\ J \W: g"<6w׀*^O1FugͨSv2EN35akD4q< ]698HL*+7ɪ%CMO*6@Dމ; $xZ%.J RXhŐ5vĞTojޤ%q!nEp\5(f,:Cпj|5V@>m/u=|%Y7wV33Y7jlu x }g4n3c^rNE5ׁ *zxxb䯧DRF3 o70 4NP۶9KC*%hJ~>^ j9J[k.Aw.Ui㔌uɇvJ|ԻۗZ/% 6ۡɢ ON*)=Ŵ7d8M))Gykp}TˍCQ[n/ >UX Շ2Rv`\Y?{ Ǡ+*l2/e{G9n:xM_Ͻi1XWW O_A W*`3E{< >3=N2RCRT}#ŒH|2|Iy 솹Qq#0q8"(xS8$%n5Rl`Wm3pD鳶)| DTؠG0 >UԚQLG! g =;hbԓ:0㚇R#صcA ,2~N^ ]}' 3IEj=3qD S?X–aݬPZىꐸP(XX*bj#.|N1zO@3UD#3 4P9J~=Pɼ+.*"qϯ" a勱] JUPPk1Z@#.y5*4X͘NbN}̞|ݯ<%z&~ *3HUºط2V9|W:0ʚ-|_ԝ5+=0jk}pqe z$Aw?|FLe+R(uk/$8e&Mb%M xM=-(NcMϛeϑx?~LPE6o8S%AP \m(LGMIfedpqFNAG㓅a8TQ Fϥ zACd _nfT*āf.3 +.@M0}X!J=/ 7E# ]D2|y,ӆ/3$~1td]ݾAP.=ב qTb(16U}|{@ZDLfdsәt`CMo%in%quTpۧ͘C%sh Bao iu TBτ2&iw]>ig 1d|/[(b%> stream xY[~o胐 g@7AMbE-JuYS=gnk;hÙ3˾?zQ:??Sa̟s*X%k;RW0!UKYe-#uUKimbpQvukiYKuO-#ɪʩKDU׊9fjZ^}]/ 4P^/G.[l(y&8V!r}jͩ'cQεE63bvΗ\VF)\!̀>ScWltiEA3՟UH % &.?(Evm߷m$}wz*k5ivmp C *v9>A]kQP,%y}hxlNnjLbm{6`ٹ VanY,%h( `Ƌr~WW"Ф+cVD[NJI/5^dX,Q:H $ I硴#{WuxMyG&@LkɁ.Eb<'=ZFd찁.&2+sE4:ċodF8'[cn099݅gjIΈhAmn;Ě+{C^6;z XXĈ ʩ%=eAlttH…pv՜kLX `xks_%GL2]7UZRLG.Ҍ {mB۔3,C-R YK 3A7b2䙠Q)n0y_\ yF9_*K8E_?::USqjFYنSXyg3W)C4TSHQ/D$fù-Cܟ 'GϚCZ q㪦QIN"xʊ6ve"z*A˛@ >xZC˨Wo 6k @خ ݲ.Y0o6&YS%2<R}I&t\FS9yƋoErrt95ߞg?s~73TqȒ fj~K]zצP):֍@t sE!θsGTɗZ'e +( ]~I'5,(qamŷP MƸ08Ɵ<;y N}trŹqI]5K%f꧲[ wߝ0M0۶c6yy)~tg5Qː6Gn7I|JÜ}aK }76vxXw0-55+Xn0Nq>j>PWbfvl6tSv 1eFmܸԭΜK&JA.89,'çsP /.'e$K1BƋ&YENtutz':]A 5>jI2\c@s+EikF^Aѯ Dp[&Ed4bMfjb_#]^nT]US D;y|@JWVx!t"EOĪ)6H G/1SAYv=Df l;*'eݹT]l [b^')pȘF˨j݋ߟPBUuBbv\{LF?VY#q4I7uIY?{0;;VMPti`Ҍ`Y#v,tG)-Ѿh  _KМZQm՗΍>z yy8uA/ns'\gვiBuFdⲞIWnU]j qC!m4/wendstream endobj 572 0 obj << /Filter /FlateDecode /Length 2635 >> stream xYKdu`g3R*y(vV[aZ "KD$_y3XʲDSZ)ſvBw'̭N䏯`Բvi԰i 5o'Db-Y@1_Nސmݽ+8Pʒz(.-<[̒uAKDŨ%u~T%hܧwݪ'M%<-fRRM E_]0 VބN^Fc,1AcwsT䜑*sfJj3ɫ,<3 Ʀ3JwWio]1S\0A ʊk3&J%1*-$iIlݾiw&,R\/zKECܡVnly{=#Cnͦ=6aiSgSޘz2Կ J_$sG穠CW],YY{E17qS _`#䣷)XX +r,(y1,yfpy%B2FB+[X#!˲%T@)JI BD97Lhr˞틌-j)KpTLjkʖ8\d< 1R0Rel6"I 'AIKPe:[w.u~,jL;ސ&BF^qQjg6_79Z!^ `ɂ Y/>i݋T21 Qx"4`^gH{xIMX!/Pa@kڟ"ȓ r7L2+R.d13 "`I" u8iբ' ěXoU_,5[xIt>JCL?` ʣl+m-0Rlb4UPrm `y%\&|b" dѿ?D/%G,Hk 9ךWk|$ivWOh#! $ ?y t݈GQ*P{p\͕µ i۵ntv nX4@~Cp 5_'p -iȓn?KTY7uqِ;ؠ7N⌓>;9u0z`9|b?gYh8P7ؽhE,:φ]mn/&OXMOnadOj!~ChK1)_g* ٛK-[Y;]"F(2NjD$:Yʥj\'Y`dmOKB z*lgg Ȍ1xt-jmCb*~>Ee ?<6y}^765pr 7Nըfg3?cnsh;2>6M܍;K]EUop^Lm 0Sl"CaЧrev 5i7UG=èD8&<"drl?ړ9us~u=;ix%^Ο bAan/b=*XK3f]pڶyc˄{O!/5*"]4H6~dל<򴏢:Y{^#vֺ|ht(.~Xq}1Ĺ;Be3$EjZ߽k$h X)-*?q^Nrcťg\jVqb~O'W(TtgA 5 1GQjm O }v%4n q2i|҃n@-KI{9lRq+~a]ni6|٭7b놅 ^\!a 3?ӴPaLO g.x-!Ն.|bH'Lz@3Ҟ<̘$_Irͧ%oO]{$22B &qSHc/Zu)jȣ\pVFGM=~L)"]Y59E,(!;[OX؜E?;p :*8j.?`q2 @ާAg Za\0:r>0#[ ;⥤:p $(6'u[0^p(qg*^a2!LKqV HH Xxv,tԔ |ҟ)gJy>X+i}endstream endobj 573 0 obj << /Filter /FlateDecode /Length 537 >> stream x]n0D )/%Eh*!8}gu= (rknrY{~s{pϗzi/_Ж6Ï4osئi}k)rZҵ%O;u.wP`[k30 6hE}"δEJcMx'בv),5NEJhH iEՅ)\22RGڱHs` 5Z/> p3-feț93sFެXa7+sffR2veoB0"&#! `oB0"&#rSXckscksckscksckscksG`\11-t6HJJR]:u*YTWbuQ:9 XCAk7` y! o5 xo7 XCXyJǑGqmcYۿOvxWu-Eendstream endobj 574 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 7770 >> stream xz tSe ʮL$(:  ˾mi6ifOnd߻ ])ETgpM};EG=3sӞ{mϓ (@0aʕԥ iY3&gPd rQMs.FE?l7=XdG6eM67T(;G+MI<1k֜3cv*cΌY].JY6s̘W ɋҘY1;R3cc'mٰb]aGfC~ՄTibR<>31>G*O%?IS23rR)Bًr({)<;W(V%:eMZ麴26f>ǎyg$N7PjAj ,5ZK=DSGԣ&j3zB-fP[6%qej15ZB=A-P˨'ԯ\j% F lXj.pM'Saa;FFlxGSػunGGg㣩uc8=g׽=_4&^o}x!q$Vy@%+gOH'\>)ISZ==x~Z,=_/ jD-O3ǼmgHl0jW',I,V6LV41kf`sAadamAEaQpdFX+y MuiSi]d|a Sq݋fo]./bL'wH*%Lk~-f*ߩ9 tM4ӔnbbNeI,ӕ5fvׇ?6tL\@%܊QV5hov̘HijQP zf("tN֥mMu{!fq$C#hc)\ȆM^6Sܕ=NA%T3x&V:rդ~>m8MV$ٺq{ftPn2]_mVg˰CTWC_#J_aDDcYVɠ{p4R B5KzO )F{I ֢ \^sߪ~>.G1Pհ ,lgR0[9N'<ߪbQ=F_hίc: A"]cu]'#|,`im m&Fk~!<ơ[Hw_HQo/1O$)|3$AbAbᔤekKwD{TyЧ[p ?T`2jɢ0,/yy݊M@Ϟ|: =c7sNଠe!Wxtժ0/=+. XUifte?]'P 7{9*R:D7^\e[Jb=+y%:RZ gIe>IiE,>F/bAրB2{Wjl/؃Գ׀F4=fX2 ^/[Ldu؜L1-YOŜÂjmr|S;S^p4 $va-j,&% C-|۲H S)]_z?VPC:+11qS7I.Іv=J*:}SXA%;G؉jMWE\5U$93f(^©E\JzÞ_ <Ϸ\+j'z3(mw uW@@._pXk~R-\*̉iu:@ǔǢ 0-@%{Ⱦi˸YǫżY苊tzVs ǔS,*s8x6!Q,j{HyHM2T=`HmmLM%}{N˩&OA\ag_jpxAfȴ(AI|b37ff$,\ls=ƲwӺmj`&PDz$ѳL}0\fmlwD8BZ8l\ցx4}oE˔w5Ԅ6q'45sJx&9Fٕ*q80~hK߯9|w>fp z^o6)*ĮY k#wm=sϧE&5N 1;m>U~+:̼cBUyIou8DPE;9>?<& =P-$2Sn4 LĽ[bROROo7V4 f{B)vh6z@9K2:fH{̈́6H5nxb?Eo~1jb6Xy$$=nH\PJM7hᶪˤkR7L ,Ţ\O^ggqݚ%8-^ FbzWx|*3WX။&ܙ_O!Q=G{9$ugwd'_Uc%@J]~ntRS4@\ zW^%cXRdG 4j5TWgß`$G8Xtgcs6&$FAҳHB~$s,p!3x-'j2~@3ÖWϗP8>s[/#ry%][lTIaV>+~/1^Z ͚]*ϵ_g+7nil2M\ 'g^ĔnRoM(&e xQělqji[H>׿~8u_ŨF,z#3o:9G|~m=ס,E`4͍uGw'a '>=oho7AH wARd0 e`b@0x~-4Ҽ ` pevI7p|rEA4rĩwts}g+>B2Yt&&s[Aq䁺\U-I3 Lgwl6/kV߭ @=HQ<)%kIKUnڎ6r\>OgQY9~cYZ_eMX:$AGbXߡ4> 5#ԋF>pM)rX|$1ML]vm.l9alXp2}[Z~6U]Z\g>e(^4̼/ص 9DS񓰓)܋+/oxMiEnT':vtrz&c,y^f/ `3UN(kA,+?y^>i;_F<}a0pj v*{UW'i2֬M-RW740c#t(),zoU<739sB4CٙuW)[^]%H,| ZIQo| õpdJXprX"BQ6rU '4S$?6$ cϮ|ဟYӰجN ٲ}-@Tteή?{.W4Gm2ynBRPSߢ:}h|m<eϘLf9(wp^fd0y/M%Q0zj2#8B\ABַ;{J⟥t:<G$Uoƥx SB7nݲMfcxM |}re>bVY4n===y]\j\1w+D#4FB+eHfGt \1F䫨߄?ZKnnk=h4eCMDQQa0:zo&?1rLe  @e:!ڈr("@(Y $W$:~P-iF#/WxbV~"OMjLnׁ^? ETF ?Zg![L;^)4 B t }PWB#QնԶ0;:\[s՞e= v[S1P`ֲz٫.JӠޞz4aoBl~#=I_BKQcH-2yD*qO o?J02ڠt2'Pdmke7/#0wxM3K ~z#qTs܌iß`#t$guXmt.,=[%A'WR&*?F-eL&%.̓g3 ˊkxUCOwlV|6[?{@U63V,ضvHCfPjr R\|.ASlQ#ZHof٠X_[-brN\nRt 7rj+{h+51 I1M&AlY?A=rK.czT@v$49AϾ yʜhVEW_ٽ"m]Λi!/ 囉+JZg$7V4 V=(I[2-V-8]"-bR{[_ޡv#MJLHR-PP/f\h]1,9Em?n[ݝp+'*x뽨~AGJNOٸ_,]O> AY5Fy+h@%c>y^4E#nB}U-:$ͣ" 2b5Lh+\e;AʏtzxpbbwtV2U{}CY%a?G59,r4:?kTh|VhPHCtemPY`h-Ǒ̤(Ek>pTrr:H*@=.{faC[sy>CԠs=9vc2c qu]0./Nŷz{ϞZ?gُys L6dQ&1`wۼL2:Bh7XX5?0REPT2@!wi\2qNs l$m`2N2날U_‚9#rYZ -r#S{HjāU<6F`d{x}W?65M%n-tC ,m׆i^_ .n8 R"`b:I(3Чx0[_vTD| rKpAwvGApXr>+pҔvZVr'pDBz#Ozk 2J֩"P-v R3Iז1X pVg5p/e baʼ2kU*.C:^SZs5)UIxg@erm (k]ݛVS# 9}~aO!֒RWH'W|tq/pB-"W#4iSj=?}D3Rb@3DPWzfD漺溺ffLʂoT,Q@ c_gLr$ADz^fwx<:~^E:iP+Ȕ{I$ha%rR,95j`7Y h^ωq Nhs҆=QŨȶ'D4♸+g4OdFr' +/|NѮ>^v~stV.((uq8 ?qnrp*o?{Ρ A` Osμ`(fV‘,6x= OK7' KzkB:ΰ=o{ N,AR&oA"&HH1KpƤ7Zj)`!2>_pu'F8F5h"1:D#vyZ9̽`j]ḥ/_[˵gÄ6 Em}ŋ<̃n+';3 a, B(3, Ɍ>{aAZE6jEp絨endstream endobj 575 0 obj << /Filter /FlateDecode /Length 231 >> stream x]=n!F{N X%kqa+Jr,"pFz  ߰;zKURSrRu:>Lf1߿6`)\p^>{(. -D졞QmmΠ%$>A0& L:ҹ14I-Ձ@XGHG ҉5@H=d=g=d=g=`\Ug3:zǺJT**oK&?dvendstream endobj 576 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1589 >> stream x]SmPSg!pshKn#~{S[ЮV LkbWDpbD!>%XSY-u;Zekq[2?vw9*pN\x6N6<F+þ"dˇ\!~Ǿi0a&YđUK9\` dKmGzxTFt@!aa}S{. QJ"}#kGC4ۏ:ۻ , OWS^Aۅ] #T%MJYk\ϙ>oI*^^LT7&kRj.4ָR`6 w*? wejjmِάL]A=>R1cK!O6Ȍ~;xaOHhE`0'"a@%)UJ{i=y٘^ ¹gv;T1U7pdQH<98W:_\_C H'``E챖W[]*2 $ "iJK++p6 =\Ty0PΈY^x@"NVn8r}Zz0d&-Qhnhqr32g .E7{L*k%<1_~ ae-XX{AcpY\u]?oI ٰ!y\j~Mm+MQu) V15RV <ӫ[zxᜬfmٚ;g̯2,h^8-޻k}>|W18~cy?v*e.m-l,+g#0d%sqF!I0Ǯ#7Rlug6ByOk//#d:Odf[]f[fU_RQ GK''쏚'B)pk-7<.÷ n6zeՒmZ:{r;7tqV1~;;2MF~{ޖR 0| 7ޟdz):5eYӠ;вn;gxkqr(B;>ܼw]P??LPbH="]t=klh~[ٶ?vwq#'.n4%2VTı[>8WO]&®4(ڵIS)O. ]4\6C{(X]I1zH!O|qI)Jn(3.- \d0jUN4Z0]R ZjhW.4kA\N>c:UU5r9Eendstream endobj 577 0 obj << /Filter /FlateDecode /Length 416 >> stream x]AN0D9EnФ/R lXpqPMPܞ)eb,֎9q/e;ryyr1/U9_~Ic>kԘP+?{|GMӔ +6uHtC9] {`O @IOJ a8&*&i7 x*FK #bwIIF52@gо%)@ SRlqRL``TȒJF(U2d I!)@UDߨΑ Lkk͒4"&&&PMWj5\MF_s :r.AC%ttttȹz)ΗRp*8]N}#/Nv.s,}RrUT?dOendstream endobj 578 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 5850 >> stream xXtW ""BHH'}KIH4۸JFG˶prB Il* ݷro]ٰ=:civyĐMZlYdkԭ9/>]5$iyb"Ɗ9OW4CaT,&?GucQ8bnk\XUdo=̓O/ťU͟85=LZxƲq ŜG 2n͊+̊[f %X3~q1-MOԭE[R > qE/%I/H_|E+rVۚ?j # b xxEL%V 4bXC%#O' Bb1'OOg%sRbg&Fcq<< .1 bo )3A38"vԑ*M֏27sܥ '~tO`M “ߋﳣa!Y[볇VM 5'Qz5?秩YiJ|n.RiBȯ` .~7w*Jʫ=-:ǿ 5 H[5hn32 8 kPFV^d˱zHZuJNPR32i= zOܾ u= fېY@NlLl(ȶHf';Tn %rm.-=fҗQ$ iAIY.{]Bkг !>t`;@IWr " fS9F' TjQ t!4Mk vw6^9X[c7 ̥~ EVF(fin1tFV &>ۭ>Vd5nC4֛@ 3@i HnuF".̥r+V$oYh)J Roz^+O]6O0X;}`&thOa֮4\S+ka=[[`ܸ>4谝mE]$c*Q,}/"{>'?MxN> h63 KiQr`75tdƢ_ic=,b]uT7KUs(n_caಸ,]6ow,]}n=%p:%|5XUPGmM d\8&C&6Ѷ d7\ZƟ hdJW8nWhm D,]jnD~eS `ѥV<ruB=ȋ:NrvNܬ i0ؗ}}/ Xvҩt R/F_>7D\Jn>NFϠ{QC zFi2*FpdFh<}_M8: 6VkÀ AH j|IiҫWI*. (6iinHJmI"9.m{lVx usprP&Ԏ~IGq鹻UzM@.}J{ X4y8!Zoa&@p1[BGX,r]eZFR[$7Gzgw5ܴ`^j)GA৏C7F":*T[I+rd-?ڽwj&ڈ(NQ{O0*3SpӒWq/,EWd k`*nl$-$be2h R/B3y| p닆NZ"JttDH]u |:#3)7-8{LkY1mf tK=~@>Bۣz)ztčOv 7PsfpC5o{O>on.H3(BYЬۏΞ}i7&{\앞?Np.~**(N/e/56-؜?YWM"\+\A,::w@7i}9ݏ2VQ^;2/ds6 `CjV0X3Y vg}od->0ԺrQAq+f7}E 2.GBZ;7n"sa`} }2nj9,ol%=.?iQ܌)8+9)3ԧb QbҸ : N'eOa4GQQbKӁW}$؍?k ˃ͭ8ʟX}X9yٝ"zYkI{a |\9_#oXD2؎ZPT[r,َFE54&w");0t97Oh20ZГZk)l=-5kcHszM&zDy衘u'|4F}`)Fڬ$ )>O%8#TffKqxm5鿍*lP>^o>O_aů&Yo>{&:{뻺|1.$I=W۔@L(QtFk$zJdʘ$*cIm <0`2`?0mu8U.WgF@ 'C(*&50a$_߻掐j> SFD8F1T0@u ʼni?Y׸~@?H= ]^6|䚾Y۟_޾$d/KחԮ\zLRk2&ie8Ypk8-=|~o9jw[F^JQU+ |0ggʓhu1_Ǭ'yR}iE Eɹ{'B:6wvH:Tre/=}ğ~we ᔚGp8e'ӏuBºՇ߅3pĎ#;eJ܌ܤ@K>q)` ؂d@>AQ ]Q]쩲UbRUWi ZC^ |1*;[fʯ(rr^M\rt|.P&Dh0v&):L%ЊXg%޻iKYaQa1e(#c2 ׺Nﮡ߿x ƢM']EyₜҖh'' OUe7"񱑼<^BfTe^)> stream x]=n0 FwB70Mv Z%Cd hy)eHvRL6-q{v~*Yn|c8S9ӭ>D"PNd&? wĜ =zV֑{MI|ӣ`I^4pEyšDWX|DLkkT6S󒘖B׵ʔeCvEendstream endobj 580 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1458 >> stream xmS LSW[;+6΁:j|QkWںP*} п[n TDqQg挺ef Q8YnKi9(+[s$!H HjXoԕS(Cɱ dlbB- L1b1h=E$FMEMefȨ6gL~^iVd*V*wLbBݭX*UăjTVSU,)P T?W,[~MߨVU4uZCPjYi0jC?uanF5LZ~^Q!~o^z{4Dv-Vb!Mh%ȶ EQ>`` Rkp=KvKNZv@Hէl}TGE*YuߑeX,[N̓J_>畽72:&op{h5usM(W7 -`+8{,g`WHCUebtOcU6pA^ok cFOk( )Jƍ'm+!dKh@&pa GɯgzpiDD$#xټ9}(19y4RLFiocڿyƯ]ĉxF cm$*}ҰS,>iEi"mA$+pv~-퇏w56ztyVh@Sf.fw`9}6pB w@/^Pn+'$$JFE)5AhRy6WBi[DWRaX~pӈrwm9,jv{׹}P 4&\"5m/uk _`C~_~.oM;qfmq 3vYǴ <\nGc7MDN 2lscEB< 1RXް3~R1ķDix"و_R9ZRy44/e<'"ɔ&BO6')X2gE^X"DK e"@1SwH˱VZ@f=ZPA9 o Lh88F#$j,>o=OH,&5r}endstream endobj 581 0 obj << /Filter /FlateDecode /Length 336 >> stream x]n0<oH^K/`8 B}MU0>ΗKz]r|_c*9iaqװ9,_K*QƝ_5Uou<bZCLũ4RKTG1 ekc1;b˼* endstream endobj 582 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2790 >> stream xV TSW}!ZP^# N;-VG_@E@oC U"*ZeZjX[}x;/h]t֬Vֺ'w}>{ !V{FEG:Mq G8;7Ƅ+!BnMMNkMIŦtQaM*']n&0S210h$ NdP謐%xɚF hEA?dͩaUs ɨO 6Hp5QKXDd% 8*A+(>)^ߝFlc7Ys mУIz^8 Eh2;ƺa-*h =MP&N(lTcDP]%BqY yU VS*?9i)$Ϊ* tEoͤq ^ԪlEX,l=hEK#IjkKv6I:8u$Z\\6ьbOz?j=V2nU+Z?!fnܰT{rgy2,{x2U g(R WC5cyڮFG(FZ*LK i;}Ԑo {y4Sj0߼mj[x{!zgJU[PW^kVN,4ZZj:f&ԛa_;쏧 9%w樀10B\.@MEI yABb:8t>}JF%[7AD7sS78K P'U*+!,^ G3+u$ y 7NaQ_Vt.Mx~ 2p(kG1\S7YθtvNNTUrɃ4xJK(]9E 1gȤ eݱ} Q!ֈ['>ߊǾHхf={}%#w._+{FlR/;p.@oaW=4Bj|̃4̫pyBn(C8,npgPDz˧A-|`9Lwbed&&4)2]-z`Sm ;7r~hnv3 ݘ=iCYblmcVvirw1#ScC" |359 LJejM.k8 zByEz+ݏw5ϏҌKF[lXI҇dIj&"SD?#G\|6bCb PTd"ғ=_RQMT'l%w Gp=A)ͩ®]Gvfу!,N4bG~qz;SOOyw\ݗ-No'鷞,yDw~a'bG\;s*s/_v>[=(u1|ߙ ӊ"W3LL9 q}LMddLLddML}}MM=) 3NPL GhzH8~ϘKn e dr2l#khY#uB$^vHNNERh/*R0٬myQP$d14~ߪO<,k8QK#5)$9am1 -nu̷WxhXadvka6t \Ŭ~"P+G xgՉ=T$A`Bm+rlt8KGr #YngƔ/Lʹ{Kq+Qdq4_ƚzG 7Zsnpendstream endobj 583 0 obj << /Filter /FlateDecode /Length 282 >> stream x]n0 .O%M+9~) rRQ> stream x}U tSiKIf *#!iiIIڦ5M&7i~[ii Ʀ ?c:9l3eMByvͽ'~}y"iEMmuFSWhSvx3-Hڣr K$4:}z#5Wlhz/~i5miUϜ1cԩ9OSieM[VZcج^6vA,SFQmlT?][xJ=i#-MV`k[̺fq1i66iz٬֦ :͠kךCgnZuUkҙ6CNz"M&_߭kob4>Su‡(EMwӍs$),9*tCt2Q4O5R#tt6b(}$=H_-\[VI8T|䆒!ϤeeOгe_Kj%4⹋r Vg;9p5]X GB)x;MǚA (t9\W⪺*<׮hHۏb}ݶ_m>|QE%jR BGAh?Ta- `")y4 =$5ᅑ x$}xClOSfygBPxjWz#޻3}Ko/7\5FŨ=hZtw_$XpOL2=\f{-ëGZh9InRFm.eQ^G0+j$TWRT( d07z2K疡ll,>Ȩ>W}B>S_W!_b9vp{ܫpA.FgDDm`c=b} ! eo)dG9"h~ 'nʤ;d'pGG̀II^ULRhnw{S$^$ Ǖ36;`o랇_3 0K,CQh@Zuf~(8бU`sѨT;Wi8o8{+T̕o[ok,darݗ΅~yaњaFW華HУ`6 C摑Lv:$HQH#\j9°A?R a{IT~ Z*s00kǎwx!ep1s͢`*XmBaWB":w01<㍇<LLPvqqqDz9cA|iJ &# ($r+D_{%c g%hnΗeb{mЗaǢ,nZ|<+g9F66w$Y,~8~~tGTk?ai pAW`7,o|ϯ7ED%[Li&ʕ~mTEf6uvs ǁq& qӗ΅YDzwg2{3X(QJ͐C7mglOEWkK1''Mˠ١tpJ+;e,<=!"`aqN&/œ9JkƑ&ҝdѤmxnOߞqd``0cC3NwcL+!1$^<0i8j@d + *u. ^3NtIC} We:юYG'X &υ/u}tJ>G;?1WR[効2\@zoyGER>$ u/H[n%_B}lz9n#O{Uq]Uθ;ɇ!d''H)OjSL!el YR,_0HS~I_ϑٸj<Uq?2W"+& fKR DH8"dׄ oNendstream endobj 585 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2514 >> stream xVktSUis/Z% H॰軥iI}ombۥ0|C#kd|I_]?Y﷿ b<=Ѓ7lǯ2cRZ $&ΠйOI!fˀ1J<2<{g:Vp%b1Z2A9a.0 yHD(m@ah #*Aը uch h3u qz /X@#3Ձ~#S267dc)ȘM:%V]*$T:dS~7h#t1ɣ"uQ1XfHJS'}QեDn3n"4n{':!Mw_Mx/aG9L9HѻW1)Hz=i{IIŞ?Jǽ&{Nc6iNB0 Ќ6o پcgrO/}6`SA/,~f1H@DdAVdCU*Z5Gu5FԄQ :Z+U ?zG0UJ^^eXc}Vp;9w~״i#KγlWIOn*ؐۓZTapPPj+Ua̐^@LI3YC֙2( Uk~ƪ!w϶cK#Gm cI:Q2e hR˞Ny-, q*J Oۏ7>,\7껁g\ ! Z%ѓY&9K,AZ'9P 2E䟡.g0Cf!8y?f@#pvQxl̝ó{pkB'=frvIp99)PYmlX\MB|$g%vlrkAS عn_`RjhV:ʩ#Ҹ!ғmUmP43 pʺ*,kz@nL.ݧ\.nj9`{M9}ī=.Ctj*W6)TF%)**P^Tumny`;ڳbpO"zb /u}  `LV޳b@XH2}`毧UçO>طk:՝S싉2\2L8RLU}qϖ_B_w [J,'Mxćx)lo]y}? GX@m{Yq{۳^ioxJE{7y%k}Ǐ% kuswk8|P_l54C9'mePI۬kDc(evk#,YbػmC^n&xYdŸvz4 /æw }Ej;kӉi4uK`1ی>Nsx>~`Oo}|TfhRUO6fv7ϱC9BsZ5)] l4;Cd*3gB 9_DDN)g->A YLsvWCuztdO'`3[ָ'7`( @ڌgzWYiup5Eg2þBej &q{,mҊ"9G"j곫z|,BM.V9ϥK7(C2I^!v`'};ụKi;>2F@S N-'[A9TQTwbJ #׎Cq0YW3:nPF!$wLSHt^߷!zt<GUsTs9 dh8=k ;2Y~`,cxOPvVM[л/;sp,DIΑ-8\]Tw&oH݁#r]ϠjiL&} 5VcaY#sK+) b6p9^Yi] rf}.q`WBt~>61'ǟzXҁ !w@ SE'd MA44ZbQڬx{ >"<"1֮V %N~eH:x ux L?&MT=QAl322̝KvҴ :2M:Eb~wRnzűk<-VVIG!4F{F_KR<=QBDȧ 1"]s^N"2m%Q+Fk%G{0v%}nq5ҜrIUc ݫ3,{R)V6keooHendstream endobj 586 0 obj << /Filter /FlateDecode /Length 666 >> stream x]=n@^ DɀݸH$E Y.ř)fE`?>ୟ^_mX_6O׹zZVp8ͷϦs~.ӷϥC?魯Xisi>euZ^qV}9h?~ui8D6ujMA5Vo FSP57)z:5ub7u:7uf=4ڛYMA'x4| fqjk&kFjk jjk&kFjk&N: :p.N: :p.N:K94.SиDNCDk p!`A`\p!`A`\4!QPWhdp!`ЄDAQ@EMH%"$ IB)B~$$"$ IB)BOjF%4)QRФDIQB%EqFY& \ &p)`XWidő%o[EoZk[%o[EoZk[%o[EoZ\ Xp% NnүɥzM;\;krYpendstream endobj 587 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 8841 >> stream xz|%¬A i"MN0@ Ԅmn6{6[MｐДRB+x;7~xo;=9y}(k֮ ;4S7Ό}#q}~_-A0xah gpҰ?hӧϜ:'e4ջI\vsY=m4uaRr0ebX.a.>[\6m\a nrڴk[EmY$lm"GZ*-V=kMط]_w6zm 9ᭉN>yΩ^Ӽ_ Y9jyc]0nE5zCSzj5@6R(j"zLM<-j ZJMQ˨ivj9:NޠVQ3(7j&ECͦPsԛ:j.PR(j D ޢPoSC)WjrXʋzpjQ}( HD)5~+VRrP0rO[}=^miU3A//8Io%=J7{ыFnj;xlɸ*zŠ U~k>^3y)[L͘z5 +O ?Jzב6359rJIqe`DH> AJKHV@10K F)rhmRPK!UP"\S 5D[ĘtMd]xX~"/h#oJ* Y[bֺߨ/뼄NH`A0hO|E I؞ٵ\Z.b}q90냥ܾjmM[kA^VA|Z ε~zŹ9Wn️ "@"`jy2Qx/ô4Dp=+rXy0U28m6Yde>bE,ISYЧP { ab,Ϧ> |(GN,q4WŰ-|\'݄[pnutfy )>dS(uc$adW$xs3\UyTI*ae[E<҅Pm4ވAeQy)$϶8|kEXy3Z(65EШDj4˯|pbWu h} !TR u˶v/!v #-u .5zB\ŗ>tɏ`;l̰cz#QdX%h$ufȽy~ @ˬ.&'_yHf̻ͱs|/I-~c(ҚdD,5IGą&6]u4x۞_3rL1G@E*0e Ki&>48KwLONҪU@MBjٸG$UP~t^\fC FLσhF"Z4;_ 5D?$oDncqĊDjlZgbgF?ϋ؄R=q3@'޷f-OL!I_7$u8Z]ɰ~8H^<T~Xaͼy$6(}}ncAOl:xD{W$c5Ҕ.#Y#B#hMb 4B_ZӗɅE(fO(6#G ؘLGbzll7WS/zӊd_`''b}\֘9h$;>==rrSqr#B4%;񻢻?Κ|i5a"cm nՕ>o*qm$znf ;zr'}?`sڑtcٯ}ίɂ,|4&.'VltB nyY 5H&4vL˴Ndro`xS%sBdڽdf6c2J2r#I&1=P+i}\Fpo'ԈfZv+!n&34G`wÎ0#MFSrSCJ͟3؀݀v!-%h \ U$cƤk-,c1.C T݉IVcbDNb}AIuO|PͰ#N%lSpߞ66Ha<Ѭ.$T H`{&q +lQNӛ={P]Hj:{?NM ;9˙ܔHܪc"=ZxzeCHb'MDF|A 2` ~g*{썤)A d U>?] 'Ey9Rǰˡ6]$~')xԎDRDↃ=Cy`mcDVGC~쳨=TG7]tWT+{:ʠ$M}5tq'ohwh#GEZ䡕B53<$ڢjzck54IS5hLLq!\@L;:e96R*U<Ϯ&tŦO aV3OgجI]ҹnIh_жm> {h6zM&w͵0}U{3!7#I e' EUJ"c. OP{ 5ęrQ"0KНmā49u"Vfȥi;xF'O~ș$!*Ų*B9z& ȤRZqfN}bdI8e!Ą_䴌dXzAno@R<ɽn>ondŅGW'"_@6NsgtKA!뿙=Y@m]e5frظ_ m7 >L\VWǕjd)z}<_l]Jr646=Ft|: aU'6;_2mv-ziۻS'&?Z]]bstE"L'$M|P_F|+:[c5h8У|Y%JyA-'g. hhꂵ19ΩG:GQGĆ#\4G(ժ>>쾐_˰>%ř%A#u@X悂-!?{z"H Uێ^|[gѓwpzEԌO$'n$%SɰNe 3 8֙FCdBzh?@ +;UA2sm~`˹So0쓔%=zUbgq)^iũmsץ u˶`Ϲ9] 16Ѩ 2F#9댧fO~Ꞗ&o?ΰ*XM9wH\;%F|莈UP"6Bzݺ2SR+R5.iw. ϖvؿi=~"Co$OGeh%o|pwq݅k|$Yi5;ec9I6"lz[(n]XKNu[bS*VƗpϦW@3=ŗ؅AjN_Ft ]͑%Db❃z\YScSң5qi9J8|(4q"Sh/c*֗ D&qfʐ|$oS zmIn!P- c1 x`[,hc05`.ez@֚@+C ?(T6-#ɬ4jx쐂gW'Lx'MOHUI)P,Cf{_qƂ/۾mE|Oa$ ԽA{)X*4gd ^ ga~J/ο| ~>Z|t%eGGU!xS,A. |wPģ1|lӆ]; { ;˂ :m{6|֕@Xnm*@.sYYD{sr:)^HZT׮ f 31^Q)sx{RHI#= h-"RԡZ* Ԥ3s>άi (*1 SH> 4#4jAŒg{xEQ>VD쇃hq\NUW΅hc{:.=A_@CK h5*W'"B*4'wHt(<~tZ8^bc}$a)706֢ٜpdk&c3 Y U3ndˉLJ۪KzSi|%m%JN*B!U"Js4+Om6!R'Nkɍ]~:/+]I(Sa8u3{𭶋^ͼV͓QȋI)6eeeU?x`ݙ4S}6u޻fFz9C dz9ޜCRwhC N3:N\ Dz/2M٧upƒE O:n3Ct]׎6[w&Dw+Z/Y{ ^L.ڞBX!+XYѷ6ux/Kᗱ>= ԡi{fOVN857ɘmҗ"IsJ`= h-y8((Ju* ,4QFj,KO(pNLN g$%BYr K\L~cQMqEaSSQe/|vI=g\DmjRe[)>ɓ*0[(fU=|-ͮ.Aic;5q$?D4Zlԕ":A\Ӻ KmW,޸ħG'e4s_r CjقIqLFsX/-& } D2 M)rG+4XXh%턈<#sA4 QB3 jZ"Ϗ** ٧O"xԧKqblj9jQU2 rXO_UɋCrbKĄ;Go( c4q]F_JCTL]x2dT-$'JsgQ+Zܼ\Y/!)_*u'Ws{ Ew+6d.D@>H!| -g/1;y֗"K ur˂vZn[BOrk-n /'[ [F0텱Kܓ]'ݛ) ~{XwnXὄq l:fn3gpNmWx2Xsy-ךc^5*p9'!ޱ؛H:C1Ю|}VBfC]#(C#Da͕q=Ԩp`”uqEFɤ/r?  FX4 mcV*Vxa.̇<UyҚ}e)h 4ım{Vhdg!7!ސw ~ ->6}\S Yy2EΏx<Ԛ[1v!=R(G` 샓8oOɐm4EtNco!Z򵍒7"A9~u {#wGΎgO^8|5cXs >LnJ8;qǑ}HPM{T$&.<+s+h\qB6_B_ m`EO)8y).2t(HStp,TVO,% rJL)Goe1[;~ )kOi8q9|8;:<7l'\àbwTx 6+k ӼmUQX_*N9ȍC7[^V!%ʄD6QRUBl Z3)yTmAI*VUn_&a߲6\G~ɹḻ}lrWℴ]s0i+hbv&ݲ'̏kr >#׳OH#ЪwLr"Bqe^mKtDʾC7*f6_j 5'uV,޹W-/]5fk;kH,̉.ڧWGr}ON|W -#ɦEI<\h"NzBm.V1C\(אK[X2GؠL:Ᏹ`4endstream endobj 588 0 obj << /Filter /FlateDecode /Length 4129 >> stream x[KsN߰b^rnɦd׫`Q$e+>EVR>X{yWg3fW^}떔zq3We!م*/2G3͵4ӥκ~ !w:0c f 0SecL*"̊ޠty=|98?i8Jpss:SRNC"GЯA6,E$ $rLV UJsfTYDP; :#Nč(eNXur*sZ"w{׬?oc=y{oTGlfl v1t+~`ԾͶia(v=v`1Ufn:H &ǙY+E[f{S)L܀#R۽ly@i$%{cLTk[?v]vmS] 9fo{]i8̺dBuFX>;->zj>@W6>jk! 1pLƲO.E/I;SU 'zqvdR82Va:I.trRuēUZGB` 6X#0إ^q6 аA}u')H9$qݮV`lշ Fũ9do^ݺE|J9ˆvU1\St] @"4٤Hb˶I+ȍUATaǪ1 0/2 ߣҒhUf3-)!,,̧RzًnKпpG+!i$6 e/HWQ( *s^Dsu (S2Ck)¤fThݦuVxk6y}}}4GE4Q&1v9>XpUe"Bi| 8[f#Q# qnV%e:Ub6na$m@ xǦޯ$mΧaҟ88)|G ܁A;i(,wdZ2*w JT߇TXΤ nJ?B~4ㄡ PKƍȹ.{A; త%MjaGP`6 !m3Z4k:ODI`gn$hm֤P1}Dܭ,JКӕ dc9$d88=>wft3p, e ~oHZ[:| V(mI|%]3x8:'<>;eoDvQ B@޺݆`u"U<>#o#cSrٌHpVXj$"ɹ;t^T!tωI'3L,.W`wv6.YIREqTu?ب_=ڤ=<>qgpƷl"찼YSIgiĵ"Up..cK %,((iFeoߔ1ߌ*s-ulRJ"y.$ ~4(KX*>%Cv&X ޔ:VJI԰/mbH㡯SDD6v(0'T'n*6eV ^"k a WEJX曄f!X_K{w:z=DE!Wi'Q+9Acj1)U :L$ wJK)+IR`*Es1A S:"q9˨=g3.Yc]mR]2*gi潢k>vQ k`>4Qj,A)mZ߶4]#x!w$j'N(bm Hl\v/GݮO,ȦyVq%nU/Ӱ6&}`ґcv++ދ00oe9fh}F^*Q,Eڎ(R# P%BW~63zgFa\uΟ/YАA3jWcrfz>{b!&!8 LSS%M'Q[{ ]*g2) k>aናe UpgK7HK\7'^~a`M_C? gz#9-Q3"JM_hea#z޸̩P?b!i3>}W,q_>dWR8{iId_ڈh}󥏐!7|M>&uwnĠc҇SOl_m'mkg  zt쫏{ 0aɧ+qVd@e 7~ ShWo<*rE-㈉ VG%Hш_>r3;eUchLrݿwϘ۸Ed+ d>+ Aل ]jqۍcPgfLej;.+0xiQkc3ʆrIP6gG+yZICÉ{EqXD_іZ{ttm CSmJVCx;nn)\u,)OZ^utX.ցf/M)'"t4z{'܎$9o)G*$,Si-xgƢ. u c%1wW[lg&":>GGh mdA8?El|>%=-Vít+,+ HR4 ϓtgazܦcCQ 51[*㐒vWR5ԫTHKQD#G\2ԋN]\%Ʈt t:Og۲endstream endobj 589 0 obj << /Filter /FlateDecode /Length 162 >> stream x]O10 XЪj8(NߗNN>ˮGֱ4%"@cQ`}*Bv7ޟ@n]O$u*j 745$V?i vw@Pr48n.1Ҵ4CN .hS.endstream endobj 590 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 483 >> stream xcd`ab`ddd v541U~H3a!3#k7s7ˤ9B``fdnls/,L(Q105H : F Eɉy %%@NBp~rfjI%XMFII~yy^bn^~Q̒ ԢT; kiNjc1' ,?:~uz{{ຏ똿/~Nt=w5SLT׽Ys'NjOuxuȳ~;7ws>VY]Y5{ -:#Z+*gwϕ lҜ{俇~_,|C߁ݻ[do.[+7BwZkN>ؚhNo#2ωN۽{ Ǐ^˚r|gc.3`r%E'LսwV Yphqd`]31endstream endobj 591 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 5365 >> stream xY xSe>!4F&8ê [)PvtIHMw4kTJV#;*u8ӹsA3IzR邢bVZƂU@.շQ;ؑQh8^fsd_xJb\Yhabx[|J}jg_f* Z܉DE <嚲ʺ XXfǸ!.rKZ[ Z'K@{!wȗFʐ}1Pwׁ|Sop/I[,53iS>P[B ltg2ޯGhn/*IV_yП 40JGWQx8u972i΄lPT?PwB$)xKI{r8C䪓IC\C}Hj;{AT7{G6Xn6S΁[Nm)}%\>dKqJ~[u{t@e~ d+ғ)5FG)6mMH,Ѿ+GSlTjRn2Y~;9~ɪ|wnY$PNjʙQ4v#7CՀ 6eM٦X,Ɗ\ZFa~YoV!d|$l0J=k63TO!~ϛd)$ҫ9jٶoدSi#v@#鲕ư!-rD:9KaaOiڈj ;'NyQ4…NE4qX!C.%%)X pGggn#*IuZJ5/_ P9r*| L0`6SX/TKum27nwj^Jōƅ-^]А<$n`TYM6n( ii6?FAQ[WRZBq9n]jj ow>.%+{Xp q ҩ4HF'AJH56:nh_dӗl| qrՁ:~ =[z +pXHܥ6DR/$ijH`ZpȱF7 @:Z׌ܢI= p Hz[w%>q2Nl_jtMB4q (nSs nmn(fP!5Mmh t[(~ >͎s@~qa)<r˳[/*?zR'>g# |1r%klAHO  WԊU"etD0)lqٯ 9Z2BT/,_MۂX ZTUUdĎlyn;FKφS\cD`㬂 3(hFrS;s\j۵?TB+ؗ0wb8V vC~! ;D*8M~l>L4x֛Fd{?ȋN`v^jl]0EFq. SL}mi(j+=ӴFO$oIpb{7{ Azņ&Y+buSJߨEa9zn (p68.FC/鷕(Qht1WѕGʿ{f¢ʣ)4ǵJQ黸.j+wr9<.Mm>ZcdŲtqdOAUzW?063|ևTB۹Xkk)\&o_% 5S&\;yq%ك☁݀K`N.`j =2Gɬ*;֑_'xkQwnKb!.,vJYa6rqfI'GCaT麘Δ8?߳A6 x}gZّ!P-;,X?% #l0L9~{Bs.~OJ>A[i+P`YcM_r :` "00l-}z>30&+Vq+`$F0^'u MAclFj N4 2b N,wШ9ًk4QFmR(_n)8}CA_#vS_ W]T69{9^_{Wa)YB^j;ذ-ZD6@[U,>x|rѡچ #("<ƒAj1&3BncX:7񓀌~gkWNS(M !Očk^U+1v΂~y`p|ˎW>\kękϏq􈑭U*otB:ߔEOBz ‡g%N`Q,7FBɧ,^`.KI-3^ݦ|A6= P0(> 6B =&NTS(B dX*{؅na#y14R> stream xn#@ >*NCnMk-}-]Y^?s9qb !J5\/{y{ҌOޝz;J\ގ>;߅V&듸G4aA9ǧJId/ or n|*qj|jgSZ ./y ;%4:DoEᚶ(ވt5okRl2V/Ljx9{,Lg3@ًvc,Wƕ W.pgfgoNNSeߞ 8 8L gHُdf 1Z`aJˬaQ^x|X㢆|6zzT7A0U' 6!eCplٮd:? ɊWrouBh110%5=$D<,?-oo#VBE\+e}8ߍa+|P 1xkǨBqpr,>g#+]VmUPnY #',X:zHqq9M%[R"l(ZߧoVͺ@"PԏhZ1nccIוlC>fҡ:&Q#*PY yA %l w "qA_Bғkg2-xf8WI̴Zw&7؆&yݺ=RZ+[%:5H +Řf|ǧIFڹXfJͲ >)jyذ`92[>̧ ܬD3VQ:;6u`ul2Ǐlr }WJG Xٷ28KDhNC$Maoao+4:nM|\sޕړEff g:NFTTw\d,&z$gjl ˋP9b6\ړ rt>i'Փ #ʧZH.MbX1qw:mUam|(l @ӠҎ^:ť3Ioz!ӱ޵D",cAbfYl&IZ٧=g0\x6/:naSK2#d6ZT%~CƗ}H? wrN$Gjdd.:1ׇmilת\\Q:>ʂQ/a *+:.(jGFg-"G:Z;K丯ۃi "k5 G]:*\CK,7H5@f UQᴔS eMfnbul#Se׻ly^˴J-Zhfۧ 6# "oLRl2o9 \t{9Ltw2hJV ,~mΚ2Espz۠)`J 5mmMQl@Y]FN03BLi؝ ߙ`5cN b*FC]&!! Ԭ!B{;1ُ j(Ϋ7}tm=@m5p lLF"|dəbl'*dc;!l>KzG>U`UݝP ))3j_7OJUJ1x2}PX] Pp,mmC/Ǘ:>ɸ]sElcO^- ev3hMu@LL%;zsW2/`n(D=Ŭb4M2^p5w*oZy2>< 0+䫃ou&EyX`ҡn55w~sUV$@kb=-WS򋲁}pd}ﮍ̢ۄAH_DTZݬmmv4y Ǎh̎R9L4Wfl[dEZ5mc@)48@yD YQ\ZD2Bip!d,-nާUes ܔʍ V:Vgx0[ 㐧ŪҒ˔B.(;iD$1blаVG}p`{gY~Bm)E&2눥! ɿ"!|\ h@84T&κpԊEYjЋhN'(?p^wW˕_+C eaa(Ct)18g׹ܝ/.ٹ3&bWUr \׺[1x:vTnál1y^CQB,ۗņ5U#y/PJ:^P3|V:;iLuyQ|cl7,sˎ6P#F07: G#t qaֲJU\LNjTllO1vF[un|l,Gn7] -GI}z5qnHmy 2)ۺ&GW WenQ*@pձsl֊spt"9rEAVteV}=f 0 6'b!Y_xVPhN"5xqS`0o:4&7˺ѸEYgV9NEɶ d;i=`RT#F CzM՗yDP.ts.G#sZk4rX%{:qjfCU'4C;ߕ!eݍ6y4i鬱)vӼE _ò ѽ{Do#PHߝ|jNiY3 xҔ r2-LtjQoc$>y]$O:NGBVCw]榝A˷]q$'OIV*6F7,CLs1>_m1ϩdEOm-lsr;^Zm/9dGʢ [nmwD&A-Q<|ܰu8 *n]p ƻ?E0Ȧ)O $*F$iZ<o:c%.]yqɐ@%6`+Iu菫 Z;+YMoY=CaM:& 2Ap$8whdlȇ+OI2M(n'ōKMHvC 8k}Cpё'L~ Ju]W߹t !;t(_hv4`^zTojW/7zqc3)C[ЃEncGz,5"W_z+=xz8^j,7&L z_)+#HC[ SulL7jRmﴸaG[^*lUMǟ )7vJ*M"paoZdbZJ O>AIZeozk|%o@v17> stream xYr}7M"f&ʎ})WJJ Za$(Yo~ sf@RJ*}Xj.=}9szygt?j;ɧ&'ԎNW0v),*2t\?dd,3Y+r?[0\ -p\jkfƐjϔ];$,f, 粉&>-?1<S H+}Um3$ α6"҆;:Q" G ^qUe@3A4w!6w >:Ya=4$r`Ix)FSnbA&7B0Kԭ52Q槰 2#ȿ* F4A >9hy%*pK#W%|^%.;fߙǙj5:J"SLmWl! MVO e6\OH5<1 QwA$~G.'eȃX b1vΈ]:;] uV01]7myw,/1# yp r.0n(b(gH8&qN@\EN0)r'rq-@%˶1p;M4.QPt(^UM,3>:=.kpė*L? Q~ 7#hv{AMr5iT*P7!`=CXH_x:5o$]')UȌ)_޽gwʸ|<"Y %^~͎ 6.zăK ^5^aVW w8*7@8վ;hՓK F%[SL''L&WN܂ZvcÇ]:M_mϽ8- /?YKY?tפ!37AjEa杵pwY0@yg,7tx\kǟqmp8у\jUi)Bă-=<^AxLB3}rSɄ_N~'|9=t?jo=R3 ׌LsObyo"W=6-<&8fhZͫyzJwYJcgi6?+?^5 _D_h":CS(RE0J+L|n{ mRzz36g##wm ґr t ZަEw5hܾ?5ZvKqWzfvݥ<( -`H߳ޒCkfJ². m6)DHrKP4{2|miƤjM˳ .`l)k^{K 2㤨lflOܞžՅmylzb9<+,M|y(|~J"m'GR`eJ GoPim -i>F׌ߔa)ᶘ7zːcNB$eLiمh$W&HHY%m $Ύ'K*yϐїOǷKg]j 9;"_v|"bˁ7^}` |?"Zۖ}W/?&/endstream endobj 594 0 obj << /Filter /FlateDecode /Length 2370 >> stream xYo#ߐ/G{K A +=%ZVJs.)%Iq83f44?UO NU=b~Lntq7q{贠S-uf. alԂ&0z$u~1UhC~댩oY.!ef?Z9vzQIj,5Y|kyS#]_ޜ7n^j &si[P5塭>9I} h4}YoF1Xv ow6GkH7O@EA.UtaAE43EkPɛ/N0\~41t~o=W:0OL&Pw{cv3>UV}())3P`E49 @^GN5 0PX󞑿gd#/i%yWÉs@=)Xa튌g'~Wv63FXpJoV%z:xv4w~@kaHgbj[;/~DQ?eEDz2Ixl4Zlfm$*c4IPt[I04%O^ BP1SikWy/,RGtڳ0p!]пmF 3 ʇSW'Z./x|/W4GgS -W 9yn9آ# ȓ0#w#II22.mǼ*ۘC6 y;$[U.YK%!Y;!6R(c읍;57"1}$jS7u |q*lK=};RRPW8'&+ȴM D~f\ET[M誄ޕ|[J_%"ؠ'#> stream xXKF7 啸'Ivc10%q,&5!);Ù$VUuUuW_yy,:zun۝߭g@ "-|};3:ty&r>(-h$ B1XgT,hYAӧSId8-a&M R֍YK}O]kL xX-VJ9ZI*4ndNs zx;y)C:f)T2JfF$\£YqS:_qJ+Cu*zW.Vǎ~( MDCYp9x>ݝjV_-})kщeUE28 \$/ڊt6>TKV%/b3z7tA}m(T+G[o/}}n:+!8)UTALءtSVT9Yw'%0ҩ{A9qcުQdqsJEBy1b#I6597vNCmTY+GTFȨsFX66?0nX2n iu{iv Ae)zk&ٖQ2#[m`Ůl2Y$"ϋ| 1!Qݙ]Mut,<( y^zfx]pzn7ayۜ(X zy3%jZUt*gf7/hR`zƴ!'ab]5S(=95 Ű͋o=x^u<4D7/l\_۪PocۗiH+ҡ ~2(4cqބ%ѴbRo&Um ?wƘ |) ഇ)<.1[l7x2)Ҹ7!K§:u g3 ٙBjwW fx7E_l4+C48~(",툨E/9 xعu0YA A=FpԼ߿C 9ov CSgRp|4_/0%64 04g,YLN74h\w»HGs M*SPg\lDj`rp> SƘ<*}~> k10=~3ڜ(NM*`D?D-LK6 ܁1ĴC|3ph?wlk ?oRP6h60%L5Fq:>54ZQ :LC!뀔DT8ǿ\!& qyءV^9g$q7?~yKq ͇+}X80 |~"Д"ЮP)59ҟve9!Kկvttک'] eFclv{/vpdU`ml_V&@[>Dw1)L7Ѯqo- OF? _alJendstream endobj 596 0 obj << /Filter /FlateDecode /Length 2487 >> stream xYےܶ}oԾ2ĕ+Il)'VʖJwf+k;?n\HYiDF/1yF9|}Qu[,gyCO /37Ω`ͼEf/ee0vg _\3Ԋl\j2B3cHGʮyuiIY."/;z9xEUq4hN K,L^8\cpZDf+ӐoL 㦬SSy:,W6eߴ/ܮn^1 `"ͯ顮!T|v~}cV$V}mɴ~áq @ An%xGjN_ 0~ď-n9y樃OP92p!3Q))C[i.%WgbMy[o8¾a϶ˤLM]6YϾ[h1 *s^4lqQgq{p>8B)>3q"cU*E圀 J`!T1VQv&ԅwaqSFt@#dBaԀvM.uTs6` Iڌ{mB|Jy X1`~Zt&upT8[skE {iJ,],þ#9GG<#x;ſWAHpvРA뀽GZC!ۙ3E&%T' \ P /*Hm7jA:8UќBrvX!{,ߣC,ɿKhpn%U2XD N 6p沌JqE_GOusƛ"B3*LS2"jᣮ F8n.l@N>>\t"Gp(y鞟I6N^~-*el]R]=M;~O KehƐX rT*iG{[T.d$#l deFKEiaqa_`CV<뵗/oUqClË{qj{T3$-RUP/utZԷ Ҧ-hu5sWa}b LjMS;/nqS=y (P۔ ҆8n/l [ %{/f90% pjYdVۑ\Z~۾o1iKpoVX&w$FK ]~kOo]k\оxq_yُ&:wbp5,۶~ɪ>C. vEMভ:oZf딦 ϑ]" +l嗬txtRuPn!-ȬaluyZbr $S~S?%{M>$a{/ZUړ%FVZL)l,Dui. s(D}dg(&hhߤ ;<Ag@ ; {x`*KoTSt̆endstream endobj 597 0 obj << /Filter /FlateDecode /Length 2836 >> stream xZ[o~ż-UDLѢIZEAUMg86"@<s>rsԼj_{u?k3V}bxTݬ+D_Ymk/uuq?d/BJQ{/yS7ZZx~4v3_s/u𞭮7Y\ivQ!n\'/nY7<^;ZRJ[g椣YUDu2zƱ_:aٟl M_M.'_\ϘcA xvиK -oo?lwbu]o?՛'O@dMZF#lվ*6lE0pHh@`˄RBjA@m;1V%׹1φ4_Ө^'7E@}DA4a"h],[53[&Кmu {;U4PvE.ue-dL&Nђ]r뫢bnqӯ 4fS>Doۺ/7U5]P& `UmQuӄjsĬo7ooWwF2R)bQhLX2* hClzUxRAX.݇(j6 \$c>L&NGm3˶k*k61\RŋM1ˁӕ9wm? ֛"Ū7GS{*f=cvC}ka\l \zuGEu(a&G-[jS~>!(΄pL%(kxt1nC  {GAiyS9% q&x 8,k/uYbyKT !ptN"G<ۨ; B}1qT$>XT 3yX^;C xn=A JTB9.52:B|rTd` kc6E_M"NxM_EMa%eǖ %wZ xZ­P jZ(E.}C $=jNPr#MK`D9Ugբ}bhX /-ʉ?L`Ey}{ %NA9%`PeUQĈrR)?T@0Z =ǫ=QzOCp TԠy'z7@Vyp)Yx"kZɠȵtf+ō#aֆUQ{KGZ5߄#}_P!:l0QD}wbHW$:@өQͨ>f̏GXXj6 !xc0lH/U a=in)0 'Om /~nhJ^vƾOأILD2O=(:GE>[}6r`čd][1ދa0 #A>LНx,\\ɒR$1m>ܩ)$ǰuu)#6gT.yDJ}OTqrUzt!>ߡb@biݸ]gՎ{bEYRk\;+"IPġdwF'0ye;@v#' qƝup/{̜J~լxpi:pqmknʝY_ؓȏ9(L-t5_#H~`3eiZ} R,(W>(ccDEq.#Q-|8{?n22IɌEy\6X̨4e'PVu2h_mO1Au>ҡp"،qn͸> stream x\Kq}Yi퓫-vZEp :$y3Cg&PaQ( D}X =[ ?}slX\=ѷg5 |ջŻglaPg\^|%+aqqUw޽_rmӧ\>vo;\wA ׭7w_;=GѢfߧWo+IK۽X2cZ)ˬm~+!\wq\)5;Uך*iX?8g}%6+nUoXIK8mXgZϭbbIj66eYSs-\Ɂ jMTqVkuz&u7ئP3[ιij5gXLkrńEnXvT4g]Ws9-?aԜ' ?kz`2^%%|A~+n,gqU7?Xz|\?m)lG81LwL14W]ۙ˴̇D4 [`ff} k bgI1L /$"B?$1rb䃘 oOs)U"+R: F_s꘰f F V׻U xМ-6'|U1J!e/UrV\+> l[]wv\72wk0`/]tw塀-hY}//C31mCC+05"7͏aL`r` OdB9ӭxų?=ލm_qς:euIa' a uY/`USSY#5;r? +]Cn ww+>7%ET=2Yر~;ŠV8!tkx RpsDvPsv2^X<ЭiG_0u/ar/@~v*=p1HOv{N6n7AxN) PD[)]!abŪo#0ph[7!f +@g@6oݭAQ1z lwPv{8Wyٰ?6m |5c^`pO𒟱Nŋ- g,cjg?{Cހ48CiA~ lR zR`\K8BClIhiōF' OK܍64؝s~AqY}?nO_ʽB_ l9CEQf{ K~]}8Fۆ X8P6 R';v|`u$\'2ή+Xc ?K]ZR Bk*P[ۑHdِz1ZС=BoQn4amS7(a[ A)"Vw~i;N 2<,#f)f29ĿEoKoNe_8 \"N\(r!}r!]Bٯ*ݦP4ζqt<5TN}KAV?ލݭF{ R(R| `֐*-RI4@@Ms!c %荫%X@eXQaahM2 5 ,3D ݣyW!%,>IqCfu<55g혦am r0 Ab3v6y|65( U3ӂSnuquN$miv̜T qQ-iM ;!ʷ*M0piufM8^x$o-h4-#Y詧hoDzXoy{_HCվ5uX,+DZO)+ "777a`aè3{ݍKG"As"HbR€'09CQqOf_"nL͈_-۔pʁ3QO,_L&2L4oXiS6ih p pŚQEøPϑsLLenh{jb =ȥ0GQ `?Ns)X~a$5 e7x9/w?ƹi@ (#!3tpaZm7~:kXڜJ02 AhWkNc1~\ufsX&mpL,C}0>B2L".K&^yn~u^'hEԏ]2hr_ q8xWZW&*HN*'q>|3fzRd:+Z%Hu; br8M2 U"X'GWN]`b;ĺԞqN>5LJX\QU$Cҽi')y N"y,Ȃ0dTqn=;f#"/^+ޝޢP\S;,"o9Z(\w`m+'*!KcU|˦rIř l{lb!4>iIç"HGD6ѷAg'I c9yv'2F3dλQޡKe\]LqZ4u1MGPvi1ij5`sLYs PDIߗš)w~:./ďm0h!ckUUČ (\i^;k,,2cShF7(JqNy.ηa1i_s?1Ya:; 8޽ }ջgWv{ SAvc`(E1fd)ҍ)Q2H<^6!s/C5~np<@{K8'-Y*TЭD4p`A5@6X5I<Êpz 1 q06񾡤T*$=V>gnĨqVP>T(MIWU"L[6A* WV{DkVyӏ܌$sSh-P'cP+QwdkH &}fou}6쪨]pJAЗ4F׽[a$$ Wq4,=8ػ-&<`(SwpNgC|T%j]7l:ǢDimC'Ogb ]A9գ*R  ՙL/F0)>lc܁J,_qJB8dO6 *haLY ߆_  g5 u5nlDs*cQɝ\ZYŇم۵j}$(yh9)MI}>7)k=8M>p9-3 fGtƗc,s ܳGk.%ݾzB,sT`Q|h:[]!őXL]m= -#6G4`Mzl uk|@lȗ'QUA6seQjC/W}/ʏ 4t=h#fQSOAGjL&v4l&_x[d"rqNያϞ3=;cZm[ yf-bǿ*JUs6qWYj4޶ن-G(ǻG5i=3zWإn*; i=I`uq.+mʡb5|[eQx1v:΀1~+m䈀~Ϣ h8FtER HwL+D, IB_cM!NBiYG Xns8AzWb.HyqO%qGU>,81z v}qҹ(k|Z<ehjEZ-ezO?oƆNWs62NRD frU8H6\s+ ́`¦`h*4V$x|7Gz|m!v.fNϹ|mf`beTNid ўh 2}d$'BgJ-Ict9~~y?蔞f w􊙫XT:| λvF3 Lb=,Rey j!X _x~YimSu\O|r~coW &*f' ˏ4{ִs)It%K݌#+)~5{&ٴk;j/2G0+|:r" =Pxr3g_y"{4;p%C|[W.|эNLxVq `]z:;*w4IyWsgVׅ_endstream endobj 599 0 obj << /Filter /FlateDecode /Length 191 >> stream x]P0+,ҋ^8h}lI]dڙNKwy~̭&4.Q#W;ʊMAV\n2?y2]]X> stream xmoLuBnajƼfzw/6L`{e1φLRjK m--2{=zkaZƺsC̀,f|cT4k9S$ڮ"$"f!1!JCN9_$RynE,,Io^עtEp R\V*Z`EELq>^|&]ӆd,y9cL׋@ !7;Y h W\T]S.JhK*Yٝ \vPWZ*Tr6IAT6*U'Y9^k6nQ\*{|CtyaoFFϑbh?(2VGDd8J-ηUfX79Odakŷ+Wo߾YýA' qqa%f5|}`SfHO`^vUtc0bM&cYJ}D,0M2q5?W]Ei;}Z ' D2qjMHHEɭGnq9֫7e*'2ӨP-)jݩSNp .pS^a|endstream endobj 601 0 obj << /Filter /FlateDecode /Length 2195 >> stream xY[o~omsI Ilޠd[ܕD/Eɡ)ݠE[Cr.990%N L>L;?D+l$SCZjl.dfwnd"1dXMѶ,2ڢ͘hqjzF0\SbQQsx1c9aOlLl.PUoE_YP O h-=ya'"݉yJPJ ۏ\t sփ<(b+Q Wؒղ]j9i'3fߝ/4ҟj I ҡ8TKĚd.ԘU, +:E8W['=X> stream xWn7}7Aju.дECSE!Z{i^A?.KrX gΌ9eaOo&wSk}XL>{Ťen۰)N UP+tq,KeBpj-'?r+QܒfGEv܊\q:pkIOʮ{,ȂhI\::q&,AH!H/z>*Nn#a51ՀcM]: yCd ic?#^/ńEpQX*-};[qd* fBQS]k$ȘfLP%-%9Yrch9etdlI~+ f"eU*T٣(JsPPBskA=2L/95@NG"j(&CpTO״,ƈUsߟjk;#Іms;oj_u.Lڻѵ^9ZC!Xڸ-޺.z(0\H(`l} .>h/ ,$xDd1|hQ J>ZGZBr8\%$JB%PU L# PrPadra AYj ̲ǥF^ #SA+P6-AE.WXYrpS+a{jq 싴9,OgPaZpdnadp蝬|ɗ#M2i>fl:'7 le~i:_AY+m$\j $t>x:)yCnEp{LnIFXs%6Z- S!t Q!]Cu0PvmǸ&/_N+9l9 Kqub$.{..{ oNT86޿( )!r)4,aM=k\l$ )}yVµ ~PRÆ硥67B! ints0vϏ MPKz1~!endstream endobj 603 0 obj << /Filter /FlateDecode /Length 2443 >> stream xYKs/$O`jM•Jd쬪r@KRק (ۓl@eNs6v3:2c[Z~>6_Ϝ l^"7B͗a4[%KFó$ UTY O׹G3dќ*Q0jHU:"^GvyeݔUl?i*,uRj$ʎR%+uIMv7!e 20@攽G$RR%,XN7& Ω,h$/KA1[(.aAj%?7ao,,YМsfݐ5P+/z%G[/2Ӱϛ3|!7?ɯʅEQI>68*ȋz1[2k%K}ׄ+9tMU5vTeQ2襺 XFkr4/~F,m؃W[KSv{֫%du=b/"(tϫ-$$'߁'wv / -Bq]6`λeM9n;f%2gװic>>a>E}9۪/N{%}B8r/{/ w^Bs((uЮ;1CïagUяN{xxrJl{ӹ}XHXڰ4SHГ4m0[kT"b)>H, b,Yx 3Ȁ8F^סDVq0u>ʥ^"?+|6e3A.<]UR70x3 (ΑYLp؞~!ZBғi%9e|1<?`3.KPݚa']`*pծIr8ۻ 9,<ދf{> fi1 XPM\]}&fkِoraA|G+$Pd)޽ -RMq M:_Aca6N2{DF߫T)@٨" %C `<6K9b/ ,m}LMD10Ǿn `dd2q: ƿ36\k^L/AXq[O4Y:5.Ki݉%9]'KAW.X1 e:inZ&f9zW7UT($(iCCZJ ,ɡb%|(!I0{#x73K0(>ުYbjrH]$@ꠏ!S:ud5/CI@K*NO)zo`E Xs``M7M`8ƌ!`bٜ3hcȍCe#6 65Z?58YoT%3ۊ}fb%n2V&(r^ȡ{Bx\`#Ё@HVlCkWљ\>R X= #^Njb԰6tJ[H!Sm;+y8Oͼ׹=&5)mKeu&`m[+TPP [@F`8滱DKo]ƺO)5튭rQ.ڴ>^:e"ve}toBYCZIn{jUQ~çg l3R8!gwCp+

o0ed9ak-iٰw`*Rv)R&%Eba[xnߔ0~Ñ^Nzw.^6h]膨kT H6p?\PA9VQOa9:jAS4]'y6/},8]`=endstream endobj 604 0 obj << /Filter /FlateDecode /Length 3588 >> stream xZَ$}7tވ̬6ȖABẗ˹KLv0w1th? \o~ TM7]cMrSq~|9~4?]mwSnL&lM__m_,i<\mWoboP\~dt|*qֻ!a2&=?{q4*qw{XэV݋v?ܬ5.=4x^hpN7ګo7|*oL8PTR-)>/Ǎr o?o7fJ cYvx䆘LFpB@jU$)&"u*A3)yrHj&R 0X3`),$g< * 5L^*vNnYW*H6\/;9KT¬T+IL+Dmy+(''L/=BYWƂZa2^|Z*2Ű'h1S`׵`s8\Htkp wVw%P1թIMMX?"2_G, O5g!vyy 3F[ ųė x|z2pdһ6Y=NY e K\ko"[*X]!D lK%O9)}'i#)7sL]tIreYIK۸1?lÉa/xQRS?Y#l4S-hTa,)wRJAy@HH٤H1L@ʤ nT#rg˶͌ x"gUX+HF4SWD_U("d@;},KV7κqvr8D%>%uG Z523i 8U ")Ɂdv/*3PZ@VR`0O Hapy8! Q ZM yN2Sz6q9<]7H͂'з%N 9_PA/脝5tggVB>xfӮʹV/"GE`Zzk-WȨ%ʖ%2Fjͷ DK"aTXP"QC@DJW! V^ ө0##ٖ0(pH+ZD}Q$/g#׸/g-ܥ-42ٵAsZfК1lvL\;/VfquM"B$5ڔrxdNL 3Iy^2./_L9ЏKxf(]=P5$J\ę"p )[СYYV?c.4]"Ea`4[ vo J(bɭIacnf5rkVFt* RF׬5bܐh}}b5%zBuؖ(}\ʄN6 ykkQؘ( ^C W:,򘒔m'2tfآA(O h$v"HYTHVy+K#"- zqHl] s_ 43%IAVU1R%Xy[l@˩qn5[S.2Le}@~x'-W9^L @fP )u+Pwb r\3{ rJh0<7gV"oxD)V9 c(%$^w6.r5Y=Z]XV0xJu]vI{@%macGDbZf 'ͽ9hnChK/YӜ5*a[i hz6}c\|Ǵ2I=Kc\<Hi@.jhfGV,vhw8'4/DZUf8BuJɬ\dNrH3%3HlM t9È%vL s1c/Pp"3X;aE zhᅔ-W4#&S>mM赊\iv`1d^ﯸ E%0rWv/ ܰ^P3R68;5S/cS Q7iPgS}x%uK" IC{: M39'Q9'-8Ck߱o!虶7g^nPX8e AFp ktm#C9cXaD U $_:7\IdlG3HJe㏽&,ڳ> :'-U-<>;\“b)Gy3uqҠ}?)'re M%9ulBPo$.U;ե#L(ߒl ^F9$~~cE1vx()#/nۄxp~3{^y~Ez,h*L㛛wEqOs׿s+=$591xwthS˫m@NŎ_\~1qo-$~U}%?ѱJG)I75\.qxݝOΏG:03ot+@eU.4r|7gZOj-ͿX{m[<ڝTJgTkč`]d1~oOdׇ^su(Kܲ$^,nm6*gkϯo_髫6 (v^Tz ֍ϛN xޟO~LjX`^ppӷZ;BEoǷw t~=/٪rrL}>鴃^Olt#M|j%'b O΋nPuj0p:7Hv+;n&>>ROOǗݞv_'< Vo)[lu8||<={Yݼnq{%v~O] 8"lbjsa|x}<^,_O7yU J~*E,΂_·[> stream xI4[%4_q.o"!$$)1@ JEQ4h}lf(@T*ٱf[J_o?~_ײ[ ?SNs>鏿9c/ОO}h>̾kW響s7WUF?GcR_OO_yY|>ޟ_an_\0~K0qu{>9r~ 殿j0_ǀg hp;yCm[Ok=7?gN/~^/Ϫ7?Y'g3F&Ϝg"y5Ou!k'zF5HRgN~ny@!g9@o{|]5'L\3{"~K7҅D*>5R#1\s|;woM?~22N" H1mz ۩sm"K_q}܃t!GO]c|O/dzk6@=$o) w4;Y ;[O5 u5+,/iAn7Ҁx=6HmD.cw.Lc6Wո|U8DsAp{xYsia )f:q?76Az"}Ԋ7 DC iW drXX@t!iҽFD\hU=4>-r<yf|t8M^!x'N ?y`0sk}Vgay9/A5:vy`fƉ m,ѱL!ŃD" > z~6҄\![0g7<^ҍqҚ蚡Aݞϖє]|#Mx&(BZF y7Hȡ|LY1?Az kl{Ƹk#zCX]=HX+k|܉r]o"ovj>|W{n\v8"Y %]E97&D|h„Ԉh2jG̳>~!| +=U}{SKAu=w~j Y6hu i[Ql t®lmSx?VȰW7#qr Hڏ9 &_"' ݏ3rp@țצUn&sz6qedga9O"P &a5ݫx3WtҼund涳 %p;7M+ x`8HqV&kV.3f.SNn(a#[6绽0l @L`D?qH"%ՆZC&؎+fH m?wZqC{si:{vd<烴DϞ>L83Q RTM@&~2t=VuX-rfx`\adZ&qe+t\({$ +O [B"_NM(w3=J@¬B %=k2 2 .ă\ әjc!-[Ufnl t#:>@THd僌Dx@J"HHNƓcd_}f8{iu#kYiB0hکG|mL0hZϥكl! |D' \D7G#սvƞ@ C_gN)^ed0T#Wn9|FDI®m;P|FG>M{;#O@!@E 4D41׿n,|}fA|ЦG~z)1B;Lb%r4h9ZȌdX@y?Ed:vɹhłB?0E"Liu dw6 V38(KF㰳I+8#:4̿%koLM Xej1f2|2bN#,W \>"DhnǑ{#2d v"~M`^gs5E_f5ey"U,K3pL 8o{#iaJQی<"z!Fru-fAf"K&>rj#* {o* tyò-/C{1ˊ;Ꙍ)>;$@t|D "{yj]mFs"Ty gف4!^Tb$8!va2 b$-lv%_iňDpa$#WxcF>L:,\Ft#x/R/\ȆP+?3nt BJd+֚Xɦ6ٲ\{&dF $MAvJ1kg͐Õs@Њ298q" R>E_+'y>J:mบ`[֟IgS^Y7 ɅGq3uǁy1[$?ޭyc_ӻp(:wؿ !e NBHn"=qkvMglO@v^_aT`׃EǿF1?=BXVXAr3O'r!F䛐"˾2Jx7 }&0CԽ;0o\W2Ry&Ѯ5""D֕yݝk e)g#J24Ư78Å?jp# !>0fGTp2َMή8N ]I ZA` 3)w88 ZԈPRvW*&R^ v9 fa^/dtÌ4_22J2b4KԐlF;WeМwWy~^+*=IB+fqgΓ٘K YS`fՋ#HY^S2?vmRrdE{s3v,sQfbM{Ft ]eXvӿ1+ݵaEz:h_9zvMC ]H?3F/ c~ Ϡ۲\@НX^Υ(cU"Wa\$[Tq^EzB'JoE/Z=؈B8){`S/i)Pnw"Q.ӫEE^/&Qmk-:2ےF&\ZmlyƵQ<τHn{ꇸBZnPZpB:$^vkP0+sTXoDvӮ:@m_<ʙWUG2cl鋹U} .y6|H8u~! }{.d)9T 72_U4%r,Jp'j@)ʳ=8w}#{Pv}4q5-i7cz;փV҄|x D4Rx Ē5,cٴ[͏Ds5DҐ=lk EFyC >!z?qy>vѾcj(TX[C)sB '{D)K9a5Ǟ"]h?cooA{Q-:HcDOmNuQ }G-ؕ>ڞ~NgU߃}E0Ѕ=>5-,>v| ֏Am+jh\NȰ,.Qa8l+^fL[d* *!b\,1~񇶜 t#p믭ƚִ˼!V=,1J<,l(il3jaet}.BA6]UU9I>2t*]џx⹔nY}%W럑쓹wPbs__3vAY N\S&t_swx:Vƺ S5oNFjc*:3EoaكhO :`fcЩ` "CZ|i$p ޤK"ru9%DPfiML@ Lϟ1MT|BA6epZn#??o|pA G3J,&?WA=J2w%҅teL "ܕ !(/(`LQ.R^X&C=2}sM_տ03I*ZlJ :%_>LɅORrݓՖd.邓L=o& u/Bn҇Hϊe*3r?4AoRdj"C&x~IWQ8~ͱx9HqĹ <1M& + B0 įf꒓u9漙pbV=ͷ[x+Q:[Y|k\š(ifDΗkDSW,G$G"!cF&nrd U'+tQEߟa{xLH,:t &@f՝6-i>Uѿ5S\A\~(BfU c,; D@e%k"Ǣ*u$>B󺪏b:FH-7ow vVi&fuҖJ#jj@ sr!VTnU5"L׭R3i蘯a^&(FDʮs:iZT9slD?7BilfL.L\dC ?2AbۺR>Q5a M=L/*U,9 %aIs"x:,r&zl ެn%8`4 ZM$_Cpj5uou84ŵbjr .=6lqkƭz F#\w:t VL|!]'Q}j$zbh<x-2BŪLKy$931"lw[Wg*FvR1|Sȳm\$y8A0KT;W ~]ҝ*jצ<k׹éR^2'@_ҋts1lڳ4RvbF8cbٜ=l$1o\, < 8rzܽ;;(N53dDf ښgR9rO٘n6۫*,2a D I\NjX}$(u1ʱ:ǥ  |Qʺa$FL)ǃn(aN+R ]5j46_J.fpE-H)7QQ̥ĂFs2nL&Go\4{DV2< $etFnF1"Fj⾦$ڛx>Be80j`!0~M/ 7ByDžxi\xqgkeǧn"7wU@y:g)z]zE%/EjYژS/l4BZ'/2"\*y(HfNNӺ,E$8ob[wjomuGC+np[`щ`8ϯ8»GZڍմ9/Qd<)k& $mGqV7]=o5ƶ(\ `fvz꒣D rrb54;f:޹҂C?9̖X3+9|ay&0kMn+eғ|Jkv͸HK[eDf<"€ n&a mϵ60c+ǽ^ֲCdۮ]e7D=!X[.arSՁ=y?ՆR>,.ݍuLCRXY_7cajO}0LJ2|/R_Ń_ˠ*5$UW z.2Cֱb qފ Xu|+3)sI`4BfS&JB{:N=S9piχ LL:+;NuPnc5 ] f u8w;]p| ߸?&SD$ L*XE4^;eCad\"z Q9ܷN&\|R^sV #uxN3Ո0;+%d Q/GBj"*%FQEHcit#7?dɺՐ_?K(9H&>T$%]jUc"Zܻң1P.%d("]j$LA:Tem{Sn0ݛSzE#2mvÆ]CYnFVHWtsFUC7q*7c K Od/Irv7y.l[! m?2ȱ◶D|naiaG+yQP">bݍHZf^PlX ! h̩"E4fO!!U$6>>/>cS?!7@֖fF095X >W6*4Qx؍ȁoe$S,`|jE !S[,OWZ+Ȧ$BBz|"kgqD7|  8~#dky|UoD_0\szEy&À0Wf.k>)œƽLj@l_xXΆ zȕ#ՠ8Z;m\Un;Aogiz\$(QzFwuxcjܟWbo\Mfv9~2`nH$4m[Ga͏M92*1 Է z%~™*3!ӻ5}paY`4fw(VLݥQ=9UPN5>X5djӜ;AуF]u C6C }c J'0o2]2j#Ukk?mh sL;(Y e2tg$]"K-;]^3u;uwWFP2{`PŻg`Y̱yt$d{Ǡ*cYQ;tQĠln! 6 -vv3ۤTbɢ-BF"eE52DdNmqUބ$DWUў0[q8 q/oNsZ#l.cKƼŇH~9b~}kosX,! ajBN ŇQ4*ڋ d<0\ַ)|_㰀 g^Ά*#9>ٯ_ZT1NҸ+s_Y 徲@hv܌UF߲ClqS'hM0,0pmA)w}eU@y`Ye[xV]e6,V9-XMAoWY ['lzfWY 6* NUDvUޥE]eDMUX* gL7}@wpWY awmA[!w᮲-fu¥q^,vj^T  SeUɌ+D5Ev* D8mfUHQ+捻aGU3V_)#|~ޮL>ʬ):]eϬ2JAB%?oWYDT$h\#l4ۜw#~趲 ҅LU{@Bk u_&䝕MdU l+l+ Md5`I.6p[YdPnⶲ@"h>H.3_q1+os=7!E+ۂ*BARme[KTTOisJB4[galW쟷,"dm+ l+ -3W-3ҍvuU3) 琻˂^bSե. dh,U#䰝f!5ڒ^+k$k jQn>e#vYPH*{5s\K795S㶼 g5o芿elK s0eAkRq8[@jsn8J}l(H6el?ooNy{TtoY0`V,>Eb RQ~NR#% ero٤foa_h#bqIn$@uqB]r Wq!*AQ33srY'lbR#es}mBbyR- Ke&BmӓBcp,7mE qsYq;I6B1qPkf` +c,.Ļ \Pd(U"J< BM]}NևNNsDWua-NmJHCs3/ @4fPZ,R9]TiP6ZR 6V趨Y!f3mQ+0VNea6!rLvLAgy*TM*f~,v@!ƙ6]P&n8Vn/ ׸lԋ>LAe !zum W"u,3uNw-=j E'psY"-M twnM&Acw~Ti5͎Dxњ.nN|Jeצ:<)Ju¶a4)6̩Ȓb09BJC:_FƌΎTuKcM}(oj*mf`kvY8glwm%*oQϑ07ECѐ~4), WgBR{cZP3d \Qbx VCf".t{ ! Y$ r;^c wƐ4ڲ2qgfU"N O(PV pw^R ~yugSiLz`} K@wh޼:޼z!2 |%./BN"[wu55*h9Z!Yˍ3_KK!-u sdjɄwY WH$R9UYEJhh+QwWunjͺ q$!+#Dyݥћ1[W!,lG~]F@,QKY ])?on4ϖQJMOfzg󳒡g:UgKj _á)M|Zvx CA>#;CRvYgyC~KO{jyxֹW;,M#TN]z&d$M͖֕,+}vJg*$"PUvfm+ꉺ1 nhUV ZQE6v=*RtY)m P"1q' S~r9Vol!fTn5 =ޫJI?_},/UȾF0qGٰQTKS]ޭfAK(W ׌뿃*-vT$+dvqY lBJ/jJEptӘEl_- z+yYH8ؒ@ؖe'ЍdZ;䡩kh \d!SV3bjvlv<7紛QYC6gOMV;z;w-: !N} Xn6KbY_|F7p ݸ%ln "^+D6ir_:Twu3 5MFhyo[ͪ:;Tњ8QlVlrZ|^8jmK-4^z? :BhCg4~f +O] gn2ޝz=@c MY,4e9M~H7nB+.3On}gX/lދ̾ѿ,"46r0*#W?#kqT*..{ lȵX7ݨ^tkC|+_W1P)K,18vPHzEdR^tE Uy5QFjR$1LF+c}!DFR*Ia*S$RU3pY]UxJv*!kfK~JjumlJ¼CHؿ<_;Btb {2N4Sd~26&3`eJ J̡ mdT`N A0xޚlD*ގCʲ: "SWGnǚg7$G2l.o>YkOUvVa5%`$jnվ#AZt~>L@uJ&! HK}aj&qC6zؤ5R- T#%K ԚLId6 cB6vc,[V憛_&%sHRw ̚.4h;Zg|:iPT9Wl6pFA-ngm}C }Zʢdd60&DMb@P9C+}7 e\*xs8eINtf^It|ުi|-FѼr]CgsGV1mn]trn;<-x׋Ϋ+CQȰ@5ӇB"xX з ʮ Odg(o q3`2pQT:{A$uhljx(nR |,J3^gS:Ku{Uٝ-<0$$ q{} 䰪Xb쒽y(;X: )&9Ӌ\ovlhL15N%c)$=߯nD }wu'rcT#Qުl`塸=uRz,<=RQGM>N{Nݟi$Utn/3\߽b:U_TCG0z')n-F){ |"}~rX.cP}y yQ*Je8H딷1N}8Bw7nߪ?.;vrBɸr}q;u}$k#i6;>Jua/Z@e[2=!'mXDsv-E[Zҡ1!aNHM܌BB(EcLVjۙHY,`^?dptzϷ/$6iAWEP,"3-J"6 bݲ 6>IH8>Zٔbn5A;_nwo@RgDK~]l#JN}rWy Λ>/W$E;6ֱ>nY9x+DNz$hI>%4˰wIg `hclybw7uFԦsIy︺ZĪc;fgn:5]I%d \&qošFa4lBwo4=l}"pFRB&_4 RB޺R^Y./A ˢV8Z:Gz7aJKgP, #:Dwd_ iR_/'pU09QE=:FIilS6>ڻ|bG 9ΰsϑT+^԰'?P$/qifKp7šN`h_G=Ѷ %0z>V<1PFZMW"߷gdv .)Tpu(/ X}s'ex /)#FynF;c#mlg="WPML-.QEacVXXT+Um9h͵=HsC_acPHk7DJC܋V]ek.GH:ZRuV<}k[+Ͷͯy]S^Ub}ZeΈ#q;F}VL~j8gFf݈v\+kNڝaY~ oީlj5,ahos 4̆sEC8#cN:0oZ3HO<=P%DQ L{)=lT'UY\]Vt=c04JZK5atѾ 5/[bX:6qCUFG(u)bI--k 3wY`"A )z`1$V5tpEᶊ}'IGO5axt+5^e]~ (AK4HՒlj\@)P=0[Ax@S ܈]TU }6$XR5K.}BJ{Dx .V,IU%8V%]\ -f>{燤~%7%5}D8-ԃ}ٕHUBrFGE:M2V7 J736N5Kz%3o:l+=<ٚUSW;0l 0)1QY2U4I}&dVEvl$kj<:8AԬdK .sXȥ4K#Z9T3Uf/bxdyvW>>ߪ*VSeM4tGf.!K5zʨBe%drUux6d&t?+>;?UH;O3e?y)n ޯļ\ɯ0a/2Gɴ`sqծt*?|~7db}5th] _=h7b7]h 7\{4hd'%?31 Ί:myp8n -߱XP b(TrrziئFQ 45;z|b|$ŗ132hј}?ovy覬ԏV!e~# ͌9~ lq.Fl1.d(ߔApȷLf*2ӌۨg&}?3_pC >r r(n Q3]@* !gvR,W ` 'rj ](2'r[eww"Tt"Y&i1!" 'F&fn˻2ɲP&-g+m(Gӡw/NYmRw#̸gg05eJ ^ 8 ;vu젶zN`50w~MG ̄9xGЯ0{*$FBsl r\ќC % Sf\-rd^&¸3sWJ+W"P` 3[,qtSC(o:1`N>#,ja95$idĭ%r:83Ǘ*|Bә u9(Ijkb{EiR.dJP$ʷ]5GKJF_Yt;ٗn)RxPרԴbQJO'zKm)Ӄ6R B%X,䊮{ 6Nm\ ֯2*V8ҀG2]C'mTx$"R)Gp,Y|ɱnU@7  "k& LFCMQR)|c&h4imJc+}"铬ԩN(>uQP"r$pT2:6INAlrxUZbrVp^oɨF'L3"Q-%6&(23#yj&t- jV8q懇vqHx:a lŇ|` "xÌ'#IzU߻S,!w7vmW?d8tfQHyY08x= U6s +bٜqᆛjCjI7p輛(GxY*GXdv4+]'"ېo EAD(Z!N׷?gO`p0AG86b rmA+st v|;L1žAa/y U-+5URGZO;U8<'r ؜tj]b #1-ȷ~?U0 YȦ7Ð"}V]/h)'M3Ȓ&Gk.R0;s 0S:o2S.?L-}Sd@}DXA 6XRA#e.]hzԘH %H}cE7IsV7!qR]) +e GIz[?wzhTk{_JE[չ/%ٮ&ehlg2lK4@#%A$t>4!r 5?C=K;jv1^m2Vёn>t#yXR`V{2qd:UB=(g]^إCUk }/PY*)n Pѧ蕖ae> Uq#}Rz>+T6:VL7l)d`v}~Kv*l j?y.G[M>֖R|ąfot1}R2G֬IQyRV\3iE!+N3o7 NUQn(R \ͣ竭=X$Jm觺Y]nUBu }P%jyuUF}$53`A|RS4:4$~,2,q؉Se;QN(j;7 $bP*iK64 dQ?&] pP@񖷫4eGSa{")[`eJYѪ_p(,꿤}FbT a!R|%X./mЈznwYbA-)KP)')24n J&0IpZ%"M "Rgq;e{La_cj| B $sSqɩ |!YQ5R@f[>#'opCoV@ŗ8Lb'b?UUX>d)e*5Wo/ƪR9.?g^Rc , MBHD0ZCA7P1Q$̵JΎHĀB ὦ-3t|wM) ֱG̖ '0ܓaxC Œ{ xje@ :CVq? gn%x?+guIq[%f ]p ADO}ȅ8ь`.fUvharV=g Y,2 ȪYy )BX aos@eoDT.cE5:M9WO.?YZ&2(8d!h"F@I]Q1ͦu-vm/ͰG L9Z:p*[92j"4)Z q ]PY2Dq7v 3I7x9t DT7E\ Ŏ T( miP q,bM73!A5P7Fڟ?oeŲOﱠxu>Yy)|vhxާ8/}rs#>`Z5iɽ=s":;?VMj;h _}FHmfݬ]-D4ﾣƏ}C` 6ج@T9(0cMڞ~M'bMo&J?|?N]CiU LjMPDF"U'kGjV[)ZɵD"zSZ7?uU'i:9 7*ve-ڱK ୲1Y8e䥛q)]ZΠ5%RRb&pA%˯ _kq>o QO$ TWTe 7B4L-ҩrknєr-*zW HԻM*FDCJu'v`9bbI4 %$q$#eco5IuVjWRK2'e؅3jOjI-8~7+a2 H}O()@R+9~e͘ B:~7 eo(%yxw!5opw]v PFv'R&rڹ!"~WT40c=ZglVQ>?l0ihi㳓J -cTxXQ a۪>u4!)ic2 7(|+$~g9<|N`&4Qvh%d4]QiZ ?hC֙#AbrLT`ZcSyp01Ӧ;Jl%ND{fE<=3R/#% (]?f3M@a5'\"T=F7@$NxnkY9,:R J#ng}d'Y1 :4Fi)~EGvS54#;jkć*MvU2]xL:{Q[8Muϸpnj-]ęMٞiDkz.n33>T`HgxZxY C~H,#|Ch_vBf4lgyez hTrNT^$yI`Pf'fQp_ɿJw~GղH G 5|۫%f\uBIsgG͓X!lVḛ/4.r]ݽ5hs, d%o]r RNNq"p/CIv|(yU^@_ȕGyPxlvCKʈXt"d&OI$n)> RrQkv; )׳@-q$-d% $1I 6#aоpIO>!#dIMJg|pDD [1tvt(fk!8N~' \Xtޜ7L@V"W9prL[s6- g}{3子ArPoS&p/I݈&}X n/yNVh6'-b[MK92)&k7;w>G`y)V+"2t?Y@gn\ylèf'Iϊv=? /~Ti͖2u׏pѶҍ5]4粳ߛp7ݸFr"d{~ܯ5n_~ϩCII{Ic]k| L/_jw{o"9PР'DYk-ƍ$5rCz^#UGD.7h:o QQFQE7@'@G)ׁN HRH7,b 98LdZѤHIe.5jU;űEﺷ]D[CUi$6եU,5CX$H). ӉH7v/$H+D=}6 Av3O3dM oHKS\d 3o<* pÎs0%*\҆gf d ?(ca¬zJj<fYF!QGySN:DHFbw 9cyI荥6P$ D"1E('uZT@ynշ]!eF_">ͫn]6^cph =}=m H:6N"(D (|-e7f͜FV#Kz駼|m qx=ZgppGHNhaķ3t$,*sыSdM~3-:.$gDX v ȇT":=& M T[2Da1_; +a-- tl!hxL-6kEhw\sfy_HYpM6|r{V?"}$Zy,,@Z"&)N 䮜KMءX8%/N /WI|hOK\I>ˍ@ShDn06hccL S!R :#6ș28GRBGi}m; {6qQVHa+ϡAS46@b{gָOp@9wUYUZkw MD.o L+QYsm⯷v.dP}iVuӃP`o Mԃ2)~s{>(gvнM,ِ>l <,qBV!eST ]Wpp?'E(HS.jZ;T=|(0EԅDW; "ś3Fv6r (zTrƢ ) օc cT6 ,_~a 5@hЙaDNteP*o(CUyy/mN.4!:\y#KJFT꥿2(lPMyzeN5_O9<)A_i5ыMS8Xp ^<,Pm4 +,/.|d,^5K)TV(mKm➴=n@c(Ώj;Oʡ^8!Ngw<̯`VIpr`b̫ǎq9r:€;1Gb9 ZGuE\n(wW*e'G:Bp.w_b"䮬ԋsw:v)؅5ޏ !Z!.[fEpϙ\Q a8*D-1nY9Z0`boݯB!xq|C3pLl+Lw%d_OTާ8.V#xHTvX6LX 0"m)WjXIe^,D-=CfOq D,:G{qE}mzSCBM8sf]`*- ^.zX6G&0jPVt구KSܶ8V+&w[.v&Jf/=xL_\4hr(ޠՇہ)Fʲfʳ[((Zez,^b=UY€)+J]]t4M.~(L R?~V -1,a7[PLL+[iZ5c%Ty7 0?7`J)fQA4Slp )| <6E:/hR{~Ƈ(q E8!Z]űL3L* f%.ZMH ]SԀUX֖ ]Z#PN{V̙c\7tʺXy_(:? b =P`Rʠ;܏:N8&ܘ9d7T6s;K*=ݜr O7$f{$2neF6(=I)[7}q;H[2>ܰV*o]Ӵ%dzycg[).9y +A.dǿQdS(U#l2q(+I8[-p:7aKB?nvV߮&Y9[I=vcrI݄!2\@"*  ]Ii* vɁeԙ S>:C9ɣ)ָJ"<,dJ<0#S+ (c7^gʪ˃N3"7+V<ǃ^Bk?P3-߱m>>9"+&VᾄP `׷iofeC`sB.:=kTeA/D7؛l&P9,Ń7{"$nnPZ3<BpD@x,;@x""' :]*`54X?@ckD{@E[Uֈ&Wy, e-I~$2l N9bdcSc۱=%bK-jFpչ?&Bk6b 9;ā܃^R;S Zl]b7 ܜq2Z6AM&Mbv87.BI|Y BxZʝ2_Kw?Ե+~ E4#il@æHؼ~L%_ - asTh $l!Ap927e+5GYrnkaߔDAWYiUd"P%ߧΗIM|K@M~. :Z1a+Ud0^;Fw' 83SYw04w5f zN1хL|aNpLΉ[䡍%fɌ H) !5eRa]T3^HN8ZY5b #螼 MH0b!:*"~!?6O-db*"\G09G*NZ+m%q:[XII- Pi2Wk ɴIkC]*WBLS l@;]ϔㅢܤ^4 .Q蓔'jkϹ`v0wP",\_EF)n)v0QKDiהhw]VaxE g I/Ϥ&!.(x錧T,6G5 7# m46G1EBA9)bRkG"pͲ0ya2J)PxL9vȌƝd2!iJ—sxhEZYx ~›ĭ^wp\mEX9z5rX3r M#8ϊ}̋ # mΏ&Tz08AGPY>Ws2]2CqWq$J 2g-{=wHЅ;J\a ԁR+Rmz4&y祪. MCJ Xqɍﻦnk*W-bF ,Ɯ֦m AKԮs@jjBywA`DRt~oNJ Əqx Q>[) Z(>yS[T\)zW۷(г.J@ >ygwz;{\\WDHՅh*>fR-*Ag# }yxXp`˝D ^8U!q34U1τBiJ5ʊu rR#XP9%: +aPJ/z K!dAc*YdrZ=?=$SH5خg,+TpVJ5&TvHtX32vQ j,g66K;m #&F5fL15BbD/XlnD՟X"Ҕ\|y8 5E)eS <7m&ΐ% qislD%w.\(@=jrw0An2Ax#;PU0V&n073gI&#h?ƌ# V/kҚ'JB2=Z/ |kAf2Kl9RЭ9JD[;q`Ӧ|-yHFj{@okp0Wz[ 5lĜ^D}O"I$rDȅ$rD}O"I>'$r_D}O"I>4ߓȥ$rD}O"I>' I>'$rD.'$rD}O"_=/ۗy}z_;zzEyɸNzP+ӟ~ۮ_>O?Ëm7_^J ~+i yd.l(>B>ӮV=ι[|Gl6sx~ .Wr*<%0ﺥ‰/T6jc1k;I)TR(1 B6u{PWV\Kiv/T܀$B#7Cs+ S򽶂CKW*Oy&+gL6ގXF N \ф5⾺cQutbE!W[K!ӕ}_xS|u)KmԮ L})p6gjWp'gjW9OѦTgjWS .7\$jnC=+ƙzMtagnW:^vpO|)DVȕI?H\JR;n) M]Y7D&i}R+Nr.XI[2Njq$8ZG"Gd>&஀RkU&'HƂTbmEO>*)7z2ߣ™Y/oLcsv9' e.xhc;pXvcKؠ,<^;1>egFt)k ٗɳp]?x ǘ%A!lkq}DC<dXӾy J6'~8yTE81~K@C #y*pezUy<#ma#p]aG5A2+g1CM_ ёi/y׵ J;3$5c p/oM߈q4vfJ\J}ktm}Í|) ]n7W:hNmiA019'hv -ڷ>:3ؗ:|n7N7G !JAY-Mi._8SB017e[w7JKϣZ"~ ƽ[N0zE-gMzJ֩\I4 TGIϐ 0hy0e rr *׀Qi7iVȟƀ/S%cA6;msŁ&/`R e5K6/i̛mtެg+]`Tn LAv)Mbz 8e[%>gM1`m5njt(L3JC͘+0CS6`cENcΝ+hHI'9m .69Ju3 Ad&]gBdY 2(2mwk=x+w_J r`ʠ85;>gDɵ5EiSp3OM&,DڅKP'go8xBWKf" 66K D+^_J&:\+߮YTp8n{Sʴ7E_Ѹ/la *3T:2<~]>dzew8W@Ϸ% ŢR&:Kbe)":[_x; KH^66 h +箑A^.e;F5 =%1[T tjx T 17Zxzˎy1Mɖ}ܶD1 g5=)S{f(G YLaΪKaPs لzpnp-QQ7=IJKgfz Y.ƔR2"JrW`Jp!Bʀcg WsKp%ȍp?OY1MO%\yk SwT*$Lw:JѸJ KxPMi=?(\¾ݐ3ڡ,j}A 38ISfz5k54xw-1h1hy$ զD AG 7 ;`CɕuAb4n[ a%hPXƣ"f3[Њ a2Ԙ1 cFe &@ӠCIk5i-Xͩ~\"ndrw\pMT =4n*5|UX`]/t!svg'/% lZJ `RZc+go}k"ENjL1={D;vD*D7@ZD h5"m {j|>=Md.scGgJ!h_\ (wˀ :Qt;(w).4}9Fsd*¶p+ ɮoktE&"HAfgy6sa\Ҫޑbڭ#(z[6s,2l*^B}=ey#S\! * }%Ƣ pҩp+\0 ^zFbtd*\lea^WTu; rȪ Y*Je^2* 츟+¼$(J!fM\LP.*5 _*Jc|eq(Q.4۔R>wc)>rŀ+6+ڼ+oRlj&,hV&FU:C9T.SyBʽ4 xٷ7؄,_5jcevTוIE=;ʪo[\"4殺Jb{F驞BeV=ƟUxk˴*k,~T>e7phTgFHQey]Q^XxwX+FkV5b=W]^«ϊJ7! n+2¨3*{b9nTa} My]Q^.{Ga&2fʼETr(X+jս~Mz[$}8XəUm8ɡ .9v PkC@k449I:hlf^W{V5MOMbOЖJ2ŋnN(8cBdJɑpf0G'=*K,{[p+b%SX(u 䯠: eދc £d/5n8X:Ee;g,Ϥp*{Y^^Q)we?Y(ɁQ&(l9*u߸壳SƄYm >o|+H^*O0w}o֜efG)A0ݡQЃNPM# ^ 0UNS%7I`8HUe$,PݎOTj+ w(ẺDl' V]^$" Yuy= &VGey&1=flR"58 }V]^p؜"(\#EOuy=+(}Tyطj>/#ބl,ػ;xk͊]սiqL>/HV$42Xwѕyдrj,O!nS s$tTH7rQ^0uC3\c$5iLpH-c^vV^W|P0Jkؤ@he%y!JrbaJgA'wVEZ@+֍w`Jࠋ5çddb}UED)ütB(R$)TId df31 D3p+fv?, wTZ(F褠al5z](h4KKzJF(HHe,,"C=[CV*ҋ]*|yGM^NeyT' jdD_L") B*k/ UҧFoYS- FJdA^.FrƢv?#sQd*+(iH+Guj/CSǥ[^Ӡ iR#'*HO^WҸUb)ҋ~J9EzQ`ߊk2ZO^wz+J"@kO^V7(JQQר0+z+n:ob[YR"|ٺ6nDbREyS;ʣQQ1;!?TCV'_@rnZp2U)(J]";r+ҫ-HָuF,)Aj]JmDF4Z RMD/[^ɷ &z{6<+Q3n-Wy^Phm7dQWΒj) nQTWUN^W*K]8DۧiR^Tn#2EEx |V!aqϫV>GC+ $l-y=8 <-,PuExqbe.6*Ћd<(-6pE}ۨd^XO*Jb9^ac6̊2ql罒3?{8\w T`o{ PzUM{k$VTfZ5w{0@2Pa콪^oBSL, FW ʺWuEpy%QIAhcrMy꼮8s<[I@JbE[X;Ҥ*{Ӧ"-zDFjV=Bz % R vS=Kz}O2I>'$sd+O2I>\(O2I>\)O2ʓ}O2I>'$s<܇~Td}O2I$sd}O2I>'$sd}d.'Ǘ˿j}>EwK5\8+;_}ß~z:뗯G^ʿ{^,|Wb]laP&% nc(~Mve(>Ck8CfteS)qyc*OP1'+☮5%-)͕M33teR)Yo5,]ٮ! RJPR(ffq?]JєB1Y?W*Xj&}Xo؝dg.eR]It*5{԰ ߺC8L5ZpQb2m'w.T T Wsټ&;jcF`*-1)ەhM_Jנi~d$\+fMG] j] խhR$4R<2a8-RL9lW航1Sr(ӕn^ P0.)WFTڤlCSڔxM5+9-!㡺/ǘ[Pfpޘ8$3&u;B16tjY% ~e+ ߝ{ ]=r$\e /][Wj)؎~pLseėq0o)_x= Ҹ2 Y`L_43pzO[P%S1Frxk#Y5tu1q*Տ1}P&fdS#(M=T&NhZ¯ !aMC\B2>2wž—dge4Ij)4P KMS8/ 3bj[ӵYc[BOnDk2<&c@W:@ 4*8bJWvRp?)X&(E)6Nj>~;ŭ¨Zm/™t#+l*4ףB;?)u_w3S5,0WqU){8'%vC"e_gN]P@KA'߰)߭N|dwە3CG\ h”/𱣦l*Rh6rs)w3eR7|?lۻ9H|*sU(ss>`y&-fV599.`krapg{lur\+::&垻ڥ5l ?M) v\pm՜s\ |jR|-lK.*,CKٞgʆ.iW,{+!x)\a0zEéئ/58R/9 v☶ IS||ƩٔMӹ6EcaK S|0!W+Jec.ukXS+zUmsſՏn1ݮ>#&0\a۪,buuŧ͐ݥddUCGZR^sFY/vu^~b[[ްm3^I"fi,) -; ֖{ZoJahT<*oNdSF( QkDCsP:)af8_Mk[vX~JA7\p9Goײ,u}N)|S4-}IP*}\l6mNS"Ma͟0 HJBޱG4[m ֑+x( d__e6xCGT[{J eu!~SBYBԤ%n2&ȊSѧ]}2P+;%/C __7nvJ "}/Va 2 J쀀WSv(V}#`JKD OL͔Jb;m ޹ڡ r7N$٨4tƞrYCQmS()5 5‹ዯ)tqeNFFCXK>dh]3F- \AIt*ee3Ju7ry; j~F7gSѐei Uƾ͔6[^x;̔IQA40o~M*H8`r[ gj;k)*lZRZCkp bmM5) xG.ռqGnʄI~P|ܔEMs)%?us3<@3e<'({똒ZFiwϲL!_;?9Ne>ry*Ka_؅諲A'}('~SJ|ii ͍IviiF sѼ|-19hq &*̢'ע]?Y-h>~o2 n>17nzF;~" ^c3z`&";`]V#ld[$)B"XTr(ZEqQEr p&DH;\^;hV#RD7r89GEkLɡ8FF u8M4*'9nQFMoe[qJTa ֌-`;Q/\3ű;cbE#fH'+kk-kc#<gs,Yrؔ1o$*4XmЋj4lr;z\x)MfG M`W5+0+Y<6y3`}ƯϏyL*k]§N")=}G#>5RjtO@IŘj.aInt؉=fq ֋CtFFѡK i|C;dT:v{tYcBb9A%f4 5_[;@Wnn/0v6yꚸRBq/\ c]h/rk-~&]trwK [R͝;vFގۡ#yn$)} P[@ޑ&T|+nONi!U`ZM Zo~Trcb50X_t`Aӆ eiߔNVa^2_._mXotXz~+Ud2$ oTyrw[IGI?rQaU+pjtl!3{l޼`khdԢdˤƴW (1o^eX͒PJR*]9fn؜S 5-ψ '-\W\L]9\+.R)B.d(х˭") _ A) $mQ+0Ȳv8XJaxjVzb)桥Kh.݃Ql Q aцs/0udFy;]*α,_g!7&SۨBh p+0ILqO lI#S&٣KSҨkyɲjnxSUqͪ0/L䰲"X{߻6~fo?Ϙ{S8 4nJ ~j-SzE=d.Fh7h82V0@* XNo"g& BTj"'x y%PaA -Di ,oBmuXfG0K;fN"rX ?[VܹMXd},@ZP3(`~jw0kQQ=Vl4z+cB0;yㆳڋ􉤆xt`+f@ݐwRG$vd&QݕʤRbk;ȼe. r/LODl, (ʚr?ؕf"6^gJZla p0+ΰ6@oס3_[W©6NP.'n3@ONYR ȸ 4TwoxAi><*s>3A!NoeKނE8( 2Eebg81[}29)8 a`gX0 zhjڛ-|l\%V492o/]& dYRÔ !q2ԙ@mRgii-*P |S';&RL2b,J(D8{`( r!, ĪU܉@яW\t+C %&,y<8>OҐڊK^ݔE &T&"i@jZ-AݻF 7sAmLU^(VpWBX$3%轇*VW}cT\0Έnov ,}hx~#_b~--9qeRW>9ӉgfzVŎk#=FC6XqSz(5v< Y1v5 qye,21Q·PG05xNe? 'Gظl#0[9g%xEƲZflsWn^=#%xl8'7,D~@@[Bk+BPSf(^ ,-Lc{օ3^F7F'溷cRC_&5=eijoR+VO^:9NWJ4P*[M~3T'RPmW +:vD.Mx{vuAFΠƺ+NbPzLѤH~r`O(JG7e&P"ꦬǛ Hdxmljc3jHҐg{xT?tb([] A~zanԅG_˜Eqc((Y`w"y(nK1V {ɦ!3b9ˌlXPbf0heyaȏa p2>V]MYa lυ|&o@8GLηFbs=g@1,z=ʈi@dИuEoc:P XqAsi\UIKfA%Ȅ!qڤZႽapwn5ᰥ+aj&Xcᒰ"qx.pȘ "۳ %7H/0MFhY0FP70Ha;X:a%Jy%lbFot܌Fp|a|~)hff3kF"6Vb:>Ɏ%c*Ύ^ h`; fnͰk2 KwC!ޔ;dAELQz542Rl]Ɣw7e]ᤞ}+%< JnPf0+-L,M)d*̼H`L!l `x]FLÒg5YJa§d׉.S x<`xB1?{ {Lړsfl!ȁK BWʁ<h㕷Q%]pNJ@A^GH4M+WjĬ2XԻA Ĕ FpWbIOY%qw "/k24C,ÎK25‹FFTN*Lڐ'Oy,g) EcLRgdPv`<i(f3Al~F%3- }1B>2/; "Յ}#i " DŽVܘ]O~1+zzj]a3 F= KIj"F#l&JTv b,(Lʡv)ה Y<0rHģ fUiklPƍt;ʔnP#xKr2>a^t}ҹO:I>ܗ'stuI>'st}ҹO:I>'sst}yҹO:I>'st.'st}ҹt˓΅s<\)O:_=/ۗy}z_ks雗k^}k>৙/?~SZ`ڎ<_ ׆?}}]Ï_ ʿEYx飅wk_wNw[eWۗfVG???W-|ʵYK^?|ymʇ~?~[j0_\# ]^-}w_}_t3}G;+ÿ~_}|ºfO˧>*v?^N]ȹݶV}7g~??}N2<]>gkWKno+sS/C?I7R?|]~~TBJjEX{-?߆1>Ǐ}a|ws Mcm54?ԏ~L嫇~=Ɠis/R_d&7"W{O;k=o5z5Zl F|o/2|u>o9C˗?eWʹ~~/߾,.~~#v_2ŻE;dkqmGeLh~#^ݥߺ.~ 5D>vўZo%_}ß~q}ԟ>FtìWrnΗ^C[+_Z6/n+;S_eZ? w[g4f#ĺ/uQ K'\_ݏ_kLt͎_ ?}\ZrӯE?";oWߙWf.=o>۳b<د]_k~Bp}3L$Yendstream endobj 606 0 obj << /Filter /FlateDecode /Length 3669 >> stream xZێ#Gr}WEc\y x^Ɛ8lv7fErf4s"2`YfȸLnL7+#Ԯ=t]ӷfL e,_eӥBw{XƯo$7WŎۻwasim+O6М)zK?ϫD7@vraWq0c;plri\]raӌ)]?bL&pdTg_߮y|LL03Y Dv]7lCBrnf}IɈw^)CIPt_tZ۱?]w9vzoۘ-2d۵G8;q״]d_:y?.2=Hɝ Z7w_ߏquriv]*wO") H``Ҙ@lC(C2N6{(f21h#B&pcD[lCdv=* v! $N٨@0;߅TD+Gݡ'XEe;d18D@pYO4'."(8"h`DDwcBZXf2Lng}փJI G!+BS ( )npJAG7.z%HlU*sF sJI 7(ѫZ2X!uY(v@Cq`i~!Kg`}kDU1N\Ca͐+% %R;T(.grkYr:$<,/l7H\S#KtjERX`($k-0JHeҠS%%MFڈs sB֖.[=kJ 1Wb"XFzvRȾBٱX(%7YR8ȖQ!)N&PKXM,4: eA*;ezMHD@R ,ֻ‚|pT%I@/P![   򂨾`}i5V% ;bP+4Y4,5BiP C6Q,–hEVTEkxi0$@qZ MJcp4;69dP Il'SPzvaH7wэz%31ĨV=P ҬF#8rQKZIf@ 3h  F -lF+.QFN6Z 3JE(t=U(!KTk#7:E17J9cѡHON$2(P2Ո!A (Mj6/mBu(iDUg5ϨZLM&ڎm$OB" %L)hjyDUbP'W&Yje?,()NE:I`=Uz4|mqigpGOJ1eh:)8U++4ce O̕L7K<53vƑF6 Z j7 @%6I/팺K-&epm3ȧxD0S`m. ܕ0|cf?nt)O8#aZyy ?$q6~/LDyPffB<T,Oo]E3;#-~u~ٜλoc;|_>K9)y7z'O@lGBJ^~ont}񸾑!wʕRi.x.&tisw{r JӑnVCM'3VީМocuWN?>WZ -npmûyn=?L?Heŗǧ'}+:^"rZx&ѡ7GZ}=EiNPz,E|76v)?K QRq4] 79?HHÇͻzhO3rm7 FsCbqIsgN,/Oϓ]8ͻwwϳW,t`}yzm?ovo>mΗUҠqvyŧi7kpY^g$lT=mذ_cf:\[,̜~\F*8#*?\wR" -6'zZhg@\DnK uϜxrw` o(7ǟofyO73=oOߗ&Wnxܩa?TI_elQCK;o#7"|n0d#/=v{7Ls|\ɳ/F4pӲ6(XXMmj!Vtra~=r]r~i8f˅[!endstream endobj 607 0 obj << /Filter /FlateDecode /Length 1359 >> stream xVn6S.-xHv-F\0DRE{ԉv>wYb&/7 RO/ŋ΀(2-:$e$@19)xx>c4P3X`=A ]1,$ڶ2\RPݔ'-)PZ'<8Da\*,d=x=iL2A31 1;hfnMP!zQ1BU "GnYL@B!sdsG+%!A9#Yy8h WtZ߶Fm><eAut)נ]Ī/?IcN׎V7ڦBqH{uGQt݉0#)lG%©D+c\ R|_iCBu!Dq/|xqhc hfbZq12W,8 gR.Z(iPHW= !߻٭GCF1tE;a謗D3*f!t!%)4aVb zW Lw?W"UǬJ3[SmEqJ9C >]V 2 nܐUARͼkxJ+kl;eKl`l<˸s++mP攳g.At}iN'#6< h&өَN0 #Sc{mŶq9Ys=6c9q#xa?l0K[TW nzmv^9tߍn!rv.:X @'O|{0?2zG?_T΃n[gxendstream endobj 608 0 obj << /Filter /FlateDecode /Length 1715 >> stream xX[o6~02j4^D,S4ٚI!ރj;:Jmi~/I[nl!}!Nw^ fv@Wg$e0H,pz=0kȐ4Xs'\$p9 62ZF s&TJT֗h&iq~)6č^LݓgI7{$KP.`;?X?8q*j5hR?S81U=L2(&L߉B}3u PS'tݔƚBݪrԙ~\NzmIP1MA!jk_XJc0sL5I&ٔE,x.RZ6k 5w-&$:r]O$q/0gU&Qԓz N-m@2K hlB_p,íݪwEUr,ʪNlm /OKIB m@W^yLrk ="aY:TOQi/]עZUW|Fd5[\`!v{sk0Q[,5(]%vͶ|3u*9D = >ןϺy=6^LgIf8L=x7֏G6fro7W-lc6Sx"_ OG Ł IҀ|}4nZO H ӊDħ%VxLZy,K(K? ݣtbKH&Uj>\NܒB7ݖc f3d|An።;E#Ɓo;>od>]Zӥ^iW6epL4G6oR0PCfODgߦ:.nWDsRXwv}읻+H_|c)?zBǮ /%dY)֎Eoi[.7˅ Zܸ!St|g^]pT`1yTTf˝{p›4-T'DнxWpyl۱ڷL{Agd~u Nط:+Gz([_G61$F]G䡲2Ys}XT$O77endstream endobj 609 0 obj << /Filter /FlateDecode /Length 4010 >> stream x[Ys7aߌCS$%V%)Jt$*WE :b3?軋?J#磋g>JPjKԣ%㉔z/1LK˙'7ΐxϽdڑY,fyr\r DQ G.^\O$eNN)%iͪz:F ų$YD9݄ͬ)qcVc%m ^ lipi=U~1;#܏/~ A`\&ZRP] u3ewif.y:&lb(8c5dchBPc8-+ DB T;i DV\(91S%?U.ӫ!.z Ybxx:uNj࠲z;>A Hw>Uߧj3@4y2;BR뎛 bK7mŬTMl GЋK!mM 3}xWZtZA&2YIJ5ȭݴ'Bw#KTC 84΋ݩa N"z6x;&b:-6eKr)ɥb.%nG2_vO8 ƈnoQ,2VJ mi}\qޟ#u#s4q5HDS"" N"jG~=*k(X6ig= hM*ro6FTLlrUl"W-cP&زBx1IOȶG7?oVDpXЫ]}jWhpUqlj!@  -L4䁶W nAl('1G05OEخ{6yzr!,7O/f%#qdz0 יcfx.]>5]\fjnɺ;M6tw~Zx-v~,krtX%A9wZ4w2Τ8nl8爏_{&zX⬟2@V%$R.Wyvܪ9mKV:TPHyEXv=ŃmBc9N8<ԅe-u ?Ύn_č6་j-yů|PC[ut~~zkMȅ9'wX1CT﷈fSЮb]Uq~sC?"c4tAk}Pf9x*arl13Dfv>ňޟA^SaeVqR{Ll7)];?/Nƣ&%!SML(u1Ő8X*h${ c|-)}@]w/G9|DRobM©N[X֎Ṣc>lE (ꠎ^WjS*:Y̪:wX K-eMRm#7|6wcW4e:K̓*eXSA6T߲8vBW=Xl~C{rR刎Pi['\׈xpo`>PůHW|o xiGp,ށ [z2n&0m͎[7AMߦKߪ٦nr`H ۓ4 $WzOes6f6(Q>ɚ/lO,(IQ ,*fY2l!J:((Eχ2iT|{$ݣ,H +Zy敧Jע\'KF:fXyR?BԵ%!sP9P>Rų!KU`_7WUϓ>vaf{-|yolm!(p:BBJųŤ4O?Zq6ht\>y[t]S&EU؜pAcoji/pcTd XO]n.ɿ`2`v,0JK6,<'r !Bh!=Mo_?.vu5o3'c[)H _C !7))4OA?@ rsӋ5B)&}nGM6t,#,U2Л@L ꔤ0< a⟜~C]\DnK>> stream x]M ?ј6vMaQ ޾è]t^3̛.+'X7EX5fX^ rVeU'`v7dm(ߋ` JCTn !;c$7]5{he.IBn%ItD#Iحkm舅$! KIB,VX$iL#v@S4෦C('fVendstream endobj 611 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1021 >> stream x]_L[Um1\MdkD, D pPp @-]/X%d!~UH`c W&N%9i4̰5Sc%1{$p(AErr cf灔Ku wS -(E)[ Z W=Frw -E&KIQ L5ƛ|vjn*'բ+8r*R̛/ ztGaU`{(Q!2lhh4Q@E P7VMOt); Rt/#M?B\[QT&07Nfŏ`އ܅%.u5A佊"< ]rcv7Z^!507e{e~ˑb *S[[_۴Rbxg&HK9⥕݄!$KWpց%C5xa&6Y;7+!d$Tnd^cS5첣lןLHy* u飜2j'0C7Ta8s Gb$n;Zv9N\ĪcPK@5JNjeeŶnc8zŹI/Cfmb/;"47]"~y9P ;^xigw,9ʺg}|yn8enwޑ70-/uMWaC'cDrܱDC0< :u 쨲wY I1X]iɩ"-`&tOTke4fnݓR? Őh`;|W9aRI {q]~?̩0S"Dȿ:Y`w&caVwRᦈ{l8Y|wNo-[^QT O*|6Ao*ѓZ푳=waQ?¬H7)Eoc" ox|O!rendstream endobj 612 0 obj << /Filter /FlateDecode /Length 161 >> stream x]O10 ] ]Z2D! }I$[.%Mů Fa:8 dw >?LyUuYU{%hy"(6ֶIG`6S\ HJ$pLg9*S$endstream endobj 613 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 302 >> stream xcd`ab`dd M3 JM/I, f!CGO]nnW}G1<=9(3=DXWHZ*$U*8)x%&ggg*$(x)34R3sBR#B]܃C53000201012~_)Y{ӏN3~_Gئvkb_ޝ+ڝ͑¾lzٳTR> 7s-<{ 6qb \;wq$o2endstream endobj 614 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3224 >> stream xW TWLejgz>ں*Z,]EBx< E --=[u[m;eOt왜ɽPND"iVm*~T*qs8S"rgX I,)9ecjZ*,|_Dd:*:V}z P[T DS mv*ZGR s$z6QTA=FA9SFOHQ4\\r:qcҙqєS.)nb}{.:.^tCȲz"Q9Wg4I`DÇЪ=Q粴msu.bYNӻu<{upFAi?>FΗ8е:IRqUz"h9z.<%A}ypO!$ޝiA뙶jN nRB@qÏJ ;b]:CYV6xv[;qt |koys Z(iQ6}r|.dM< ah^Ъco"+ dxEWX8ȑ/k԰nfaGYG,{,Jږ0h rf`߲U\v=A 43?zS 1 A!Eh+ѓx=7hd̺H~4Vs)h6A AmS]v^׸H1ىAM0H0 X Yepd)VE*rcb>,.D HQ((.+NjjʋˉJ|h|LqZO -z}/T̿& uC򥉌<,ߠzAӐaۺBKΖ? k 6FnpխηTs:UIku2׽.g ٵwC-VÊ";%FFNvE%$s]zR"'2I 59+[bxjlfBDsrGVz&*j{jOANl{K"y-ҒI[4E^ \s!u"O\:gH ӳ IOom8 OO +⏡_MԩЉr$O2HW֏xAGwiv{Rt%tY"GX}9McwWQ34-ٽ?|^oNL2Ǡ2`;x0p:Q FHE _̻{HWh.5A==8 :%k,?#q<{}=#{MzT eeh8C*ʕ("B!.#p;Gts8ıo>2`>g4 ;E ~cgCP!$&~F^UKmAÂ;p|sbOihŢn"a3 ]zF;Wosgv«8<5& $BVavi=[/$_ʾf]jNBq.Kթ}*`=Ҧ= ("ѵj /Kgase][RSVeҧmϮOJ(.tSumy1%OOrl9>oۏ45`Iա9_`mwCUaɘϓag&12m]3ϏtDtC5D-'fEr’WxQJx#e<`zjIV(~)oKnKNkNnkknvdrx#@B $D $gv?畋EE!ТHkyDgfƿSb" -!~^/@!}Ʊ*j%Nf<.Hzh?Z#>G!I/jNj-u`{^hN =vr?v3elP^:t߆?[gBʘ&څ<٩-QIZ%]   <ĸZW9.X/-~T;t~ ȃ:CEFYv6O (r K\tg CUR+JJ+e2bXгEVY2y] %jM[01޴O۬*/3"0Ih<#7h0x209~zbT~W&9P2|A{-a> stream x]A EjĤaS7]hzCâ`]x{işa>E۝gY\d8KC5EQdO;(lQ3bqr ٩W4 F)8 ӭzYJ͡,hVEXe5&g!gff8j7Kz[i)ac)N1$I|ѓeendstream endobj 616 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1167 >> stream x]SmLg) |ͨ!SPt oUTV[{ 6@Z"m6Gi!ӎh\e~xn/2eχ'y?cqIv}ZAyE_b͖ paqD"'{ d?8>D(Hd8h5i+̇Ҥ{=Sje63K4:iC=='e9ieD_LQF]`:pEXyb6X 1ScVl#$5X'\ͩ;o@T360Pu[m|9FDwx)Qj3d+AHsN]+Bc &iTV+zCFʃpR=HQoC!?6҇U?<{p7J*%E fa#jSKJ㝏Ef26 X;oP ēkri1)ʞ ՉTI, BFj4UEy$WL'y!ǯDeB PGry Σf9+LaڵM*w sL:p:= 5]o]i{NZ"Nq9@:L1MNO0yZkoOO{6LB~^~Iʑ(rIل0*\n-%?*?Jn jN>,5U\@b7:*9/y,=Z\֑mySB}4ǿ~32 )[hX`|X7N y\B?DRqz9z-x>HgI+70 {c4>82 zIBq\?Vv}cs_C_(\%n^>tS;~5l+лX), z<$Ƴ>^/sXmyP&i>ܣ]`RMwH5_n ZTD$g;2sC]}NϷ->%DRs؄/.sw%$`?r4endstream endobj 617 0 obj << /Filter /FlateDecode /Length 1573 >> stream xWIs6sRl\ഝIex&MtX>P$eѕĄz2} (gkxd_'xz=y=!jw} l 2]n& NiD`t\`BP>XD@qro!A2c**R$iy+ҷ)#8D%Z0Ǻb1쒽#zǀY;ckN nK/Z*Ǒ 8υ}M%(@o1-8' 8 %%z(.[+ĭeb]U]h =t}zh&Whbz#K8:%?1\RF(@0b f-FldEdq\e>7)>*Ǥ*>WxRǽ]4yU_3F󕼪E:R IW&&a6׌1jPMQ.*6|1@p~oEGIGfd]vq>'h<_u7d[u 3`[̅B`\Qpf4"EmR -:G>i.>룖hx(M6׆,\ꨏmUv,\m2O߮7@\?$sͻpViP-! tv]>?Ye.պI6&*?3x/+Ow;x\$I /m 1$:AARdi5pPǠQ`laLPzq :%qh!6DQ-C)J:ֈeF5_8ҙho,I iHGTo>'j'CN.ЃNb?_ϯendstream endobj 618 0 obj << /Filter /FlateDecode /Length 2213 >> stream xYKs67A5'(eq&MU2VVj3ўgkQEN m%҄(|6T~f$<5l۵n<[֚aN]^t{!9^-pqHN#KQ噌rJK\ye Ȁ)K|#iOCϕr˥ ~'[y# {xVpA*lE}VqWpckE\7-M@k^\}p 4u-$_6u],ELӄ 뮣f:MeSIҎ!ʹkf0ֶ&ױ ̠UHfYO3U` c "5\gg& PNڜ;l P%T4d25qЈ Ui@yc8l3M=݀0h|CzyiUyh9c>̄+10-RB,mӀALu$lk_oc0=Y K*f 1DCp݅MPJ I`exY\ zW''r3TB`. /ۧ1 fiO=Xg B- h$0w&*{$+U,n]k'됡eBm@2]&-qpYrz?ryj|wlSta] (o ND7T ܐO>->zXWQg~Nɚ\i 3K@V& si^L~}1^|ON|JUߜ'8rB$ zj sEfOaثO"h{anm 7zHjm(f-?.޿sVG͗Tlre"h `^3& ŬٴDGwWQ')EOa0!)7[øJ"'AQ/m X1RbM(1~h*H0⧟~h8KRNrnӾJ va{qeRK*L8uK岩hj -кdpzQ%4<3`ڇbeuKFzXyܜ #0ƀ#v#ף}*$+"G,-iƍ'ȑӶ u"3?Zc*oa۲mle`cڌHܑ3xS'|Q@^?;Aj"nƷx8Phinke4bK!X:u{U na7쥶1UF]sن> stream xZn}߯X%D;EHĉbĉf`VKZd‹Mv䜪5@`:Uճ_nl}rcݶO7}b4WSα[Mzb`|͵35ud8dGzt&cBqNi[tW!a6&M /?>?/O ~_W'1b/6avò9Feu;21O'gP4ɣ}s4fr秛edھy˓!qC5s[rmژgۛsl~1sJ~bTC^4RgDT"uƺDl1o̕3XAjR,%v2H$e*2E:+e!ɳIi.2$8 gY89“M?sGFl·241!I?']99- }WsIn+s Z'9p'1HW2hv+Y6նntp27ٕls]T?ٯNn~zVlݼr jQ03aGmrظ+wxSVZYy"I Ү6Oܢ1J=i7\0k䮯XkV׷\m3J%9Ac  9KVUQ #P-ctQy:h4RC)(8Bc I 7@bf-{wZsnWi os3MXk!]˰uB`@ Qv?(c0@B~ +̃/&5+6 :FdSg׀YL] `*F*Hl_@I*""/ +Pl(BhU?\Uj sr9uqj ! T^@eS 41h[H)<2 T| iXoyt.S!NMAS)=s8[KvUotw"M8ˮ< !_ӦcsJC=b 0uxYYc 4NBḁ%sZ(e069 dpyMӫ20@IQX)cTc9@PP]`U !2>9%؄tX@rsNIC]!Ѳ-#|C~>E"eG\)# <2K:~5]0H5 )BrL.})Rk)nDglƄBь"V$\ E/cZ:LVd.u`BAt8du+dG`\TìCD3DV7([pt q'\HdEcQ$ё-"B[G';XX2 }ZbYsZradq a(bf:Z"fb-q1eschx,0U.* Njk^Z\HtpYWV?Dw+>-utknڄcj{hu)Ebs 48DaGBBuufAw巐.^U0,g}@FIz?5>ZuFQ4 WBT占@թ}ӧj⏪sVmkI`sOCRu28'P&f&M#IZd8م)p}xSz)0(>S2N'YEMDp;^R"LN)=ƌӷӨ v(鎓JMf=JeB<(\(EK5!ݻk%l&- f(Irb0K9e6:˰v՚ WGFHh6 =Z7f6Vq* Ue2;= +i›:V1).dA绍[ P qYyH@A's[(rб3NJ_ ANoQ8uv6"ij @3Z'ɻu @\8ر =TlړaV֠a&b"\Fe\GJ%C>gdmw$ bf$>wJT Hm׎{-@q5q>v$TvDbڔx=&»6 лW.Ҧ @,+!Sbe^LwY +VL*.GNژ.FM'J)ݮ^l 9E[J>>3UrjI.ZGu*yncp17]^n /K73әYʼn~V!&˕&/7;@D?'"wЗhqBβ'u_r+/WR۲ P5@yVjr.^:AtWo!#\@4r),,ʡOm$鏗2ޞ) _Ftu kB%7H$VѪ#Yr,S\H#{hXB<.<NYnȉ%gLh:,#v![CJ$[΂dA~oa7x@R(&Zg?> WNz_BoО1kG, lAŦߗ#L0px'WN}-\g*|  U5 @|,Z,#mPa2C%sZ܋IFe:fez2jY=S@˞>&M,7Ѳ 0ۗɟEy`̔[\B ݀JowDQY^ CJcgAh?Ɛg|cY27 s~믹Lm`Co~>囯8].v;oS³[ CAؒtS=~N_M2wYߴn/aif P]~~>O`j񐌘oOvQOSu|o+ //׋]s5vx?Q~?7OfcA'ٓ'OES*+ENpy{yy{q So wӓ琶pv;?p%F7 "/쫣N?@}(۳*ҝ< $8J]Ą=FUjn^;!ws$5]k`>jƛ3.Qt9m?H}#3^ h6s}C?"u^=jB"jPOuFz\ty߭r#R3OHOGBsYUu5^ߵ3CpGlftvPvK_ZUґ3!t^MvZGjv f:]gC;i/W?GwC_OYF1ˏ??dZpWV.PM=v/%IE]!<{wo_NQ(>X} ,R}O t7 (C2(]chMߧ6x he On?ɍ?A; ZR_ ޾Sti~wQ)YyW'9zG+K5[6Dendstream endobj 620 0 obj << /Filter /FlateDecode /Length 1491 >> stream xXKoFWtUH IH^h]@=H3Jb"}{Yii0ɧ'L9je:tzX:-鴐El7R PZ(#9TӌWYhS%٘3N5yY.yAsM O_Q<k׊|>f R`$B"ۈ7JT%v;9ɭwF38"5ΐpJrIY]0ɝ 8uLt2+iLNK{׮{w%a1G\.'~6C(ϤVMVߏHЉHΥ'i(FWijkij9}Ko+su+H`&1H(KԅvwMDi;UM_붹]ȍAZdLuQΘ>P5Mum[cHc$)-ͅDz),r[vST{/M63?aP7/!1API}?V]z R/ɠ>mn7?Mo=u]&0KrCo&CY BhѪ/G*JH,Cb[H%:> R'oTqFDvhxoUz_1|N8&j̚$b:]xV |R$KҺ P >X npzS%C dtY> ĐTAɺcmfm"@M%DXHz쭼P~lrJŔbŵUY{,3šu:n,n*|?K=<62dI`B^"kI#D>DtCIA1/L`„b'I1yf@皇َ7v7/|I >~=*Cy疹(5-X[%?(_ q$%PM]J gANxl[oX9D/c[㤳o1th5~$ Ks7hy3ڑ2V%E 7B;;w(!cF6y7췎Zо~HX &b4V&GVQr,@ &xQmk{>j;Hυ@' ahsJP<-,+.Ɏf E$ ifI_9?#jn" lm@b-eVb?vU~+LaghꘖHjYFdyendstream endobj 621 0 obj << /Filter /FlateDecode /Length 3460 >> stream xZY~oK/FKs(Q|-T*hI-! V~}"-=,1cqZtZj=)דFzɟ_RPaKK&~:RzBx9xԂf[(3.K3d~}1UXIfeQJiiIUoO\(^7q\lT)0l.,REoFrTP i8L~gQ!!;f0SCL $3jFL\F)/Kl.} yrlO'OZ` 8p`x0 )/'l~i)~Ner:w|E#V2- A6t$0pG`LQuTmyfy j.sXLeCY)n=F nei-7USMG&Vڶ޶ɱ5 &r8,l4w_?Rrp)|nQTz'dFcJ!v{DaD+NVQnCi^hT %IE)EǷM)!J " k9;F-YEyCo:IZQ=p~yxCJZ4țYȊi>MEn]'J{Pn^n!Rr:?OPao>?˳8 x~yՅw=@W,GɓYS+FfXi> SoW?9G;yKgDɃ5l:w![6j ;qN1V_NeA%?~uz)z)ODd Tl@4w/LRОL3t13lֹ=BȖ}p4 i q2{r۽:=,ϙ] Zz۸93v׀0{lRu:hJ D+B ɶ р\b$ ̘Q9zgыhV(qDM~:\)-3CF^Q9XqOG 2 W(*Ԋ``9 C[]vb00 +C TYRL&*n] ' ַ>EUj8~|uus3*Y`ѵAI"`pp%1 Hv12C*8>iX!-A|U}h1>˩WH͐ Ҥp q٣O Rw$,櫗OleaNvW5(1 7A۠G!ˋaVg!.)ryA C9X3G5&HHSNl=u*2! DXmŝQ{GBđ"hBXE˘02EW ?%e}Q PDy%9 .1HVK=L]b(`>;* Gs rHqW˰)v.J̈Ν3mmRa #4:A|4] 4! S8w{1>kajJ\<  cq]N=h5ђå@B!@nLϩ"*!uF% oY";w@a@OV o\-%C;Ot4v({N7P8Oߺ>)q/Z/q+]< M{D?y&2 }RG-~?YHLGDZ{x=Ԑp :')C׶Upb҅4fpi;:MA&cnHy/Hcs=v_`9>Ci)!$DKLLYX1BT M;iqwîqW $%/,^5Qw/k#:. `R#,^0Hg.[kqg-$G6腁pNJ;e϶Yf~[orPrB^|{8Fg 'g;Rԡ>+@l0+L ^jBb& pk6r/"B` 7fy{Z{{v8mC {C~x·! ?|e"q~t!isU]dƺFƊǻh@y9 3xk?6&x"$Iv1B XTe)WH}%2&-z"N\]c6kTKvq8@c4=qFڣtbbG)bP*(?'pO2ZZ4EX/ϊ&!?x" įIglXx﨤)_t@($T ^"?Qڕ/}S\581}9zPbNˎeFK@dM>yԫ^&Lo!;&5sws>]O8rGA !7;`Y\|!0 [YF|YX0d ~;P*H&V܏9<\l>>0)֜el 袶9ZGlKx͢j/}ɲttz%1D1J끤^طu4$8YmL@!h >fN(SpDnɟ&Jendstream endobj 622 0 obj << /Filter /FlateDecode /Length 2553 >> stream xYKs봹R0̊=ݖr:S\S;)*+xndfUhz H "hd?.jmZqphV G$̕G^: jyssi;EuTm][.pEzE!3UM ;ia/~()ۦud&M_]oіۅ| 7Œs?OB39x}Z7'TQRz 5bxc YydHZoHD!ضS)r p R,9LL9IvʤW!.E/Fˤ ]`Q_ :T P ǚ,!i1USzBq[I:!q~l5,Pa i[yN/n8X*\93r U.&ON)plum=aPK4TQJ(cZV Ӭ'8z&2ͅhT0%G&rpmu~A4P~ q7}J)ˎ.v~Kg%& QjG!JHMNux`2%d)"UCRfZPG}/EƸĔ> oKH np[a#jEE?( gBnf1xPEe4@ka|~Vqj!  ?$JM"Q2nk`6FD!<ΑԷTjmrL2.‡M|a$, hj\H+u=`flF ˲J3nʄ$GkF`YnPhE 쨠V_Wr${-[6^ Dʮ]u lGB,GA; sPQ"| jbKmY yhYTƘyj‡qDɄIec O#AĻöݐa_a4mh8cѮcAX #G(?(Ie'*5wo]B 料Ka3y1Yp5OiNjvnu/@h25X_H`LQwG"~l"lT,z'C3vk X=}222\+{bPB! Xsd饸jCwB;iI4q]1  aG*G503B)#2\ M9wg}JbgbofJ2) |M /Q;w`m D_uo$J@Bߡ0ϕo]?gJ!Zv$=%#$3>:WN[2>eMz2y$ELh]Sé9nCCI  w/^<* SQW΍OGٖ+DW!.O*̵6cŀjƒ7{oES)CGD$C p:{#$=ĸ&xC} /X0R^3\zQoa3Ջ^xO.쇲)7I/{/3?^f!sh6Ɯڻ)?I k*`.zfs1\/{*ũ-.n(>#H =5`mmR6vGGwdiŒ)Mn| /?D 7*jhB;BEEs[u95B> stream x\sqY|pUbNC|Uq$ϱSNF83QROw ԇׇD_7J_{=7gg~]?ůVtc3߇-,[eJ'|{V<֒%Yj=ί>ۺ_re+%ץ~˪0rE?+#hQl0þf\']I.maRUApIeVۢ]ߎ&Eh ˊf1[s詊E ,~ Og%`EJjqR\8x//yKSJ`4#X~,T)KUB*^xW%]+e: `_6Kp^9+Fn\qaY 3dž0sl`rv>Z"9;MLh$4(8AM>II%c"ԏT6s@h'QMY Qa`vM(ކr-ήgA57)Ol-l1W}]hYnXܭ M2n'1 Dd70|%!};un6vfm$2CJ :ߔ?f3ǤR+5WA Pr}>'EpK?;V|O@VRz1P[E,sJ\g7zvy!lq"NW3KdKTRĿ |5/嚙8;eO2ؔV#76| BTC»My$ZJꦴ"@Cx׮SkI'?ghߌ^hp6;m6^YqaQXwu)d5@=,yf冓EaJHpH9NӁw1)c/}G@vwDQQ)lptf#`l_4nr'܁Uk6/@ܓEGƤO+fJaSH!*GipKҮ_J"5+@D :.<1M5Im(K>ۇqJp3OK1.1֣-†!nKu!g 7 l҈P/m25.ɼ'i/T8-=K]\ tđ; Car}rV,Nm! =j_bh\=wtsS0 t$N>KaehC uӜ T@R✨5(il&ÆsE=Ϩl6]t~0}? %8f7L-Ufbjѐ47(g@+Y 5f1xͩN}=`j0qI&#Ch2ˀ%])R!- <%kdM| b J'%"2UOezYc yq}tX{` W$'c$L+p_`JYן/?`˿)QaIK$a|z~I?; 9y\Sq\ !"/4rjm&JbG )7ܴ -A<\ %XㅜSlRͲ7y*diHX';P^c?aq`m[T=я씹Ei%z.z7Kj ?j1k!bԹ3o]/1¨JVc,{:,Z(d$&K^LfcKX5`CVVtg Yٯ}~2b0Qq liA! !'"2DEY rw)ԘɫY05'4qt& T\8dh3h2zrTJO _z>t`Mqj_٢#ciFTxg13p];7X a{8B-zRAI2 ^Cws(_M.?&rZyxw4ةSh I`ã8 l.PT0>^jƻsl V fa|æ9J)ի':ߡ/#& Q.󤩗7|~X6u<mChe`8di?h;Inlzy zM 1GhB B1zɎJQ3oGu,gzC`'5AT!9ڟ),WYd6Iϻ{ bL& K2K%`^^(3nezG&j.& + UMae(כ>B'D3l&c8l7iSG2hWd`fEg<ۑoX-|jP'q$9H@#擮2ʫsK4 ,2ǨaxqNT{8S ELףcH"&:dU-nÔY>YO__ HΌn?gO ?) VE0Qk IcBhBYOEyݰ!#Q3ƕH-m8a*ļl"ѣ%aʌWiVq.6`2.*6ykύx)g3h!;Eq2[{v :“x~6cDw?SZf((*1txulNJ:J띯~EZFK̩N1pnN |R&p^Fy6O%EmYY!62p29;17spk0fx{ F7lC|f饢͡t*.RJT`!UB)x00AV-= p)B:2WwK &2&E^h#e蠲3%h9Uپ77X:qǵW^_! ߥݼ*p31.Kcc"n/W|g)p3c&;yN7͊巜 &RsT#؎ߧ:f/?J#8endstream endobj 624 0 obj << /Filter /FlateDecode /Length 2849 >> stream xnor(fk23d,f Z% Eݔ w~ Uݤ AdyEټaVgf̝ß7?2)ʲn9΍2 5_=>7tSk9yha%%GZbVT&FZҮ_MU+96GDҪ>]bu-M\ԈR욇z<*Na&c fЍCauM# ٻtѐ]~Z ^\X*-}u;#.V? cRcFr;Wt?or45(LS?6$59.yWQيB:BB ]pՠ>RwFMkkjlfԌ6@kKRJ,5ZcR}Ya/Yu1qHPVe_I r&5b X0٥FDcM\knNK qh#b෡ ހss-!| 0n0>X*."ͱH\8.:W~]6}u_Uv{U MoM8m8Y"=<Ȼ^?uK"dƛ&nzsK7n|ve?#{0mħ3]I`5q~t}εt"J<6럛wJ=v;IíJZ?p*Niݶ]t-7!Va y\>7Me9/>V/HJq7 @f0֥%N {A0_kXpIBBՍ$ |x7j6hx8*c :0fqrSܢ(V6L?sYLK@F-omh%K ĉl}5 U2Jc.9vM^R \m{y!)J!qȏ[r&"Z>u48y^^٘9h,,գ~C(/X2F98 [H\ t|Jh $ǪUc%A)$Z<MRˏr! %R ym`DRԇJ\x} B}s%ARɤP;v;QPt|B/?@ݼ" 0XP̱`Ztf3PұJA;r@_at9)Q I-;П9Z%omw0gAqOK3Q*}|('9HA)=Lv# $Grr/!fAq h@zj)p>-7+c/L׮^ *d*Gif]CV&.^[ͻpAB *` դ U@HBt@ҹPL=E:K 2Y4Gr g@s! 1~W.kfG<<4/ޱT3i.)8k>TbBzə.U;+M<+7Ѵf'.(0XMй8S~ *W +hDp0.-!_W#m\#=ث>Q3/Os+qT!?P+ '$GuUC^ď]#>A űBL_^g&| :+|8V5Iv}'Ccjw]'?$:=@5@Y: D7/@t=ԓxpš.Bmm =N~gl]x:%4V0,٬w !!,3P_N-nFqmÅ o|M ~,+m1۶DݶnWPxX7romD*e&Z7ʊt @ron~k'fu?;'xnvY` /Fy`v}XiC<=.".DY/ a .1v[::NǽъeRAlSXx9Sv掣YUka/lE!Ҁ?…Œ)]d\UiIiF;]+mZw|ɗgQGRGmsszlJ-qx]W7jRGbojp3owCm^Xu/#vx{+<{b6'+9-#n[10R>]endstream endobj 625 0 obj << /Filter /FlateDecode /Length 2311 >> stream xێ۸@}(P#/K;tS Cfķ4M琢Dʚ4iaasnN36~fλaz52K-ofs67dV0#.Z怱%~KNӇיGu{Y[Ќ*a"isIJx|_ܖTrg*TjJ,9xJk*rdF4SCDev$H06_ Z{vRg |.k˦݀Y*7\:NDz#A9)#/v 49ں*$eӔO<p3l-@cZ ?zi]G4M|sRvӼi$)xa$4 v0M[m䪁c1*-1 ƒ\ă@:Ɇr%J:zDΫ>$2y&B}_}(C-[SY)CXQgSsUBg>Y,XSC^Aᐋ;fH[{lIql*B:ݱF ̈HUe00 sVƋ/f5P>x%Unfӻ$wvJʝ4 *IXy;ys1} $M@G^'V],=>anfҢ91T^Dh-z9 \8N( <șy[UA*4%،:jw<N[%ՠεdNZy"GDɃ1</''<{1 kl'BoE5?4~q_Oй:f\<*pnXqٴ`&wظ">[nrJ4L`辉hQUBRo 0c&2\5+dŀMpn/ y` kHR՜sZ<5i>@]7J]f\V9̕24 Zfd;Y6UgR{xhO}Wzpw"4m? g?Jh p4cۍkCo38>KBLB%,6@T^}Pn~b~{G2|,i1'SL]t4R8=^eMkʻ-]m7.ْÇ-i{aw-{84)q w}3쉫 tBV;0;nDABNO\ЌY""Ox +H0=zs !`>4_wr)`c}zx~  '06Yɚ>ءݫ- $yc>lwEu|1Ls!E[<<]+}Gb@]1o~ؕ@6ps c&,:‹KL.Kåq 7X]\>rvUHА/NϡӸNS)p>r *Ghxp*Y+Jc"&Q޲'}Oɔ/v՛;({,fNMGO@yZ|:^'~?g3גendstream endobj 626 0 obj << /Filter /FlateDecode /Length 3027 >> stream xZ[.7> *,w@hbA]MVHZwz/3l7.;)|_݄r7j1\IxEs|5|ʕՖ:|K:'țLK˙#@ʐld"+O*itxyU,ho(c|W~ӯh YJIm+V/g(dl8"r6,]4{-š'QՄ(>[R͕ӹԴ2xO6z[KyCi$mp5|ґ,tA.O Q3C*5,S FeȾJD\T%Xl 1YE!"{KV0YyM~۽o-`;kvT'im'H?"%ޓs|_0G!”es[/{M1+idu/3~cjSg?ޮNCE>"zE{/ *&r (ish5tث^;u x̅Uxi[0}'snz*;rap?Wv{Y$e [4oyEiɝ u]귨L]{a]oUeQ0 '1% <3 84ua]?d1VM{܎X q6{m 5a,QV yΥyrhYIVc?@u t q=FFn :ʝdH pܲ:LRKfDVq?t+ h0tN8"H7\uQ6Ƀ)@L7.o6à_:aSCVġ0d[ tdAVML[S0?0h2MV!X\H2((n1!C}z"^l{  %ORK\!2bX*%?k^T(J%:}#In1c3pcF<#Ʊ]W[7R7Y.qT> %)R+Nn҇)JmWOI.Gt(VPJh˓UٻC{ƔÒ>> ?PUcW!7q=^#_%vY!u=G7PA O Mxm"99/!gglbdW%6u&6uޡ~ P4&ծ:e-2Dkh= &csC5Mh*|U2ER)`*e Ud.n [tEu7'Iv0EU})pt`Q~Km4Ff) - endstream endobj 627 0 obj << /Filter /FlateDecode /Length 6201 >> stream x]o$7r=<Vn&sw|َ?ĀJjH!@Tn=`3fUŪ_}Z_[\pEz񻓣uj]-2jqr}H~|=, Rs费^msln\6;\suܵuY7:7zHE y맔pvux ?Nri<^JڮyrGF)ˬMiV#({v9jCv#P ;k̤U,kg` S-A[XBv QM6כ˚=@JM! |kYJpZa5e}[]ntꉓEt2YyGžUBsځ˟/>tt~}̭RK.)ǥ0ET@UX_׿^bR <({ٕn Η_Mn5<.J|5)|5s4>Sa.Û6N~?76u?Φ8IZ$hf=ƛ>έ\v_das8+,F;M}&r]lZnF]uO]?$=}4c=xd= [`wD#OhZ+ZǑ Qe'UL'r4Y$8p? c ƪVVh xF7ylI&6~0 }qBmKM<0 8a$7vJDa* 0 `PlBfF73CP(3Z=23i &#)%#f;sbfk1w&ҟ+fZm#dE3+`e7 vݵ't|a$- nY RRWga)XUnK (:ɱ6S]h Hhxq%xHJM1kMiM.T젿#c\4 Z2gtM,!9xtÈHxDK HU|*rtn_vd l+@ A%‘ڬ%~Wu=*c=v5B\R]ctEhse'>(; UZΫo2^] !lH--wJ4ʃzK:ł,kY@ pN"-zvq?M n5k@ԇoG̗Fdۉ0gkpN@HNV=ؽOcjК.D > K8jzЀ"<p{1`^'u cNP#ӥ׫0`Fkef-W=灴,04-CO´pʼn!eW3KZ fibJ *"o NϹjPATKTQxK-ޒQU̶kSy2M_xu&YQmN[_77oNSAGSeڤPd},?YL=O!kFУzsn=ٮGn[,J2 ,Gax j8ɱ^R68& vEd:,PTaI/p,Uf>pO{EҞ:?Z 6'»<Վ RDHh\.x$H?M&= ԃyk̎Eg'PўX\)nDrT(]8wZ89" ym0F4w:l7Ie`{q>W@5AU|;HHtb@z2p-dn]܀Apt1S8C4 \yTy$p vvs ]u?M3|XJH*UQz@!eQ*=_]yD3wX Q_g|c@% &b^{ss #d5_C!,b0;IȾ2 m3eK `e*ޤ7XWX5*[s/my8S%KC3PS7Z9Re.cĐS'ztɐz/(N` IcKTŮoe[J:VePJC5LY6epHl+rFY ,*&M-p@V' r,:m{arf3H0#@)RZ( G׫ݶ>a0Ẉ~Ucm5V鿯A0)t ,O?̃cP ;8&4]MփV`ogI6Mzr:8*⩊v.lI:B_3Iaחs&Ӑ'j j'UFՃ\A".sp(2xJ 7n_E tLgPL&sL-7{CҌ5%>6TyMW@wpzs OnTCB Ogെpy;z-yыLHUNbgM;pE 䚃u$BJF:yC%Uq 6OU>Me(S8vq8*9gvm}t)fea\8)6^N3q3%ޙzi"봄oUYe!K+_ ,ٱ3_Vc.BܓTK`s@c_ն#[+mfS:iyBl Vt5(?ʾ6 o1aʳ@Btto C3GvR?Mu2hb>Lʨ={~ `#mf%@IR!({4ıɏE4_~œE3v5hGFBaDmP\n?Th 2G}cLٿNHsm:&=m'uoIL{#n |v>tXtGb\z˸Jqxg-J/=UJ`hGl:qjJ?kri6nP\?SñW],b<#1%,Xj4A^\i7]iH`/ML Oza˃#`M#Ba΍Yd>JN)J⛃8¾?=N{eJ,,w9us6y1HPb(+>ExN^:/* YjO}jG>:zx!N ZV¦JĦƖۊ>ע]dU76i0o;fҵؕܚ0.-f52:X2Z,[AD͜L٤ӏ8j(LA8N{ҡ2NU ꑮe%"ʨlSh:LgR~1>z>5m7cZ8eAB_ތ0cT.Lr*?e2 "%v "A9#2/1TLnˤ^%ڱ~̪}kmx`a De4+zD n/*pe'Oju<,%ZlNwVe1_߲ z]hA%0z_u$\k*P%lXBfuMr;Pg0|DL#A^1]_tvz~V@uRBQ.Jsb YCs}ljhK?m֖k?k]QZrpWi ^S'vT@$5A'T2t'3h|)r$\y6Vܑ'VX;z㗥f~\Rϕp'V9:;*\і|EX:<@a}[NJUs%q՜ʺ"i%99CD͕,Au\vyxr:#e)0爐yۙI&9Ohrjϋ aZ2ܸA o.WvÛ5,xPsD%hk`]^Y:H:&-}^vH·3 ҜҰqaR[5u&-cEde67nR!3s Yo"$|mX uk_g~]2#wc9 6w`7%V#;b-ޘ=mL?+d-$H  { 莴:|MspdR ;5 \g*C{Kv @V %uX]CA eiWl%̓Z2_lgbÞhG\klrR{_\cs y(tќ.:J!x+u>xpѺCO>c!2u|KfnfjA- Z bU C ^BOUcYh2#I~d0Z-S ,kT?CmZp"4l*.p+8ø2"P54o\\ |͚7{_Q,ʏYIN '){ -﫣׿,endstream endobj 628 0 obj << /Filter /FlateDecode /Length 5043 >> stream xW'O}]\/xv1)u-^g؂Iު-2jqv}rC{Ӯ0sͻ%DžV7/O%;׬._Q˪MwCduKpEc>M/NFśɗG0|=m.=mm>DfOMm?~8/DxgR Zg'goNRRj_7_Zfm)l+]-oq]'GZ5n\^RYc~PKI?UQkd|8UuoW@n.DsݴM?spm6Ÿ VHiݼnw<_qyh.WH]]gy dV .g:Kףh鷸 %$9 !&z27  - zY,hto~ Kv?2p:)#]_4j)f$GZ`Q ʁoQYR?TbH"ҜV $i%JV6TJZd$ K~SF;6 {s@ ρ#~wUb/rbE czTƫݚ-@4S iAtLxuFp.@q!-\UAW-s֊obNeܚm=5ҚӺL ']ɉ*ef0LAF2}6-Ii2|+ p10D]?ҭ&6B4MLs-ڍgJbZcs(~iᅦmW/p}D[rp}x2 ̃ "nu폩a vroͳ@H[N(~$T>>!U@a ;^Un`k|d>i]yX W}S h|T>SR,G<ֵlHl?ZX_ _:I6Qf8[[e bc+?`/FHxoN@l^3أ[SJ*P[hveЀxA#0ͧR%8UƲ:cX;JӫdyU"7u`Fk-X$1YeWsAKܣUa^]e@dA@)A9zXf}/RV60h15Eq+rwh(19\r[pKʺA{nM㲺q16d% {[بJF56?XW;51io3p\> 1ʪkۀF R{Dk<"aqV+N{)(B@F Y_׳Yac_ 2<1k&ǕG/k ٪N<@W5Jk7owCpBK$D rl6L?E1Z $= ,5CzӯY@ '(%c2õh>%}qa1.Z`0NS5HV4Vݗai_C2Jwyƚ;7 |NJ|wU9d0dfs;]Bn[_r_eu3cI=w;w?v7~YhUӋrE"$(1Q.@Rx -jT.>OKAANn bFؓɏN xw]Z?P*&/~GLZj=6P2OBcaVЄ&m׀U.S>8͇ռ :fe.oK{v/e|fIbf'.\]LMHmlͧ<ֽP>V ۀ>XF5)i XzE}H5G Od!8JNg;X f4upkYBؐ4 g.F5o nX&>UX#ʊq(vE:6gӹ -D Ʃa.afv<}}^Øͱ֞XQŸ3x>`IS6D*gIHY`玀3ֱMhO?U&ɓA&c:L졫qȫV$_> HEV6jʜ+_w0$TsMes BaiЯ87ou ]T&fw3N?d]#?XB$M/)9–*mf˜ڒ+Pܝ)J#h~ ӫ\g d`c$g`z)cK:]N!Oiq\X܄ouXK켫~X8SiYy~?lE|W׌](cT5"L&׌rVtCG蕦pȬКMe2~ȇ_JCPpfݘ-M~o[ fZ=)G6WVUa9(aS6cB~Вlk( ÉG |jp]+HVs>,P8jt&"S hNg+,3cNuz@lJş-lƗ pl +Verm5ּHq>$BL$Ā֟7Ϸ 6~NO12Dq@^R\ǜxejfi\2f&3 C\&끁}Wɕ1 j#m7/nYPb)tGs  L Aڱ +MίSy0iAJR TÀ0rbd dutZiVE_/@]o1Xb?LqJ].\&pzs xK o?~,]"'%Bocq>+kuDZ8M@ $ϱ䆙]Z0*Zݷ38:evbGrV"0djA.Dir:o?s<%$wߞ :#cЖar"l&ʍDZY 抨,p鵡/s#(R~؊ڷKM:ǭ7֬#h{v}"дkw2~of'/ FZ2SD#'١ f7k!f}]:V'πFI);0C>u~=#rMA4<椰WmN BRdk :!BAB8Kxf:Z|4Ɨ 2T#;\%qbΑ 3覔O\]So<[w}Ae,gﶅg7 }Vc>_d~9`tLaMG909`瘯^W7_{ёoAX/ooO تendstream endobj 629 0 obj << /Filter /FlateDecode /Length 3415 >> stream xZ[[N_/EKb~I-bM:ڻjzry# Z9ɹ}3C8aOM/#N'G_~ϙO3''WGq 8>R/dyDEj+jxVFSMr֓U~* H7=2ʴy2_o?%#y<}96Tn~}9O)y1))c\#J;#moRJx'ff@Q y@j#5imRW´2I%L0K2Z?XeS&pFfʷR:܊II*Q>af;ܸ@ǐ[_iXzw\vC%(5#om+5Nfsb g^JޒBJ_mK5q9093NX,>bf*dD5P$h@ wEіfT+jru:7i'|Xы7(]oJft|JtGcGڃw} hٷgGWYQ5dG'H`Cy<0W}5U?@x8IInOn ܷ.?Xz>?0ܖ~0  <|! G'1Ma/ ,"IO)`! @l(>{@u/of }@ȘV$ds_!g0:cis5aȸ9']3Q((9髖HUB6hY -)t0(Y 5m %bWZ="2s/"5#bacx9 ]5E3_.,GZF;G2NʻdWaf4,JI!UOL1:PUqoN>1l,(l`!S @T&ZOBV#t?Or?K{3Ax2g]B],}-DBcVuFcL1Ee#i~#Z$LM}n{@ub&:p1P +>k BRptĴ2M\/6L 9 Jo cɟ`I@)MnbqY~W |ڙd`b5DvQe[hPivx)|T4s;)(OmEV K\ڱu)e}V } 8gD'8LռJ+Rkl]>Z\rL h<:>am{u yNuPxƔRL _{ M3 *9hb^G7غ3fu>0em}r1viI-duٲ+vj/?$9^JM/^l[ݼ;zٕ)S {I3k1*c]OusuH0@껙 @Y| LBk.J= L`QwMDQR^uQkحJ3AH*ZctHJ U<1> stream xYn#W_ERȠ)qv (u ZDxGu #g8CJEn]x9<<>S(//7V\O>MxX-?|w\I,Q/Wn/T3WNb| t:RPy?eiYrt&5d9u'ddΑej^dNSmE36yqHxv:}COW)%&}96jAnI'_ZDfHWA3|óo%y[7_38+ӀQ| |:1dťB3%ueY̴`-TZr:kYubƩFmdcp~)Krj /{J< DgnAM*[ZWm<9 9\1Y=S\&m{7Ɍ^Q(wfTԎ+_c/(Ʃ yPT.yYRƆsp5X ES1eV;g60^Z*-Nps1˳"3tԢл؄-AU{lj 8C2RlMB,o5%QZcn$jdloE/Y0f|u6xxWm@C/)VNiܵM.c[,+5 E"ִH%|=XEd#l|\6nUout/.eyClX^hLJ19wU^k7;x{'v_n}<=m*«1i|84"ђߡFhsU^sXox )04$np 4d;FQŤ4\F:NqnGw1a4CXu jw>FrD>>X:Aa0d~3OT\`XؾfCWE-.fq4us ;|<-]4-O~,!B`(X.S#;0J,3Fxk5YzF84lF`c$MBlvCQVJrV4n[NU [znh)'u{j]'aZUM]uJpսb6tlx6 ,ZYU4HC^Zn>/Jqz҉yxߛe_7[~uRNHIBm${kJ)gH$?dbnj$wk3|䠉h/d6^O`C4R/Bi݃Y .j駻A#'9T2҆fMdܢ9.1m%](tR:ܤ _zhEjS mߧ_{{F\9DgOZ`xo`oәU4.IARXܣ+ .0w@,eJ_%zTiK3aNe{@^ ;>!*ޞ6im??^U9 ܋3`Ke$7e~sq%;Հƌ)&0WiP2GbCl v d Z! rʙ!5]VMb>"@/BYrނPc`q?2jO$L!ݽq!~n\w}YWw,GBڈy c7YCud=un?Zț4R N_,#a39endstream endobj 631 0 obj << /Filter /FlateDecode /Length 3247 >> stream xZێ}`?! dİ:qxc+@OpFJק(_ra[SJ0+ >+oj{Vn>qz: ]mg/g{K W:>[^6|VնpRϖ3&|Z+Yõ2Z,Wgٶ~ hUYa.L]3Ecu #q,`6qRzWTBUB)]aE"+]T[wR={(,Z@Kͦ3gZ^.8KmV$9-.*cCaB0]u~p]_ׇmݡ%8k<^Jmn|'aCj6\J?զ_=:i힨EleuV2g/Zs^L8jTU͖ߝ-> #dٷW Mk,L0J_CRNX{OwJWl R|ds$W3s2"ѡ06°zs{ޜi9X6Y u&htYWshKZpxZKZd77Ӿ(5_ǹ)q#\UKKaͮ |`1QxJ -@ZX'Jw28p{Q*MֶۇڲQC8+`m]M?E`,pW{*2lY_oip@WqG5qLpɣCHYv=CO=2VlXrlI&baWԅ1%7=xxxBoMQa=#b_BݸY;HNB3opt}2PT8ԀU}Il?FI-&LQ Qc?'8qÞljmXk) c PD|?\i+kf/C/rn6KyU$88 t{h}SV )Fݐ[a*z"9#B0,h(46TT$\ |ٟw3 Ae``p NGC3+Nա#cўeMgKR-Þ|ܦh]ΞٶWQh3Z@3Mpj3BU4+W !v jLj{q"3BR)=qZB>@Pr71=VExHp]?v;)!i.7D#և ʅWǼr Q=rR !a,dND sb@YιxD̀M666Ȳ[aVک*;*O>Ei/Z&vWȩEu\æq,}eE'Sj`}XŮvU"M1yL52^0FgO+8HE<m[8{(@6D>A>x\ (8+ѹ)ɐgοMv%tTpy7dN 1J~{7mH.س.Gѻ|wn:2Z!+A2%I0^y׽XG/R " p鵫Iu=kCiJ@y_ѽ%ҩ3>4Vً>k{痤ITcsHCb(ZfwP62)Bv:2#&БWĕMf>QA%*)'Wy~GSTdIi ,5eD6S5=RŔՑ)9m0Ē%#-d0aP[<:@-Ld2i+8#sO:>%Y)zd;;ގuo(-f& &4r$\3V׮J}պ#HH|TLиnX@?D:`XI"YV&ag_p[0\ %2I D=9Jkr'd;$m2qru581119Ow̄0 Uh(Z/@sM$T*(gd*ǔ/Sm4Y?5â_65)#jzǮSNB.l4Uaqfmet Z$s>ZD.3_arKME>6vm{R}xhmǜՑg TŚ}'`Hffzv#]gSvF*(PR(5^Y:Nkoٯ h6TF'A`?=P-{ |aW㙓?N"WB@}^yGy~&0Be fشOEFI Qˡ5 c Cs5LќuLWDaixDCQ+`m(!k)*) e)t,}DV̞;=ZuL# Qi~ 0΋ 4AeH#3ǽ*^_}yQ9Lu'm\M,^r%zA]-ST}u[o0YCȐ$:ŧx]G<߾' ޭnnrXML(Wq.؏%h\Ej ,ܽG&(>% TYٜ/\Z(--Y26ũ 8rTazr,}f|$.B_5߂ӝm=I>ÓǓ|0Bř(Ck\c;Zԯ՜^<^%NC BBgr(-U]TP@rխ ~ E_0꿽 f^ >|6߄gLSz·~[|t,C?uc^j|"##~ԿmW'/zAdje(O!JJi,q* :a1e!ЌCɷTNr0UBlC%O;Jqmo`p5wi%ИT2іJrYQgB=>tendstream endobj 632 0 obj << /Filter /FlateDecode /Length 2928 >> stream xYIs>C3"/8U$c=T%5(Ip@PzAh6tx[ d_=ógĭ¿ϯgTlly}̔PabܞA_c0s\` j D®FM5O/-вHCxD(wɋdϊ~smY2Mv_ͭuX? uυlt,.J7ߨM77߭±JΔ)j_VgW h9-( zBPnED[o[U^\~q]Uy6<˳s.UPjSFڲդpEJXVA3ǚk- 8_TTco D(a%rlXXrGg '{"2Y,p*41qLh,|ҞN`pr 4l^( 5swLDMwarJ=XE O7:`F6> ( RQ&6iY.XH)wAnΜ)E6B Hc{a([ڗm٬RΛ@IID՛E5 G DA&~T fisI e$2ܗ$t[r.cp<ë, 9)կ6nSQ AyGy-uPp7i'\C.4Ixns14VD+he<"c~eV ~M ;6{-!ʮnX'ׇ[2Te[>KXꮾs,(wyXh!͍4@!: ؠM+# ^"CpŴBeQh^@H*%U7xo Oc[p&lGBhoV!mf Z?pÉ27!}'ڢ:V 4|a !\ks ;n1C`/TK:!16ף$dS'c䠆m֐a=%C_?ˇÓL'x`M5 fϟ ;:$`Vv>OX4'Xz[B,M\8LGO&)\;j'qW§.cg)RV|z-<2ֆ7Z#ia,Kg 7ېN9`պޭ.12="`. n:V@5>0=F )Ëut3ՇDťTZ}bH1C}X: G]xHL tlPˣAQ} #0XVcSΎ*ǦK.,캎5"jsTẠ*!7WE}Ы MXƥ.!i"L4*uB;m\MM)C1coG5f\>UKɌtj7t);P= +م&q@ n6](5Gc\p_[OCm5Q.jۜHJc$9j۷Sj!vyɝ*z, f|3kWW}L[OVݏ.!8m[߱&<էalp,=噯ēA9\B{#B/}w' !2 2c(22oP:Y:3DH""T@r{uUp]ke@sޙ*shQ6͋v ԒS`NGzhFSgBSn20탎i,g z%"?agrB? Jg~U Xot cs`V@ ;c "n]Q<&V.cՏcUxDІ t>>_ni'.@8*2$3mr5)VsW&LElf=B2a塤Њ9_~ GaP<aSV 13/h'\95*(D|:9<"YSD њJc{Fqmn\'6l^=mbŒ??RH1c &{[k@9-l7#.=ak?ij`C~7#N~?^F 3t؝f>0ȥJ]!_Nܪ>d,< cs7䣛 DЁeĤO^6ᣫIOZ ?bn ia3ԥJFxmß3endstream endobj 633 0 obj << /Filter /FlateDecode /Length 2457 >> stream xYKsvU.)8ʃX+)*Kp.kAhrII&rxv+1،Hħfl;<b<;3bWeƳ͈)=BZĉrm7S>H[|dL'F9o?\Ui\gKoW)^Y쯓֦ܲev>,"[ߔRΞ c@+.>v j i g:Q8=o^g`bi" =M~u%J`Cv2v)ݲm,-IE#WT9ߊc#يq5~,D%L%?5%3#q3:r2*nlHhWV( וLF(|OQOfca+F:n8uaxd=zq{G/oBibS~ԪP_"-0 RT*E` tt 7|GݠDA~?EC-U*N *dY4勋46h[$(hI{JU MT%2;R~(S Z~\˜W4'zL3%=EoՕT 6Cu'Fkjֳ>W˧'O趃=:rwOF쇟NN&_ݔ?¾yliL9Y[!i'QKs+3pH؇:xd]Ofz`;-aA~].][G`HȞ. J/OgRD`GZ;kigRa!.KQ2dO Pu}cRs+,s(h ^R۹}(ayW-arZ%P&\m̵ձuXM&Kgmd8L 9a-8M}>4a6WT6%,vG5pfdW?n_=(hbֲ[Ll.׀ٻ =qå ً^?"=),;UY[ JW{*6e<ЃPeAW"&;-eWq3SZ&c{%c3itB2)mZ؋ot3 dg?[w,do*'-cr~HJ;hB;abgi$]dʥхDک ض}aEϋk};oazv Ph> n$8ZuiqSåK9׭ϊO{$Cx'҆?z=_{-"d>0@44Q0\}锸6PVikG?l7/Q~nGs9s}҉dZ˕TT7~/yU P RCB'ܳRsO(2_sMQϔzͶXj5l'v?ӟ*W7۩ʛS4CMEA Ә^]D7Xo?<u,;]nـxz >il_!jbOóN'kb@C,殉EaH%Ă &uղ0F>V2`:]G6~Vendstream endobj 634 0 obj << /Filter /FlateDecode /Length 1768 >> stream xX˒FX(hRHY,4fFĶ,τv[e M*4c]Gx|34"N:3e2]=dL86c%Tf֣KS[Ggdєs22i)Ko6'SؔQd*(D*f^f$g I' =G_m۪4ySN2 nh{bUp8#:/7`|N,4*ҍ g\ .8fU bq[Ύvg]PUmb@ǀ arHT !5a4RҒckn #qе.MF הUqg4 fAicorvqف߂0& uOE8uK>X6heB"h%/pGu.f`) ̥1kXQt$"nW]}{ I2 65 K4O oWѻQŸBNi%OcMls2j}L>huf^1RBsd/徭L)]͘ &d/|ҕċӑW !L2WP6Pܦ͇|, Ѳ̺Лf2M?K +bږZDiVG5U8/'Pᬪ g cAij ;uQ N E)3H|t6T ϸ>2o pCŽOkC PdyCdaqkN}P@x)VYȬCWO1irHPs5VjѕXxܬu^Q-n.y\ѧ~8ۀ==le=WI;2uhk[Гmc $/8 QRiūo]3\ڀ 5GվUF/V džуx܆WC%:U.ӴON8ȔqʡtB|L^X{ّAGŮ)!?r -~߻p0=8:6zKFN"BnQM3 (Me.6;%*ZnQ֪ѹ-nCq]nbW^EκiwirkFϬSH84u7i`_:#fPP{k-ѕc{ 9^ۈl*[FC$)EkLX7S4ƣ0э*tFXF0/<`DwAK7"9XO>8kc zx&;b#8.ci`ƹE >?>RK  aʰ6HPe':p.`tu(9'ileB@虆qD/u_- & F,"DasT(CI "9~>~~7@sendstream endobj 635 0 obj << /Filter /FlateDecode /Length 1011 >> stream xV[o6~ׯKRd!{ VADKl~XC !8#1v#E_"K[2 ]4`HI qId c.) m !ʠ8zN et 6HA4';0|($)9}HRED[QhQSo1Lɀ0dP)  %)d*a3n)6N #FH2i)BnMRA9aȒԮEqv$q wutb66+6(؅s| F#xĜӈ룟AScv]+KW,_YMԍL]j ,le6*b)=T +ۮPD\_M4))*#=N>&)܀&bPm/mUQMv[~4$e]u(Y6_',A}9p7rl?JXm=Rƻ\:f'TT9v{xgABgvUR791E2HQ_a f%?- s8&qhaュ[,|0L{T+5T+,a[4۫(Y%T!e*xAK OIA-xb\r E5՜0[TkY30=tl;[vն<|.Ǎng=mTa\OuunbI ǁ:W_ĻԜ&cE(<Rӣ8h U?_pSs5UdK^b)E4־hz1*ɀ$!ւ& / 7pqQ|jL\c:I|*x] $Ts.Q<]B+8IB2./GF{ -t\f1x0( ߨ|e:Ryޜ3=ܽ)yݽɐʲʜOջiYv{G!endstream endobj 636 0 obj << /Filter /FlateDecode /Length 176 >> stream x]A E  Mɢ11޾I<6x){_u$XÖ4 fhq:T^T$Dh`U't0F!)?87_lY9ND!EFV!6uۙ+Kų[Js,ߩ1Ē(SY4endstream endobj 637 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 533 >> stream xcd`ab`dd M3 JM/I, f!CǮ<<, }G1<=9(3=DXWHZ*$U*8)x%&ggg*$(x)34R3sBR#B]܃C530001021QLR e2f{hendstream endobj 638 0 obj << /Filter /FlateDecode /Length 163 >> stream x]O1 y@*,钡UĘ!B:t8K结ϼ5#8|Qm 5 H Yz' w~3rʫzSxUյZwJ`4]CIT @6榹I*`,Χl`_9SHendstream endobj 639 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 264 >> stream xcd`ab`dd M34 JM/I,f!Cܬ<<,7 }_1<9(3=DXWHZ*$U*8)x%&ggg*$(x)34R3sBR#B]܃C50\``````(a`bdd?3qG߷0~բxy؜u̙[r| 87mBU\XBy8L;!_>endstream endobj 640 0 obj << /Filter /FlateDecode /Length 160 >> stream x]O10 XЪj8(Nߗg|wYvg@ޣ'%M/ ZqvV&N:]uxj H>N\VBoh)jI4U6ֶI{`? jUqp8I.r V. S'endstream endobj 641 0 obj << /Filter /FlateDecode /Length 2637 >> stream xY_ooW՝_r$97MS/ADBQvCo:%2mHQ"9o4dcy1ӈ߼?;& ȾLPd8LE4B0I8y;!U"f4!IQPG$x?Ti02R$!$iK+r#24"uҼ"B<ᳰnQ$]|>*N.z7ic[-fѓN$y+{پe?=>N~E2.FDƓKP %B:P=q0z> -te6g@+"9(Һ?LNlŮ= F!$)[m3'.mh:o޿?ؤ`Ddǧ-QZK[&y)9.1* j~i] v%/ߟ}qA^XM1zUu^OF~{Q)w5FwvC F?Z該zWga_C7tu1_8-:f{\.ҏ[D=raS=-)װt^ak3O3T7AzAU^zHúEV- ii`,l=EQsXnS'wFUguyG}SkGʹ3Ry4/WY۬ˮJNOiݫ=;?B߆ :Ќn鲕z3Uҏ..סs>O|.*_dEVw^!g^;5IcA&s +BcSp||z#6묻S.;;H݃a;ؼ:;ԽD>51c4A43CQ`" &f:inA,֌[JCIғDe~rq׍j3#&͘P>N80V64I@)f։v)ˆER~^oט-aKQsgayto`4}d΃xA[0"0fSݞA!~[b:6FlZPis6cAsa*/܉E^f@T{3tF\h3+u a\"[^"]mB&Ð IR#N3 &2\#^FogR=Аv`i'5"{zQF.Rqh٫n̪0nIEhy$n10Ne'͡Yۗ<\IwlݰV3h;J%[TLb l.#(F+TP`bP I*0霛.EazȬ-VV^Zt20H(-zv ͩHB{[kA ;o_غd>3ŦuTr^@KѰZsxi*J> stream xZKsΙ\gñSbWI8^RbRK.dCX= P*sI@,_~Ak/ޞ3.opvԱ,LZQ0Nj{vJF9,+VNPeɍ;GIϣ.ȪεEdM&ivك;)+V_,-4Ͷxz6*N6<.WɤiKo _Of?WFS;\WKn_ݜ閫w P%%[TBVk{K~2']kkɗxڻu}=ܯ4O۾K4ZI~]hl]ڤJZkJ$}<]W˾{Xi,zL Fy:\=*Ymb߰j(F;-hl!p#\DVXFҲViQ3*XZP CsƆ'ك͌&E ilm<715} ]Rs}/!(|lmaŠ(Vm#cbRs-rI^_|TszyeemvY~+E|Oq'"dtͶ`};E ~ ֯qN*S KM#7%?EH*-\ D{P؄8j?J8F`*Fz (ZPs\xc)6t8rGd/ P;GSC*}aۯJ]=.KXp(n wNjpq\r@e8Ӑoh)Fqo >Q|WyE?TaA/ wUdCGaڽvE <%C6}s<#uHT!05k[ ##p~expYC G R>oPLc RI&w1Z 0( Ez f!,p=AL8mH@~\yxѱȤ\-^q(KYT eqߖ$#|cFݶЅa5h3 hR~s;yHmwTriC\ĵ DiM2yvh }pxيB~sϞ|@)KqAjR-Ђ1$MWapc.h4!#cG! rZ/@*J0)uI<.P=#ͱ "Z 0+3cОO?M=U(+l`p?S2IS+[B_$\]CVwnH%[VL{hX~(<±GNjiSq\@Ċ{ڔ:qB3ERn4dbm,mbJ5Ň5O@Ăo3|dnRMsKX=tԌa&TKp(4VhKO}f_(Ѳ ?=Vzfl#s5}T0 <2*F,4D xwAy yn_{&XC4[="7BGY"%U._tF* \|,}XuӅ4rP;xZaJ.'I*AV0:{΍0 "0?Ђ +*0y&9EG"\Xk",^ ,Gt@(k6)@=t9%&̮d"%Oʒ1馜s@> stream x\Iyr)x p]>ȖJ*29$SiB2搒^4#JR:ݯ}5 )\vFIr?QRi3:RdzG B1Y6 2)S wS[̧$kJlQիۯp(^lcnz>/3I)΄%!Q߾pFbsos^<'$tb[NY)ejZYncfV)̸,Rn* NR CdK'J&m4j: 6:LWem*OԘPy(iZH -- :oB {ǭP%^錙p6 l %pd:AmL"@OSLQ&Xo` :nnhTRxiWRY4ʒRF?/M6 U*c>n O0YTY'3M׼ &m f8cV_):`Lْjm&'(e_9)%U pq DekԜMD1=jsNҩK| ?` 0PF{/( lNRnZme{]ae1zY/B]/ZqlOACȈw7`D08hOD ,0( :H'fM94Kt%Gaӏhq\r[fG-ʠJܘ|1%fOFS?nqbF4'<;0Ne?'f7RF o a,sgEm]hQlEd۵׫:|$zw.i޻^]zݵqV ,d>!ÈL"1Dn ¶֫vOGkm;:ncRjyDA8!&d_ $|/ڇQ̊eNØO`2W:Й-$K3Z03aٕA ?̂ +@{? A͐1.2)¦2H628(Mډ(%Ĥ@v¤xf06!Lۜ Tߗ!p(daH߮W/pREO6zc8&cu RѪ@9p&C9~z1>)"I&ibpzU֫DI2Wd/ XfZ~^\t¹8]k^Dj==Fi(mW=i-1ĉ.1졂vCxΎʅ`=EfY B2DS6}۬ O[qvS?us `|kX* rѼo pI]"WB ޥA- cOMxaRz.hNLXE#Q ;4^UL$$I3EO`@OH'`-96A<=էlƒzK@M΀=Σ%-9UQid~thNMoXɛ32 cK9JR3AJ>SfV ݌%l$LEFG[ WYb&Z[sxs콛s~_SOP#\dĕȮYTX%#ܭƐ\A)d%B~BJr I.iT)qrܐdMs@R[J6sRr&3CUoi*7 tαޗKwx̰- sK/ևrYEaի,'95'N6`Oe4vKH`O Cm8H6\?ݯJ {mDux8܈Gnn.7ngxNuNj;& NAk($%yUVos6CTЎ2!&dy0_ҫ{lgnu`XB=•mn?c ~;pןDkJ;n5eKZ` 5૪[Op%DSFO9RTA3)66|(0NJ7WҞ,\mK)Ta8yd vmCYr2t0)f SG;o^Q̙L1|RicC7Uaq;qzuڤS_u9J*w~)9;gj:nyqz -p&biM`]4Y||PնrJ@%P@RB~>pMxWmm:^`1RI?+vǡ  VaFjxeia>Gֽɔr%̵GN\vu߻} ,o-Q}ނ̀8ANScOJ\[UVgjCSЏ+9C՝mxG'`mUۤ}_֎mܰ|pƵ 6OF}M**:GVLm3[hFS^+6\y@m XNT\# S$@ZG'lrj5ɁqwqV8ņ!8g'4(W%wV=VMj;* }B`筽w"kAuqM&9?c=bԩ-wZH +԰${)!JS~B^[&MXםohJ eU gj;딻ms,Wk?qʋ7Z5 w;Vm5Us[ܙu^Y}6Q#7nQ.݄\-s = T1c 2v ^N˧uaBǷQOʻ'Koo;e 6v/xF 1: hII2 O kl˻@]3zI݁j+^|yN,׊,'Bl7hv6:`o]`o>79g|_kv~JQ\+ʕYY\Ɓ']2c]?&+ƫi4lݤ'8=F;V?$̤+6[ŽusbGv܄xXou5JOIr6m S60Jhnw<>CfGĸ" EDv2ݩ%3ͩ); 6@ ͿdqK\:>IiqJtJKnۖiߣ8*jqSZJqG,TmЫw\  r0 o#^1yV@_"?AT> stream xr5gk*d0½/N0^/JR8UZh" -#;` ;`/{bfis,>9}-WUy^^p%*|arzY'R{Q~7frDBgʳ{ɴ+gF9}9?,˓{]*LUm'U#,2}:F(/;/e=EtuVOo\y̾l7ӺnO lJy$lTj>>q4Q+g >~U\+LyNdTYuڎ;v5"en/*{&;&g|ײ?9pg@#i C'yo۱6 l|\o[dk"HLߍ! Dϑ}+/4ˈ7RB:Xa<qp-82ULL%Eglد+?qQ~ކE&#Hiɹb&@ɘkփV}?QɑچFUYWuxrD p+} |0}/4pcȲ X%p:Q׃@[  v?h8 @!bwX/F(],GR1x>X{UiȢ{?u7)4g?+Z#yw-Ird%7r vJHrp  *G: P 3\̪H^>p˜8Hs-@:/%&J0 R4ofYMV6g ʦ"d庬W)/sY.;~қ5|T>2\W@-n^ U  ff.+4i<@ݴW]vǂs= IZ7WF uKܔZUvP:__vM C9 κ}qv(sXRvHJL( 2IEY'\:B1?yݹ`wH$!m<.{Ғp"6JnnQg}~jFp*f*!1 Z T\ؠQ(|݌5 4ej~`@h6Y5k*Z* 9EI%2 tk=>/z1(]f7E4\Ow \}uSwc@3H+˅ȱ rd*ppp"t0$d)XV] nehϻ zD%L[_}HZYb*?KN$ XH(DDe=Iw1gŚ~z>R [vw,Ô~yH"r.^;H-#D5 weQP1x\٣"x&Uf8$1#,wD[ksn0PSZU #FWUD|-ܗu }D?,}0-v}0h&i(h!UpP!"NX hoH:x|^K(^9?d`V*)B˄y~3N9oWIn=>.[Xd_3sx?NS>,;Mvۀ2AYC.Ld˸&A@Cs|8Pe6,B]@+!0`m?J}ЙB㋃Q&2B0a`5?@xPVk(@bkǕ1`{"/ZZ#+U:p CSq 7l_ƾB>z}nJ0,yz?Ոc O$ 9 4lrqWHeCD6m>c'& b^CiH31$8B5d\ΚcTPXU^$|Ƃ f_Sb4T@Wf e#WY5< $(UΨCD뵦216AU!mpu3x"ڳy1 ֡3~[i4iْP e)0 +iߺCп4ۥࡏRJ/w92Is n+izހ(ֿٖ!=eYĖ$ ɻx8W~oAJbJx+rii~2-7ڲȳsb:rsȀ2YNA*[|2nZ\ lFR^nsQ荃R<@b*A$x:Pd0]m'%ҵ:d&}ؑhO'Kfa](晴ysyKwSPhVYE` e`4! ǺA]2ANfP o @gv~NСL)C7TlZ&9~apS b=)ܽcEE1#'3hSO3(z]P Z `zq"N8*W,vy :ơz1TEؐ+ʤ(a0#NM蚠KՔeL;;g^U{<)r4Vu zC`ױ\Xg_LIR}ݔ #gMiA1s;sgp.7$naM2ձ5T9<7m#-#;61Z}3/Aln wG![6{QqT ]9n3w#r KEjvΌ݅=u3  A7j)+3P`2[oqDTf_@Iendstream endobj 645 0 obj << /Filter /FlateDecode /Length 2046 >> stream xX[o~{ES+ 4EiдR|aVmsf- r8s߹Ìb6'|v{p"hu6'=ZR^J7' -së56-6'}͕yUIve}6,u6JqSѥ*\_=JyLFnʹH_?I*uIN_e(.ZlN=3Ș*](S4.>Hߢ l ;X0cOIMslL^`gFj?̣u><T[waY-߇%D\ zB8avu}X$Ŷ߶/Dl ]IwBV\B Q&IR;[|w߃_*s]|[JKnO]n.E N2ưZצ`vӛ/q࠺ˆrbRpQBJNw*!~ p9 }75Pxd]P*Zu(B:m ck)9(e/&8:sUV12o/KV*|B]iwgϊ<!s^/e@'TowB-I% ,0|+ 0veZ_6k4+*Ѩġ5&}H1iԂ@cK>c.ٴ;-+.ٷ:kڭ'I>Q=MA>(mN?:6Tuc萱v.dQHf(!|T'?R]f9f2潈Q:Tp eA\LS! U GrHîqbE.kX]0@~vWq$DoQaqU(lPds=f֫KAIj*,wFO&l+ab$Q"KLiʳɰts+Ǹ}0GG, (tYNtL7f.ONtwp ϥB˯k "(;̕avB?OuO.K=, 4I\18&%x}N?@-}Su%I= r*e!_lHzJ2-o v"8 {8OpIm|l1$d@b" ]SoWQZD';:Vv7iB{Њڱ uMv8u?>Ć(+E8nG8)i?Ѷ nkTz'EYHa;ӽDUM횟jiT3/3eLY>gƵW5(A"9I ?%u ?1vtq;?%rɨb~KP)c%iר%Lʓ֔)Ms7[_ƍ\p$\ 2,%$PP%`^9RyEsKCŇ}\EסosYv/d_4 1zIN%Ywb1X]ߠ; qJLY;nkhȬ >U1H֮Iz2|iƑ _ G} £#kad_lj& ]g:Eʻi/HkT|2E} tGX ^άDbTF io 0{x.Mߡ-4o[Oڷ%^8`G-3,SF[/`n 6pv;X旉6; Gi`m6,"5$Ǜ7oP]!aH5~CHH^hy0ķnwܜ&NCMU|˂Bt w]>ѤZbxԬbt8B쇻z1{]( ǓP563$rKkG@\РKa4\Zdx?P 븦vzI ?nWendstream endobj 646 0 obj << /Filter /FlateDecode /Length 2072 >> stream xXo6Zcǰ hðb[a~PhYV&H")i;I;wwgK23#r+|* 6dΆ3d\ U&f.ݜda% j) jч7F +pST8{a)J&O$9 m,I)b(1h+KhF&0c 1e S.v7ȔHW&z /)9t.U Ed!l jAHɅ aZ`dqO#jD22a )|l S#ZidN nXg[ @l鐚v?nSFeH5˖מ:mΙc%!ukbjA 5v[#1"Y?k?q~*>;wUdEtbs׶b[_ ^D.҈=>ulj BۏU 5wA~׺jKl~j} g 6ÝUЃfߎ2j,111aoSr>nj8~t*YlмIe )#*H RR&B  p)%3D)DQn3pmȨ).CZÒP]j# $"O.jC]{BX5HaZU6ۺyXYo=Jcge 64rs#@sBit[P  =FMJnvǀw.#'QSءT.|B˭hImQ*< "Ak G3|miЖsU `jOFx" 7m\ V$)i2 jW1 CMW6og/˒pc?j|noLЋUozup` hx}z vC!u.k<Uihd]i9|Ir;pVԂMmӀK` 7DꑊM6e!9 B6~ΐ}v&`ER)kNY^'/(\ߜ>Ajk6t`0iO۲Bw(bðZ[<3코Zߟ3,6!~ %Ȩ펐P[s `z>֥SPЅP|i;@ClbIԹNOpkm83|eX~Q8Y].c& BXG~z҃$pw v̦Alȍ$9} "w’{8(8{(ﻐjq\;84Un9Evnb(ߖQ;FiTKۍ֎CW,t2WڿUs 4nY)L9(b۵&_H)4 `:Qyݿc$IJ}=Nɻ l|bw :Ь˂~’~>ļQRNJu ?oПu79[0r?'@WMq.8WUם~71$t݅/3@ Lv}@i8¤W[]ɟT7&+nsz/"L&".ByquuWg/|q< Т!.|s;U'gɄ\jG BT' ȧUO0qR3yHJe2B?%aBB ND9UKDz%_:|T29 `X&2ʧDmMx4{J TbR/Υ:s_!S䩻i`A 87:rM|v~3ɵKKr?U"KJ=մ> e$Cb L{2^׍}_x 0^nDǮ}:J._CR~endstream endobj 647 0 obj << /Filter /FlateDecode /Length 3708 >> stream x[K%>Tdh-ǃ7 ũCIX)YڃS:}P&9!Wo!-Y:th*٤|}RMO~=a$'ߜ|I?rlrvu TeJ'l}r^΄sx1J *WNgZ]\NgłH˝+KkN-2FȲtz|)XzMEB^gSQ&qycwY$k"-DagwMmӦ0xeR JPgB듙l2Z+e]oeŮϺtl\N Δ[89vwfHeeQZd=kzF96u,74_ %IYWVuKf~SLמL.5H܏>/W`;w#PoO;gwd"IMoju UEi57E]o}y( Lv9J ~:).Ir=e?o.^a>8ŏ޵f-ST0ͩ0ui)iN~<9x8YUq#ӳbRRնi_-7/vr{3L3q9{w$!20dŽg;Nz2J3M^ηQUnⴿQ Ѵѕ4`Fh333#qm*5EsiL7sb3Ѣ4H|eڤއN?  . դ= sc2( KKWKKA&~Xײtk݄%g*#+&LS2b!rf%0Q6c5C&5ؚMu{2B,U+<2H&Z}+*d%ˊ<31. _[H#v/'Df"SGbwUJ =>ev ,6* 7c'L1Ja$(zPm&CUBÁc&,D"F7׫QYBJ 8*brմyꚃxk*XE| EjRz꣪)\i$'%w͏IVNc 14q=ӯcBx뫧{˪+[2aC [&l*`Ə)91 >W eaGLz/P# 6J `Mґ_Xě0̻Ȃ, ,fBQY 6Ϡ)Ay(=`)' Z!MqM (IˆOĨ@gE 1Jk##xpQ_qaq/3䙎dDv[Us'RTMihH*1$ܒZZң`lAPbec4X;/%5cJ&q١?{SUr*-ǁ Bc{>^ 10vM4O'ȗ'eŭN,%!3Z=C:!rB*!z|CM7q^D_6a V  ! J0jYa&Uiqר*;E! (T, dU9<n! m 5SE"Wr;H3 9Yk㱴BfCh1齬}E1B-RU:lՑS } trճ|`' k] 38B޻vt=_z`@ *ƷMʷgqd 9P!7u>o޶IԃG{炃:[\i*wbuIq*.P =!vh'i06 a !`l _@P0Mt{5<:%Gbq A,@I>M@ E}>[xđ>@ )nwR!Uđ,ioaYr"yl] #uq$Z]*{ḆsŠKVb4#X]A1Iqh 5q(o [l#y5=7k4Y2R2 \BVǫjW9*gg&fUV Bm~p0 a ';BPθbM0kps -;O aG>TlpK4 Jo" e{ImsVn ո(ʑِz=Im2^%CW8zYebSji[ذ/ ~(MZ,'t`oQN'fu|"˴:z@gM>ۂx=LH{x^0 Ux?omwx?0ij[_ڮqvx:m;HXDaa2o't9t(~ ͢!*} (Tbt`9|OyIHw{'Fn]qQ"/o5}%-A #fA_[n_މ~ROSD7/>C{9v3'c3^~Rn`<<6FK-I0= 8 őѬązN~^I)"|MWj)^pB .PgAy1UER@5W֐M }@?^2u}̍cg]ص^L(.ʾXXgendstream endobj 648 0 obj << /Filter /FlateDecode /Length 3065 >> stream xZo/7?vBír$^K{/E| l$ӡ('n/:3KRRAPHHjvvCLL8>yuDӉo<=? sx'nb<+oN" 5\k+amTª"/Y_NJd zDɮ 7߮]ܰO4藄,3# v!~"+-eX!EV#qV*,`%kr~*0/]L#W>Zs%%[ԫŪJ 9]];xm,nD3Udt ^d>)AV7̖enuKEĸ)]`_'+ZS[ .4XW>](:␐y*Sjp8xPQ|ZhL3\! uİZ2 x[G [b39P^3C1y9%ѬwDo=G!Y6^ӵeZ|0r^l)Pm+z:bמ#M``4E"V쬁wX4;pP-ۮO; ?c(4:2ggϟaR^ſUBpYˁLM;|x~f~tdZAѮCCh0$i65ΙVgd\/Q_43%%ԉ6L(T*7O՗J5tC5g:/jnM.7O(^4|ЯvԱz暽#ܲ?("X:AmzݥQ V0&n`@~L7W]U,nF jvV3.W1Q^W@xG:)CnsfSc$is`,<@nquUoa' ^<!QoZQ;#{ejU[7/Db(Wi0e}5q^_-tD%kdtVU!oĩv) /tYI8T йCE-rp%`^ǝjbJh 3}yAFFWո Q<xlަI=g7f 'u&޼֮&KALuT Pp}JY<˗.  T˩VjH-r U"d)`%@FyΤHEbA${cqt롼- 4{8z`&jhr+B*jcfD!7R8"$4_oҽ). 4 4ic95LMG 2YSiaSQR}w˼.xY#9柖&QQ8cCѸFl^]Z`ެrbޓbzSwIϑ@}~SytRNZMrjC-s@鼷68P>= AAn]crv| IH⤣.'=&5:0כBա5$NPB+Jir pW MSF)F]̻h0̌tO=xXDD:}ZPOJ#ЙC\l.UAiؿΖP ls96_E_4 ɓ'ZvN438s %=g$.W͇>e?qlcsdcl6xyx4J~ajRV7ˢ ''#H=;Jv|O&Q5I:`}?^<4 > [a$ŶOf"'޺f zӭZ8 >1uk19{5GCmlkzh K3顗 @N vhA~kɮ+{W?0vPendstream endobj 649 0 obj << /Filter /FlateDecode /Length 2832 >> stream xZKoaNMgŰd#'rV>pF8_?~P$vDvwUu=zп,.2}h/WԼ]?o*ՙ=CTTfz<\.V;&MTkF~J4<&ɒBmg GLkR=+e߾r IViH0i)r,<#UbJxbJ57g\Ș}Uz5|2amaZ*Եgi7Qg/TFe8?Eo;S"q *t,utlJ>p4ޓ!8dWve=4b "VN~/57nsİSW#92A,R)`HE=Hr=,T2 e- WOwVx`t"^ZuRp_3DiĂL ؉Q 7?'-yiۿietۗove[sC?6ۮzXC-7~NSd> i !|fH`@ ]/ VHS<~u^9O(bDpA#cϻi^$Eu.Ct}Ul+E Wwy{ 2(PbKԨ<)쏞? cEyIġ?D' (y1q111%@W>4eTEkizJ:6o 'Ev͓?!IwZ\p*Ŕ ZluoAK ])> &cDqH|6Z;z̳韨]X，S3$_Fb]wن2 @(S3P:4n<ǵeSz.,ɡ".C)4]^-! ;_[l`՞e(릍Qڕː0#54X&E)Y0:(9_og Bi$FsMY.1,  il텖'Kr=6`Xv1Dz WNDf]E I;@B>2Njozώ[1ҘRTf2\v Qlo+ \q5%?*j ʠ hg*daՇshxRmJ4^@[^-t,n" :fƘۥA`6Iܟ#OTZfumQRr/ĥb'eSfc?u81ث$rsHS-|H#u@O3:z31Iø#91rVf'z̒$uUjhƷTjXI|1F >z][oN3rdv]$D*=S͡;+mbs>:v=$tC_\wSB/P6~(Il<0$^v6*Ύ=KXl4W f6I\JNrp?9h$4nT=pCGwadT r-pPۦwӡ6cUozGaс u[xW>Qd5{iQ׍>HS'e-7i_ޣX()7 ;8^緯&(!4ÒF(ݟf0+rnp^K苅td%9 |s,@w;Y@/w¥3l ̳OjéeFs%I΄i֚+,I< uN'd>),FlH =bDs(qԘ #Y DIH_#=Ѣ q:f% 8 \Pc pTM<'=L&dم/ O+3 Bz2;V:aZ,!Wb{,̙Coag.;]&RO'ɸǝ̕ߙ%澧H5Y'qQ&Gɴ>3, :kGJWV8Q=dwps>cB'P`zFsi%Ln1ܜS~pMEWtendstream endobj 650 0 obj << /Filter /FlateDecode /Length 6083 >> stream x\r\Gr!o&84b$Lx!@3@>'3[ Atv=y2c^ޟ̻87' H67;wsܮ]IeBڝߟL9F=f_8_aO{pӷKF׋3|c~wzcs63n.eT:=^o?=Saa0 gfzhizifq0)??#5Ur s@wޕ%w׻=|V>]ާTBتײ++S׮ywx{{wib+yw=JK{X%]ݹGg:t}99O|=K=,W<t P=(.@~Bu)m_P1>kJɺVRAvz6C٤8/2&9۪ąC]&NRla$ B7F]7Cq؛SRẲA) 㡰 wAmI$c1Qa;!̡"TAD8V(3}vJT(NPRlfT ~{I|rǴ=B*y3ADm%!orݧ(mq.[J7fV8>II~c!4FuՄKZSK[5DW[H&aΓVݝ?0|ߥ3O yD׽fQ/z$zo6W|eh2Ms~Hc.#`936z(zhM^\(9NՂ(t&Dsl?v) iȮ8A{$ö vA2([B(iv ;ن >k#"ޚ/2V2P`39 _8PD U%qpj# ;9 4 J/4&H56b].B[rD_0|Fz =Jb@aHJIһJljVJy8UqV$8 jD6-1&]kqE8wаh"(ڢeO#`++gp.5"QS!Rb/q\C1oGNKM.,j/mɽ\ׁ8ngC8Iv9"׋rhWM zXu<[E!5EJ2̠Et3HHZ60˝K{]֢.rIvS~YK=m7L>$KKGp2Ίe/8iS *FEr8I lͭ$n-Fڴf`fF Z&o1{lT5-2̎rS:-3E>ANi$VSH=yK3yI|ev e@R{Qh"cpD󟘵h+N1--H!WNN% % V5Uf|M TPv,CLd#"r˾K(CBkq 9п;,DڑY`y (!oIﻡ ^s(hF>d.q`"?F_"$ |ŰVhE\iZ|IHOO()wt/nm F/AAC_Z,l֓^)cIU.%_~#GWƗKd/{Ol`/OA[zͅBiPWTtR"ϗ|~#K[rsBز}2sW!rPT7>ɗPk㬨C?^j-W}6'{V8y}ƌBY+BN^{aYi[Вm*a?\ N>`TX^p/q.U}{~Ztp7WE3_]6|'yyEݜ$/ ZdvĞzXO\i; fݟOXZ''w/0c YN no~8r+L'eι[}8g3h]GΛO6a"9$>O>N66M,`cT.SK۟2]dS\~z>al@eGAgop0]9N7_p{xOTŖ~ʻ!_'}yO__Ԡ;h0%[[xhkq\m*u19sn3G=;<LJ:Y -.RLD, 8 nϯf ӛiEaa߸Yׯrޜ~ qۻnV1#*uo\b/@]Fx_|IF0L텛3:Ll~vg !$(]nB`oA,i9Nf}iW}44MR@ ˰t~swp1#/ރ/^/Ͳ zaaY鋬F9%HD.|0wTg܏l6pwwpɦ8%m nU+Ft,ۇ!OE^)C[;8;ȠF?x~?Fme笒L!C?(qTd)׶W!i8WW JmY-H3#EX@ ?f2=,ש{q$Jzzx~ݪ=V_뢮zͧs+K9|x~JcveQFۿ}Z/xv~182?g0sVgͲgs'G ]%,,g׹iҭHUZ/H)f;uw xm Ry vP' [T zgUp]וI/__e|gӐ玱/DǻOc)~c#>7ŚJ&b`z{k9|%7a<̗֠",}s/w{X_B_۬Ɩ_E{x$AAW,' z3"1>m# C/y s:ʀ[B[\i(R6+oepG?*zEz'pE*m0x~!k_4> 4> stream xY_ gprkOC[`isv(P0k{wb{6l(iFIa5EQ$EH҂M:0?r_0UXjty3{ؔI^(j* +t%/brfF Dɨ%wFl歠ʐ Hí%:]fxEE :$ Eeϋn_3X A]vgNF]2Ya&Ն|^uKr NuS8-S:/7lqP}BMBFkGBqD$YS6oڪݞVd\׻}ZfsG@!nW`9ԒU}%LiciI;|9 QIx.ok%~wZ\ɷy%/"9>͚J.Q/|8: FPp,l9[B j y;UhXr5ךdͨb9zGpm xe|Z'47}S')*>WdhdVs@IJVh`*#7 &XF0KNH:ǂ{+9.JG+yvZ}8c 8fqgB1ΦHՒ*B\.q'/cl~ϺjzL̓J̶M'3iHTȥ cb4c:'2$?fݙ$6t Jjmi YT%dE\bF5sa1 %L$sA 2CQ#_QD=xƧ?Lǒ]Tۇdu3i4ƣRj_ٗs1 V!|K RMm#;x ) -d) (B27/>cI(V볛pݙ |RǭSa]AM#>kd@35ڠ~1QK/4(GOszZL"I&ZAA$4\7I #Mp'=,?o2+?5. ^~gpĿzUG6⎴p\ge?Su0@ᄅj|nRp[})6a?M0T2f6_7=V)ȏǝ TvV釫a03 _YO'NXĀ< (sdpnπ 6_f "vxó7~\dFz/ޯ_Si,n] "wg1Q]2j-h!W2۞z5>/֕@ ؞gƋXo"̜,o'j&-;!P,DH vs`s 9lE(xlҤvo9 9KXZvT{.]2٧KvR䲆Lb:ԵB? 07f?K u+ҕxGJry3WximIo7׳oi8/O.iH c- F_ͰwmVi|h$BL#^wlTŒdG|=w }pzio-(f)xh4VK"Ǝ$~gi6~dDi' S`ੰHj^USFu7u'zlc72> Pnc#߈;1DrqEA!R|t}l@"?glp[y_A){aWF,ɘ}Dcc%ڥ7æ+Ns~"ц{-ļ\ZiJDLyLr>6!>z׏P'OR .}IpDOE%~)endstream endobj 652 0 obj << /Filter /FlateDecode /Length 2230 >> stream xYmonWF\M4/ %j>N>im3$WKWv.(b ܙpC)|_ j;r, Q.'AO >R'tcf4<+#@c\m:UXGLeZZ)]yGInT7Tfsd ofs4e̐uQV^J0W[ oRJx'n1Nl1 (߲r@i-Rg2I> RIΧsiaLȇZ(Fc[աrꊜrgXA4[Տ(rf8S.VlqWnYc[׋݃&`dzxVihcY~T(ů#SvKc ߮&9=x5<%9iV,EqjbLƽ?Womvm.A_۪lv_u[75vPͪi9ֹJxؒ4~BF 0O4ctlIg@%o;^r^E57qO\kQ揣f-0QbīvCtZ@.^?@,l(\ICZY ǀgS4 (O|I5Z__Px{uU}\E6i"yI>@N>F`'U29jSю [{/9EYΥcr3굥M*{IC{1:~ ǚk:S@U'$e]^sgqދs&uysPnC4Χq;Bj5ZX^?4klvp^P< ts?ρd :sJb/En{iΥ|ήw6ٖWd^?-m HgUWS3gۋ#C8%MZB_ * [`y< 氮}5qxGSb觗R;68}JxYrx(WRyMNC3lJʥw2N'6`ޣ?w(L9ѪwN9r /{;$EeD6g7)crPDZzpGFώ^kl>F@<_H]msVtBj ; <& jdph Ow$MRg:ex0}(`'7m4РnG&$we7tCC1ӽ%T*/d=8 L-:xgI+_8=q(J+s(ۻ${X >@_ +aa"*qCW6‘iܝr-ln$ߖ9OAwab#ځ9*z;j}ǒozC 1lx~0nC8$ǝ.! }lrtn|8jb<;W?/'N/zݿLH&(WflcIN]^I7_Om*@ARg֦r/Z.$JE1w68V& ۺ47u{оB Rǚ TP@[H@x~+md&-9Ƌ)1Rk>ߎ򄋚L It Ц.Sԛ=vY3Cqz [bϊA!(taTkQϾv äyTmo&Poendstream endobj 653 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 269 >> stream xcd`ab`ddM,M)6 JM/I,If!C+XyyX}*=E{"8fFjʢ#c]] iTध_^竧_TSHJHISOSIP v Vp 4TQF ^Ȣ} C_g:OtiQw_>ڢ%3\ҽTq ?oZȶk?s> ==3zz&L?#eendstream endobj 654 0 obj << /Filter /FlateDecode /Length 2770 >> stream xZKs>濐ʗ@O[IaS;(x*E[̱Dz)jn$@QHme| 43+N sXm}wFf M9^X*x|v LJ)ahE}'*m5u7)%ARD PYοFvDj+5SR',xޘ7xꞕ$狕ԙ5d r ȹBhkW,% K {~h\n }\@8#sɶF)m1op):dKaA ;DɚSַ^\uz6(4L,fվ,rv ^A$]շgdK޾qE0F!_}eilM'+'mf2g0[J~z%`%"\4uI}Nf$PY*M c}2dx;pKs;vw߷ T6)"d=b--2K;'B9 v8/@SA`v }a(> XG!NF㡫cmR<GNaY3H6y򷵋W?|)'ptN'NKw h<']BtdE޴::G5z<b@1) L  XIQ;(Fq8{AnZτ[*ZBJ6SѦ2Ȋ~F]դ60*#|gL(1s| Ļ- @ B; 1gf+3q3G(!1}ކg` r;Wm%d̤@us|P 9HiϹϕϻmλB/`uw x_3xvm?&Ӿ\l/pJ4/α 5:cy'87ٛ6ruG51@v݇=KaIZn{}1 ? /`@\RbCtr_u2uIju/Mn:Zgt @BdWߝ@NA5"Rcs|֛ C Ns88'm@Y?&kc?IR.DU:Bi"5kpU6d۴,BIX.0i=Tΐ.hrN ǔұ(<ϮH|(GKM֩kr3G9C=x.g6̃t)Oh3 Q Qwbi2Dj2ҿ3ɪyf#L3D!^߲f(ōn"p3H4!Db%_3+8n w7& Ԭ"SbM=̍eǧ*H8M9*+ @G^JpC0ѐr?'$>R!64m?<űK_njt+*˼p/8ܸ$\hº l6NQ b,Ȍ:1L*ɝAX^~- CQKc.{+I1cco*Dd(~qe8!1"'W/ 8)"R Τ-!RXdBIw h 6Nj0?Y±p-3ךU)bqk`'1O) Qj~IĦ4E,ڄKȹ_W{~85g} Le@S =Qa'/endstream endobj 655 0 obj << /Filter /FlateDecode /Length 1098 >> stream xV]o6}o`EEÀKvRaAeG-l`$EɤK{xyFǽ E{M6 3B Gf39RQS(l0N(%P)>"NSbeyE`m}$JW9wX hv6B8KI)w>.b#'ƛf>fyB >)x۴~7/!>4U)C{십J0L ,J(Rj9ty]"\E 3E>8)ÔǓ"%r,%M#l=ĠڷM6`p/zH,5Aһt7WyBJ #x+}y) K{.e#JA]tUS{B+syb 2keFjBnq >]^8psaBK.@;8'ƱEHFnxy{A )v' kmĩCdKE܈7̴0X],qeW%(`m'W̋kZg1_6}ۡr첟$LL^ȋAPz8gc6Py^RxۄNs<:G_Ea6?^Gf,u.?mn}5ǣ0e\_Fx7 꿶yp'u ɮ8'жe]u_ܻuoQ[׺@1QSgO?B4iʰ8tds6:LĐzZ_m>*5 LnB9m^~ܟ;[k5mM.Pwe{ ~.?J3O=]PS޵տ&- xB)V%: AO (' :(If`V?$걿걿זRjoDN=&I߸u>)l~}tŘendstream endobj 656 0 obj << /Filter /FlateDecode /Length 2492 >> stream xYsSŽnLۋK['=<2)Od^$RGIyw H$$b?~[88vף#j?oџohĆg[CǚDl;"BMfplxrl U:1l&LE~ԐIŒ'46$͋?>hu:Jd C*Lhb2BFqȲ"/,VTYosx'000AD15!{`$C1Ŧ6&3p"NxeSeUUVgtv,ŮEMqȪtlSgUܕyqo8J<6k4 yCL%&RJߌtB   ,YnwչUJ*X+P2|I*58Qb;|W5CϐtgcAHhJ#%]/1PeFplCAn2&!@A`n֡?X!µ0Fo6~޿/41oSuNOձp٤R,!Dr`i$ɀ:u5S'Vg*OHP{8O0bUgW]^2^;!`ڐoiڡrXy0Oo Oj6z=rA \HB(&/|6P`cդ6o}{IB1I.m$O41?|bNi= h88 8-SR%ENT0syˋO ) h:~HP$Ղl&Ð =b /qč!F !̛CHc>旝 n U2$ͥ_azKf=Wc08بf2жj9`B!nr$3eCsvkßӤ=&rČRiO3g dˎ(߭PV|h6LcD@(7&Rֲ \մyOJeįQݴ m~Mu*Lim%wIҳYje_Lq/^ 癷s"v -WdA{)^Ik\B+*F| ͨGdƕA+ L0V1 d" BCK%en^ay (5Uv5 !VEUCDz>ȡdŔ(QqIgMg2 /x[0T+DiDPͪ8i &2?L*"j}7A7 ~s i, chJnI (F]l?FIh}>̮q ZN-'^:}~ |@|^`>qh\ U]:eI/q/Fˣܽ(y#]Sn:%;!cM!Ƅn[XH.ab8F[E"#yikػ7 ݿ(`12P J$ #Y  lݱ#6xřz"d+Ф׊i '͐5͐? 0\Y`y,JxLh]+m B%f\,, ΄?XC uxNǢDP=(Ѝ{POrދ&~y} kKoif/pyS5a3|CdyzنX:8Oc ނw6e!=mdڞvf^4렸v&iP_L&sR}-Y .)~nmBg6~eV䳼 ޞ]94VUm+;X}YՇp,d> stream xVn8}WCRHJ ^, ewDhQiȪ֒I,;ԍ-6l9s;ѳmb`ityB]R}09!؇-[`Aˤ!'|[8 r|.H(hJIAŤ-`z!= (L2tUqt;c7@.cӂ#ܴ\{hi$eTK1NQO<9 FPg 6& *4MƂddƢM&iNe,"r1,󚄜a b֜ [;(ۤqDsvp;7)=!\03 Nh&}ބE$d2n7iY}-e\5~U^ "CZKlEiv9p,Ӱ*s2m$/9͢|5_xb3}(Qƀ+7>\8}!GH% uܟޘѻ#i$^X}wFtB 5Ѷg1kEbOazAG︤0Ϻ )DY>#quw.\i>aV&UgjX.5d<ܞL; HJx8r9AٔRuK VJV;ʻQ'ؚKi6v ~wt TUz59os3њICQ*6UewL/6ӎbjSۑ(TG=} z|mRF/7Q٨l7GX#9ݞ{eVu%hj0x?~ء3ݝ&ބ۠oi14ygQ|&l 4Ңvۮuo5./s*`L]ӃqLV[l# 'Ÿ_~xjmeq8%}V`Ij4JZkYT?ؕTO7)fXj{Ǯw'+y䞏1Y.MҘsY?m&XPoi/5|'|endstream endobj 658 0 obj << /Filter /FlateDecode /Length 1986 >> stream xKsߐƓNTb&tfn$u-6tHZ~xD$~c3?.aǂۥo\~]2Yn, E)& 9IK j"W^VTf >1 gX`ʦ >,#Yx6O1%^mIbNyެ6 cJ4‰1g+(KagA)М"1fN21ѭ58*0Ј0RZsNu9>r}  } |vJ{UQ٭VZ\2A)˻mw26۟Kx'rO"UX:LѷtYoN4=jCB`e ONl=)** *߭2/ݹw&T/ңutR ٪9Yfwixy']mY2)8~A'?M9 MS)qPtV߯ (_ 9PP~45"/̡݃2G'ZdAazt ޛ r.1A1@IQ`IHm&=T#pZ_p7+$z!ol[xpH 瞄0DdǪT @ވH)~*k:xGN/ƾ\gMkj:g@RBŷ`<h4]ڨttdcUM@w66ϑ}紳u; $#3storH)>MzH0Dqc樝=VuZ!x@$NBzxH1zrQ:7aE*gܫ I' ݿZ1d̘M3MHj!Ł}9޿J[Se9%: 7њۓDiȕNx:Pbg885M}-&"M~p}x)&D1jڙ!`SN ;lbvo!+xȿJ#x69._(c}<EIei*@B2^4&5' vizkBI&44*ft{`C+(iEt(e`ҌLW-rhMMgs5Fz.͡qќ=ieN)1r#e*Y˰VVSd|{FdK%]\y?II_rzHE$17yxΉq,^M6^(FI4c$~>T]''B,M%6)NN;_^lf$x~#7¢GL)At=c)}X ,󋝇%gw F/3T27%Z˅}&sK iCX]5nt 1w}S>/[+&1A@O̚6 Ve=Ujs=4e0DSr3-vHmDKC&|jX@<efX_7ףx'i*{wdjU$ܩi•ݴ7{Dfp3 KupѭEy;A f_)WFV' $Z Y4AO BF͙)nX<h`@D1! XOL"1 `Rd4 Nd +1B 3AO蟞XWgퟱ_ߔ3 .R &w΂Z :W,$Ԙ,X1%T\TDEaI@YЗImUջB^Ú|O>GCv_?Oendstream endobj 659 0 obj << /Filter /FlateDecode /Length 1229 >> stream xVnF}WA.[h IZuP4Ka끑(D*$mW+J3gggdw]l'xz? DLd!Si&*24Nn/٫,I1 6h*j$rðhtƠj)f6bi,Ds c~+Ž3a&uvh *66^$GA:V0Ph aF{PM80cΔɸ ,vYR4e"RZ[tKf$9Z9f`XXP$2 7[' Ee$`u1`]SɨX 8|0hlESeY/wu_&fp_K|,sxߴ3MpeMTo宩}ѷ?A1efb'=;, ]RJ֒j"BZ5@%  Pb2 'F)H= Lnr]P3Xi5z$ Jf&vd"0n D[lMsS}*7պiEO3V'\0탑CMC{?yCvm}X:LJj;TlWo}wK(ف:᱾KRB%Ƨ+&|CA슶zf0b r:KFO^_[ MdqKF 4ѰZi6}7nibuFH[kN*NZ2<=qKkePMRYR6 <BfC1e0;_~5z9巋;DglFt͏=ϖh?5uQ?WrPmٯɆg(C2b[^|͡Cp66)z"@/ˮ eFž*86FWN`wMA}c<˪[-T#m"rUǽ%C]^5X׮!0taZ8kxDC]."]l l6]!XAboЊ\\6D%w@Kē]n 6R螠`3]%x:VD v܃nJ[2]$(4~ Lk "(L em>ނendstream endobj 660 0 obj << /Filter /FlateDecode /Length 1657 >> stream xXYo7~ׯCR>@Hk6ڕUV+;!~s|3Ә٘owӈqgr9zy/ Ɩ2s'r3"JN.ݒe[jl㄃54ǯ sdsd5saԑޞF7sDzs&KeϏm5KK^MfR9D_]2-itHc>Ȍ rNs!{ARsF̙ͩI.óX$τ[]b}P"ǍϘ+ mus(@!mߢ3>LPY&mm.xp) 7ٜSM G}ލ.5`*[" -9ş#x@ΤSBԁ )vLYk= Ĕ:ž+eіoڶi' NPOq<1bӛd|NQKU6_*9-2I\=bp[rKUv_s 꼓!!3#\8>w7+8; 8Vo!Md $XnDjvܾ?Vz4e3r`,K48E /~rڪ]}Wn*UX.WfzO?@ҡfz>슶Dc0Fr Lh͕ ϣ&7/ywv[_*k,#EׯP9X"A (g$K"] `5PtPn-Ds v"M^ϡ=b #epnȀiAFi[lzk2ú$_ek'l6@z{{.7 a #e=8Gn)Ҵ љ+эaoHNE`754QM'Aä[F: x\G7{)dIa[KeE 蜯&M ]GLE@._Qt:`g4Yw}tͶ7zJ?kc9_OcesF]>8#IF޴aWߡrvJzx%$],Ͽ7˪}{잮*I)JM#$E۝k^O؏ʈ_;U/m!Oxs9 ~@Rendstream endobj 661 0 obj << /Filter /FlateDecode /Length 1569 >> stream xWnF}WA [-86襰JF"BrFhc"g~]i2#<}s:v?d{% +2,F j4QL'%:ON(f&JQ! ,%XMSMITD>W ϨR7y[8Y@ėfc~+ڰ@{*2-1u=wX8eP_ܣ΍%3tYStV7>ߞWtq*J}2!!_&+Q9L$V|jCR` b(_DpEǓwW*9 w,԰hMUi2է=!qitPJYt:(d) 5yHykb4jgBRl]D372 %Tcэd VAs2h |$V䨭O, q `a%e M )JIS(A> E.ￏbA5X(w1. !E7_$ju=j5E5+#Yl e!6v PcZUpk@pJk@+<vXK5>^DuV}!Tt"[q`n{b$)[Qn i[薦 ̨|2NXmMއ% Pi-'h^?vB}q~fRm@9M^m5KWHMX'=D(&)lgnV%E̦ʽpӓF4|ƖP8֧,)_j;AZ@Tf8 W]p7ҁlr}D6M H BSϡLYrD:2ZqiBty󱾝-PGdR'Du](=MQ&>qT5LHLQ'}\'"UmY{;Y ?n-dMܻ>9z}xjl@gFFÑu iBSv.S8a"4%bG:|GK#u8f24#L*_,g9{X,Vi V)O&9Y`-tȫ/f QiG)D "+dxrs!,7}endstream endobj 662 0 obj << /Filter /FlateDecode /Length 1488 >> stream xWmo6_aF&JYk Q5Hrߑ"%RH,wsǁǁm> ƻձ?W> %?b<^ݍ<8S>^#$tEJ3H34V5ʓaJ@+ cTO_D1GP1m$LJdN=#,BO=ƸZYUR<‘Po5QJ]Ą:5A&%A>6'AlxnD1{M@>18ap EzH«Pe1k<S38fauN= @'!kC}oomOp└3 "grLYQR QǠy-'L ѳi#Q/B ѽTpṽĭ@@.IRNy(zssAJ3s,^[wr,*٧N oAlDqm]Z_m.NAM:B߇ DS#*Vt{[7`n>~;VUR^6zV2T,tv{#As)nc$Am<řϪzӋ䬓t76Sn _or_ k [YVz1hY;/(3N,R>yRn`^;OPr)n'̝7W [WF&)T)(Vh@["qXIUwd& fykPSmHT6*0ϛ]~Ƈ"wɩ;e*g;!8CŤ4Vu9Fƶ"/ܹp@qr 1Ԟ26a$%Tgj\ĒP(6 03trYIZpb-~f4Hq1 ͈s_XPt9hԅ8)=56B^W씙>fF ,Jfi`G)嘵MpxQ'eكNPfH!T_Gi_JA<#r] )}<-VݕE#Y>!q8oqTěc#A]ɬCnzж  9dӄ~3׹ƀr~~1oObcTݾ3u;@=rfW`;kЖ5:|U2bnlpC.{ɹǢg #h K~f | NJendstream endobj 663 0 obj << /Filter /FlateDecode /Length 1705 >> stream xYK6{0KCb]`ӤEEQ@kkwJ#IwCJ2Gv.<8x>1|Ӳ׽7=bfͿi<}LOE +],铘F~“H119:1)EG`AHa( BW sffO,R(+i4$GȕfΝk"L<㨛+ 1iqOStLFAO:)3svFm'{1&E2p1,QQY ^8&H c5Gqp/Zvy36 1$hewI"-PIpFGu|a?8ZT 2ѺH뼑(JuÂ%3,%*+sElDا.Q/[]2guC5 Fկ(:#StiL_VE"WFP!:kq}@q?z= :m ^{,&lQ`*,n!9!QU?ӛ4Ov!FCr&-._gӺYLLH^il$eQ&,VZzw֍l?eZWcj}pm"b=ˢn+ы?jg6/2_d1<\l$ԣG=JxTQңG|I|/BP2g!G[ M<"OQ/1YDm?G^{{g~ưg}t>棓>B|fh/(B񦞀m=Ǎ;^]weݯ7! _Q>iׂuX߶D&{mTLuBw1NL'la268~[;-kN (n[GȮ[o:FQ ja5Rb000(kYpY-z3GYY22kĸYڻۆAsˋRJ )h{^:N.vay,uZMDu=@9Gb/ؕsw l#YӺ(F(, J^)p%UY_[`ΐdlbAnif15ಁYs\u`^- dI0OE)vAXáyq,ޘ^-*_^鸃iTRr]&hbnؓ.p$%";=_nI,Z!ygyJtdvsr_|͚4-I V2PJnsbvQ8iE3A:%-PAڟ6\qXm6vj/` sPiF{ީЫ{ik:s+SʤBn" n-d[ǜ+Zwbp -qCݴI;{E:ٞJ2ozS .};=M>[&*{3AWբvX;bhsM:!K>OG?endstream endobj 664 0 obj << /Filter /FlateDecode /Length 802 >> stream xeUr0 )X.3(m'"1'-Y#Je@ (ʨpV%%m\[Ư宼?EuJ&9QԕF*]q7T !8q]E U0Zpjx~ ,is-ӓf.b.&iPDJ5|mAB,Nige}J!]O"UN8F8\2-_L];+d\]n~'|f\q})$5rys|2OΐWG]|XM~+쁨,M3Əmיc7ĦʟfovRñ ZyLZ6+N%үuP]y&x["{9>+3Q+s ~hn76Hh5]zin>3y`:aOp~}*>Pzœ> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 666 /ID [<5aa2aa77967563705154215fefa3fa85>] >> stream xKTQ﹎@gL7*(ah"6)EZhQD W6EjD]jڈLAp!5 Ù9yu\8Ix:0ZkޑRfbVȕᵦ6jy ˰6 jՆeX岴9caF$mڰ kc/ѹ#Ǝ;=35$g&{疘`b;3Ί-{b >CdN u&9K;3d*b15G!=|?GsC)17NlTtKxj&Y-sKoՙ ɸO`p-Pd!W*Ŏy:]{'R7XTo?LJ]ęwLpB] Ӡx t5H23I~z'5;gፏv-D}lvUy5.a3Ȝ_p endstream endobj startxref 382814 %%EOF markovchain/inst/doc/higher_order_markov_chains.Rmd0000644000176200001440000003006614714756746022341 0ustar liggesusers--- title: "Higher order Markov chains" pagetitle: "Higher order Markov chains" output: rmarkdown::html_vignette author: - name: "Deepak Yadav" affiliation: B-Tech student, Computer Science and Engineering address: > Indian Institute of Technology, Varanasi Uttar Pradesh - 221 005, India email: \email{deepakyadav.iitbhu@gmail.com} - name: "Tae Seung Kang" affiliation: Ph.D student, Computer \& Information Science \& Engineering address: > University of Florida Gainesville, FL, USA email: \email{tskang3@gmail.com} - name: "Giorgio Alfredo Spedicato" affiliation: Ph.D FCAS FSA CSPA C.Stat, Unipol Group address: > Via Firenze 11 Paderno Dugnano 20037 Italy email: \email{spedicato\_giorgio@yahoo.it} preamble: > \author{Deepak Yadav, Tae Seung Kang, Giorgio Alfredo Spedicato} \usepackage{graphicx} \usepackage{amsmath} \usepackage{tabularx} \usepackage{longtable} \usepackage{booktabs} \setkeys{Gin}{width=0.8\textwidth} abstract: | The \pkg{markovchain} package contains functions to fit higher (possibly) multivariate order Markov chains. The functions are shown as well as simple exmaples vignette: > %\VignetteIndexEntry{Higher order Markov chains} %\VignetteEngine{knitr::rmarkdown} %VignetteEncoding{UTF-8} keywords: plain: [Higher order Markov chains] formatted: [Higher order Markov chains] bibliography: markovchainBiblio.bib --- ```{r global_options, include=FALSE} knitr::opts_chunk$set(fig.width=8.5, fig.height=6, out.width = "70%") set.seed(123) ``` # Higher Order Markov Chains Continuous time Markov chains are discussed in the CTMC vignette which is a part of the package. An experimental `fitHigherOrder` function has been written in order to fit a higher order Markov chain ([@ching2013higher, @ching2008higher]). `fitHigherOrder` takes two inputs 1. sequence: a categorical data sequence. 2. order: order of Markov chain to fit with default value 2. The output will be a `list` which consists of 1. lambda: model parameter(s). 2. Q: a list of transition matrices. $Q_i$ is the $ith$ step transition matrix stored column-wise. 3. X: frequency probability vector of the given sequence. Its quadratic programming problem is solved using `solnp` function of the Rsolnp package [@pkg:Rsolnp]. ```{r setup, include=FALSE} knitr::opts_chunk$set(echo = TRUE, collapse = TRUE, comment = "#>") ``` ```{r setup_2, include=FALSE, message=FALSE, echo=FALSE} require(markovchain) ``` ```{r higherOrder} if (requireNamespace("Rsolnp", quietly = TRUE)) { library(Rsolnp) data(rain) fitHigherOrder(rain$rain, 2) fitHigherOrder(rain$rain, 3) } ``` # Higher Order Multivariate Markov Chains ## Introduction HOMMC model is used for modeling behaviour of multiple categorical sequences generated by similar sources. The main reference is [@ching2008higher]. Assume that there are s categorical sequences and each has possible states in M. In nth order MMC the state probability distribution of the jth sequence at time $t = r + 1$ depend on the state probability distribution of all the sequences (including itself) at times $t = r, r - 1, ..., r - n + 1$. \[ x_{r+1}^{(j)} = \sum_{k=1}^{s}\sum_{h=1}^{n}\lambda_{jk}^{(h)}P_{h}^{(jk)}x_{r-h+1}^{(k)}, j = 1, 2, ..., s, r = n-1, n, ... \] with initial distribution $x_{0}^{(k)}, x_{1}^{(k)}, ... , x_{n-1}^{(k)} (k = 1, 2, ... , s)$. Here \[ \lambda _{jk}^{(h)} \geq 0, 1\leq j, k\leq s, 1\leq h\leq n \enspace and \enspace \sum_{k=1}^{s}\sum_{h=1}^{n} \lambda_{jk}^{(h)} = 1, j = 1, 2, 3, ... , s. \] Now we will see the simpler representation of the model which will help us understand the result of `fitHighOrderMultivarMC` method. \vspace{5mm} Let $X_{r}^{(j)} = ((x_{r}^{(j)})^{T}, (x_{r-1}^{(j)})^{T}, ..., (x_{r-n+1}^{(j)})^{T})^{T} for \enspace j = 1, 2, 3, ... , s.$ Then \vspace{5mm} \[ \begin{pmatrix} X_{r+1}^{(1)}\\ X_{r+1}^{(2)}\\ .\\ .\\ .\\ X_{r+1}^{(s)} \end{pmatrix} = \begin{pmatrix} B^{11}& B^{12}& .& .& B^{1s}& \\ B^{21}& B^{22}& .& .& B^{2s}& \\ .& .& .& .& .& \\ .& .& .& .& .& \\ .& .& .& .& .& \\ B^{s1}& B^{s2}& .& .& B^{ss}& \\ \end{pmatrix} \begin{pmatrix} X_{r}^{(1)}\\ X_{r}^{(2)}\\ .\\ .\\ .\\ X_{r}^{(s)} \end{pmatrix} \textrm{where} \] \[B^{ii} = \begin{pmatrix} \lambda _{ii}^{(1)}P_{1}^{(ii)}& \lambda _{ii}^{(2)}P_{2}^{(ii)}& .& .& \lambda _{ii}^{(n)}P_{n}^{(ii)}& \\ I& 0& .& .& 0& \\ 0& I& .& .& 0& \\ .& .& .& .& .& \\ .& .& .& .& .& \\ 0& .& .& I& 0& \end{pmatrix}_{mn*mn} \textrm{and} \] \vspace{5mm} \[ B^{ij} = \begin{pmatrix} \lambda _{ij}^{(1)}P_{1}^{(ij)}& \lambda _{ij}^{(2)}P_{2}^{(ij)}& .& .& \lambda _{ij}^{(n)}P_{n}^{(ij)}& \\ 0& 0& .& .& 0& \\ 0& 0& .& .& 0& \\ .& .& .& .& .& \\ .& .& .& .& .& \\ 0& .& .& 0& 0& \end{pmatrix}_{mn*mn} \textrm{when } i\neq j. \] \vspace{5mm} ## Representation of parameters in the code $P_{h}^{(ij)}$ is represented as $Ph(i,j)$ and $\lambda _{ij}^{(h)}$ as Lambdah(i,j). For example: $P_{2}^{(13)}$ as $P2(1,3)$ and $\lambda _{45}^{(3)}$ as Lambda3(4,5). ## Definition of HOMMC class ```{r hommcObject} showClass("hommc") ``` Any element of `hommc` class is comprised by following slots: 1. states: a character vector, listing the states for which transition probabilities are defined. 2. byrow: a logical element, indicating whether transition probabilities are shown by row or by column. 3. order: order of Multivariate Markov chain. 4. P: an array of all transition matrices. 5. Lambda: a vector to store the weightage of each transition matrix. 6. name: optional character element to name the HOMMC ## How to create an object of class HOMMC ```{r hommcCreate} states <- c('a', 'b') P <- array(dim = c(2, 2, 4), dimnames = list(states, states)) P[ , , 1] <- matrix(c(1/3, 2/3, 1, 0), byrow = FALSE, nrow = 2, ncol = 2) P[ , , 2] <- matrix(c(0, 1, 1, 0), byrow = FALSE, nrow = 2, ncol = 2) P[ , , 3] <- matrix(c(2/3, 1/3, 0, 1), byrow = FALSE, nrow = 2, ncol = 2) P[ , , 4] <- matrix(c(1/2, 1/2, 1/2, 1/2), byrow = FALSE, nrow = 2, ncol = 2) Lambda <- c(.8, .2, .3, .7) hob <- new("hommc", order = 1, Lambda = Lambda, P = P, states = states, byrow = FALSE, name = "FOMMC") hob ``` ## Fit HOMMC `fitHighOrderMultivarMC` method is available to fit HOMMC. Below are the 3 parameters of this method. 1. seqMat: a character matrix or a data frame, each column represents a categorical sequence. 2. order: order of Multivariate Markov chain. Default is 2. 3. Norm: Norm to be used. Default is 2. # A Marketing Example We tried to replicate the example found in [@ching2008higher] for an application of HOMMC. A soft-drink company in Hong Kong is facing an in-house problem of production planning and inventory control. A pressing issue is the storage space of its central warehouse, which often finds itself in the state of overflow or near capacity. The company is thus in urgent needs to study the interplay between the storage space requirement and the overall growing sales demand. The product can be classified into six possible states (1, 2, 3, 4, 5, 6) according to their sales volumes. All products are labeled as 1 = no sales volume, 2 = very slow-moving (very low sales volume), 3 = slow-moving, 4 = standard, 5 = fast-moving or 6 = very fast-moving (very high sales volume). Such labels are useful from both marketing and production planning points of view. The data is cointaind in `sales` object. ```{r hommsales} data(sales) head(sales) ``` The company would also like to predict sales demand for an important customer in order to minimize its inventory build-up. More importantly, the company can understand the sales pattern of this customer and then develop a marketing strategy to deal with this customer. Customer's sales demand sequences of five important products of the company for a year. We expect sales demand sequences generated by the same customer to be correlated to each other. Therefore by exploring these relationships, one can obtain a better higher-order multivariate Markov model for such demand sequences, hence obtain better prediction rules. In [@ching2008higher] application, they choose the order arbitrarily to be eight, i.e., n = 8. We first estimate all the transition probability matrices $P_{h}^{ij}$ and we also have the estimates of the stationary probability distributions of the five products:. $\widehat{\boldsymbol{x}}^{(1)} = \begin{pmatrix} 0.0818& 0.4052& 0.0483& 0.0335& 0.0037& 0.4275 \end{pmatrix}^{\boldsymbol{T}}$ $\widehat{\boldsymbol{x}}^{(2)} = \begin{pmatrix} 0.3680& 0.1970& 0.0335& 0.0000& 0.0037& 0.3978 \end{pmatrix}^{\boldsymbol{T}}$ $\widehat{\boldsymbol{x}}^{(3)} = \begin{pmatrix} 0.1450& 0.2045& 0.0186& 0.0000& 0.0037& 0.6283 \end{pmatrix}^{\boldsymbol{T}}$ $\widehat{\boldsymbol{x}}^{(4)} = \begin{pmatrix} 0.0000& 0.3569& 0.1338& 0.1896& 0.0632& 0.2565 \end{pmatrix}^{\boldsymbol{T}}$ $\widehat{\boldsymbol{x}}^{(5)} = \begin{pmatrix} 0.0000& 0.3569& 0.1227& 0.2268& 0.0520& 0.2416 \end{pmatrix}^{\boldsymbol{T}}$ By solving the corresponding linear programming problems, we obtain the following higher-order multivariate Markov chain model: \vspace{3mm} $\boldsymbol{x}_{r+1}^{(1)} = \boldsymbol{P}_{1}^{(12)}\boldsymbol{x}_{r}^{(2)}$ $\boldsymbol{x}_{r+1}^{(2)} = 0.6364\boldsymbol{P}_{1}^{(22)}\boldsymbol{x}_{r}^{(2)} + 0.3636\boldsymbol{P}_{3}^{(22)}\boldsymbol{x}_{r}^{(2)}$ $\boldsymbol{x}_{r+1}^{(3)} = \boldsymbol{P}_{1}^{(35)}\boldsymbol{x}_{r}^{(5)}$ $\boldsymbol{x}_{r+1}^{(4)} = 0.2994\boldsymbol{P}_{8}^{(42)}\boldsymbol{x}_{r}^{(2)} + 0.4324\boldsymbol{P}_{1}^{(45)}\boldsymbol{x}_{r}^{(5)} + 0.2681\boldsymbol{P}_{2}^{(45)}\boldsymbol{x}_{r}^{(5)}$ $\boldsymbol{x}_{r+1}^{(5)} = 0.2718\boldsymbol{P}_{8}^{(52)}\boldsymbol{x}_{r}^{(2)} + 0.6738\boldsymbol{P}_{1}^{(54)}\boldsymbol{x}_{r}^{(4)} + 0.0544\boldsymbol{P}_{2}^{(55)}\boldsymbol{x}_{r}^{(5)}$ \vspace{3mm} According to the constructed 8th order multivariate Markov model, Products A and B are closely related. In particular, the sales demand of Product A depends strongly on Product B. The main reason is that the chemical nature of Products A and B is the same, but they have different packaging for marketing purposes. Moreover, Products B, C, D and E are closely related. Similarly, products C and E have the same product flavor, but different packaging. In this model, it is interesting to note that both Product D and E quite depend on Product B at order of 8, this relationship is hardly to be obtained in conventional Markov model owing to huge amount of parameters. The results show that higher-order multivariate Markov model is quite significant to analyze the relationship of sales demand. ```{r hommcFit, warning = FALSE, message = FALSE} # fit 8th order multivariate markov chain if (requireNamespace("Rsolnp", quietly = TRUE)) { object <- fitHighOrderMultivarMC(sales, order = 8, Norm = 2) } ``` We choose to show only results shown in the paper. We see that $\lambda$ values are quite close, but not equal, to those shown in the original paper. ```{r result, echo = FALSE} if (requireNamespace("Rsolnp", quietly = TRUE)) { i <- c(1, 2, 2, 3, 4, 4, 4, 5, 5, 5) j <- c(2, 2, 2, 5, 2, 5, 5, 2, 4, 5) k <- c(1, 1, 3, 1, 8, 1, 2, 8, 1, 2) if(object@byrow == TRUE) { direction <- "(by rows)" } else { direction <- "(by cols)" } cat("Order of multivariate markov chain =", object@order, "\n") cat("states =", object@states, "\n") cat("\n") cat("List of Lambda's and the corresponding transition matrix", direction,":\n") for(p in 1:10) { t <- 8*5*(i[p]-1) + (j[p]-1)*8 cat("Lambda", k[p], "(", i[p], ",", j[p], ") : ", object@Lambda[t+k[p]],"\n", sep = "") cat("P", k[p], "(", i[p], ",", j[p], ") : \n", sep = "") print(object@P[, , t+k[p]]) cat("\n") } } else { print("package Rsolnp unavailable") } ``` # References markovchain/inst/doc/gsoc_2017_additions.R0000644000176200001440000001276314715232601020075 0ustar liggesusers## ----setup, include=FALSE----------------------------------------------------- knitr::opts_chunk$set(echo = TRUE, collapse = TRUE, comment = "#>") ## ----setup_2, include=FALSE--------------------------------------------------- require(markovchain) ## ----message = FALSE---------------------------------------------------------- library(markovchain) states <- c("a","b","c","d") byRow <- TRUE gen <- matrix(data = c(-1, 1/2, 1/2, 0, 1/4, -1/2, 0, 1/4, 1/6, 0, -1/3, 1/6, 0, 0, 0, 0), nrow = 4,byrow = byRow, dimnames = list(states,states)) ctmc <- new("ctmc",states = states, byrow = byRow, generator = gen, name = "testctmc") ## ----------------------------------------------------------------------------- ExpectedTime(ctmc,1,4) ## ----------------------------------------------------------------------------- probabilityatT(ctmc,1) ## ----------------------------------------------------------------------------- probabilityatT(ctmc,1,1) ## ----------------------------------------------------------------------------- energyStates <- c("sigma", "sigma_star") byRow <- TRUE gen <- matrix(data = c(-3, 3, 1, -1), nrow = 2, byrow = byRow, dimnames = list(energyStates, energyStates)) molecularCTMC <- new("ctmc", states = energyStates, byrow = byRow, generator = gen, name = "Molecular Transition Model") ## ----------------------------------------------------------------------------- plot(molecularCTMC) ## ----------------------------------------------------------------------------- if(requireNamespace(package='ctmcd', quietly = TRUE)) { plot(molecularCTMC,package = "diagram") } else { print("diagram package unavailable") } ## ----------------------------------------------------------------------------- states <- c("n","y") Q <- matrix(c(-1,1,1,-1),nrow = 2,byrow = TRUE,dimnames = list(states,states)) range <- matrix(c(1/52,3/52,1/2,2),nrow = 2,byrow = 2) name <- "testictmc" ictmc <- new("ictmc",states = states,Q = Q,range = range,name = name) impreciseProbabilityatT(ictmc,2,0,1,10^-3,TRUE) ## ----------------------------------------------------------------------------- if(requireNamespace(package='ctmcd', quietly = TRUE)) { sample <- matrix(c(150,2,1,1,1,200,2,1,2,1,175,1,1,1,1,150),nrow = 4,byrow = TRUE) sample_rel = rbind((sample/rowSums(sample))[1:dim(sample)[1]-1,],c(rep(0,dim(sample)[1]-1),1)) freq2Generator(sample_rel,1) } else { print('ctmcd unavailable') } ## ----eval=FALSE--------------------------------------------------------------- # transMatr <- matrix(c(0,0,0,1,0.5,0.5,0,0,0,0,0.5,0,0,0,0,0,0.2,0.4,0,0,0,0.8,0.6,0,0.5),nrow = 5) # object <- new("markovchain", states=c("a","b","c","d","e"),transitionMatrix=transMatr, name="simpleMc") # committorAB(object,c(5),c(3)) ## ----------------------------------------------------------------------------- statesNames <- c("a", "b", "c") testmarkov <- new("markovchain", states = statesNames, transitionMatrix = matrix(c(0.2, 0.5, 0.3, 0.5, 0.1, 0.4, 0.1, 0.8, 0.1), nrow = 3, byrow = TRUE, dimnames = list(statesNames, statesNames) )) ## ----------------------------------------------------------------------------- firstPassageMultiple(testmarkov,"a",c("b","c"),4) ## ----------------------------------------------------------------------------- transMatr<-matrix(c(0.4,0.6,.3,.7),nrow=2,byrow=TRUE) simpleMc<-new("markovchain", states=c("a","b"), transitionMatrix=transMatr, name="simpleMc") noofVisitsDist(simpleMc,5,"a") ## ----------------------------------------------------------------------------- transMatr<-matrix(c(0.99,0.01,0.01,0.99),nrow=2,byrow=TRUE) simpleMc<-new("markovchain", states=c("a","b"), transitionMatrix=transMatr) expectedRewards(simpleMc,1,c(0,1)) ## ----------------------------------------------------------------------------- energyStates <- c("sigma", "sigma_star") byRow <- TRUE gen <- matrix(data = c(-3, 3, 1, -1), nrow = 2, byrow = byRow, dimnames = list(energyStates, energyStates)) molecularCTMC <- new("ctmc", states = energyStates, byrow = byRow, generator = gen, name = "Molecular Transition Model") is.CTMCirreducible(molecularCTMC) ## ----------------------------------------------------------------------------- if (requireNamespace("Rsolnp", quietly = TRUE)) { statesName <- c("a", "b") P <- array(0, dim = c(2, 2, 4), dimnames = list(statesName, statesName)) P[,,1] <- matrix(c(0, 1, 1/3, 2/3), byrow = FALSE, nrow = 2) P[,,2] <- matrix(c(1/4, 3/4, 0, 1), byrow = FALSE, nrow = 2) P[,,3] <- matrix(c(1, 0, 1/3, 2/3), byrow = FALSE, nrow = 2) P[,,4] <- matrix(c(3/4, 1/4, 0, 1), byrow = FALSE, nrow = 2) Lambda <- c(0.8, 0.2, 0.3, 0.7) ob <- new("hommc", order = 1, states = statesName, P = P, Lambda = Lambda, byrow = FALSE, name = "FOMMC") predictHommc(ob,3) } else { print("Rsolnp unavailable") } ## ----------------------------------------------------------------------------- energyStates <- c("sigma", "sigma_star") byRow <- TRUE gen <- matrix(data = c(-3, 3, 1, -1), nrow = 2, byrow = byRow, dimnames = list(energyStates, energyStates)) molecularCTMC <- new("ctmc", states = energyStates, byrow = byRow, generator = gen, name = "Molecular Transition Model") is.TimeReversible(molecularCTMC) markovchain/inst/doc/an_introduction_to_markovchain_package.Rmd0000644000176200001440000032063514714756746024736 0ustar liggesusers--- title: plain: "The markovchain Package: A Package for Easily Handling Discrete Markov Chains in R" formatted: "The \\pkg{markovchain} Package: A Package for Easily Handling Discrete Markov Chains in \\proglang{R}" short: "\\pkg{markovchain} package: discrete Markov chains in \\proglang{R}" pagetitle: "The \\pkg{markovchain} Package: A Package for Easily Handling Discrete Markov Chains in \\proglang{R}" author: - name: "Giorgio Alfredo Spedicato" affiliation: Ph.D C.Stat FCAS, FSA, CSPA Unipol Group address: > Via Firenze 11 Paderno Dugnano 20037 Italy email: \email{spedygiorgio@gmail.com} url: www.statisticaladvisor.com - name: "Tae Seung Kang" affiliation: Ph.D student, Computer \& Information Science \& Engineering address: > University of Florida Gainesville, FL, USA email: \email{tskang3@gmail.com} - name: "Sai Bhargav Yalamanchi" affiliation: B-Tech student, Electrical Engineering address: > Indian Institute of Technology, Bombay Mumbai - 400 076, India email: \email{bhargavcoolboy@gmail.com} - name: "Deepak Yadav" affiliation: B-Tech student, Computer Science and Engineering address: > Indian Institute of Technology, Varanasi Uttar Pradesh - 221 005, India email: \email{deepakyadav.iitbhu@gmail.com} - name: "Ignacio Cordón" affiliation: Software Engineer address: > Madrid (Madrid), Spain email: \email{nacho.cordon.castillo@gmail.com} preamble: > \author{\small{Giorgio Alfredo Spedicato, Tae Seung Kang, Sai Bhargav Yalamanchi, Deepak Yadav, Ignacio Cordón}} \Plainauthor{G.A. Spedicato, T.S. Kang, S.B. Yalamanchi, D. Yadav, I. Cordón} \usepackage{graphicx} \usepackage{amsmath} \usepackage{longtable} \usepackage{booktabs} \setkeys{Gin}{width=0.8\textwidth} \usepackage{amsfonts} abstract: | The \pkg{markovchain} package aims to fill a gap within the \proglang{R} framework providing S4 classes and methods for easily handling discrete time Markov chains, homogeneous and simple inhomogeneous ones as well as continuous time Markov chains. The S4 classes for handling and analysing discrete and continuous time Markov chains are presented, as well as functions and method for performing probabilistic and statistical analysis. Finally, some examples in which the package's functions are applied to Economics, Finance and Natural Sciences topics are shown. output: if (rmarkdown::pandoc_version() < "2.7") function(...) { rmarkdown::pdf_document(template = "./template.tex", ...) } else function(...) { bookdown::pdf_book(base_format = rticles::jss_article, ...) } vignette: > %\VignetteIndexEntry{An introduction to markovchain package} %\VignetteEngine{knitr::rmarkdown} %VignetteEncoding{UTF-8} keywords: plain: [discrete time Markov chains, continuous time Markov chains, transition matrices, communicating classes, periodicity, first passage time, stationary distributions] formatted: [discrete time Markov chains, continuous time Markov chains, transition matrices, communicating classes, periodicity, first passage time, stationary distributions] documentclass: jss classoption: nojss bibliography: markovchainBiblio.bib pkgdown: as_is: true extension: pdf --- ```{r global_options, include=FALSE} knitr::opts_chunk$set(fig.width=8.5, fig.height=6, out.width = "70%") set.seed(123) library(knitr) hook_output <- knit_hooks$get("output") knit_hooks$set(output = function(x, options) { lines <- options$output.lines if (is.null(lines)) { return(hook_output(x, options)) # pass to default hook } x <- unlist(strsplit(x, "\n")) more <- "..." if (length(lines)==1) { # first n lines if (length(x) > lines) { # truncate the output, but add .... x <- c(head(x, lines), more) } } else { x <- c(more, x[lines], more) } # paste these lines together x <- paste(c(x, ""), collapse = "\n") hook_output(x, options) }) ``` # Introduction Markov chains represent a class of stochastic processes of great interest for the wide spectrum of practical applications. In particular, discrete time Markov chains (DTMC) permit to model the transition probabilities between discrete states by the aid of matrices.Various \proglang{R} packages deal with models that are based on Markov chains: * \pkg{msm} [@msmR] handles Multi-State Models for panel data. * \pkg{mcmcR} [@mcmcR] implements Monte Carlo Markov Chain approach. * \pkg{hmm} [@hmmR] fits hidden Markov models with covariates. * \pkg{mstate} fits `Multi-State Models based on Markov chains for survival analysis [@mstateR]. Nevertheless, the \proglang{R} statistical environment [@rSoftware] seems to lack a simple package that coherently defines S4 classes for discrete Markov chains and allows to perform probabilistic analysis, statistical inference and applications. For the sake of completeness, \pkg{markovchain} is the second package specifically dedicated to DTMC analysis, being \pkg{DTMCPack} [@DTMCPackR] the first one. Notwithstanding, \pkg{markovchain} package [@pkg:markovchain] aims to offer more flexibility in handling DTMC than other existing solutions, providing S4 classes for both homogeneous and semi-homogeneous Markov chains as well as methods suited to perform statistical and probabilistic analysis. The \pkg{markovchain} package depends on the following \proglang{R} packages: \pkg{expm} [@expmR] to perform efficient matrices powers; \pkg{igraph} [@pkg:igraph] to perform pretty plotting of `markovchain` objects and \pkg{matlab} [@pkg:matlab], that contains functions for matrix management and calculations that emulate those within \proglang{MATLAB} environment. Moreover, other scientific softwares provide functions specifically designed to analyze DTMC, as \proglang{Mathematica} 9 [@mathematica9]. The paper is structured as follows: Section \@ref(sec:mathematics) briefly reviews mathematics and definitions regarding DTMC, Section \@ref(sec:structure) discusses how to handle and manage Markov chain objects within the package, Section \@ref(sec:probability) and Section \@ref(sec:statistics) show how to perform probabilistic and statistical modelling, while Section \@ref(sec:applications) presents some applied examples from various fields analyzed by means of the \pkg{markovchain} package. # Review of core mathematical concepts {#sec:mathematics} ## General Definitions A DTMC is a sequence of random variables $X_{1},\: X_{2}\: ,\ldots,\:X_{n},\ldots$ characterized by the Markov property (also known as memoryless property, see Equation \ref{eq:markovProp}). The Markov property states that the distribution of the forthcoming state $X_{n+1}$ depends only on the current state $X_{n}$ and doesn't depend on the previous ones $X_{n-1},\: X_{n-2},\ldots,\: X_{1}$. \begin{equation} Pr\left(X_{n+1}=x_{n+1}\left|X_{1}=x_{1},X_{2}=x_{2,}...,X_{n}=x_{n}\right.\right)=Pr\left(X_{n+1}=x_{n+1}\left|X_{n}=x_{n}\right.\right). \label{eq:markovProp} \end{equation} The set of possible states $S=\left\{ s_{1},s_{2},...,s_{r}\right\}$ of $X_{n}$ can be finite or countable and it is named the state space of the chain. The chain moves from one state to another (this change is named either 'transition' or 'step') and the probability $p_{ij}$ to move from state $s_{i}$ to state $s_{j}$ in one step is named transition probability: \begin{equation} p_{ij}=Pr\left(X_{1}=s_{j}\left|X_{0}=s_{i}\right.\right). \label{eq:trProp} \end{equation} The probability of moving from state $i$ to $j$ in $n$ steps is denoted by $p_{ij}^{(n)}=Pr\left(X_{n}=s_{j}\left|X_{0}=s_{i}\right.\right)$. A DTMC is called time-homogeneous if the property shown in Equation \ref{eq:mcHom} holds. Time homogeneity implies no change in the underlying transition probabilities as time goes on. \begin{equation} Pr\left(X_{n+1}=s_{j}\left|X_{n}=s_{i}\right.\right)=Pr\left(X_{n}=s_{j}\left|X_{n-1}=s_{i}\right.\right). \label{eq:mcHom} \end{equation} If the Markov chain is time-homogeneous, then $p_{ij}=Pr\left(X_{k+1}=s_{j}\left|X_{k}=s_{i}\right.\right)$ and \newline $p_{ij}^{(n)}=Pr\left(X_{n+k}=s_{j}\left|X_{k}=s_{i}\right.\right)$, where $k>0$. The probability distribution of transitions from one state to another can be represented into a transition matrix $P=(p_{ij})_{i,j}$, where each element of position $(i,j)$ represents the transition probability $p_{ij}$. E.g., if $r=3$ the transition matrix $P$ is shown in Equation \ref{eq:trPropEx} \begin{equation} P=\left[\begin{array}{ccc} p_{11} & p_{12} & p_{13}\\ p_{21} & p_{22} & p_{23}\\ p_{31} & p_{32} & p_{33} \end{array}\right]. \label{eq:trPropEx} \end{equation} The distribution over the states can be written in the form of a stochastic row vector $x$ (the term stochastic means that $\sum_{i}x_{i}=1, x_{i} \geq 0$): e.g., if the current state of $x$ is $s_{2}$, $x=\left(0\:1\:0\right)$. As a consequence, the relation between $x^{(1)}$ and $x^{(0)}$ is $x^{(1)}=x^{(0)}P$ and, recursively, we get $x^{(2)}=x^{(0)}P^{2}$ and $x^{(n)}=x^{(0)}P^{n},\, n>0$. DTMC are explained in most theory books on stochastic processes, see \cite{bremaud1999discrete} and \cite{dobrow2016introduction} for example. Valuable references online available are: \cite{konstantopoulos2009markov}, \cite{probBook} and \cite{bardPpt}. ## Properties and classification of states {#sec:properties} A state $s_{j}$ is said accessible from state $s_{i}$ (written $s_{i}\rightarrow s_{j}$) if a system starting in state $s_{i}$ has a positive probability to reach the state $s_{j}$ at a certain point, i.e., $\exists n>0:\: p_{ij}^{n}>0$. If both $s_{i}\rightarrow s_{j}$ and $s_{j}\rightarrow s_{i}$, then $s_{i}$ and $s_{j}$ are said to communicate. A communicating class is defined to be a set of states that communicate. A DTMC can be composed by one or more communicating classes. If the DTMC is composed by only one communicating class (i.e., if all states in the chain communicate), then it is said irreducible. A communicating class is said to be closed if no states outside of the class can be reached from any state inside it. If $p_{ii}=1$, $s_{i}$ is defined as absorbing state: an absorbing state corresponds to a closed communicating class composed by one state only. The canonical form of a DTMC transition matrix is a matrix having a block form, where the closed communicating classes are shown at the beginning of the diagonal matrix. A state $s_{i}$ has period $k_{i}$ if any return to state $s_{i}$ must occur in multiplies of $k_{i}$ steps, that is $k_{i}=gcd\left\{ n:Pr\left(X_{n}=s_{i}\left|X_{0}=s_{i}\right.\right)>0\right\}$, where $gcd$ is the greatest common divisor. If $k_{i}=1$ the state $s_{i}$ is said to be aperiodic, else if $k_{i}>1$ the state $s_{i}$ is periodic with period $k_{i}$. Loosely speaking, $s_{i}$ is periodic if it can only return to itself after a fixed number of transitions $k_{i}>1$ (or multiple of $k_{i}$), else it is aperiodic. If states $s_{i}$ and $s_{j}$ belong to the same communicating class, then they have the same period $k_{i}$. As a consequence, each of the states of an irreducible DTMC share the same periodicity. This periodicity is also considered the DTMC periodicity. It is possible to classify states according to their periodicity. Let $T^{x\rightarrow x}$ is the number of periods to go back to state $x$ knowing that the chain starts in $x$. * A state $x$ is recurrent if $P(T^{x\rightarrow x}<+\infty)=1$ (equivalently $P(T^{x\rightarrow x}=+\infty)=0$). In addition: 1. A state $x$ is null recurrent if in addition $E(T^{x\rightarrow x})=+\infty$. 2. A state $x$ is positive recurrent if in addition $E(T^{x\rightarrow x})<+\infty$. 3. A state $x$ is absorbing if in addition $P(T^{x\rightarrow x}=1)=1$. * A state $x$ is transient if $P(T^{x\rightarrow x}<+\infty)<1$ (equivalently $P(T^{x\rightarrow x}=+\infty)>0$). It is possible to analyze the timing to reach a certain state. The first passage time (or hitting time) from state $s_{i}$ to state $s_{j}$ is the number $T_{ij}$ of steps taken by the chain until it arrives for the first time to state $s_{j}$, given that $X_{0} = s_{i}$. The probability distribution of $T_{ij}$ is defined by Equation \ref{eq:fpt1} \begin{equation} {h_{ij}}^{\left( n \right)} = Pr\left( {T_{ij} = n} \right) = Pr\left( X_n = s_j,X_{n - 1} \ne s_{j}, \ldots ,X_1 \ne s_j |X_0 = s_i \right) \label{eq:fpt1} \end{equation} and can be found recursively using Equation \ref{eq:ftp2}, given that ${h_{ij}}^{\left( n \right)} = p_{ij}$. \begin{equation} {h_{ij}}^{\left( n \right)} = \sum\limits_{k \in S - \left\{ s_{j} \right\}}^{} {{p_{ik}}{h_{kj}}^{\left( {n - 1} \right)}}. \label{eq:ftp2} \end{equation} A commonly used quantity related to $h$ is its average value, i.e. the \emph{mean first passage time} (also expected hitting time), namely $\bar h_{ij}= \sum_{n=1\dots\infty} n \,h_{ij}^{(n)}$. If in the definition of the first passage time we let $s_{i}=s_{j}$, we obtain the first recurrence time $T_{i}=\inf \{ n\geq1:X_{n}=s_{i}|X_{0}=s_{i} \}$. We could also ask ourselves which is the *mean recurrence time*, an average of the mean first recurrence times: \[ r_i = \sum_{k = 1}^{\infty} k \cdot P(T_i = k) \] Revisiting the definition of recurrence and transience: a state $s_{i}$ is said to be recurrent if it is visited infinitely often, i.e., $Pr(T_{i}<+\infty|X_{0}=s_{i})=1$. On the opposite, $s_{i}$ is called transient if there is a positive probability that the chain will never return to $s_{i}$, i.e., $Pr(T_{i}=+\infty|X_{0}=s_{i})>0$. Given a time homogeneous Markov chain with transition matrix \emph{P}, a stationary distribution \emph{z} is a stochastic row vector such that $z=z\cdot P$, where $0\leq z_{j}\leq 1 \: \forall j$ and $\sum_{j}z_{j}=1$. If a DTMC $\{X_{n}\}$ is irreducible and aperiodic, then it has a limit distribution and this distribution is stationary. As a consequence, if $P$ is the $k\times k$ transition matrix of the chain and $z=\left(z_{1},...,z_{k}\right)$ is the unique eigenvector of $P$ such that $\sum_{i=1}^{k}z_{i}=1$, then we get \begin{equation} \underset{n\rightarrow\infty}{lim}P^{n}=Z, \label{eq:limMc} \end{equation} where $Z$ is the matrix having all rows equal to $z$. The stationary distribution of $\{X_{n}\}$ is represented by $z$. A matrix $A$ is called primitive if all of its entries are strictly positive, and we write it $A > 0$. If the transition matrix $P$ for a DTMC has some primitive power, i.e. it exists $m > 0: P^m > 0$, then the DTMC is said to be regular. In fact being regular is equivalent to being irreducible and aperiodic. All regular DTMCs are irreducible. The counterpart is not true. Given two absorbing states $s_A$ (source) and $s_B$ (sink), the \emph{committor probability} $q_j^{(AB)}$ is the probability that a process starting in state $s_i$ is absorbed in state $s_B$ (rather than $s_A$) [@noe_constructing_2009]. It can be computed via \begin{equation} q_j^{(AB)} = \sum_{k \ni {A, B}} P_{jk}q_k^{(AB)} \quad \mbox{with} \quad q_A^{(AB)} = 0 \quad \mbox{and} \quad q_B^{(AB)} = 1 \end{equation} Note we can also define the hitting probability from $i$ to $j$ as the probability of ever reaching the state $j$ if our initial state is $i$: \begin{equation} h_{i,j} = Pr(T_{ij} < \infty) = \sum_{n = 0}^{\infty} h_{ij}^{(n)} \label{eq:hitting-probs} \end{equation} In a DTMC with finite set of states, we know that a transient state communicates at least with one recurrent state. If the chain starts in a transient element, once it hits a recurrent state, it is going to be caught in its recurrent state, and we cannot expect it would go back to the initial state. Given a transient state $i$ we can define the *absorption probability* to the recurrent state $j$ as the probability that the first recurrent state that the Markov chain visits (and therefore gets absorbed by its recurrent class) is $j$, $f^{*}_ij$. We can also define the *mean absorption time* as the mean number of steps the transient state $i$ would take until it hits any recurrent state, $b_i$. ## A short example Consider the following numerical example. Suppose we have a DTMC with a set of 3 possible states $S=\{s_{1}, s_{2}, s_{3}\}$. Let the transition matrix be: \begin{equation} P=\left[\begin{array}{ccc} 0.5 & 0.2 & 0.3\\ 0.15 & 0.45 & 0.4\\ 0.25 & 0.35 & 0.4 \end{array}\right]. \label{eq:trPropExEx1} \end{equation} In $P$, $p_{11}=0.5$ is the probability that $X_{1}=s_{1}$ given that we observed $X_{0}=s_{1}$ is 0.5, and so on.It is easy to see that the chain is irreducible since all the states communicate (it is made by one communicating class only). Suppose that the current state of the chain is $X_{0}=s_{2}$, i.e., $x^{(0)}=(0\:1\:0)$, then the probability distribution of states after 1 and 2 steps can be computed as shown in Equations \@ref(eq:trPropExEx2) and \@ref(eq:trPropExEx3). \begin{equation} x^{(1)}=\left(0\:1\:0\right)\left[\begin{array}{ccc} 0.5 & 0.2 & 0.3\\ 0.15 & 0.45 & 0.4\\ 0.25 & 0.35 & 0.4 \end{array}\right]=\left(0.15\:0.45\:0.4\right). \label{eq:trPropExEx2} \end{equation} \begin{equation} x^{(n)}=x^{(n-1)}P \to \left(0.15\:0.45\:0.4\right)\left[\begin{array}{ccc} 0.5 & 0.2 & 0.3\\ 0.15 & 0.45 & 0.4\\ 0.25 & 0.35 & 0.4 \end{array}\right]=\left(0.2425\:0.3725\:0.385\right). \label{eq:trPropExEx3} \end{equation} If we were interested in the probability of being in the state $s_{3}$ in the second step, then $Pr\left(X_{2}=s_{3}\left|X_{0}=s_{2}\right.\right)=0.385$. \newpage # The structure of the package {#sec:structure} ## Creating markovchain objects The package is loaded within the \proglang{R} command line as follows: ```{r, load, results='hide', message=FALSE} library("markovchain") ``` The `markovchain` and `markovchainList` S4 classes [@chambers] are defined within the \pkg{markovchain} package as displayed: ```{r, showClass, echo=FALSE} showClass("markovchain") showClass("markovchainList") ``` The first class has been designed to handle homogeneous Markov chain processes, while the latter (which is itself a list of `markovchain` objects) has been designed to handle semi-homogeneous Markov chains processes. Any element of `markovchain` class is comprised by following slots: 1. `states`: a character vector, listing the states for which transition probabilities are defined. 2. `byrow`: a logical element, indicating whether transition probabilities are shown by row or by column. 3. `transitionMatrix`: the probabilities of the transition matrix. 4. `name`: optional character element to name the DTMC. The `markovchainList` objects are defined by following slots: 1. `markovchains`: a list of `markovchain` objects. 2. `name`: optional character element to name the DTMC. The `markovchain` objects can be created either in a long way, as the following code shows ```{r mcInitLong} weatherStates <- c("sunny", "cloudy", "rain") byRow <- TRUE weatherMatrix <- matrix(data = c(0.70, 0.2, 0.1, 0.3, 0.4, 0.3, 0.2, 0.45, 0.35), byrow = byRow, nrow = 3, dimnames = list(weatherStates, weatherStates)) mcWeather <- new("markovchain", states = weatherStates, byrow = byRow, transitionMatrix = weatherMatrix, name = "Weather") ``` or in a shorter way, displayed below ```{r mcInitShort} mcWeather <- new("markovchain", states = c("sunny", "cloudy", "rain"), transitionMatrix = matrix(data = c(0.70, 0.2, 0.1, 0.3, 0.4, 0.3, 0.2, 0.45, 0.35), byrow = byRow, nrow = 3), name = "Weather") ``` When `new("markovchain")` is called alone, a default Markov chain is created. ```{r defaultMc} defaultMc <- new("markovchain") ``` The quicker way to create `markovchain` objects is made possible thanks to the implemented `initialize` S4 method that checks that: * the `transitionMatrix`, either of class matrix or Matrix, to be a transition matrix, i.e., all entries to be probabilities and either all rows or all columns to sum up to one. * the columns and rows names of `transitionMatrix` to be defined and to coincide with `states` vector slot. The `markovchain` objects can be collected in a list within `markovchainList` S4 objects as following example shows. ```{r intromcList} mcList <- new("markovchainList", markovchains = list(mcWeather, defaultMc), name = "A list of Markov chains") ``` ## Handling markovchain objects Table \@ref(tab:methodsToHandleMc) lists which methods handle and manipulate `markovchain` objects. \begin{table}[h] \centering \begin{tabular}{lll} \hline Method & Purpose \\ \hline \hline \code{*} & Direct multiplication for transition matrices.\\ \code{\textasciicircum{}} & Compute the power \code{markovchain} of a given one.\\ \code{[} & Direct access to the elements of the transition matrix.\\ \code{==} & Equality operator between two transition matrices.\\ \code{!=} & Inequality operator between two transition matrices.\\ \code{as} & Operator to convert \code{markovchain} objects into \code{data.frame} and\\ & \code{table} object.\\ \code{dim} & Dimension of the transition matrix.\\ \code{names} & Equal to \code{states}.\\ \code{names<-} & Change the \code{states} name.\\ \code{name} & Get the name of \code{markovchain object}.\\ \code{name<-} & Change the name of \code{markovchain object}.\\ \code{plot} & \code{plot} method for \code{markovchain} objects.\\ \code{print} & \code{print} method for \code{markovchain} objects.\\ \code{show} & \code{show} method for \code{markovchain} objects.\\ \code{sort} & \code{sort} method for \code{markovchain} objects, in terms of their states.\\ \code{states} & Name of the transition states.\\ \code{t} & Transposition operator (which switches \code{byrow} `slot value and modifies \\ & the transition matrix coherently).\\ \hline \end{tabular} \caption{\pkg{markovchain} methods for handling \code{markovchain} objects.} \label{tab:methodsToHandleMc} \end{table} The examples that follow shows how operations on `markovchain` objects can be easily performed. For example, using the previously defined matrix we can find what is the probability distribution of expected weather states in two and seven days, given the actual state to be cloudy. ```{r operations} initialState <- c(0, 1, 0) after2Days <- initialState * (mcWeather * mcWeather) after7Days <- initialState * (mcWeather ^ 7) after2Days round(after7Days, 3) ``` A similar answer could have been obtained defining the vector of probabilities as a column vector. A column - defined probability matrix could be set up either creating a new matrix or transposing an existing `markovchain` object thanks to the `t` method. ```{r operations2} initialState <- c(0, 1, 0) after2Days <- (t(mcWeather) * t(mcWeather)) * initialState after7Days <- (t(mcWeather) ^ 7) * initialState after2Days round(after7Days, 3) ``` The initial state vector previously shown can not necessarily be a probability vector, as the code that follows shows: ```{r fval} fvals<-function(mchain,initialstate,n) { out<-data.frame() names(initialstate)<-names(mchain) for (i in 0:n) { iteration<-initialstate*mchain^(i) out<-rbind(out,iteration) } out<-cbind(out, i=seq(0,n)) out<-out[,c(4,1:3)] return(out) } fvals(mchain=mcWeather,initialstate=c(90,5,5),n=4) ``` Basic methods have been defined for `markovchain` objects to quickly get states and transition matrix dimension. ```{r otherMethods} states(mcWeather) names(mcWeather) dim(mcWeather) ``` Methods are available to set and get the name of `markovchain` object. ```{r otherMethods2} name(mcWeather) name(mcWeather) <- "New Name" name(mcWeather) ``` Also it is possible to alphabetically sort the transition matrix: ```{r sortMethod} markovchain:::sort(mcWeather) ``` A direct access to transition probabilities is provided both by `transitionProbability` method and `"["` method. ```{r transProb} transitionProbability(mcWeather, "cloudy", "rain") mcWeather[2,3] ``` The transition matrix of a `markovchain` object can be displayed using `print` or `show` methods (the latter being less verbose). Similarly, the underlying transition probability diagram can be plotted by the use of `plot` method (as shown in Figure \@ref(fig:mcPlot)) which is based on \pkg{igraph} package [@pkg:igraph]. `plot` method for `markovchain` objects is a wrapper of `plot.igraph` for `igraph` S4 objects defined within the \pkg{igraph} package. Additional parameters can be passed to `plot` function to control the network graph layout. There are also \pkg{diagram} and \pkg{DiagrammeR} ways available for plotting as shown in Figure \@ref(fig:mcPlotdiagram). The `plot` function also uses `communicatingClasses` function to separate out states of different communicating classes. All states that belong to one class have same color. ```{r printAndShow} print(mcWeather) show(mcWeather) ``` ```{r mcPlot, echo=FALSE, fig.cap="Weather example. Markov chain plot"} if (requireNamespace("igraph", quietly = TRUE)) { library(igraph) plot(mcWeather,layout = layout.fruchterman.reingold) } else { message("igraph unavailable") } ``` ```{r mcPlotdiagram, echo=FALSE, fig.cap="Weather example. Markov chain plot with diagram"} if (requireNamespace("diagram", quietly = TRUE)) { library(diagram) plot(mcWeather, package="diagram", box.size = 0.04) } else { message("diagram unavailable") } ``` Import and export from some specific classes is possible, as shown in Figure \@ref(fig:fromAndTo) and in the following code. ```{r exportImport1} mcDf <- as(mcWeather, "data.frame") mcNew <- as(mcDf, "markovchain") mcDf mcIgraph <- as(mcWeather, "igraph") ``` ```{r exportImport2} if (requireNamespace("msm", quietly = TRUE)) { require(msm) Q <- rbind ( c(0, 0.25, 0, 0.25), c(0.166, 0, 0.166, 0.166), c(0, 0.25, 0, 0.25), c(0, 0, 0, 0) ) cavmsm <- msm(state ~ years, subject = PTNUM, data = cav, qmatrix = Q, death = 4) msmMc <- as(cavmsm, "markovchain") msmMc } else { message("msm unavailable") } ``` from etm (now archived as of September 2020): ```{r exporImport3} if (requireNamespace("etm", quietly = TRUE)) { library(etm) data(sir.cont) sir.cont <- sir.cont[order(sir.cont$id, sir.cont$time), ] for (i in 2:nrow(sir.cont)) { if (sir.cont$id[i]==sir.cont$id[i-1]) { if (sir.cont$time[i]==sir.cont$time[i-1]) { sir.cont$time[i-1] <- sir.cont$time[i-1] - 0.5 } } } tra <- matrix(ncol=3,nrow=3,FALSE) tra[1, 2:3] <- TRUE tra[2, c(1, 3)] <- TRUE tr.prob <- etm::etm(sir.cont, c("0", "1", "2"), tra, "cens", 1) tr.prob etm2mc<-as(tr.prob, "markovchain") etm2mc } else { message("etm unavailable") } ``` ```{r fromAndTo, echo=FALSE, fig.cap="The markovchain methods for import and export"} library(igraph) importExportGraph<-graph.formula(dataframe++markovchain,markovchain-+igraph, markovchain++matrix,table-+markovchain,msm-+markovchain,etm-+markovchain, markovchain++sparseMatrix) plot(importExportGraph,main="Import - Export from and to markovchain objects") ``` Coerce from `matrix` method, as the code below shows, represents another approach to create a `markovchain` method starting from a given squared probability matrix. ```{r exportImport4} myMatr<-matrix(c(.1,.8,.1,.2,.6,.2,.3,.4,.3), byrow=TRUE, ncol=3) myMc<-as(myMatr, "markovchain") myMc ``` Semi-homogeneous Markov chains can be created with the aid of `markovchainList` object. The example that follows arises from health insurance, where the costs associated to patients in a Continuous Care Health Community (CCHC) are modeled by a semi-homogeneous Markov Chain, since the transition probabilities change by year. Methods explicitly written for `markovchainList` objects are: `print`, `show`, `dim` and `[`. ```{r cchcMcList} stateNames = c("H", "I", "D") Q0 <- new("markovchain", states = stateNames, transitionMatrix =matrix(c(0.7, 0.2, 0.1,0.1, 0.6, 0.3,0, 0, 1), byrow = TRUE, nrow = 3), name = "state t0") Q1 <- new("markovchain", states = stateNames, transitionMatrix = matrix(c(0.5, 0.3, 0.2,0, 0.4, 0.6,0, 0, 1), byrow = TRUE, nrow = 3), name = "state t1") Q2 <- new("markovchain", states = stateNames, transitionMatrix = matrix(c(0.3, 0.2, 0.5,0, 0.2, 0.8,0, 0, 1), byrow = TRUE,nrow = 3), name = "state t2") Q3 <- new("markovchain", states = stateNames, transitionMatrix = matrix(c(0, 0, 1, 0, 0, 1, 0, 0, 1), byrow = TRUE, nrow = 3), name = "state t3") mcCCRC <- new("markovchainList",markovchains = list(Q0,Q1,Q2,Q3), name = "Continuous Care Health Community") print(mcCCRC) ``` It is possible to perform direct access to `markovchainList` elements, as well as to determine the number of `markovchain` objects by which a `markovchainList` object is composed. ```{r cchcMcList2} mcCCRC[[1]] dim(mcCCRC) ``` The `markovchain` package contains some data found in the literature related to DTMC models (see Section \@ref(sec:applications). Table \@ref(tab:datasets) lists datasets and tables included within the current release of the package. \begin{table}[h] \centering \begin{tabular}{p{0.2\textwidth}p{0.75\textwidth}} \hline Dataset & Description \\ \hline \hline \code{blanden} & Mobility across income quartiles, \cite{blandenEtAlii}.\\ \code{craigsendi} & CD4 cells, \cite{craigSendi}.\\ \code{kullback} & raw transition matrices for testing homogeneity, \cite{kullback1962tests}.\\ \code{preproglucacon} & Preproglucacon DNA basis, \cite{averyHenderson}.\\ \code{rain} & Alofi Island rains, \cite{averyHenderson}.\\ \code{holson} & Individual states trajectories.\\ \code{sales} & Sales of six beverages in Hong Kong \cite{ching2008higher}. \\ \hline \end{tabular} \caption{The \pkg{markovchain} \code{data.frame} and \code{table}.} \label{tab:datasets} \end{table} Finally, Table \@ref(tab:demos) lists the demos included in the demo directory of the package. \begin{table}[h] \centering \begin{tabular}{lll} \hline R Code File & Description \\ \hline \hline \code{bard.R} & Structural analysis of Markov chains from Bard PPT.\\ \code{examples.R} & Notable Markov chains, e.g., The Gambler Ruin chain.\\ \code{quickStart.R} & Generic examples.\\ \code{extractMatrices.R} & Generic examples.\\ \hline \end{tabular} \caption{The \pkg{markovchain} demos.} \label{tab:demos} \end{table} # Probability with markovchain objects {#sec:probability} The \pkg{markovchain} package contains functions to analyse DTMC from a probabilistic perspective. For example, the package provides methods to find stationary distributions and identifying absorbing and transient states. Many of these methods come from \proglang{MATLAB} listings that have been ported into \proglang{R}. For a full description of the underlying theory and algorithm the interested reader can overview the original \proglang{MATLAB} listings, \cite{renaldoMatlab} and \cite{montgomery}. Table \@ref(tab:methodsToStats) shows methods that can be applied on `markovchain` objects to perform probabilistic analysis. \begin{table}[h] \centering \begin{tabular}{lll} \hline Method & Returns \\ \hline \hline \code{absorbingStates} & the absorbing states of the transition matrix, if any.\\ \code{steadyStates} & the vector(s) of steady state(s) in matrix form. \\ \code{meanFirstPassageTime} & matrix or vector of mean first passage times. \\ \code{meanRecurrenceTime} & vector of mean number of steps to return to each recurrent state \\ \code{hittingProbabilities} & matrix of hitting probabilities for a Markov chain. \\ \code{meanAbsorptionTime} & expected number of steps for a transient state to be \\ & absorbed by any recurrent class \\ \code{absorptionProbabilities} & probabilities of transient states of being \\ & absorbed by each recurrent state \\ \code{committorAB} & committor probabilities \\ \code{communicatingClasses} & list of communicating classes. \\ & $s_{j}$, given actual state $s_{i}$. \\ \code{canonicForm} & the transition matrix into canonic form. \\ \code{is.accessible} & checks whether a state j is reachable from state i. \\ \code{is.irreducible} & checks whether a DTMC is irreducible. \\ \code{is.regular} & checks whether a DTMC is regular. \\ \code{period} & the period of an irreducible DTMC. \\ \code{recurrentClasses} & list of recurrent communicating classes. \\ \code{transientClasses} & list of transient communicating classes. \\ \code{recurrentStates} & the recurrent states of the transition matrix. \\ \code{transientStates} & the transient states of the transition matrix, if any. \\ \code{summary} & DTMC summary. \\ \hline \end{tabular} \caption{\pkg{markovchain} methods: statistical operations.} \label{tab:methodsToStats} \end{table} ## Conditional distributions The conditional distribution of weather states, given that current day's weather is sunny, is given by following code. ```{r conditionalDistr} conditionalDistribution(mcWeather, "sunny") ``` ## Stationary states A stationary (steady state, or equilibrium) vector is a probability vector such that Equation \ref{eq:steadystat2} holds \begin{equation} \begin{matrix} 0\leq \pi_j \leq 1\\ \sum_{j \in S} \pi_j = 1\\ \pi \cdot P = \pi \end{matrix} \label{eq:steadystat2} \end{equation} Steady states are associated to $P$ eigenvalues equal to one. We could be tempted to compute them solving the eigen values / vectors of the matrix and taking real parts (since if $u + iv$ is a eigen vector, for the matrix $P$, then $Re(u + iv) = u$ and $Im(u + iv) = v$ are eigen vectors) and normalizing by the vector sum, this carries some concerns: 1. If $u, v \in \mathbb{R}^n$ are linearly independent eigen vectors associated to $1$ eigen value, $u + iv$, $u + iu$ are also linearly independent eigen vectors, and their real parts coincide. Clearly if we took real parts, we would be loosing an eigen vector, because we cannot know in advance if the underlying algorithm to compute the eigen vectors is going to output something similar to what we described. We should be agnostic to the underlying eigen vector computation algorithm. 2. Imagine the identity $P$ of dimensions $2 \times 2$. Its eigen vectors associated to the $1$ eigen value are $u = (1, 0)$ and $v = (0, 1)$. However, the underlying algorithm to compute eigen vectors could return $(1, -2)$ and $(-2, 1)$ instead, that are linear combinations of the aforementioned ones, and therefore eigen vectors. Normalizing by their sum, we would get: $(-1, 2)$ and $(2, -1)$, which obviously are not probability measures. Again, we should be agnostic to the underlying eigen computation algorithm. 3. Algorithms to compute eigen values / vectors are computationally expensive: they are iterative, and we cannot predict a fixed number of iterations for them. Moreover, each iteration takes $\mathcal{O}(m^2)$ or $\mathcal{O}(m^3)$ algorithmic complexity, with $m$ the number of states. We are going to use that every irreducible DTMC has a unique steady state, that is, if $M$ is the matrix for an irreducible DTMC (all states communicate with each other), then it exists a unique $v \in \mathbb{R}^m$ such that: \[ v \cdot M = v, \qquad \sum_{i = 1}^m v_i = 1 \] Also, we'll use that a steady state for a DTMC assigns $0$ to the transient states. The canonical form of a (by row) stochastic matrix looks alike: \[ \left(\begin{array}{c|c|c|c|c} M_1 & 0 & 0 & \ldots & 0 \\ \hline 0 & M_2 & 0 & \ldots & 0 \\ \hline 0 & 0 & M_3 & \ldots & 0 \\ \hline \vdots & \vdots & \vdots & \ddots & \vdots \\ \hline A_1 & A_2 & A_3 & \ldots & R \end{array}\right) \] where $M_i$ corresponds to irreducible sub-chains, the blocks $A_i$ correspond to the transitions from transient states to each of the recurrent classes and $R$ are the transitions from the transient states to themselves. Also, we should note that a Markov chain has exactly the same name of steady states as recurrent classes. Therefore, we have coded the following algorithm ^[We would like to thank Prof. Christophe Dutang for his contributions to the development of this method. He coded a first improvement of the original `steadyStates` method and we could not have reached the current correctness without his previous work]: 1. Identify the recurrent classes $[C_1, \ldots, C_l]$ with \texttt{recurrentClasses} function. 2. Take each class $C_i$, compute the sub-matrix corresponding to it $M_i$. 3. Solve the system $v \cdot C_i = v, \, \sum_{j = 1}^{|C_i|} v_j = 1$ which has a unique solution, for each $i = 1, \ldots, l$. 3. Map each state $v_i$ to the original order in $P$ and assign a $0$ to the slots corresponding to transient states in the matrix. The result is returned in matrix form. ```{r steadyStates} steadyStates(mcWeather) ``` It is possible for a Markov chain to have more than one stationary distribution, as the gambler ruin example shows. ```{r gamblerRuin} gamblerRuinMarkovChain <- function(moneyMax, prob = 0.5) { m <- markovchain:::zeros(moneyMax + 1) m[1,1] <- m[moneyMax + 1,moneyMax + 1] <- 1 states <- as.character(0:moneyMax) rownames(m) <- colnames(m) <- states for(i in 2:moneyMax){ m[i,i-1] <- 1 - prob m[i, i + 1] <- prob } new("markovchain", transitionMatrix = m, name = paste("Gambler ruin", moneyMax, "dim", sep = " ")) } mcGR4 <- gamblerRuinMarkovChain(moneyMax = 4, prob = 0.5) steadyStates(mcGR4) ``` ## Classification of states Absorbing states are determined by means of `absorbingStates` method. ```{r absorbingStates} absorbingStates(mcGR4) absorbingStates(mcWeather) ``` The key function in methods which need knowledge about communicating classes, recurrent states, transient states, is `.commclassKernel`, which is a modification of Tarjan's algorithm from \cite{Tarjan}. This `.commclassKernel` method gets a transition matrix of dimension $n$ and returns a list of two items: 1. `classes`, an matrix whose $(i, j)$ entry is `true` if $s_i$ and $s_j$ are in the same communicating class. 2. `closed`, a vector whose $i$ -th entry indicates whether the communicating class to which $i$ belongs is closed. These functions are used by two other internal functions on which the `summary` method for `markovchain` objects works. The example matrix used in \cite{renaldoMatlab} well exemplifies the purpose of the function. ```{r renaldoMatrix1} P <- markovchain:::zeros(10) P[1, c(1, 3)] <- 1/2; P[2, 2] <- 1/3; P[2,7] <- 2/3; P[3, 1] <- 1; P[4, 5] <- 1; P[5, c(4, 5, 9)] <- 1/3; P[6, 6] <- 1; P[7, 7] <- 1/4; P[7,9] <- 3/4; P[8, c(3, 4, 8, 10)] <- 1/4; P[9, 2] <- 1; P[10, c(2, 5, 10)] <- 1/3; rownames(P) <- letters[1:10] colnames(P) <- letters[1:10] probMc <- new("markovchain", transitionMatrix = P, name = "Probability MC") summary(probMc) ``` All states that pertain to a transient class are named "transient" and a specific method has been written to elicit them. ```{r transientStates} transientStates(probMc) ``` `canonicForm` method that turns a Markov chain into its canonic form, reordering the states to have first the recurrent classes and then the transient states. ```{r probMc2Canonic} probMcCanonic <- canonicForm(probMc) probMc probMcCanonic ``` The function `is.accessible` permits to investigate whether a state $s_{j}$ is accessible from state $s_i$, that is whether the probability to eventually reach $s_j$ starting from $s_{i}$ is greater than zero. ```{r isAccessible} is.accessible(object = probMc, from = "a", to = "c") is.accessible(object = probMc, from = "g", to = "c") ``` In Section \@ref(sec:properties) we observed that, if a DTMC is irreducible, all its states share the same periodicity. Then, the `period` function returns the periodicity of the DTMC, provided that it is irreducible. The example that follows shows how to find if a DTMC is reducible or irreducible by means of the function `is.irreducible` and, in the latter case, the method `period` is used to compute the periodicity of the chain. ```{r periodicity} E <- matrix(0, nrow = 4, ncol = 4) E[1, 2] <- 1 E[2, 1] <- 1/3; E[2, 3] <- 2/3 E[3,2] <- 1/4; E[3, 4] <- 3/4 E[4, 3] <- 1 mcE <- new("markovchain", states = c("a", "b", "c", "d"), transitionMatrix = E, name = "E") is.irreducible(mcE) period(mcE) ``` The example Markov chain found in \proglang{Mathematica} web site \citep{mathematica9MarkovChain} has been used, and is plotted in Figure \@ref(fig:mcMathematics). ```{r mathematica9Mc} mathematicaMatr <- markovchain:::zeros(5) mathematicaMatr[1,] <- c(0, 1/3, 0, 2/3, 0) mathematicaMatr[2,] <- c(1/2, 0, 0, 0, 1/2) mathematicaMatr[3,] <- c(0, 0, 1/2, 1/2, 0) mathematicaMatr[4,] <- c(0, 0, 1/2, 1/2, 0) mathematicaMatr[5,] <- c(0, 0, 0, 0, 1) statesNames <- letters[1:5] mathematicaMc <- new("markovchain", transitionMatrix = mathematicaMatr, name = "Mathematica MC", states = statesNames) ``` ```{r mcMathematics, fig=TRUE, echo=FALSE, fig.align='center', fig.cap="Mathematica 9 example. Markov chain plot."} plot(mathematicaMc, layout = layout.fruchterman.reingold) ``` ```{r mathematica9MC, echo=FALSE} summary(mathematicaMc) ``` ## First passage time distributions and means \cite{renaldoMatlab} provides code to compute first passage time (within $1,2,\ldots, n$ steps) given the initial state to be $i$. The \proglang{MATLAB} listings translated into \proglang{R} on which the `firstPassage` function is based are: ```{r fpTime1, eval=FALSE} .firstpassageKernel <- function(P, i, n){ G <- P H <- P[i,] E <- 1 - diag(size(P)[2]) for (m in 2:n) { G <- P %*% (G * E) H <- rbind(H, G[i,]) } return(H) } ``` We conclude that the probability for the *first* rainy day to be the third one, given that the current state is sunny, is given by: ```{r fpTime2} firstPassagePdF <- firstPassage(object = mcWeather, state = "sunny", n = 10) firstPassagePdF[3, 3] ``` To compute the *mean* first passage times, i.e. the expected number of days before it rains given that today is sunny, we can use the `meanFirstPassageTime` function: ```{r mfpt1} meanFirstPassageTime(mcWeather) ``` indicating e.g. that the average number of days of sun or cloud before rain is 6.67 if we start counting from a sunny day, and 5 if we start from a cloudy day. Note that we can also specify one or more destination states: ```{r mfpt2} meanFirstPassageTime(mcWeather,"rain") ``` The implementation follows the matrix solutions by [@GrinsteadSnell]. We can check the result by averaging the first passage probability density function: ```{r mfpt3} firstPassagePdF.long <- firstPassage(object = mcWeather, state = "sunny", n = 100) sum(firstPassagePdF.long[,"rain"] * 1:100) ``` ## Mean recurrence time The `meanRecurrenceTime` method gives the first mean recurrence time (expected number of steps to go back to a state if it was the initial one) for each recurrent state in the transition probabilities matrix for a DTMC. Let's see an example: ```{r mrt-weather} meanRecurrenceTime(mcWeather) ``` Another example, with not all of its states being recurrent: ```{r mrt-probMc} recurrentStates(probMc) meanRecurrenceTime(probMc) ``` ## Absorption probabilities and mean absorption time We are going to use the Drunkard’s random walk from [@GrinsteadSnell]. We have a drunk person walking through the street. Each move the person does, if they have not arrived to either home (corner 1) or to the bar (corner 5) could be to the left corner or to the right one, with equal probability. In case of arrival to the bar or to home, the person stays there. ```{r data-drunkard} drunkProbs <- markovchain:::zeros(5) drunkProbs[1,1] <- drunkProbs[5,5] <- 1 drunkProbs[2,1] <- drunkProbs[2,3] <- 1/2 drunkProbs[3,2] <- drunkProbs[3,4] <- 1/2 drunkProbs[4,3] <- drunkProbs[4,5] <- 1/2 drunkMc <- new("markovchain", transitionMatrix = drunkProbs) drunkMc ``` Recurrent (in fact absorbing states) are: ```{r rs-drunkard} recurrentStates(drunkMc) ``` Transient states are the rest: ```{r ts-drunkard} transientStates(drunkMc) ``` The probability of either being absorbed by the bar or by the sofa at home are: ```{r ap-drunkard} absorptionProbabilities(drunkMc) ``` which means that the probability of arriving home / bar is inversely proportional to the distance to each one. But we also would like to know how much time does the person take to arrive there, which can be done with `meanAbsorptionTime`: ```{r at-drunkard} meanAbsorptionTime(drunkMc) ``` So it would take `3` steps to arrive to the destiny if the person is either in the second or fourth corner, and `4` steps in case of being at the same distance from home than to the bar. ## Committor probability The committor probability tells us the probability to reach a given state before another given. Suppose that we start in a cloudy day, the probabilities of experiencing a rainy day before a sunny one is 0.5: ```{r} committorAB(mcWeather,3,1) ``` ## Hitting probabilities Rewriting the system \eqref{eq:hitting-probs} as: \begin{equation*} A = \left(\begin{array}{c|c|c|c} A_1 & 0 & \ldots & 0 \\ \hline 0 & A_2 & \ldots & 0 \\ \hline \vdots & \vdots & \ddots & 0 \\ \hline 0 & 0 & \ldots & A_n \end{array}\right) \end{equation*} \begin{eqnarray*} A_1 &= \left(\begin{matrix} -1 & p_{1,2} & p_{1,3} & \ldots & p_{1,n} \\ 0 & (p_{2,2} - 1) & p_{2,3} & \ldots & p_{2,n} \\ \vdots & \vdots & \vdots & \ddots & \vdots \\ 0 & p_{n, 2} & p_{n,3} & \ldots & (p_{n,n} - 1) \end{matrix}\right)\\ A_2 &= \left(\begin{matrix} (p_{1,1} - 1) & 0 & p_{1,3} & \ldots & p_{1,n} \\ p_{2,1} & -1 & p_{2,3} & \ldots & p_{2,n} \\ \vdots & \vdots & \vdots & \ddots & \vdots \\ p_{n,1} & 0 & p_{n,3} & \ldots & (p_{n,n} - 1) \end{matrix}\right)\\ \vdots & \vdots\\ A_n &= \left(\begin{matrix} (p_{1,1} - 1) & p_{1,2} & p_{1,3} & \ldots & 0 \\ p_{2,1} & (p_{2,2} -1) & p_{2,3} & \ldots & 0 \\ \vdots & \vdots & \vdots & \ddots & \vdots \\ p_{n,1} & p_{n,2} & p_{n,3} & \ldots & -1 \end{matrix}\right)\\ \end{eqnarray*} \begin{equation*} \begin{array}{lr} X_j = \left(\begin{array}{c} h_{1,j} \\ h_{2,j} \\ \vdots \\ h_{n,j} \end{array}\right) & C_j = - \left(\begin{array}{c} p_{1,j} \\ p_{2,j} \\ \vdots \\ p_{n,j} \end{array}\right) \end{array} \end{equation*} we end up having to solve the block systems: \begin{equation} A_j \cdot X_j = C_j \end{equation} Let us imagine the $i$ -th state has transition probabilities: $(0, \ldots, 0, \underset{i)}{1}, 0, \ldots, 0)$. Then that same row would turn into $(0,0, \ldots, 0)$ for some block, thus obtaining a singular matrix. Another case which may give us problems could be: state $i$ has the following transition probabilities: $(0, \ldots, 0, \underset{j)}{1}, 0, \ldots, 0)$ and the state $j$ has the following transition probabilities: $(0, \ldots, 0, \underset{i)}{1}, 0, \ldots, 0)$. Then when building some blocks we will end up with rows: \begin{eqnarray*} (0, \ldots, 0, \underset{i)}{-1}, 0, \ldots, 0, \underset{j)}{1}, 0, \ldots, 0) \\ (0, \ldots, 0, \underset{i)}{1}, 0, \ldots, 0, \underset{j)}{-1}, 0, \ldots, 0) \end{eqnarray*} which are linearly dependent. Our hypothesis is that if we treat the closed communicating classes differently, we *might* delete the linearity in the system. If we have a closed communicating class $C_u$, then $h_{i,j} = 1$ for all $i,j \in C_u$ and $h_{k,j} = 0$ for all $k\not\in C_u$. Then we can set $X_u$ appropriately and solve the other $X_v$ using those values. The method in charge of that in `markovchain` package is `hittingProbabilities`, which receives a Markov chain and computes the matrix $(h_{ij})_{i,j = 1,\ldots, n}$ where $S = \{s_1, \ldots, s_n\}$ is the set of all states of the chain. For the following chain: ```{r hitting-data} M <- markovchain:::zeros(5) M[1,1] <- M[5,5] <- 1 M[2,1] <- M[2,3] <- 1/2 M[3,2] <- M[3,4] <- 1/2 M[4,2] <- M[4,5] <- 1/2 hittingTest <- new("markovchain", transitionMatrix = M) hittingProbabilities(hittingTest) ``` we want to compute the hitting probabilities. That can be done with: ```{r hitting-probabilities} hittingProbabilities(hittingTest) ``` In the case of the `mcWeather` Markov chain we would obtain a matrix with all its elements set to $1$. That makes sense (and is desirable) since if today is sunny, we expect it would be sunny again at certain point in the time, and the same with rainy weather (that way we assure good harvests): ```{r hitting-weather} hittingProbabilities(mcWeather) ``` # Statistical analysis {#sec:statistics} Table \@ref(tab:funs4Stats) lists the functions and methods implemented within the package which help to fit, simulate and predict DTMC. \begin{table}[h] \centering \begin{tabular}{lll} \hline Function & Purpose \\ \hline \hline \code{markovchainFit} & Function to return fitted Markov chain for a given sequence.\\ \code{predict} & Method to calculate predictions from \code{markovchain} or \\ & \code{markovchainList} objects.\\ \code{rmarkovchain} & Function to sample from \code{markovchain} or \code{markovchainList} objects.\\ \hline \end{tabular} \caption{The \pkg{markovchain} statistical functions.} \label{tab:funs4Stats} \end{table} ## Simulation Simulating a random sequence from an underlying DTMC is quite easy thanks to the function `rmarkovchain`. The following code generates a year of weather states according to `mcWeather` underlying stochastic process. ```{r simulatingAMarkovChain} weathersOfDays <- rmarkovchain(n = 365, object = mcWeather, t0 = "sunny") weathersOfDays[1:30] ``` Similarly, it is possible to simulate one or more sequences from a semi-homogeneous Markov chain, as the following code (applied on CCHC example) exemplifies. ```{r simulatingAListOfMarkovChain} patientStates <- rmarkovchain(n = 5, object = mcCCRC, t0 = "H", include.t0 = TRUE) patientStates[1:10,] ``` Two advance parameters are available to the `rmarkovchain` method which helps you decide which implementation to use. There are four options available : \proglang{R}, \proglang{R} in parallel, \proglang{C++} and \proglang{C++} in parallel. Two boolean parameters `useRcpp` and `parallel` will decide which implementation will be used. Default is \code{useRcpp = TRUE} and \code{parallel = FALSE} i.e. \proglang{C++} implementation. The \proglang{C++} implementation is generally faster than the `R` implementation. If you have multicore processors then you can take advantage of `parallel` parameter by setting it to `TRUE`. When both `Rcpp=TRUE` and `parallel=TRUE` the parallelization has been carried out using \pkg{RcppParallel} package \citep{pkg:RcppParallel}. ## Estimation A time homogeneous Markov chain can be fit from given data. Four methods have been implemented within current version of \pkg{markovchain} package: maximum likelihood, maximum likelihood with Laplace smoothing, Bootstrap approach, maximum a posteriori. Equation \ref{eq:MLE} shows the maximum likelihood estimator (MLE) of the $p_{ij}$ entry, where the $n_{ij}$ element consists in the number sequences $\left( X_{t}=s_{i}, X_{t+1}=s_{j}\right)$ found in the sample, that is \begin{equation} {\hat p^{MLE}}_{ij} = \frac{n_{ij}}{\sum\limits_{u = 1}^k {n_{iu}}}. \label{eq:MLE} \end{equation} Equation \@ref(eq:SE) shows the `standardError` of the MLE \citep{MSkuriat}. \begin{equation} SE_{ij} = \frac{ {\hat p^{MLE}}_{ij} }{\sqrt{n_{ij}}} \label{eq:SE} \end{equation} ```{r fitMcbyMLE2} weatherFittedMLE <- markovchainFit(data = weathersOfDays, method = "mle",name = "Weather MLE") weatherFittedMLE$estimate weatherFittedMLE$standardError ``` The Laplace smoothing approach is a variation of the MLE, where the $n_{ij}$ is substituted by $n_{ij}+\alpha$ (see Equation \ref{eq:LAPLACE}), being $\alpha$ an arbitrary positive stabilizing parameter. \begin{equation} {\hat p^{LS}}_{ij} = \frac{{{n_{ij}} + \alpha }}{{\sum\limits_{u = 1}^k {\left( {{n_{iu}} + \alpha } \right)} }} \label{eq:LAPLACE} \end{equation} ```{r fitMcbyLAPLACE} weatherFittedLAPLACE <- markovchainFit(data = weathersOfDays, method = "laplace", laplacian = 0.01, name = "Weather LAPLACE") weatherFittedLAPLACE$estimate ``` (NOTE: The Confidence Interval option is enabled by default. Remove this option to fasten computations.) Both MLE and Laplace approach are based on the `createSequenceMatrix` functions that returns the raw counts transition matrix. ```{r fitSequenceMatrix} createSequenceMatrix(stringchar = weathersOfDays) ``` `stringchar` could contain `NA` values, and the transitions containing `NA` would be ignored. An issue occurs when the sample contains only one realization of a state (say $X_{\beta}$) which is located at the end of the data sequence, since it yields to a row of zero (no sample to estimate the conditional distribution of the transition). In this case the estimated transition matrix is corrected assuming $p_{\beta,j}=1/k$, being $k$ the possible states. Create sequence matrix can also be used to obtain raw count transition matrices from a given $n*2$ matrix as the following example shows: ```{r fitSequenceMatrix2} myMatr<-matrix(c("a","b","b","a","a","b","b","b","b","a","a","a","b","a"),ncol=2) createSequenceMatrix(stringchar = myMatr,toRowProbs = TRUE) ``` A bootstrap estimation approach has been developed within the package in order to provide an indication of the variability of ${\hat p}_{ij}$ estimates. The bootstrap approach implemented within the \pkg{markovchain} package follows these steps: 1. bootstrap the data sequences following the conditional distributions of states estimated from the original one. The default bootstrap samples is 10, as specified in `nboot` parameter of `markovchainFit` function. 2. apply MLE estimation on bootstrapped data sequences that are saved in `bootStrapSamples` slot of the returned list. 3. the ${p^{BOOTSTRAP}}_{ij}$ is the average of all ${p^{MLE}}_{ij}$ across the `bootStrapSamples` list, normalized by row. A `standardError` of $\hat{{p^{MLE}}_{ij}}$ estimate is provided as well. ```{r fitMcbyBootStrap1} weatherFittedBOOT <- markovchainFit(data = weathersOfDays, method = "bootstrap", nboot = 20) weatherFittedBOOT$estimate weatherFittedBOOT$standardError ``` The bootstrapping process can be done in parallel thanks to \pkg{RcppParallel} package \citep{pkg:RcppParallel}. Parallelized implementation is definitively suggested when the data sample size or the required number of bootstrap runs is high. ```{r fitMcbyBootStrap2, eval=FALSE} weatherFittedBOOTParallel <- markovchainFit(data = weathersOfDays, method = "bootstrap", nboot = 200, parallel = TRUE) weatherFittedBOOTParallel$estimate weatherFittedBOOTParallel$standardError ``` The parallel bootstrapping uses all the available cores on a machine by default. However, it is also possible to tune the number of threads used. Note that this should be done in R before calling the `markovchainFit` function. For example, the following code will set the number of threads to 4. ```{r fitMcbyBootStrap3, eval=FALSE} RcppParallel::setNumThreads(2) ``` For more details, please refer to \pkg{RcppParallel} web site. For all the fitting methods, the `logLikelihood` \citep{MSkuriat} denoted in Equation \ref{eq:LLH} is provided. \begin{equation} LLH = \sum_{i,j} n_{ij} * log (p_{ij}) \label{eq:LLH} \end{equation} where $n_{ij}$ is the entry of the frequency matrix and $p_{ij}$ is the entry of the transition probability matrix. ```{r fitMcbyMLE1} weatherFittedMLE$logLikelihood weatherFittedBOOT$logLikelihood ``` Confidence matrices of estimated parameters (parametric for MLE, non - parametric for BootStrap) are available as well. The `confidenceInterval` is provided with the two matrices: `lowerEndpointMatrix` and `upperEndpointMatrix`. The confidence level (CL) is 0.95 by default and can be given as an argument of the function `markovchainFit`. This is used to obtain the standard score (z-score). From classical inference theory, if $ci$ is the level of confidence required assuming normal distribution the $zscore(ci)$ solves $\Phi \left ( 1-\left(\frac{1-ci}{2}\right) \right )$ Equations \ref{eq:CIL} and \ref{eq:CIU} \citep{MSkuriat} show the `confidenceInterval` of a fitting. Note that each entry of the matrices is bounded between 0 and 1. \begin{align} LowerEndpoint_{ij} = p_{ij} - zscore (CL) * SE_{ij} \label{eq:CIL} \\ UpperEndpoint_{ij} = p_{ij} + zscore (CL) * SE_{ij} \label{eq:CIU} \end{align} ```{r confint} weatherFittedMLE$confidenceInterval weatherFittedBOOT$confidenceInterval ``` A special function, `multinomialConfidenceIntervals`, has been written in order to obtain multinomial wise confidence intervals. The code has been based on and Rcpp translation of package's \pkg{MultinomialCI} functions \cite{pkg:MultinomialCI} that were themselves based on the \cite{sison1995simultaneous} paper. ```{r multinomial} multinomialConfidenceIntervals(transitionMatrix = weatherFittedMLE$estimate@transitionMatrix, countsTransitionMatrix = createSequenceMatrix(weathersOfDays)) ``` The functions for fitting DTMC have mostly been rewritten in \proglang{C++} using \pkg{Rcpp} \cite{RcppR} since version 0.2. It is also possible to fit a DTMC object from `matrix` or `data.frame` objects as shown in following code. ```{r fitMclists} data(holson) singleMc<-markovchainFit(data=holson[,2:12],name="holson") ``` The same applies for `markovchainList` (output length has been limited). ```{r fitMclistsFit1, output.lines=20} mcListFit<-markovchainListFit(data=holson[,2:6],name="holson") mcListFit$estimate ``` Finally, given a `list` object, it is possible to fit a `markovchain` object or to obtain the raw transition matrix. ```{r fitMclistsFit2} c1<-c("a","b","a","a","c","c","a") c2<-c("b") c3<-c("c","a","a","c") c4<-c("b","a","b","a","a","c","b") c5<-c("a","a","c",NA) c6<-c("b","c","b","c","a") mylist<-list(c1,c2,c3,c4,c5,c6) mylistMc<-markovchainFit(data=mylist) mylistMc ``` The same works for `markovchainFitList`. ```{r fitAMarkovChainListfromAlist, output.lines=15} markovchainListFit(data=mylist) ``` If any transition contains `NA`, it will be ignored in the results as the above example showed. ## Prediction The $n$-step forward predictions can be obtained using the `predict` methods explicitly written for `markovchain` and `markovchainList` objects. The prediction is the mode of the conditional distribution of $X_{t+1}$ given $X_{t}=s_{j}$, being $s_{j}$ the last realization of the DTMC (homogeneous or semi-homogeneous). ### Predicting from a markovchain object The 3-days forward predictions from `markovchain` object can be generated as follows, assuming that the last two days were respectively "cloudy" and "sunny". ```{r markovchainPredict} predict(object = weatherFittedMLE$estimate, newdata = c("cloudy", "sunny"), n.ahead = 3) ``` ### Predicting from a markovchainList object Given an initial two years health status, the 5-year ahead prediction of any CCRC guest is ```{r markovchainListPredict} predict(mcCCRC, newdata = c("H", "H"), n.ahead = 5) ``` The prediction has stopped at time sequence since the underlying semi-homogeneous Markov chain has a length of four. In order to continue five years ahead, the `continue=TRUE` parameter setting makes the `predict` method keeping to use the last `markovchain` in the sequence list. ```{r markovchainListPredict2} predict(mcCCRC, newdata = c("H", "H"), n.ahead = 5, continue = TRUE) ``` ## Statistical Tests In this section, we describe the statistical tests: assessing the Markov property (`verifyMarkovProperty`), the order (`assessOrder`), the stationary (`assessStationarity`) of a Markov chain sequence, and the divergence test for empirically estimated transition matrices (`divergenceTest`). Most of such tests are based on the $\chi ^2$ statistics. Relevant references are \cite{kullback1962tests} and \cite{anderson1957statistical}. All such tests have been designed for small samples, since it is easy to detect departures from Markov property as long as the sample size increases. In addition, the accuracy of the statistical inference functions has been questioned and will be thoroughly investigated in future versions of the package. ### Assessing the Markov property of a Markov chain sequence The `verifyMarkovProperty` function verifies whether the Markov property holds for the given chain. The test implemented in the package looks at triplets of successive observations. If $x_1, x_2, \ldots, x_N$ is a set of observations and $n_{ijk}$ is the number of times $t$ $\left(1 \le t \le N-2 \right)$ such that $x_t=i, x_{t+1}=j, x_{x+2}=k$, then if the Markov property holds $n_{ijk}$ follows a Binomial distribution with parameters $n_{ij}$ and $p_{jk}$. A classical $\chi^2$ test can check this distributional assumption, since $\sum_{i}\sum_{j}\sum_{k}\frac{(n_{ijk}-n_{ij}\hat{p_{jk}})^2}{n_{ij}\hat{p_{jk}}}\sim \chi^2\left(q \right )$ where q is the number of degrees of freedom. The number of degrees of freedom q of the distribution of $\chi^2$ is given by the formula r-q+s-1, where: s denotes the number of states i in the state space such that n_{i} > 0 q denotes the number of pairs (i, j) for which n_{ij} > 0 and r denotes the number of triplets (i, j, k) for which n_{ij}n_{jk} > 0 ```{r test1} sample_sequence<-c("a", "b", "a", "a", "a", "a", "b", "a", "b", "a", "b", "a", "a", "b", "b", "b", "a") verifyMarkovProperty(sample_sequence) ``` ### Assessing the order of a Markov chain sequence The `assessOrder` function checks whether the given chain is of first order or of second order. For each possible present state, we construct a contingency table of the frequency of the future state for each past to present state transition as shown in Table \ref{tab:order}. \begin{table}[h] \centering \begin{tabular}{l | l | l | l} \hline past & present & future & future \\ & & a & b \\ \hline \hline a & a & 2 & 2\\ b & a & 2 & 2\\ \hline \end{tabular} \caption{Contingency table to assess the order for the present state a.} \label{tab:order} \end{table} Using the table, the function performs the $\chi ^2$ test by calling the `chisq.test` function. This test returns a list of the chi-squared value and the p-value. If the p-value is greater than the given significance level, we cannot reject the hypothesis that the sequence is of first order. ```{r test2} data(rain) assessOrder(rain$rain) ``` ### Assessing the stationarity of a Markov chain sequence The `assessStationarity` function assesses if the transition probabilities of the given chain change over time. To be more specific, the chain is stationary if the following condition meets. \begin{equation} p_{ij}(t) = p_{ij} ~\textrm{ for all }~t \label{eq:stationarity} \end{equation} For each possible state, we construct a contingency table of the estimated transition probabilities over time as shown in Table \ref{tab:stationarity}. \begin{table}[h] \centering \begin{tabular}{l | l | l} \hline time (t) & probability of transition to a & probability of transition to b \\ \hline \hline 1 & 0 & 1\\ 2 & 0 & 1\\ . & . & . \\ . & . & . \\ . & . & . \\ 16 & 0.44 & 0.56\\ \hline \end{tabular} \caption{Contingency table to assess the stationarity of the state a.} \label{tab:stationarity} \end{table} Using the table, the function performs the $\chi ^2$ test by calling the `chisq.test` function. This test returns a list of the chi-squared value and the p-value. If the p-value is greater than the given significance level, we cannot reject the hypothesis that the sequence is stationary. ```{r test3} assessStationarity(rain$rain, 10) ``` ### Divergence tests for empirically estimated transition matrices This section discusses tests developed to verify whether: 1. An empirical transition matrix is consistent with a theoretical one. 2. Two or more empirical transition matrices belongs to the same DTMC. The first test is implemented by the `verifyEmpiricalToTheoretical` function. Being $f_{ij}$ the raw transition count, \cite{kullback1962tests} shows that $2*\sum_{i=1}^{r}\sum_{j=1}^{r}f_{ij}\ln\frac{f_{ij}}{f_{i.}P\left( E_j | E_i\right)} \sim \chi^2\left ( r*(r-1) \right )$. The following example is taken from \cite{kullback1962tests}: ```{r divergence1} sequence<-c(0,1,2,2,1,0,0,0,0,0,0,1,2,2,2,1,0,0,1,0,0,0,0,0,0,1,1, 2,0,0,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,0,2,1,0, 0,2,1,0,0,0,0,0,0,1,1,1,2,2,0,0,2,1,1,1,1,2,1,1,1,1,1,1,1,1,1,0,2, 0,1,1,0,0,0,1,2,2,0,0,0,0,0,0,2,2,2,1,1,1,1,0,1,1,1,1,0,0,2,1,1, 0,0,0,0,0,2,2,1,1,1,1,1,2,1,2,0,0,0,1,2,2,2,0,0,0,1,1) mc=matrix(c(5/8,1/4,1/8,1/4,1/2,1/4,1/4,3/8,3/8),byrow=TRUE, nrow=3) rownames(mc)<-colnames(mc)<-0:2; theoreticalMc<-as(mc, "markovchain") verifyEmpiricalToTheoretical(data=sequence,object=theoreticalMc) ``` The second one is implemented by the `verifyHomogeneity` function, inspired by \cite[section~9]{kullback1962tests}. Assuming that $i=1,2, \ldots, s$ DTMC samples are available and that the cardinality of the state space is $r$ it verifies whether the $s$ chains belongs to the same unknown one. \cite{kullback1962tests} shows that its test statistics follows a chi-square law, $2*\sum_{i=1}^{s}\sum_{j=1}^{r}\sum_{k=1}^{r}f_{ijk}\ln\frac{n*f_{ijk}}{f_{i..}f_{.jk}} \sim \chi^2\left ( r*(r-1) \right )$. Also the following example is taken from \cite{kullback1962tests}: ```{r divergence2} data(kullback) verifyHomogeneity(inputList=kullback,verbose=TRUE) ``` ## Continuous Times Markov Chains ### Intro The \pkg{markovchain} package provides functionality for continuous time Markov chains (CTMCs). CTMCs are a generalization of discrete time Markov chains (DTMCs) in that we allow time to be continuous. We assume a finite state space $S$ (for an infinite state space wouldn't fit in memory). We can think of CTMCs as Markov chains in which state transitions can happen at any time. More formally, we would like our CTMCs to satisfy the following two properties: * The Markov property - let $F_{X(s)}$ denote the information about $X$ up to time $s$. Let $j \in S$ and $s \leq t$. Then, $P(X(t) = j|F_{X(s)}) = P(X(t) = j|X(s))$. * Time homogeneity - $P(X(t) = j|X(s) = k) = P(X(t-s) = j|X(0) = k)$. If both the above properties are satisfied, it is referred to as a time-homogeneous CTMC. If a transition occurs at time $t$, then $X(t)$ denotes the new state and $X(t)\neq X(t-)$. Now, let $X(0)=x$ and let $T_x$ be the time a transition occurs from this state. We are interested in the distribution of $T_x$. For $s,t \geq 0$, it can be shown that $ P(T_x > s+t | T_x > s) = P(T_x > t) $ This is the memory less property that only the exponential random variable exhibits. Therefore, this is the sought distribution, and each state $s \in S$ has an exponential holding parameter $\lambda(s)$. Since $\mathrm{E}T_x = \frac{1}{\lambda(x)}$, higher the rate $\lambda(x)$, smaller the expected time of transitioning out of the state $x$. However, specifying this parameter alone for each state would only paint an incomplete picture of our CTMC. To see why, consider a state $x$ that may transition to either state $y$ or $z$. The holding parameter enables us to predict when a transition may occur if we start off in state $x$, but tells us nothing about which state will be next. To this end, we also need transition probabilities associated with the process, defined as follows (for $y \neq x$) - $p_{xy} = P(X(T_s) = y | X(0) = x)$. Note that $\sum_{y \neq x} p_{xy} = 1$. Let $Q$ denote this transition matrix ($Q_{ij} = p_{ij}$). What is key here is that $T_x$ and the state $y$ are independent random variables. Let's define $\lambda(x, y) = \lambda(x) p_{xy}$ We now look at Kolmogorov's backward equation. Let's define $P_{ij}(t) = P(X(t) = j | X(0) = i)$ for $i, j \in S$. The backward equation is given by (it can be proved) $P_{ij}(t) = \delta_{ij}e^{-\lambda(i)t} + \int_{0}^{t}\lambda(i)e^{-\lambda(i)t} \sum_{k \neq i} Q_{ik} P_{kj}(t-s) ds$. Basically, the first term is non-zero if and only if $i=j$ and represents the probability that the first transition from state $i$ occurs after time $t$. This would mean that at $t$, the state is still $i$. The second term accounts for any transitions that may occur before time $t$ and denotes the probability that at time $t$, when the smoke clears, we are in state $j$. This equation can be represented compactly as follows $P'(t) = AP(t)$ where $A$ is the *generator* matrix. \[ A(i, j) = \begin{cases} \lambda(i, j) & \mbox{if } i \neq j \\ -\lambda(i) & \mbox{else.} \end{cases} \] Observe that the sum of each row is 0. A CTMC can be completely specified by the generator matrix. ### Stationary Distributions The following theorem guarantees the existence of a unique stationary distribution for CTMCs. Note that $X(t)$ being irreducible and recurrent is the same as $X_n(t)$ being irreducible and recurrent. Suppose that $X(t)$ is irreducible and recurrent. Then $X(t)$ has an invariant measure $\eta$, which is unique up to multiplicative factors. Moreover, for each $k \in S$, we have \[\eta_k = \frac{\pi_k}{\lambda(k)}\] where $\pi$ is the unique invariant measure of the embedded discrete time Markov chain $Xn$. Finally, $\eta$ satisfies \[0 < \eta_j < \infty, \forall j \in S\] and if $\sum_i \eta_i < \infty$ then $\eta$ can be normalized to get a stationary distribution. ### Estimation Let the data set be $D = \{(s_0, t_0), (s_1, t_1), ..., (s_{N-1}, t_{N-1})\}$ where $N=|D|$. Each $s_i$ is a state from the state space $S$ and during the time $[t_i,t_{i+1}]$ the chain is in state $s_i$. Let the parameters be represented by $\theta = \{\lambda, P\}$ where $\lambda$ is the vector of holding parameters for each state and $P$ the transition matrix of the embedded discrete time Markov chain. Then the probability is given by \[ {Pr(D | \theta) \propto \lambda(s_0)e^{-\lambda(s_0)(t_1-t_0)}Pr(s_1|s_0) \cdot\ldots\cdot \lambda(s_{N-2})e^{-\lambda(s_{N-2})(t_{N-1}-t_{N-2})}Pr(s_{N-1}|s_{N-2})} \] Let $n(j|i)$ denote the number of $i$->$j$ transitions in $D$, and $n(i)$ the number of times $s_i$ occurs in $D$. Let $t(s_i)$ denote the total time the chain spends in state $s_i$. Then the MLEs are given by \[ \hat{\lambda(s)} = \frac{n(s)}{t(s)},\hat{Pr(j|i)}=\frac{n(j|i)}{n(i)} \] ### Expected Hitting Time The package provides a function `ExpectedTime` to calculate average hitting time from one state to another. Let the final state be j, then for every state $i \in S$, where $S$ is the set of all states and holding time $q_{i} > 0$ for every $i \neq j$. Assuming the conditions to be true, expected hitting time is equal to minimal non-negative solution vector $p$ to the system of linear equations: \begin{equation} \begin{cases} p_{k} = 0 & k = j \\ -\sum_{l \in I} q_{kl}p_{k} = 1 & k \neq j \end{cases} \label{eq:EHT} \end{equation} ### Probability at time t The package provides a function `probabilityatT` to calculate probability of every state according to given `ctmc` object. Here we use Kolmogorov's backward equation $P(t) = P(0)e^{tQ}$ for $t \geq 0$ and $P(0) = I$. Here $P(t)$ is the transition function at time t. The value $P(t)[i][j]$ at time $P(t)$ describes the probability of the state at time $t$ to be equal to j if it was equal to i at time $t=0$. It takes care of the case when `ctmc` object has a generator represented by columns. If initial state is not provided, the function returns the whole transition matrix $P(t)$. ### Examples To create a CTMC object, you need to provide a valid generator matrix, say $Q$. The CTMC object has the following slots - states, generator, by row, name (look at the documentation object for further details). Consider the following example in which we aim to model the transition of a molecule from the $\sigma$ state to the $\sigma^*$ state. When in the former state, if it absorbs sufficient energy, it can make the jump to the latter state and remains there for some time before transitioning back to the original state. Let us model this by a CTMC: ```{r rCtmcInit} energyStates <- c("sigma", "sigma_star") byRow <- TRUE gen <- matrix(data = c(-3, 3, 1, -1), nrow = 2, byrow = byRow, dimnames = list(energyStates, energyStates)) molecularCTMC <- new("ctmc", states = energyStates, byrow = byRow, generator = gen, name = "Molecular Transition Model") ``` To generate random CTMC transitions, we provide an initial distribution of the states. This must be in the same order as the dimnames of the generator. The output can be returned either as a list or a data frame. ```{r rctmcRandom0} statesDist <- c(0.8, 0.2) rctmc(n = 3, ctmc = molecularCTMC, initDist = statesDist, out.type = "df", include.T0 = FALSE) ``` $n$ represents the number of samples to generate. There is an optional argument $T$ for `rctmc`. It represents the time of termination of the simulation. To use this feature, set $n$ to a very high value, say `Inf` (since we do not know the number of transitions before hand) and set $T$ accordingly. ```{r ctmcRandom1} statesDist <- c(0.8, 0.2) rctmc(n = Inf, ctmc = molecularCTMC, initDist = statesDist, T = 2) ``` To obtain the stationary distribution simply invoke the `steadyStates` function ```{r rctmcSteadyStates} steadyStates(molecularCTMC) ``` For fitting, use the `ctmcFit` function. It returns the MLE values for the parameters along with the confidence intervals. ```{r rctmcFitting} data <- list(c("a", "b", "c", "a", "b", "a", "c", "b", "c"), c(0, 0.8, 2.1, 2.4, 4, 5, 5.9, 8.2, 9)) ctmcFit(data) ``` One approach to obtain the generator matrix is to apply the `logm` function from the \pkg{expm} package on a transition matrix. Numeric issues arise, see \cite{israel2001finding}. For example, applying the standard `method` ('Higham08') on `mcWeather` raises an error, whilst the alternative method (eigenvalue decomposition) is OK. The following code estimates the generator matrix of the `mcWeather` transition matrix. ```{r mcWeatherQ} mcWeatherQ <- expm::logm(mcWeather@transitionMatrix,method='Eigen') mcWeatherQ ``` Therefore, the "half - day" transition probability for mcWeather DTMC is ```{r mcWeatherHalfDay} mcWeatherHalfDayTM <- expm::expm(mcWeatherQ*.5) mcWeatherHalfDay <- new("markovchain",transitionMatrix=mcWeatherHalfDayTM,name="Half Day Weather Transition Matrix") mcWeatherHalfDay ``` The \pkg{ctmcd} package \citep{pkg:ctmcd} provides various functions to estimate the generator matrix (GM) of a CTMC process using different methods. The following code provides a way to join \pkg{markovchain} and \pkg{ctmcd} computations. ```{r ctmcd1} if(requireNamespace(package='ctmcd', quietly = TRUE)) { require(ctmcd) require(expm) #defines a function to transform a GM into a TM gm_to_markovchain<-function(object, t=1) { if(!(class(object) %in% c("gm","matrix","Matrix"))) stop("Error! Expecting either a matrix or a gm object") if ( class(object) %in% c("matrix","Matrix")) generator_matrix<-object else generator_matrix<-as.matrix(object[["par"]]) #must add importClassesFrom("markovchain",markovchain) in the NAMESPACE #must add importFrom(expm, "expm") transitionMatrix<-expm(generator_matrix*t) out<-as(transitionMatrix,"markovchain") return(out) } #loading ctmcd dataset data(tm_abs) gm0=matrix(1,8,8) #initializing diag(gm0)=0 diag(gm0)=-rowSums(gm0) gm0[8,]=0 gmem=gm(tm_abs,te=1,method="EM",gmguess=gm0) #estimating GM mc_at_2=gm_to_markovchain(object=gmem, t=2) #converting to TM at time 2 } else { warning('package ctmcd unavailable') } ``` ## Pseudo - Bayesian Estimation \cite{Hu2002} shows an empirical quasi-Bayesian method to estimate transition matrices, given an empirical $\hat{P}$ transition matrix (estimated using the classical approach) and an a - priori estimate $Q$. In particular, each row of the matrix is estimated using the linear combination $\alpha \cdot Q+\left(1-1alpha\right) \cdot P$, where $\alpha$ is defined for each row as Equation \ref{eq:pseudobayes} shows \begin{equation} \left\{\begin{matrix} \hat{\alpha_i}=\frac{\hat{K_i}}{v\left(i \right )+\hat{K_i}}\\ \hat{K_i}=\frac{v\left(i \right)^2 - \sum_{j}Y_{ij}^2}{\sum_{j}(Y_{ij}-v\left(i \right)*q_{ij})^2} \end{matrix}\right. \label{eq:pseudobayes} \end{equation} The following code returns the pseudo Bayesian estimate of the transition matrix: ```{r pseudobayes} pseudoBayesEstimator <- function(raw, apriori){ v_i <- rowSums(raw) K_i <- numeric(nrow(raw)) sumSquaredY <- rowSums(raw^2) #get numerator K_i_num <- v_i^2-sumSquaredY #get denominator VQ <- matrix(0,nrow= nrow(apriori),ncol=ncol(apriori)) for (i in 1:nrow(VQ)) { VQ[i,]<-v_i[i]*apriori[i,] } K_i_den<-rowSums((raw - VQ)^2) K_i <- K_i_num/K_i_den #get the alpha vector alpha <- K_i / (v_i+K_i) #empirical transition matrix Emp<-raw/rowSums(raw) #get the estimate out<-matrix(0, nrow= nrow(raw),ncol=ncol(raw)) for (i in 1:nrow(out)) { out[i,]<-alpha[i]*apriori[i,]+(1-alpha[i])*Emp[i,] } return(out) } ``` We then apply it to the weather example: ```{r pseudobayes2} trueMc<-as(matrix(c(0.1, .9,.7,.3),nrow = 2, byrow = 2),"markovchain") aprioriMc<-as(matrix(c(0.5, .5,.5,.5),nrow = 2, byrow = 2),"markovchain") smallSample<-rmarkovchain(n=20,object = trueMc) smallSampleRawTransitions<-createSequenceMatrix(stringchar = smallSample) pseudoBayesEstimator( raw = smallSampleRawTransitions, apriori = aprioriMc@transitionMatrix ) - trueMc@transitionMatrix biggerSample<-rmarkovchain(n=100,object = trueMc) biggerSampleRawTransitions<-createSequenceMatrix(stringchar = biggerSample) pseudoBayesEstimator( raw = biggerSampleRawTransitions, apriori = aprioriMc@transitionMatrix ) - trueMc@transitionMatrix bigSample<-rmarkovchain(n=1000,object = trueMc) bigSampleRawTransitions<-createSequenceMatrix(stringchar = bigSample) pseudoBayesEstimator( raw = bigSampleRawTransitions, apriori = aprioriMc@transitionMatrix ) - trueMc@transitionMatrix ``` ## Bayesian Estimation The \pkg{markovchain} package provides functionality for maximum a posteriori (MAP) estimation of the chain parameters (at the time of writing this document, only first order models are supported) by Bayesian inference. It also computes the probability of observing a new data set, given a (different) data set. This vignette provides the mathematical description for the methods employed by the package. ### Notation and set-up The data is denoted by $D$, the model parameters (transition matrix) by $\theta$. The object of interest is $P(\theta | D)$ (posterior density). $\mathcal{A}$ represents an alphabet class, each of whose members represent a state of the chain. Therefore \[D = s_0 s_1 ... s_{N-1}, s_t \in \mathcal{A}\] where $N$ is the length of the data set. Also, \[\theta = \{p(s|u), s \in \mathcal{A}, u \in \mathcal{A} \}\] where $\sum_{s \in \mathcal{A}} p(s|u) = 1$ for each $u \in \mathcal{A}$. Our objective is to find $\theta$ which maximizes the posterior. That is, if our solution is denoted by $\hat{\theta}$, then \[\hat{\theta} = \underset{\theta}{argmax}P(\theta | D)\] where the search space is the set of right stochastic matrices of dimension $|\mathcal{A}|x|\mathcal{A}|$. $n(u, s)$ denotes the number of times the word $us$ occurs in $D$ and $n(u)=\sum_{s \in \mathcal{A}}n(u, s)$. The hyper-parameters are similarly denoted by $\alpha(u, s)$ and $\alpha(u)$ respectively. ### Methods Given $D$, its likelihood conditioned on the observed initial state in D is given by \[P(D|\theta) = \prod_{s \in \mathcal{A}} \prod_{u \in \mathcal{A}} p(s|u)^{n(u, s)}\] Conjugate priors are used to model the prior $P(\theta)$. The reasons are two fold: 1. Exact expressions can be derived for the MAP estimates, expectations and even variances 2. Model order selection/comparison can be implemented easily (available in a future release of the package) The hyper-parameters determine the form of the prior distribution, which is a product of Dirichlet distributions \[P(\theta) = \prod_{u \in \mathcal{A}} \Big\{ \frac{\Gamma(\alpha(u))}{\prod_{s \in \mathcal{A}} \Gamma(\alpha(u, s))} \prod_{s \in \mathcal{A}} p(s|u)^{\alpha(u, s)) - 1} \Big\}\] where $\Gamma(.)$ is the Gamma function. The hyper-parameters are specified using the `hyperparam` argument in the `markovchainFit` function. If this argument is not specified, then a default value of 1 is assigned to each hyper-parameter resulting in the prior distribution of each chain parameter to be uniform over $[0,1]$. Given the likelihood and the prior as described above, the evidence $P(D)$ is simply given by \[P(D) = \int P(D|\theta) P(\theta) d\theta\] which simplifies to \[ P(D) = \prod_{u \in \mathcal{A}} \Big\{ \frac{\Gamma(\alpha(u))}{\prod_{s \in \mathcal{A}} \Gamma(\alpha(u, s))} \frac{\prod_{s \in \mathcal{A}} \Gamma(n(u, s) + \alpha(u, s))}{\Gamma(\alpha(u) + n(u))} \Big\} \] Using Bayes' theorem, the posterior now becomes (thanks to the choice of conjugate priors) \[ P(\theta | D) = \prod_{u \in \mathcal{A}} \Big\{ \frac{\Gamma(n(u) + \alpha(u))}{\prod_{s \in \mathcal{A}} \Gamma(n(u, s) + \alpha(u, s))} \prod_{s \in \mathcal{A}} p(s|u)^{n(u, s) + \alpha(u, s)) - 1} \Big\} \] Since this is again a product of Dirichlet distributions, the marginal distribution of a particular parameter $P(s|u)$ of our chain is given by \[ P(s|u) \sim Beta(n(u, s) + \alpha(u, s), n(u) + \alpha(u) - n(u, s) - \alpha(u, s)) \] Thus, the MAP estimate $\hat{\theta}$ is given by \[ \hat{\theta} = \Big\{ \frac{n(u, s) + \alpha(u, s) - 1}{n(u) + \alpha(u) - |\mathcal{A}|}, s \in \mathcal{A}, u \in \mathcal{A} \Big\} \] The function also returns the expected value, given by \[ \text{E}_{\text{post}} p(s|u) = \Big\{ \frac{n(u, s) + \alpha(u, s)}{n(u) + \alpha(u)}, s \in \mathcal{A}, u \in \mathcal{A} \Big\} \] The variance is given by \[ \text{Var}_{\text{post}} p(s|u) = \frac{n(u, s) + \alpha(u, s)}{(n(u) + \alpha(u))^2} \frac{n(u) + \alpha(u) - n(u, s) - \alpha(u, s)}{n(u) + \alpha(u) + 1} \] The square root of this quantity is the standard error, which is returned by the function. The confidence intervals are constructed by computing the inverse of the beta integral. ### Predictive distribution Given the old data set, the probability of observing new data is $P(D'|D)$ where $D'$ is the new data set. Let $m(u, s), m(u)$ denote the corresponding counts for the new data. Then, \[ P(D'|D) = \int P(D' | \theta) P(\theta | D) d\theta \] We already know the expressions for both quantities in the integral and it turns out to be similar to evaluating the evidence \[ P(D'|D) = \prod_{u \in \mathcal{A}} \Big\{ \frac{\Gamma(\alpha(u))}{\prod_{s \in \mathcal{A}} \Gamma(\alpha(u, s))} \frac{\prod_{s \in \mathcal{A}} \Gamma(n(u, s) + m(u, s) + \alpha(u, s))}{\Gamma(\alpha(u) + n(u) + m(u))} \Big\} \] ### Choosing the hyper-parameters The hyper parameters model the shape of the parameters' prior distribution. These must be provided by the user. The package offers functionality to translate a given prior belief transition matrix into the hyper-parameter matrix. It is assumed that this belief matrix corresponds to the mean value of the parameters. Since the relation \[ \text{E}_{\text{prior}} p(s | u) = \frac{\alpha(u, s)}{\alpha(u)} \] holds, the function accepts as input the belief matrix as well as a scaling vector (serves as a proxy for $\alpha(.)$) and proceeds to compute $\alpha(., .)$. Alternatively, the function accepts a data sample and infers the hyper-parameters from it. Since the mode of a parameter (with respect to the prior distribution) is proportional to one less than the corresponding hyper-parameter, we set \[ \alpha(u, s) - 1 = m(u, s) \] where $m(u, s)$ is the $u\rightarrow s$ transition count in the data sample. This is regarded as a 'fake count' which helps $\alpha(u, s)$ to reflect knowledge of the data sample. ### Usage and examples ```{r loadAndDoExample} weatherStates <- c("sunny", "cloudy", "rain") byRow <- TRUE weatherMatrix <- matrix(data = c(0.7, 0.2, 0.1, 0.3, 0.4, 0.3, 0.2, 0.4, 0.4), byrow = byRow, nrow = 3, dimnames = list(weatherStates, weatherStates)) mcWeather <- new("markovchain", states = weatherStates, byrow = byRow, transitionMatrix = weatherMatrix, name = "Weather") weathersOfDays <- rmarkovchain(n = 365, object = mcWeather, t0 = "sunny") ``` For the purpose of this section, we shall continue to use the weather of days example introduced in the main vignette of the package (reproduced above for convenience). Let us invoke the fit function to estimate the MAP parameters with 92\% confidence bounds and hyper-parameters as shown below, based on the first 200 days of the weather data. Additionally, let us find out what the probability is of observing the weather data for the next 165 days. The usage would be as follows ```{r MAPFit} hyperMatrix<-matrix(c(1, 1, 2, 3, 2, 1, 2, 2, 3), nrow = 3, byrow = TRUE, dimnames = list(weatherStates,weatherStates)) markovchainFit(weathersOfDays[1:200], method = "map", confidencelevel = 0.92, hyperparam = hyperMatrix) predictiveDistribution(weathersOfDays[1:200], weathersOfDays[201:365],hyperparam = hyperMatrix) ``` The results should not change after permuting the dimensions of the matrix. ```{r MAPFit2} hyperMatrix2<- hyperMatrix[c(2,3,1), c(2,3,1)] markovchainFit(weathersOfDays[1:200], method = "map", confidencelevel = 0.92, hyperparam = hyperMatrix2) predictiveDistribution(weathersOfDays[1:200], weathersOfDays[201:365],hyperparam = hyperMatrix2) ``` Note that the predictive probability is very small. However, this can be useful when comparing model orders. Suppose we have an idea of the (prior) transition matrix corresponding to the expected value of the parameters, and have a data set from which we want to deduce the MAP estimates. We can infer the hyper-parameters from this known transition matrix itself, and use this to obtain our MAP estimates. ```{r inferHyperparam} inferHyperparam(transMatr = weatherMatrix, scale = c(10, 10, 10)) ``` Alternatively, we can use a data sample to infer the hyper-parameters. ```{r inferHyperparam2} inferHyperparam(data = weathersOfDays[1:15]) ``` In order to use the inferred hyper-parameter matrices, we do ```{r inferHyperparam3} hyperMatrix3 <- inferHyperparam(transMatr = weatherMatrix, scale = c(10, 10, 10)) hyperMatrix3 <- hyperMatrix3$scaledInference hyperMatrix4 <- inferHyperparam(data = weathersOfDays[1:15]) hyperMatrix4 <- hyperMatrix4$dataInference ``` Now we can safely use `hyperMatrix3` and `hyperMatrix4` with `markovchainFit` (in the `hyperparam` argument). Supposing we don't provide any hyper-parameters, then the prior is uniform. This is the same as maximum likelihood. ```{r MAPandMLE} data(preproglucacon) preproglucacon <- preproglucacon[[2]] MLEest <- markovchainFit(preproglucacon, method = "mle") MAPest <- markovchainFit(preproglucacon, method = "map") MLEest$estimate MAPest$estimate ``` # Applications {#sec:applications} This section shows applications of DTMC in various fields. ## Weather forecasting {#app:weather} Markov chains provide a simple model to predict the next day's weather given the current meteorological condition. The first application herewith shown is the "Land of Oz example" from \cite{landOfOz}, the second is the "Alofi Island Rainfall" from \cite{averyHenderson}. ### Land of Oz {#sec:wfLandOfOz} The Land of Oz is acknowledged not to have ideal weather conditions at all: the weather is snowy or rainy very often and, once more, there are never two nice days in a row. Consider three weather states: rainy, nice and snowy. Let the transition matrix be as in the following: ```{r weatPred1} mcWP <- new("markovchain", states = c("rainy", "nice", "snowy"), transitionMatrix = matrix(c(0.5, 0.25, 0.25, 0.5, 0, 0.5, 0.25,0.25,0.5), byrow = T, nrow = 3)) ``` Given that today it is a nice day, the corresponding stochastic row vector is $w_{0}=(0\:,1\:,0)$ and the forecast after 1, 2 and 3 days are given by ```{r weatPred2} W0 <- t(as.matrix(c(0, 1, 0))) W1 <- W0 * mcWP; W1 W2 <- W0 * (mcWP ^ 2); W2 W3 <- W0 * (mcWP ^ 3); W3 ``` As can be seen from $w_{1}$, if in the Land of Oz today is a nice day, tomorrow it will rain or snow with probability 1. One week later, the prediction can be computed as ```{r weatPred3} W7 <- W0 * (mcWP ^ 7) W7 ``` The steady state of the chain can be computed by means of the `steadyStates` method. ```{r weatPred4} q <- steadyStates(mcWP) q ``` Note that, from the seventh day on, the predicted probabilities are substantially equal to the steady state of the chain and they don't depend from the starting point, as the following code shows. ```{r weatPred5} R0 <- t(as.matrix(c(1, 0, 0))) R7 <- R0 * (mcWP ^ 7); R7 S0 <- t(as.matrix(c(0, 0, 1))) S7 <- S0 * (mcWP ^ 7); S7 ``` ### Alofi Island Rainfall {#sec:wfAlofi} Alofi Island daily rainfall data were recorded from January 1st, 1987 until December 31st, 1989 and classified into three states: "0" (no rain), "1-5" (from non zero until 5 mm) and "6+" (more than 5mm). The corresponding dataset is provided within the \pkg{markovchain} package. ```{r Alofi1} data("rain", package = "markovchain") table(rain$rain) ``` The underlying transition matrix is estimated as follows. ```{r Alofi2} mcAlofi <- markovchainFit(data = rain$rain, name = "Alofi MC")$estimate mcAlofi ``` The long term daily rainfall distribution is obtained by means of the `steadyStates` method. ```{r Alofi3} steadyStates(mcAlofi) ``` ## Finance and Economics {#app:fin} Other relevant applications of DTMC can be found in Finance and Economics. ### Finance {#fin:fin} Credit ratings transitions have been successfully modeled with discrete time Markov chains. Some rating agencies publish transition matrices that show the empirical transition probabilities across credit ratings. The example that follows comes from \pkg{CreditMetrics} \proglang{R} package \citep{CreditMetricsR}, carrying Standard \& Poor's published data. ```{r ratings1} rc <- c("AAA", "AA", "A", "BBB", "BB", "B", "CCC", "D") creditMatrix <- matrix( c(90.81, 8.33, 0.68, 0.06, 0.08, 0.02, 0.01, 0.01, 0.70, 90.65, 7.79, 0.64, 0.06, 0.13, 0.02, 0.01, 0.09, 2.27, 91.05, 5.52, 0.74, 0.26, 0.01, 0.06, 0.02, 0.33, 5.95, 85.93, 5.30, 1.17, 1.12, 0.18, 0.03, 0.14, 0.67, 7.73, 80.53, 8.84, 1.00, 1.06, 0.01, 0.11, 0.24, 0.43, 6.48, 83.46, 4.07, 5.20, 0.21, 0, 0.22, 1.30, 2.38, 11.24, 64.86, 19.79, 0, 0, 0, 0, 0, 0, 0, 100 )/100, 8, 8, dimnames = list(rc, rc), byrow = TRUE) ``` It is easy to convert such matrices into `markovchain` objects and to perform some analyses ```{r ratings2} creditMc <- new("markovchain", transitionMatrix = creditMatrix, name = "S&P Matrix") absorbingStates(creditMc) ``` ### Economics {#fin:ec} For a recent application of \pkg{markovchain} in Economic, see \cite{manchesterR}. A dynamic system generates two kinds of economic effects \citep{bardPpt}: 1. those incurred when the system is in a specified state, and 2. those incurred when the system makes a transition from one state to another. Let the monetary amount of being in a particular state be represented as a m-dimensional column vector $c^{\rm{S}}$, while let the monetary amount of a transition be embodied in a $C^{R}$ matrix in which each component specifies the monetary amount of going from state i to state j in a single step. Henceforth, Equation \@ref(eq:cost) represents the monetary of being in state $i$. \begin{equation} {c_i} = c_i^{\rm{S}} + \sum\limits_{j = 1}^m {C_{ij}^{\rm{R}}} {p_{ij}}. \label{eq:cost} \end{equation} Let $\bar c = \left[ c_i \right]$ and let $e_i$ be the vector valued 1 in the initial state and 0 in all other, then, if $f_n$ is the random variable representing the economic return associated with the stochastic process at time $n$, Equation \@ref(eq:return) holds: \begin{equation} E\left[ {{f_n}\left( {{X_n}} \right)|{X_0} = i} \right] = {e_i}{P^n}\bar c. \label{eq:return} \end{equation} The following example assumes that a telephone company models the transition probabilities between customer/non-customer status by matrix $P$ and the cost associated to states by matrix $M$. ```{r economicAnalysis1} statesNames <- c("customer", "non customer") P <- markovchain:::zeros(2); P[1, 1] <- .9; P[1, 2] <- .1; P[2, 2] <- .95; P[2, 1] <- .05; rownames(P) <- statesNames; colnames(P) <- statesNames mcP <- new("markovchain", transitionMatrix = P, name = "Telephone company") M <- markovchain:::zeros(2); M[1, 1] <- -20; M[1, 2] <- -30; M[2, 1] <- -40; M[2, 2] <- 0 ``` If the average revenue for existing customer is +100, the cost per state is computed as follows. ```{r economicAnalysis2} c1 <- 100 + conditionalDistribution(mcP, state = "customer") %*% M[1,] c2 <- 0 + conditionalDistribution(mcP, state = "non customer") %*% M[2,] ``` For an existing customer, the expected gain (loss) at the fifth year is given by the following code. ```{r economicAnalysis3} as.numeric((c(1, 0)* mcP ^ 5) %*% (as.vector(c(c1, c2)))) ``` ## Actuarial science {#app:act} Markov chains are widely applied in the field of actuarial science. Two classical applications are policyholders' distribution across Bonus Malus classes in Motor Third Party Liability (MTPL) insurance (Section \@ref(sec:bm)) and health insurance pricing and reserving (Section \@ref(sec:hi)). ### MPTL Bonus Malus {#sec:bm} Bonus Malus (BM) contracts grant the policyholder a discount (enworsen) as a function of the number of claims in the experience period. The discount (enworsen) is applied on a premium that already allows for known (a priori) policyholder characteristics \citep{denuit2007actuarial} and it usually depends on vehicle, territory, the demographic profile of the policyholder, and policy coverage deep (deductible and policy limits).\\ Since the proposed BM level depends on the claim on the previous period, it can be modeled by a discrete Markov chain. A very simplified example follows. Assume a BM scale from 1 to 5, where 4 is the starting level. The evolution rules are shown in Equation \ref{eq:BM}: \begin{equation} bm_{t + 1} = \max \left( {1,bm_{t} - 1} \right)*\left( {\tilde N = 0} \right) + \min \left( {5,bm_{t} + 2*\tilde N} \right)*\left( {\tilde N \ge 1} \right). \label{eq:BM} \end{equation} The number of claim $\tilde N$ is a random variable that is assumed to be Poisson distributed. ```{r bonusMalus1} getBonusMalusMarkovChain <- function(lambda) { bmMatr <- markovchain:::zeros(5) bmMatr[1, 1] <- dpois(x = 0, lambda) bmMatr[1, 3] <- dpois(x = 1, lambda) bmMatr[1, 5] <- 1 - ppois(q = 1, lambda) bmMatr[2, 1] <- dpois(x = 0, lambda) bmMatr[2, 4] <- dpois(x = 1, lambda) bmMatr[2, 5] <- 1 - ppois(q = 1, lambda) bmMatr[3, 2] <- dpois(x = 0, lambda) bmMatr[3, 5] <- 1 - dpois(x=0, lambda) bmMatr[4, 3] <- dpois(x = 0, lambda) bmMatr[4, 5] <- 1 - dpois(x = 0, lambda) bmMatr[5, 4] <- dpois(x = 0, lambda) bmMatr[5, 5] <- 1 - dpois(x = 0, lambda) stateNames <- as.character(1:5) out <- new("markovchain", transitionMatrix = bmMatr, states = stateNames, name = "BM Matrix") return(out) } ``` Assuming that the a-priori claim frequency per car-year is 0.05 in the class (being the class the group of policyholders that share the same common characteristics), the underlying BM transition matrix and its underlying steady state are as follows. ```{r bonusMalus2} bmMc <- getBonusMalusMarkovChain(0.05) as.numeric(steadyStates(bmMc)) ``` If the underlying BM coefficients of the class are 0.5, 0.7, 0.9, 1.0, 1.25, this means that the average BM coefficient applied on the long run to the class is given by ```{r bonusMalus3} sum(as.numeric(steadyStates(bmMc)) * c(0.5, 0.7, 0.9, 1, 1.25)) ``` This means that the average premium paid by policyholders in the portfolio almost halves in the long run. ### Health insurance example {#sec:hi} Actuaries quantify the risk inherent in insurance contracts evaluating the premium of insurance contract to be sold (therefore covering future risk) and evaluating the actuarial reserves of existing portfolios (the liabilities in terms of benefits or claims payments due to policyholder arising from previously sold contracts), see \cite{deshmukh2012multiple} for details. An applied example can be performed using the data from \cite{de2016assicurazioni} that has been saved in the `exdata` folder. ```{r healthIns6} ltcDemoPath<-system.file("extdata", "ltdItaData.txt", package = "markovchain") ltcDemo<-read.table(file = ltcDemoPath, header=TRUE, sep = ";", dec = ".") head(ltcDemo) ``` The data shows the probability of transition between the state of (A)ctive, to (I)ll and Dead. It is easy to complete the transition matrix. ```{r healthIns7} ltcDemo<-transform(ltcDemo, pIA=0, pII=1-pID, pDD=1, pDA=0, pDI=0) ``` Now we build a function that returns the transition during the $t+1$ th year, assuming that the subject has attained year $t$. ```{r healthIns8} possibleStates<-c("A","I","D") getMc4Age<-function(age) { transitionsAtAge<-ltcDemo[ltcDemo$age==age,] myTransMatr<-matrix(0, nrow=3,ncol = 3, dimnames = list(possibleStates, possibleStates)) myTransMatr[1,1]<-transitionsAtAge$pAA[1] myTransMatr[1,2]<-transitionsAtAge$pAI[1] myTransMatr[1,3]<-transitionsAtAge$pAD[1] myTransMatr[2,2]<-transitionsAtAge$pII[1] myTransMatr[2,3]<-transitionsAtAge$pID[1] myTransMatr[3,3]<-1 myMc<-new("markovchain", transitionMatrix = myTransMatr, states = possibleStates, name = paste("Age",age,"transition matrix")) return(myMc) } ``` Cause transitions are not homogeneous across ages, we use a `markovchainList` object to describe the transition probabilities for a guy starting at age 100. ```{r healthIns8-prob} getFullTransitionTable<-function(age){ ageSequence<-seq(from=age, to=120) k=1 myList=list() for ( i in ageSequence) { mc_age_i<-getMc4Age(age = i) myList[[k]]<-mc_age_i k=k+1 } myMarkovChainList<-new("markovchainList", markovchains = myList, name = paste("TransitionsSinceAge", age, sep = "")) return(myMarkovChainList) } transitionsSince100<-getFullTransitionTable(age=100) ``` We can use such transition for simulating ten life trajectories for a guy that begins "active" (A) aged 100: ```{r healthIns9} rmarkovchain(n = 10, object = transitionsSince100, what = "matrix", t0 = "A", include.t0 = TRUE) ``` Lets consider 1000 simulated live trajectories, for a healthy guy aged 80. We can compute the expected time a guy will be disabled starting active at age 80. ```{r healthIns10} transitionsSince80<-getFullTransitionTable(age=80) lifeTrajectories<-rmarkovchain(n=1e3, object=transitionsSince80, what="matrix",t0="A",include.t0=TRUE) temp<-matrix(0,nrow=nrow(lifeTrajectories),ncol = ncol(lifeTrajectories)) temp[lifeTrajectories=="I"]<-1 expected_period_disabled<-mean(rowSums((temp))) expected_period_disabled ``` Assuming that the health insurance will pay a benefit of 12000 per year disabled and that the real interest rate is 0.02, we can compute the lump sum premium at 80. ```{r healthIns11} mean(rowMeans(12000*temp%*%( matrix((1+0.02)^-seq(from=0, to=ncol(temp)-1))))) ``` ## Sociology {#app:sociology} Markov chains have been actively used to model progressions and regressions between social classes. The first study was performed by \cite{glassHall}, while a more recent application can be found in \cite{blandenEtAlii}. The table that follows shows the income quartile of the father when the son was 16 (in 1984) and the income quartile of the son when aged 30 (in 2000) for the 1970 cohort. ```{r blandenEtAlii} data("blanden") mobilityMc <- as(blanden, "markovchain") mobilityMc ``` The underlying transition graph is plotted in Figure \@ref(fig:mobility). ```{r mobility, fig=TRUE, echo=FALSE, fig.align='center', fig.cap="1970 UK cohort mobility data."} plot(mobilityMc, main = '1970 mobility',vertex.label.cex = 2, layout = layout.fruchterman.reingold) ``` The steady state distribution is computed as follows. Since transition across quartiles are shown, the probability function is evenly 0.25. ```{r blandenEtAlii3} round(steadyStates(mobilityMc), 2) ``` ## Genetics and Medicine {#sec:gen} This section contains two examples: the first shows the use of Markov chain models in genetics, the second shows an application of Markov chains in modelling diseases' dynamics. ### Genetics {#sec:genetics} \cite{averyHenderson} discusses the use of Markov chains in model Preprogucacon gene protein bases sequence. The `preproglucacon` dataset in \pkg{markovchain} contains the dataset shown in the package. ```{r preproglucacon1} data("preproglucacon", package = "markovchain") ``` It is possible to model the transition probabilities between bases as shown in the following code. ```{r preproglucacon2} mcProtein <- markovchainFit(preproglucacon$preproglucacon, name = "Preproglucacon MC")$estimate mcProtein ``` ### Medicine {#sec:medicine} Discrete-time Markov chains are also employed to study the progression of chronic diseases. The following example is taken from \cite{craigSendi}. Starting from six month follow-up data, the maximum likelihood estimation of the monthly transition matrix is obtained. This transition matrix aims to describe the monthly progression of CD4-cell counts of HIV infected subjects. ```{r epid1} craigSendiMatr <- matrix(c(682, 33, 25, 154, 64, 47, 19, 19, 43), byrow = T, nrow = 3) hivStates <- c("0-49", "50-74", "75-UP") rownames(craigSendiMatr) <- hivStates colnames(craigSendiMatr) <- hivStates craigSendiTable <- as.table(craigSendiMatr) mcM6 <- as(craigSendiTable, "markovchain") mcM6@name <- "Zero-Six month CD4 cells transition" mcM6 ``` As shown in the paper, the second passage consists in the decomposition of $M_{6}=V \cdot D \cdot V^{-1}$ in order to obtain $M_{1}$ as $M_{1}=V \cdot D^{1/6} \cdot V^{-1}$ . ```{r epid2} eig <- eigen(mcM6@transitionMatrix) D <- diag(eig$values) ``` ```{r epid3} V <- eig$vectors V %*% D %*% solve(V) d <- D ^ (1/6) M <- V %*% d %*% solve(V) mcM1 <- new("markovchain", transitionMatrix = M, states = hivStates) ``` # Discussion, issues and future plans The \pkg{markovchain} package has been designed in order to provide easily handling of DTMC and communication with alternative packages. The package has known several improvements in the recent years: many functions added, porting the software in Rcpp \pkg{Rcpp} package \citep{RcppR} and many methodological improvements that have improved the software reliability. # Acknowledgments {#sec:aknowledgements} The package was selected for Google Summer of Code 2015 support. The authors wish to thank Michael Cole, Tobi Gutman and Mildenberger Thoralf for their suggestions and bug checks. A final thanks also to Dr. Simona C. Minotti and Dr. Mirko Signorelli for their support in drafting this version of the vignettes. \clearpage # References # markovchain/inst/extdata/0000755000176200001440000000000014714756745015207 5ustar liggesusersmarkovchain/inst/extdata/ltdItaData.txt0000644000176200001440000001754414714756745017776 0ustar liggesusersage;pAD;pID;pAI;pAA 20;0.000461600217312132;0.0108336431456553;0.000176246694342926;0.999362153088345 21;0.000482488764261525;0.0107971909886194;0.000171057735612955;0.999346453500126 22;0.000494993811957668;0.0117707568980395;0.00015923328063064;0.999345772907412 23;0.00050429345591411;0.0115939415352431;0.00016057305104192;0.999335133493044 24;0.000507419256318309;0.0126057434590121;0.000160650439141657;0.99933193030454 25;0.000515426695613004;0.0152636383159172;0.000164360322575267;0.999320212981812 26;0.000525595649643117;0.0179897694669832;0.000161660453870113;0.999312743896487 27;0.000534823584740014;0.0166832171238458;0.000160135991146609;0.999305040424113 28;0.000537542563101855;0.0170682636815637;0.000159910891995352;0.999302546544903 29;0.00054010571047368;0.0189681430662499;0.000154068989936519;0.99930582529959 30;0.000540223049860296;0.0211937258794527;0.000157160647241465;0.999302616302898 31;0.000543650098790082;0.0273283049097408;0.000166920507275799;0.999289429393934 32;0.000550657084106076;0.0297242338721561;0.000176149326345398;0.999273193589549 33;0.000567666524533948;0.0312031127015988;0.000174959290838917;0.999257374184627 34;0.000589564479997331;0.0362614421255913;0.000181142949631881;0.999229292570371 35;0.00061806212917393;0.0400308116670889;0.000191872923626047;0.9991900649472 36;0.000650632511832817;0.0418389766775716;0.000199643253754878;0.999149724234412 37;0.000689474293782214;0.0467358834902955;0.000211977632924897;0.999098548073293 38;0.000731138219342785;0.0523964586730976;0.000221795302027688;0.99904706647863 39;0.000793533578699302;0.055177966832089;0.000240416543812767;0.998966049877488 40;0.000859207185781173;0.0585124067163057;0.000264674910015306;0.998876117904203 41;0.000920725621476301;0.0679656015534935;0.000282355739283444;0.99879691863924 42;0.000984991230447042;0.0757310812483226;0.000314702144743578;0.998700306624809 43;0.00105939521363715;0.0811703192912012;0.000349094911367465;0.998591509874995 44;0.00115292666392253;0.086792620615223;0.000376750745815673;0.998470322590262 45;0.00124967505305504;0.0951282991008114;0.000410031980278301;0.998340292966667 46;0.00134617679388282;0.104306046855522;0.000454381385459602;0.998199441820658 47;0.00147744439982092;0.108863822493192;0.000510090216360853;0.998012465383818 48;0.00160678108915558;0.115727419192654;0.000572265035829771;0.997820953875015 49;0.00175231797005106;0.122620733316479;0.000653974571998273;0.997593707457951 50;0.00192647416205334;0.128264864604654;0.000724389338373027;0.997349136499574 51;0.00211873152640448;0.132487558117908;0.00080347791835564;0.99707779055524 52;0.00231715656887456;0.140903426576919;0.000897377523639647;0.996785465907486 53;0.00257005954245349;0.148308971347905;0.000988973589213584;0.996440966868333 54;0.00282270426395954;0.152694601283312;0.00110175953341175;0.996075536202629 55;0.00308892793456527;0.156014449299285;0.00121842271667517;0.99569264934876 56;0.00334491994186366;0.160354906530207;0.00135221310972041;0.995302866948416 57;0.0036680988581455;0.163584432824716;0.0015021237857599;0.994829777356095 58;0.00404383426827132;0.166621852151551;0.00164389926056965;0.994312266471159 59;0.00446410949795472;0.172995362892957;0.00181867939206979;0.993717211109975 60;0.00491071415431949;0.175114162729557;0.00203795753783481;0.993051328307846 61;0.00541897972205418;0.176836610548664;0.00223079594105024;0.992350224336896 62;0.0058872972394518;0.179065380547063;0.00243327615598675;0.991679426604561 63;0.00635426205223726;0.18328905395475;0.00268594485354049;0.990959793094222 64;0.00684249456592532;0.186309865207791;0.00299675785270434;0.99016074758137 65;0.00745741108087491;0.18514690618557;0.0034276558099294;0.989114933109196 66;0.00813029947746983;0.186388327973927;0.00401498471329922;0.987854715809231 67;0.00894480989820999;0.189665426363304;0.00467257950797381;0.986382610593816 68;0.0097208540778663;0.190052370707222;0.00533807252107788;0.984941073401056 69;0.0106145155277237;0.188697039510498;0.0060901494087728;0.983295335063503 70;0.0115815669321884;0.190655935136829;0.00698624429053202;0.98143218877728 71;0.0126738410165432;0.193198718680596;0.0080193455961521;0.979306813387305 72;0.0137706103972485;0.194509663180914;0.00912917559527522;0.977100214007476 73;0.0151133228338427;0.197263891809617;0.0104517574376933;0.974434919728464 74;0.0167023100407502;0.19981346841012;0.011975363077487;0.971322326881763 75;0.0185015234683037;0.202602461969921;0.0136406055721243;0.967857870959572 76;0.020543474835099;0.20567144487397;0.0155521514540999;0.963904373710801 77;0.0226990867632567;0.209583024789031;0.0176773816301192;0.959623531606624 78;0.025242012724978;0.216536798215654;0.0199840051708029;0.954773982104219 79;0.0280714682899232;0.222812914664102;0.0225820740028015;0.949346457707275 80;0.0313087874273656;0.229026086379995;0.0254147939549998;0.943276418617635 81;0.0347623037317666;0.237135642759773;0.0283027615785079;0.936934934689726 82;0.0377325549166625;0.246569096453296;0.0313008704863735;0.930966574596964 83;0.0415709360291018;0.255103424222878;0.0350322493312845;0.923396814639614 84;0.0466891630019649;0.263805059072913;0.0392249475621001;0.914085889435935 85;0.0523809285174003;0.275827261187502;0.0435063497564212;0.904112721726179 86;0.0595353395950259;0.287154077419303;0.0477809616106315;0.892683698794343 87;0.0667672618557459;0.296736437668921;0.0520193008104549;0.881213437333799 88;0.0742284842880654;0.307394243456317;0.0567867940499367;0.868984721661998 89;0.08102260498543;0.318807087201621;0.0617441024832344;0.857233292531336 90;0.0879638443512971;0.330335659703562;0.0647086526386771;0.847327503010026 91;0.0956534410840304;0.34429171728002;0.0667471331812722;0.837599425734697 92;0.104629865442421;0.360343939150447;0.0679974373329284;0.827372697224651 93;0.114342159249409;0.376714600886086;0.0692694237579942;0.816388416992597 94;0.124830307842353;0.39337161823954;0.0705634029519849;0.804606289205662 95;0.136132619794602;0.410280336624487;0.0718796873808002;0.791987692824598 96;0.148284870965249;0.427403785267262;0.0732185913907422;0.778496537644009 97;0.16131934887796;0.44470297533411;0.0745804311136826;0.764100220008357 98;0.175263808419464;0.46213723752253;0.0759655243672633;0.748770667213273 99;0.190140356683496;0.479664593311152;0.0773741905500132;0.732485452766491 100;0.205964292416731;0.49724215292386;0.0788067505312643;0.715228957052005 101;0.222742933595137;0.514826532138116;0.0802635265357542;0.696993539869109 102;0.240474474656817;0.532374279403284;0.0817448420228012;0.677780683320382 103;0.259146922168122;0.549842304367436;0.0832510215599426;0.657602056271935 104;0.278737163401518;0.567188298860823;0.0847823906909263;0.636480445907556 105;0.299210225581725;0.584371141653351;0.0863392757979522;0.614450498620323 106;0.320518783551316;0.601351278877663;0.087922003958059;0.591559212490625 107;0.342602969587468;0.618091072857778;0.089530902793558;0.567866127618974 108;0.365390530594804;0.634555113161069;0.0911663003164189;0.543443169088777 109;0.388797364816074;0.650710484943252;0.0928285247665155;0.51837411041741 110;0.412728452936279;0.666526991020167;0.0945179044436453;0.492753642620076 111;0.437079177930066;0.681977325511973;0.0962347675332406;0.466686054536693 112;0.461737005643692;0.69703719830248;0.0979794419256961;0.440283552430612 113;0.486583475732349;0.711685410881454;0.099752255029241;0.41366426923841 114;0.511496432215896;0.725903885342153;0.101553533576292;0.386950034207812 115;0.536352406554738;0.739677649351817;0.103383603423233;0.360263990022029 116;0.561029055458654;0.752994780772872;0.105242789343564;0.333728155197782 117;0.585407551755433;0.765846316272406;0.107131414814384;0.307461033430183 118;0.609374829980436;0.778226128713706;0.109049801796177;0.281575368223387 119;0.632825598544515;0.790130778382749;0.110998270505863;0.256176130949622 120;0.655664046315679;0.801559343179304;0.112977139183108;0.231358814501213 121;1;1;0;0 markovchain/README.md0000644000176200001440000000226114714756745014060 0ustar liggesusers# markovchain R package providing classes, methods and function for easily handling Discrete Time Markov Chains (DTMC), performing probabilistic analysis and fitting. ## Install the current release from CRAN: ```r install.packages('markovchain') ``` ## Install the development version from GitHub: ```r devtools::install_github('spedygiorgio/markovchain') ``` ![alt tag](https://travis-ci.org/spedygiorgio/markovchain.svg?branch=master) [![Downloads](http://cranlogs.r-pkg.org/badges/markovchain)](https://cran.r-project.org/package=markovchain) [![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/markovchain)](https://cran.r-project.org/package=markovchain) [![Research software impact](http://depsy.org/api/package/cran/markovchain/badge.svg)](http://depsy.org/package/r/markovchain) [![R-CMD-check](https://github.com/spedygiorgio/markovchain/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/spedygiorgio/markovchain/actions/workflows/R-CMD-check.yaml) [![Codecov test coverage](https://codecov.io/gh/spedygiorgio/markovchain/graph/badge.svg)](https://app.codecov.io/gh/spedygiorgio/markovchain) markovchain/build/0000755000176200001440000000000014715232625013662 5ustar liggesusersmarkovchain/build/vignette.rds0000644000176200001440000000052414715232625016222 0ustar liggesusersK0dzn CAD<y8 o!4i$%6kMDQxˏὼ ]]7k ~bB+IfR -j&a@g83'6c?e/n&Iy}8 IEKV*6) yhm靔qJ˜s$,pXl}+XՄ5?[f < =V::<U5h@jԵo)KzL\;vkB3*}_|Mh2pb;0(u0Ź#rC5"e"markovchain/man/0000755000176200001440000000000014714756746013354 5ustar liggesusersmarkovchain/man/predictHommc.Rd0000644000176200001440000000162014714756745016257 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hommc.R \name{predictHommc} \alias{predictHommc} \title{Simulate a higher order multivariate markovchain} \usage{ predictHommc(hommc,t,init) } \arguments{ \item{hommc}{a hommc-class object} \item{t}{no of iterations to predict} \item{init}{matrix of previous states size of which depends on hommc} } \value{ The function returns a matrix of size s X t displaying t predicted states in each row coressponding to every categorical sequence. } \description{ This function provides a prediction of states for a higher order multivariate markovchain object } \details{ The user is required to provide a matrix of giving n previous coressponding every categorical sequence. Dimensions of the init are s X n, where s is number of categorical sequences and n is order of the homc. } \author{ Vandit Jain } markovchain/man/preproglucacon.Rd0000644000176200001440000000152214714756745016665 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{preproglucacon} \alias{preproglucacon} \title{Preprogluccacon DNA protein bases sequences} \format{ A data frame with 1572 observations on the following 2 variables. \describe{ \item{\code{V1}}{a numeric vector, showing original coding} \item{\code{preproglucacon}}{a character vector, showing initial of DNA bases (Adenine, Cytosine, Guanine, Thymine)} } } \source{ Avery Henderson } \usage{ data(preproglucacon) } \description{ Sequence of bases for preproglucacon DNA protein } \examples{ data(preproglucacon) preproglucaconMc<-markovchainFit(data=preproglucacon$preproglucacon) } \references{ Averuy Henderson, Fitting markov chain models on discrete time series such as DNA sequences } \keyword{datasets} markovchain/man/setName.Rd0000644000176200001440000000156114714756745015241 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/classesAndMethods.R \name{name<-} \alias{name<-} \alias{name<-,markovchain-method} \title{Method to set name of markovchain object} \usage{ name(object) <- value \S4method{name}{markovchain}(object) <- value } \arguments{ \item{object}{A markovchain object} \item{value}{New name of markovchain object} } \description{ This method modifies the existing name of markovchain object } \examples{ statesNames <- c("a", "b", "c") markovB <- new("markovchain", states = statesNames, transitionMatrix = matrix(c(0.2, 0.5, 0.3, 0, 1, 0, 0.1, 0.8, 0.1), nrow = 3, byrow = TRUE, dimnames=list(statesNames,statesNames)), name = "A markovchain Object" ) name(markovB) <- "dangerous mc" } \author{ Giorgio Spedicato, Deepak Yadav } markovchain/man/noofVisitsDist.Rd0000644000176200001440000000201114714756745016623 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/fittingFunctions.R \name{noofVisitsDist} \alias{noofVisitsDist} \title{return a joint pdf of the number of visits to the various states of the DTMC} \usage{ noofVisitsDist(markovchain,N,state) } \arguments{ \item{markovchain}{a markovchain-class object} \item{N}{no of steps} \item{state}{the initial state} } \value{ a numeric vector depicting the above described probability density function. } \description{ This function would return a joint pdf of the number of visits to the various states of the DTMC during the first N steps. } \details{ This function would return a joint pdf of the number of visits to the various states of the DTMC during the first N steps. } \examples{ transMatr<-matrix(c(0.4,0.6,.3,.7),nrow=2,byrow=TRUE) simpleMc<-new("markovchain", states=c("a","b"), transitionMatrix=transMatr, name="simpleMc") noofVisitsDist(simpleMc,5,"a") } \author{ Vandit Jain } markovchain/man/generatorToTransitionMatrix.Rd0000644000176200001440000000201414714756745021370 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RcppExports.R \name{generatorToTransitionMatrix} \alias{generatorToTransitionMatrix} \title{Function to obtain the transition matrix from the generator} \usage{ generatorToTransitionMatrix(gen, byrow = TRUE) } \arguments{ \item{gen}{The generator matrix} \item{byrow}{Flag to determine if rows (columns) sum to 0} } \value{ Returns the transition matrix. } \description{ The transition matrix of the embedded DTMC is inferred from the CTMC's generator } \examples{ energyStates <- c("sigma", "sigma_star") byRow <- TRUE gen <- matrix(data = c(-3, 3, 1, -1), nrow = 2, byrow = byRow, dimnames = list(energyStates, energyStates)) generatorToTransitionMatrix(gen) } \references{ Introduction to Stochastic Processes with Applications in the Biosciences (2013), David F. Anderson, University of Wisconsin at Madison } \seealso{ \code{\link{rctmc}},\code{\link{ctmc-class}} } \author{ Sai Bhargav Yalamanchi } markovchain/man/is.accessible.Rd0000644000176200001440000000251614714756745016355 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/probabilistic.R \name{is.accessible} \alias{is.accessible} \title{Verify if a state j is reachable from state i.} \usage{ is.accessible(object, from, to) } \arguments{ \item{object}{A \code{markovchain} object.} \item{from}{The name of state "i" (beginning state).} \item{to}{The name of state "j" (ending state).} } \value{ A boolean value. } \description{ This function verifies if a state is reachable from another, i.e., if there exists a path that leads to state j leaving from state i with positive probability } \details{ It wraps an internal function named \code{reachabilityMatrix}. } \examples{ statesNames <- c("a", "b", "c") markovB <- new("markovchain", states = statesNames, transitionMatrix = matrix(c(0.2, 0.5, 0.3, 0, 1, 0, 0.1, 0.8, 0.1), nrow = 3, byrow = TRUE, dimnames = list(statesNames, statesNames) ) ) is.accessible(markovB, "a", "c") } \references{ James Montgomery, University of Madison } \seealso{ \code{is.irreducible} } \author{ Giorgio Spedicato, Ignacio Cordón } markovchain/man/impreciseProbabilityatT.Rd0000644000176200001440000000217214714756745020476 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ctmcProbabilistic.R \name{impreciseProbabilityatT} \alias{impreciseProbabilityatT} \title{Calculating full conditional probability using lower rate transition matrix} \usage{ impreciseProbabilityatT(C,i,t,s,error,useRCpp) } \arguments{ \item{C}{a ictmc class object} \item{i}{initial state at time t} \item{t}{initial time t. Default value = 0} \item{s}{final time} \item{error}{error rate. Default value = 0.001} \item{useRCpp}{logical whether to use RCpp implementation; by default TRUE} } \description{ This function calculates full conditional probability at given time s using lower rate transition matrix } \examples{ states <- c("n","y") Q <- matrix(c(-1,1,1,-1),nrow = 2,byrow = TRUE,dimnames = list(states,states)) range <- matrix(c(1/52,3/52,1/2,2),nrow = 2,byrow = 2) name <- "testictmc" ictmc <- new("ictmc",states = states,Q = Q,range = range,name = name) impreciseProbabilityatT(ictmc,2,0,1,10^-3,TRUE) } \references{ Imprecise Continuous-Time Markov Chains, Thomas Krak et al., 2016 } \author{ Vandit Jain } markovchain/man/markovchainSequence.Rd0000644000176200001440000000261414714756745017640 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/fittingFunctions.R \name{markovchainSequence} \alias{markovchainSequence} \title{Function to generate a sequence of states from homogeneous Markov chains.} \usage{ markovchainSequence( n, markovchain, t0 = sample(markovchain@states, 1), include.t0 = FALSE, useRCpp = TRUE ) } \arguments{ \item{n}{Sample size} \item{markovchain}{\code{markovchain} object} \item{t0}{The initial state} \item{include.t0}{Specify if the initial state shall be used} \item{useRCpp}{Boolean. Should RCpp fast implementation being used? Default is yes.} } \value{ A Character Vector } \description{ Provided any \code{markovchain} object, it returns a sequence of states coming from the underlying stationary distribution. } \details{ A sequence of size n is sampled. } \examples{ # define the markovchain object statesNames <- c("a", "b", "c") mcB <- new("markovchain", states = statesNames, transitionMatrix = matrix(c(0.2, 0.5, 0.3, 0, 0.2, 0.8, 0.1, 0.8, 0.1), nrow = 3, byrow = TRUE, dimnames = list(statesNames, statesNames))) # show the sequence outs <- markovchainSequence(n = 100, markovchain = mcB, t0 = "a") } \references{ A First Course in Probability (8th Edition), Sheldon Ross, Prentice Hall 2010 } \seealso{ \code{\link{markovchainFit}} } \author{ Giorgio Spedicato } markovchain/man/firstPassage.Rd0000644000176200001440000000205314714756745016275 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/probabilistic.R \name{firstPassage} \alias{firstPassage} \title{First passage across states} \usage{ firstPassage(object, state, n) } \arguments{ \item{object}{A \code{markovchain} object} \item{state}{Initial state} \item{n}{Number of rows on which compute the distribution} } \value{ A matrix of size 1:n x number of states showing the probability of the first time of passage in states to be exactly the number in the row. } \description{ This function compute the first passage probability in states } \details{ Based on Feres' Matlab listings } \examples{ simpleMc <- new("markovchain", states = c("a", "b"), transitionMatrix = matrix(c(0.4, 0.6, .3, .7), nrow = 2, byrow = TRUE)) firstPassage(simpleMc, "b", 20) } \references{ Renaldo Feres, Notes for Math 450 Matlab listings for Markov chains } \seealso{ \code{\link{conditionalDistribution}} } \author{ Giorgio Spedicato } markovchain/man/fitHigherOrder.Rd0000644000176200001440000000222014714756745016543 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/fitHigherOrder.R \name{fitHigherOrder} \alias{fitHigherOrder} \alias{seq2freqProb} \alias{seq2matHigh} \title{Functions to fit a higher order Markov chain} \usage{ fitHigherOrder(sequence, order = 2) seq2freqProb(sequence) seq2matHigh(sequence, order) } \arguments{ \item{sequence}{A character list.} \item{order}{Markov chain order} } \value{ A list containing lambda, Q, and X. } \description{ Given a sequence of states arising from a stationary state, it fits the underlying Markov chain distribution with higher order. } \examples{ sequence<-c("a", "a", "b", "b", "a", "c", "b", "a", "b", "c", "a", "b", "c", "a", "b", "c", "a", "b", "a", "b") fitHigherOrder(sequence) } \references{ Ching, W. K., Huang, X., Ng, M. K., & Siu, T. K. (2013). Higher-order markov chains. In Markov Chains (pp. 141-176). Springer US. Ching, W. K., Ng, M. K., & Fung, E. S. (2008). Higher-order multivariate Markov chains and their applications. Linear Algebra and its Applications, 428(2), 492-507. } \author{ Giorgio Spedicato, Tae Seung Kang } markovchain/man/HigherOrderMarkovChain-class.Rd0000644000176200001440000000047514714756745021300 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/fitHigherOrder.R \docType{class} \name{HigherOrderMarkovChain-class} \alias{HigherOrderMarkovChain-class} \title{Higher order Markov Chains class} \description{ The S4 class that describes \code{HigherOrderMarkovChain} objects. } markovchain/man/names.Rd0000644000176200001440000000061214714756745014744 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/classesAndMethods.R \name{names,markovchain-method} \alias{names,markovchain-method} \title{Returns the states for a Markov chain object} \usage{ \S4method{names}{markovchain}(x) } \arguments{ \item{x}{object we want to return states for} } \description{ Returns the states for a Markov chain object } markovchain/man/states.Rd0000644000176200001440000000177414714756745015156 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/classesAndMethods.R \name{states} \alias{states} \alias{states,markovchain-method} \title{Defined states of a transition matrix} \usage{ states(object) \S4method{states}{markovchain}(object) } \arguments{ \item{object}{A discrete \code{markovchain} object} } \value{ The character vector corresponding to states slot. } \description{ This method returns the states of a transition matrix. } \examples{ statesNames <- c("a", "b", "c") markovB <- new("markovchain", states = statesNames, transitionMatrix = matrix(c(0.2, 0.5, 0.3, 0, 1, 0, 0.1, 0.8, 0.1), nrow = 3, byrow = TRUE, dimnames=list(statesNames,statesNames)), name = "A markovchain Object" ) states(markovB) names(markovB) } \references{ A First Course in Probability (8th Edition), Sheldon Ross, Prentice Hall 2010 } \seealso{ \code{\linkS4class{markovchain}} } \author{ Giorgio Spedicato } markovchain/man/holson.Rd0000644000176200001440000000236014714756745015145 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{holson} \alias{holson} \title{Holson data set} \format{ A data frame with 1000 observations on the following 12 variables. \describe{ \item{\code{id}}{unique id} \item{\code{time1}}{observed status at i-th time} \item{\code{time2}}{observed status at i-th time} \item{\code{time3}}{observed status at i-th time} \item{\code{time4}}{observed status at i-th time} \item{\code{time5}}{observed status at i-th time} \item{\code{time6}}{observed status at i-th time} \item{\code{time7}}{observed status at i-th time} \item{\code{time8}}{observed status at i-th time} \item{\code{time9}}{observed status at i-th time} \item{\code{time10}}{observed status at i-th time} \item{\code{time11}}{observed status at i-th time} } } \source{ Private communications } \usage{ data(holson) } \description{ A data set containing 1000 life histories trajectories and a categorical status (1,2,3) observed on eleven evenly spaced steps. } \details{ The example can be used to fit a \code{markovchain} or a \code{markovchainList} object. } \examples{ data(holson) head(holson) } \references{ Private communications } \keyword{datasets} markovchain/man/sales.Rd0000644000176200001440000000131714714756745014753 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{sales} \alias{sales} \title{Sales Demand Sequences} \format{ An object of class \code{matrix} (inherits from \code{array}) with 269 rows and 5 columns. } \usage{ data("sales") } \description{ Sales demand sequences of five products (A, B, C, D, E). Each row corresponds to a sequence. First row corresponds to Sequence A, Second row to Sequence B and so on. } \details{ The example can be used to fit High order multivariate markov chain. } \examples{ data("sales") # fitHighOrderMultivarMC(seqMat = sales, order = 2, Norm = 2) } \keyword{datasets} markovchain/man/priorDistribution.Rd0000644000176200001440000000372014714756745017377 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RcppExports.R \name{priorDistribution} \alias{priorDistribution} \title{priorDistribution} \usage{ priorDistribution(transMatr, hyperparam = matrix()) } \arguments{ \item{transMatr}{The transition matrix whose probability is the parameter of interest.} \item{hyperparam}{The hyperparam matrix (optional). If not provided, a default value of 1 is assumed for each and therefore the resulting probability distribution is uniform.} } \value{ The log of the probabilities for each state is returned in a numeric vector. Each number in the vector represents the probability (log) of having a probability transition vector as specified in corresponding the row of the transition matrix. } \description{ Function to evaluate the prior probability of a transition matrix. It is based on conjugate priors and therefore a Dirichlet distribution is used to model the transitions of each state. } \details{ The states (dimnames) of the transition matrix and the hyperparam may be in any order. } \note{ This function can be used in conjunction with inferHyperparam. For example, if the user has a prior data set and a prior transition matrix, he can infer the hyperparameters using inferHyperparam and then compute the probability of their prior matrix using the inferred hyperparameters with priorDistribution. } \examples{ priorDistribution(matrix(c(0.5, 0.5, 0.5, 0.5), nrow = 2, dimnames = list(c("a", "b"), c("a", "b"))), matrix(c(2, 2, 2, 2), nrow = 2, dimnames = list(c("a", "b"), c("a", "b")))) } \references{ Yalamanchi SB, Spedicato GA (2015). Bayesian Inference of First Order Markov Chains. R package version 0.2.5 } \seealso{ \code{\link{predictiveDistribution}}, \code{\link{inferHyperparam}} } \author{ Sai Bhargav Yalamanchi, Giorgio Spedicato } markovchain/man/conditionalDistribution.Rd0000644000176200001440000000213014714756745020541 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/classesAndMethods.R \name{conditionalDistribution} \alias{conditionalDistribution} \title{\code{conditionalDistribution} of a Markov Chain} \usage{ conditionalDistribution(object, state) } \arguments{ \item{object}{A \code{markovchain} object.} \item{state}{Subsequent state.} } \value{ A named probability vector } \description{ It extracts the conditional distribution of the subsequent state, given current state. } \examples{ # define a markov chain statesNames <- c("a", "b", "c") markovB <- new("markovchain", states = statesNames, transitionMatrix = matrix(c(0.2, 0.5, 0.3, 0, 1, 0, 0.1, 0.8, 0.1),nrow = 3, byrow = TRUE, dimnames = list(statesNames, statesNames))) conditionalDistribution(markovB, "b") } \references{ A First Course in Probability (8th Edition), Sheldon Ross, Prentice Hall 2010 } \seealso{ \code{\linkS4class{markovchain}} } \author{ Giorgio Spedicato, Deepak Yadav } markovchain/man/rain.Rd0000644000176200001440000000131314714756745014571 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{rain} \alias{rain} \title{Alofi island daily rainfall} \format{ A data frame with 1096 observations on the following 2 variables. \describe{ \item{\code{V1}}{a numeric vector, showing original coding} \item{\code{rain}}{a character vector, showing daily rainfall millilitres brackets} } } \source{ Avery Henderson } \usage{ data(rain) } \description{ Rainfall measured in Alofi Island } \examples{ data(rain) rainMc<-markovchainFit(data=rain$rain) } \references{ Avery Henderson, Fitting markov chain models on discrete time series such as DNA sequences } \keyword{datasets} markovchain/man/statisticalTests.Rd0000644000176200001440000000564714714756745017225 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/statisticalTests.R \name{verifyMarkovProperty} \alias{verifyMarkovProperty} \alias{assessOrder} \alias{assessStationarity} \alias{verifyEmpiricalToTheoretical} \alias{verifyHomogeneity} \title{Various functions to perform statistical inference of DTMC} \usage{ verifyMarkovProperty(sequence, verbose = TRUE) assessOrder(sequence, verbose = TRUE) assessStationarity(sequence, nblocks, verbose = TRUE) verifyEmpiricalToTheoretical(data, object, verbose = TRUE) verifyHomogeneity(inputList, verbose = TRUE) } \arguments{ \item{sequence}{An empirical sequence.} \item{verbose}{Should test results be printed out?} \item{nblocks}{Number of blocks.} \item{data}{matrix, character or list to be converted in a raw transition matrix} \item{object}{a markovchain object} \item{inputList}{A list of items that can coerced to transition matrices} } \value{ Verification result a list with following slots: statistic (the chi - square statistic), dof (degrees of freedom), and corresponding p-value. In case a cell in the empirical transition matrix is >0 that is 0 in the theoretical transition matrix the null hypothesis is rejected. In that case a p-value of 0 and statistic and dof of NA are returned. a list of transition matrices? } \description{ These functions verify the Markov property, assess the order and stationarity of the Markov chain. This function tests whether an empirical transition matrix is statistically compatible with a theoretical one. It is a chi-square based test. In case a cell in the empirical transition matrix is >0 that is 0 in the theoretical transition matrix the null hypothesis is rejected. Verifies that the s elements in the input list belongs to the same DTMC } \examples{ sequence <- c("a", "b", "a", "a", "a", "a", "b", "a", "b", "a", "b", "a", "a", "b", "b", "b", "a") mcFit <- markovchainFit(data = sequence, byrow = FALSE) verifyMarkovProperty(sequence) assessOrder(sequence) assessStationarity(sequence, 1) #Example taken from Kullback Kupperman Tests for Contingency Tables and Markov Chains sequence<-c(0,1,2,2,1,0,0,0,0,0,0,1,2,2,2,1,0,0,1,0,0,0,0,0,0,1,1, 2,0,0,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,0,2,1,0, 0,2,1,0,0,0,0,0,0,1,1,1,2,2,0,0,2,1,1,1,1,2,1,1,1,1,1,1,1,1,1,0,2, 0,1,1,0,0,0,1,2,2,0,0,0,0,0,0,2,2,2,1,1,1,1,0,1,1,1,1,0,0,2,1,1, 0,0,0,0,0,2,2,1,1,1,1,1,2,1,2,0,0,0,1,2,2,2,0,0,0,1,1) mc=matrix(c(5/8,1/4,1/8,1/4,1/2,1/4,1/4,3/8,3/8),byrow=TRUE, nrow=3) rownames(mc)<-colnames(mc)<-0:2; theoreticalMc<-as(mc, "markovchain") verifyEmpiricalToTheoretical(data=sequence,object=theoreticalMc) data(kullback) verifyHomogeneity(inputList=kullback,verbose=TRUE) } \references{ Anderson and Goodman. } \seealso{ \code{markovchain} } \author{ Tae Seung Kang, Giorgio Alfredo Spedicato } \concept{statisticalTests} markovchain/man/is.CTMCirreducible.Rd0000644000176200001440000000165614714756745017224 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ctmcProbabilistic.R \name{is.CTMCirreducible} \alias{is.CTMCirreducible} \title{Check if CTMC is irreducible} \usage{ is.CTMCirreducible(ctmc) } \arguments{ \item{ctmc}{a ctmc-class object} } \value{ a boolean value as described above. } \description{ This function verifies whether a CTMC object is irreducible } \examples{ energyStates <- c("sigma", "sigma_star") byRow <- TRUE gen <- matrix(data = c(-3, 3, 1, -1), nrow = 2, byrow = byRow, dimnames = list(energyStates, energyStates)) molecularCTMC <- new("ctmc", states = energyStates, byrow = byRow, generator = gen, name = "Molecular Transition Model") is.CTMCirreducible(molecularCTMC) } \references{ Continuous-Time Markov Chains, Karl Sigman, Columbia University } \author{ Vandit Jain } markovchain/man/craigsendi.Rd0000644000176200001440000000165214714756745015756 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{craigsendi} \alias{craigsendi} \title{CD4 cells counts on HIV Infects between zero and six month} \format{ The format is: table [1:3, 1:3] 682 154 19 33 64 19 25 47 43 - attr(*, "dimnames")=List of 2 ..$ : chr [1:3] "0-49" "50-74" "75-UP" ..$ : chr [1:3] "0-49" "50-74" "75-UP" } \source{ Estimation of the transition matrix of a discrete time Markov chain, Bruce A. Craig and Peter P. Sendi, Health Economics 11, 2002. } \usage{ data(craigsendi) } \description{ This is the table shown in Craig and Sendi paper showing zero and six month CD4 cells count in six brakets } \details{ Rows represent counts at the beginning, cols represent counts after six months. } \examples{ data(craigsendi) csMc<-as(craigsendi, "markovchain") steadyStates(csMc) } \references{ see source } \keyword{datasets} markovchain/man/absorptionProbabilities.Rd0000644000176200001440000000222114714756745020530 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/probabilistic.R \name{absorptionProbabilities} \alias{absorptionProbabilities} \title{Absorption probabilities} \usage{ absorptionProbabilities(object) } \arguments{ \item{object}{the markovchain object} } \value{ A named vector with the expected number of steps to go from a transient state to any of the recurrent ones } \description{ Computes the absorption probability from each transient state to each recurrent one (i.e. the (i, j) entry or (j, i), in a stochastic matrix by columns, represents the probability that the first not transient state we can go from the transient state i is j (and therefore we are going to be absorbed in the communicating recurrent class of j) } \examples{ m <- matrix(c(1/2, 1/2, 0, 1/2, 1/2, 0, 0, 1/2, 1/2), ncol = 3, byrow = TRUE) mc <- new("markovchain", states = letters[1:3], transitionMatrix = m) absorptionProbabilities(mc) } \references{ C. M. Grinstead and J. L. Snell. Introduction to Probability. American Mathematical Soc., 2012. } \author{ Ignacio Cordón } markovchain/man/rctmc.Rd0000644000176200001440000000341614714756745014756 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ctmcProbabilistic.R \name{rctmc} \alias{rctmc} \title{rctmc} \usage{ rctmc(n, ctmc, initDist = numeric(), T = 0, include.T0 = TRUE, out.type = "list") } \arguments{ \item{n}{The number of samples to generate.} \item{ctmc}{The CTMC S4 object.} \item{initDist}{The initial distribution of states.} \item{T}{The time up to which the simulation runs (all transitions after time T are not returned).} \item{include.T0}{Flag to determine if start state is to be included.} \item{out.type}{"list" or "df"} } \value{ Based on out.type, a list or a data frame is returned. The returned list has two elements - a character vector (states) and a numeric vector (indicating time of transitions). The data frame is similarly structured. } \description{ The function generates random CTMC transitions as per the provided generator matrix. } \details{ In order to use the T0 argument, set n to Inf. } \examples{ energyStates <- c("sigma", "sigma_star") byRow <- TRUE gen <- matrix(data = c(-3, 3, 1, -1), nrow = 2, byrow = byRow, dimnames = list(energyStates, energyStates)) molecularCTMC <- new("ctmc", states = energyStates, byrow = byRow, generator = gen, name = "Molecular Transition Model") statesDist <- c(0.8, 0.2) rctmc(n = Inf, ctmc = molecularCTMC, T = 1) rctmc(n = 5, ctmc = molecularCTMC, initDist = statesDist, include.T0 = FALSE) } \references{ Introduction to Stochastic Processes with Applications in the Biosciences (2013), David F. Anderson, University of Wisconsin at Madison } \seealso{ \code{\link{generatorToTransitionMatrix}},\code{\link{ctmc-class}} } \author{ Sai Bhargav Yalamanchi } markovchain/man/expectedRewards.Rd0000644000176200001440000000210714714756745016773 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/probabilistic.R \name{expectedRewards} \alias{expectedRewards} \title{Expected Rewards for a markovchain} \usage{ expectedRewards(markovchain,n,rewards) } \arguments{ \item{markovchain}{the markovchain-class object} \item{n}{no of steps of the process} \item{rewards}{vector depicting rewards coressponding to states} } \value{ returns a vector of expected rewards for different initial states } \description{ Given a markovchain object and reward values for every state, function calculates expected reward value after n steps. } \details{ the function uses a dynamic programming approach to solve a recursive equation described in reference. } \examples{ transMatr<-matrix(c(0.99,0.01,0.01,0.99),nrow=2,byrow=TRUE) simpleMc<-new("markovchain", states=c("a","b"), transitionMatrix=transMatr) expectedRewards(simpleMc,1,c(0,1)) } \references{ Stochastic Processes: Theory for Applications, Robert G. Gallager, Cambridge University Press } \author{ Vandit Jain } markovchain/man/steadyStates.Rd0000644000176200001440000000241414714756745016320 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/classesAndMethods.R \name{steadyStates} \alias{steadyStates} \title{Stationary states of a \code{markovchain} object} \usage{ steadyStates(object) } \arguments{ \item{object}{A discrete \code{markovchain} object} } \value{ A matrix corresponding to the stationary states } \description{ This method returns the stationary vector in matricial form of a markovchain object. } \note{ The steady states are identified starting from which eigenvectors correspond to identity eigenvalues and then normalizing them to sum up to unity. When negative values are found in the matrix, the eigenvalues extraction is performed on the recurrent classes submatrix. } \examples{ statesNames <- c("a", "b", "c") markovB <- new("markovchain", states = statesNames, transitionMatrix = matrix(c(0.2, 0.5, 0.3, 0, 1, 0, 0.1, 0.8, 0.1), nrow = 3, byrow = TRUE, dimnames=list(statesNames,statesNames)), name = "A markovchain Object" ) steadyStates(markovB) } \references{ A First Course in Probability (8th Edition), Sheldon Ross, Prentice Hall 2010 } \seealso{ \code{\linkS4class{markovchain}} } \author{ Giorgio Spedicato } markovchain/man/transition2Generator.Rd0000644000176200001440000000145214714756746017770 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ctmcProbabilistic.R \name{transition2Generator} \alias{transition2Generator} \title{Return the generator matrix for a corresponding transition matrix} \usage{ transition2Generator(P, t = 1, method = "logarithm") } \arguments{ \item{P}{transition matrix between time 0 and t} \item{t}{time of observation} \item{method}{"logarithm" returns the Matrix logarithm of the transition matrix} } \value{ A matrix that represent the generator of P } \description{ Calculate the generator matrix for a corresponding transition matrix } \examples{ mymatr <- matrix(c(.4, .6, .1, .9), nrow = 2, byrow = TRUE) Q <- transition2Generator(P = mymatr) expm::expm(Q) } \seealso{ \code{\link{rctmc}} } markovchain/man/kullback.Rd0000644000176200001440000000064614714756745015440 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{kullback} \alias{kullback} \title{Example from Kullback and Kupperman Tests for Contingency Tables} \format{ A list containing two 6x6 non - negative integer matrices } \usage{ data(kullback) } \description{ A list of two matrices representing raw transitions between two states } \keyword{datasets} markovchain/man/structuralAnalysis.Rd0000644000176200001440000000630314714756746017561 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RcppExports.R, R/probabilistic.R \name{period} \alias{period} \alias{communicatingClasses} \alias{transientStates} \alias{recurrentStates} \alias{absorbingStates} \alias{transientClasses} \alias{recurrentClasses} \alias{canonicForm} \title{Various function to perform structural analysis of DTMC} \usage{ period(object) communicatingClasses(object) recurrentClasses(object) transientClasses(object) transientStates(object) recurrentStates(object) absorbingStates(object) canonicForm(object) } \arguments{ \item{object}{A \code{markovchain} object.} } \value{ \describe{ \item{\code{period}}{returns a integer number corresponding to the periodicity of the Markov chain (if it is irreducible)} \item{\code{absorbingStates}}{returns a character vector with the names of the absorbing states in the Markov chain} \item{\code{communicatingClasses}}{returns a list in which each slot contains the names of the states that are in that communicating class} \item{\code{recurrentClasses}}{analogously to \code{communicatingClasses}, but with recurrent classes} \item{\code{transientClasses}}{analogously to \code{communicatingClasses}, but with transient classes} \item{\code{transientStates}}{returns a character vector with all the transient states for the Markov chain} \item{\code{recurrentStates}}{returns a character vector with all the recurrent states for the Markov chain} \item{\code{canonicForm}}{returns the Markov chain reordered by a permutation of states so that we have blocks submatrices for each of the recurrent classes and a collection of rows in the end for the transient states} } } \description{ These functions return absorbing and transient states of the \code{markovchain} objects. } \examples{ statesNames <- c("a", "b", "c") mc <- new("markovchain", states = statesNames, transitionMatrix = matrix(c(0.2, 0.5, 0.3, 0, 1, 0, 0.1, 0.8, 0.1), nrow = 3, byrow = TRUE, dimnames = list(statesNames, statesNames)) ) communicatingClasses(mc) recurrentClasses(mc) recurrentClasses(mc) absorbingStates(mc) transientStates(mc) recurrentStates(mc) canonicForm(mc) # periodicity analysis A <- matrix(c(0, 1, 0, 0, 0.5, 0, 0.5, 0, 0, 0.5, 0, 0.5, 0, 0, 1, 0), nrow = 4, ncol = 4, byrow = TRUE) mcA <- new("markovchain", states = c("a", "b", "c", "d"), transitionMatrix = A, name = "A") is.irreducible(mcA) #true period(mcA) #2 # periodicity analysis B <- matrix(c(0, 0, 1/2, 1/4, 1/4, 0, 0, 0, 0, 1/3, 0, 2/3, 0, 0, 0, 0, 0, 0, 0, 1/3, 2/3, 0, 0, 0, 0, 0, 1/2, 1/2, 0, 0, 0, 0, 0, 3/4, 1/4, 1/2, 1/2, 0, 0, 0, 0, 0, 1/4, 3/4, 0, 0, 0, 0, 0), byrow = TRUE, ncol = 7) mcB <- new("markovchain", transitionMatrix = B) period(mcB) } \references{ Feres, Matlab listing for markov chain. } \seealso{ \code{\linkS4class{markovchain}} } \author{ Giorgio Alfredo Spedicato, Ignacio Cordón } markovchain/man/rmarkovchain.Rd0000644000176200001440000000547314714756745016337 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/fittingFunctions.R \name{rmarkovchain} \alias{rmarkovchain} \title{Function to generate a sequence of states from homogeneous or non-homogeneous Markov chains.} \usage{ rmarkovchain( n, object, what = "data.frame", useRCpp = TRUE, parallel = FALSE, num.cores = NULL, ... ) } \arguments{ \item{n}{Sample size} \item{object}{Either a \code{markovchain} or a \code{markovchainList} object} \item{what}{It specifies whether either a \code{data.frame} or a \code{matrix} (each rows represent a simulation) or a \code{list} is returned.} \item{useRCpp}{Boolean. Should RCpp fast implementation being used? Default is yes.} \item{parallel}{Boolean. Should parallel implementation being used? Default is yes.} \item{num.cores}{Number of Cores to be used} \item{...}{additional parameters passed to the internal sampler} } \value{ Character Vector, data.frame, list or matrix } \description{ Provided any \code{markovchain} or \code{markovchainList} objects, it returns a sequence of states coming from the underlying stationary distribution. } \details{ When a homogeneous process is assumed (\code{markovchain} object) a sequence is sampled of size n. When a non - homogeneous process is assumed, n samples are taken but the process is assumed to last from the begin to the end of the non-homogeneous markov process. } \note{ Check the type of input } \examples{ # define the markovchain object statesNames <- c("a", "b", "c") mcB <- new("markovchain", states = statesNames, transitionMatrix = matrix(c(0.2, 0.5, 0.3, 0, 0.2, 0.8, 0.1, 0.8, 0.1), nrow = 3, byrow = TRUE, dimnames = list(statesNames, statesNames))) # show the sequence outs <- rmarkovchain(n = 100, object = mcB, what = "list") #define markovchainList object statesNames <- c("a", "b", "c") mcA <- new("markovchain", states = statesNames, transitionMatrix = matrix(c(0.2, 0.5, 0.3, 0, 0.2, 0.8, 0.1, 0.8, 0.1), nrow = 3, byrow = TRUE, dimnames = list(statesNames, statesNames))) mcB <- new("markovchain", states = statesNames, transitionMatrix = matrix(c(0.2, 0.5, 0.3, 0, 0.2, 0.8, 0.1, 0.8, 0.1), nrow = 3, byrow = TRUE, dimnames = list(statesNames, statesNames))) mcC <- new("markovchain", states = statesNames, transitionMatrix = matrix(c(0.2, 0.5, 0.3, 0, 0.2, 0.8, 0.1, 0.8, 0.1), nrow = 3, byrow = TRUE, dimnames = list(statesNames, statesNames))) mclist <- new("markovchainList", markovchains = list(mcA, mcB, mcC)) # show the list of sequence rmarkovchain(100, mclist, "list") } \references{ A First Course in Probability (8th Edition), Sheldon Ross, Prentice Hall 2010 } \seealso{ \code{\link{markovchainFit}}, \code{\link{markovchainSequence}} } \author{ Giorgio Spedicato } markovchain/man/freq2Generator.Rd0000644000176200001440000000241114714756745016526 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ctmcProbabilistic.R \name{freq2Generator} \alias{freq2Generator} \title{Returns a generator matrix corresponding to frequency matrix} \usage{ freq2Generator(P, t = 1, method = "QO", logmethod = "Eigen") } \arguments{ \item{P}{relative frequency matrix} \item{t}{(default value = 1)} \item{method}{one among "QO"(Quasi optimaisation), "WA"(weighted adjustment), "DA"(diagonal adjustment)} \item{logmethod}{method for computation of matrx algorithm (by default : Eigen)} } \value{ returns a generator matix with same dimnames } \description{ The function provides interface to calculate generator matrix corresponding to a frequency matrix and time taken } \examples{ sample <- matrix(c(150,2,1,1,1,200,2,1,2,1,175,1,1,1,1,150),nrow = 4,byrow = TRUE) sample_rel = rbind((sample/rowSums(sample))[1:dim(sample)[1]-1,],c(rep(0,dim(sample)[1]-1),1)) freq2Generator(sample_rel,1) data(tm_abs) tm_rel=rbind((tm_abs/rowSums(tm_abs))[1:7,],c(rep(0,7),1)) ## Derive quasi optimization generator matrix estimate freq2Generator(tm_rel,1) } \references{ E. Kreinin and M. Sidelnikova: Regularization Algorithms for Transition Matrices. Algo Research Quarterly 4(1):23-40, 2001 } markovchain/man/meanFirstPassageTime.Rd0000644000176200001440000000354314714756745017722 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/probabilistic.R \name{meanFirstPassageTime} \alias{meanFirstPassageTime} \title{Mean First Passage Time for irreducible Markov chains} \usage{ meanFirstPassageTime(object, destination) } \arguments{ \item{object}{the markovchain object} \item{destination}{a character vector representing the states respect to which we want to compute the mean first passage time. Empty by default} } \value{ a Matrix of the same size with the average first passage times if destination is empty, a vector if destination is not } \description{ Given an irreducible (ergodic) markovchain object, this function calculates the expected number of steps to reach other states } \details{ For an ergodic Markov chain it computes: \itemize{ \item If destination is empty, the average first time (in steps) that takes the Markov chain to go from initial state i to j. (i, j) represents that value in case the Markov chain is given row-wise, (j, i) in case it is given col-wise. \item If destination is not empty, the average time it takes us from the remaining states to reach the states in \code{destination} } } \examples{ m <- matrix(1 / 10 * c(6,3,1, 2,3,5, 4,1,5), ncol = 3, byrow = TRUE) mc <- new("markovchain", states = c("s","c","r"), transitionMatrix = m) meanFirstPassageTime(mc, "r") # Grinstead and Snell's "Oz weather" worked out example mOz <- matrix(c(2,1,1, 2,0,2, 1,1,2)/4, ncol = 3, byrow = TRUE) mcOz <- new("markovchain", states = c("s", "c", "r"), transitionMatrix = mOz) meanFirstPassageTime(mcOz) } \references{ C. M. Grinstead and J. L. Snell. Introduction to Probability. American Mathematical Soc., 2012. } \author{ Toni Giorgino, Ignacio Cordón } markovchain/man/meanNumVisits.Rd0000644000176200001440000000170114714756745016443 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/probabilistic.R \name{meanNumVisits} \alias{meanNumVisits} \title{Mean num of visits for markovchain, starting at each state} \usage{ meanNumVisits(object) } \arguments{ \item{object}{the markovchain-class object} } \value{ a matrix with the expect number of visits to each state } \description{ Given a markovchain object, this function calculates a matrix where the element (i, j) represents the expect number of visits to the state j if the chain starts at i (in a Markov chain by columns it would be the element (j, i) instead) } \examples{ M <- markovchain:::zeros(5) M[1,1] <- M[5,5] <- 1 M[2,1] <- M[2,3] <- 1/2 M[3,2] <- M[3,4] <- 1/2 M[4,2] <- M[4,5] <- 1/2 mc <- new("markovchain", transitionMatrix = M) meanNumVisits(mc) } \references{ R. Vélez, T. Prieto, Procesos Estocásticos, Librería UNED, 2013 } \author{ Ignacio Cordón } markovchain/man/hittingProbabilities.Rd0000644000176200001440000000145314714756745020024 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/probabilistic.R \name{hittingProbabilities} \alias{hittingProbabilities} \title{Hitting probabilities for markovchain} \usage{ hittingProbabilities(object) } \arguments{ \item{object}{the markovchain-class object} } \value{ a matrix of hitting probabilities } \description{ Given a markovchain object, this function calculates the probability of ever arriving from state i to j } \examples{ M <- markovchain:::zeros(5) M[1,1] <- M[5,5] <- 1 M[2,1] <- M[2,3] <- 1/2 M[3,2] <- M[3,4] <- 1/2 M[4,2] <- M[4,5] <- 1/2 mc <- new("markovchain", transitionMatrix = M) hittingProbabilities(mc) } \references{ R. Vélez, T. Prieto, Procesos Estocásticos, Librería UNED, 2013 } \author{ Ignacio Cordón } markovchain/man/is.regular.Rd0000644000176200001440000000155014714756745015716 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/probabilistic.R \name{is.regular} \alias{is.regular} \title{Check if a DTMC is regular} \usage{ is.regular(object) } \arguments{ \item{object}{a markovchain object} } \value{ A boolean value } \description{ Function to check wether a DTCM is regular } \details{ A Markov chain is regular if some of the powers of its matrix has all elements strictly positive } \examples{ P <- matrix(c(0.5, 0.25, 0.25, 0.5, 0, 0.5, 0.25, 0.25, 0.5), nrow = 3) colnames(P) <- rownames(P) <- c("R","N","S") ciao <- as(P, "markovchain") is.regular(ciao) } \references{ Matrix Analysis. Roger A.Horn, Charles R.Johnson. 2nd edition. Corollary 8.5.8, Theorem 8.5.9 } \seealso{ \code{\link{is.irreducible}} } \author{ Ignacio Cordón } markovchain/man/transitionProbability.Rd0000644000176200001440000000227314714756746020242 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/classesAndMethods.R \name{transitionProbability} \alias{transitionProbability} \alias{transitionProbability,markovchain-method} \title{Function to get the transition probabilities from initial to subsequent states.} \usage{ transitionProbability(object, t0, t1) \S4method{transitionProbability}{markovchain}(object, t0, t1) } \arguments{ \item{object}{A \code{markovchain} object.} \item{t0}{Initial state.} \item{t1}{Subsequent state.} } \value{ Numeric Vector } \description{ This is a convenience function to get transition probabilities. } \examples{ statesNames <- c("a", "b", "c") markovB <- new("markovchain", states = statesNames, transitionMatrix = matrix(c(0.2, 0.5, 0.3, 0, 1, 0, 0.1, 0.8, 0.1), nrow = 3, byrow = TRUE, dimnames=list(statesNames,statesNames)), name = "A markovchain Object" ) transitionProbability(markovB,"b", "c") } \references{ A First Course in Probability (8th Edition), Sheldon Ross, Prentice Hall 2010 } \seealso{ \code{\linkS4class{markovchain}} } \author{ Giorgio Spedicato } markovchain/man/markovchainListFit.Rd0000644000176200001440000000240314714756745017442 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/fittingFunctions.R \name{markovchainListFit} \alias{markovchainListFit} \title{markovchainListFit} \usage{ markovchainListFit(data, byrow = TRUE, laplacian = 0, name) } \arguments{ \item{data}{Either a matrix or a data.frame or a list object.} \item{byrow}{Indicates whether distinc stochastic processes trajectiories are shown in distinct rows.} \item{laplacian}{Laplacian correction (default 0).} \item{name}{Optional name.} } \value{ A list containing two slots: estimate (the estimate) name } \description{ Given a data frame or a matrix (rows are observations, by cols the temporal sequence), it fits a non - homogeneous discrete time markov chain process (storing row). In particular a markovchainList of size = ncol - 1 is obtained estimating transitions from the n samples given by consecutive column pairs. } \details{ If \code{data} contains \code{NAs} then the transitions containing \code{NA} will be ignored. } \examples{ # using holson dataset data(holson) # fitting a single markovchain singleMc <- markovchainFit(data = holson[,2:12]) # fitting a markovchainList mclistFit <- markovchainListFit(data = holson[, 2:12], name = "holsonMcList") } markovchain/man/hommc-show.Rd0000644000176200001440000000064114714756745015724 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hommc.R \name{show,hommc-method} \alias{show,hommc-method} \title{Function to display the details of hommc object} \usage{ \S4method{show}{hommc}(object) } \arguments{ \item{object}{An object of class hommc} } \description{ This is a convenience function to display the slots of hommc object in proper format } markovchain/man/getName.Rd0000644000176200001440000000142414714756745015223 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/classesAndMethods.R \name{name} \alias{name} \alias{name,markovchain-method} \title{Method to retrieve name of markovchain object} \usage{ name(object) \S4method{name}{markovchain}(object) } \arguments{ \item{object}{A markovchain object} } \description{ This method returns the name of a markovchain object } \examples{ statesNames <- c("a", "b", "c") markovB <- new("markovchain", states = statesNames, transitionMatrix = matrix(c(0.2, 0.5, 0.3, 0, 1, 0, 0.1, 0.8, 0.1), nrow = 3, byrow = TRUE, dimnames=list(statesNames,statesNames)), name = "A markovchain Object" ) name(markovB) } \author{ Giorgio Spedicato, Deepak Yadav } markovchain/man/ctmcFit.Rd0000644000176200001440000000257514714756745015244 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RcppExports.R \name{ctmcFit} \alias{ctmcFit} \title{Function to fit a CTMC} \usage{ ctmcFit(data, byrow = TRUE, name = "", confidencelevel = 0.95) } \arguments{ \item{data}{It is a list of two elements. The first element is a character vector denoting the states. The second is a numeric vector denoting the corresponding transition times.} \item{byrow}{Determines if the output transition probabilities of the underlying embedded DTMC are by row.} \item{name}{Optional name for the CTMC.} \item{confidencelevel}{Confidence level for the confidence interval construnction.} } \value{ It returns a list containing the CTMC object and the confidence intervals. } \description{ This function fits the underlying CTMC give the state transition data and the transition times using the maximum likelihood method (MLE) } \details{ Note that in data, there must exist an element wise corresponding between the two elements of the list and that data[[2]][1] is always 0. } \examples{ data <- list(c("a", "b", "c", "a", "b", "a", "c", "b", "c"), c(0, 0.8, 2.1, 2.4, 4, 5, 5.9, 8.2, 9)) ctmcFit(data) } \references{ Continuous Time Markov Chains (vignette), Sai Bhargav Yalamanchi, Giorgio Alfredo Spedicato 2015 } \seealso{ \code{\link{rctmc}} } \author{ Sai Bhargav Yalamanchi } markovchain/man/tm_abs.Rd0000644000176200001440000000131114714756746015104 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{tm_abs} \alias{tm_abs} \title{Single Year Corporate Credit Rating Transititions} \format{ The format is: num [1:8, 1:8] 17 2 0 0 0 0 0 0 1 455 ... - attr(*, "dimnames")=List of 2 ..$ : chr [1:8] "AAA" "AA" "A" "BBB" ... ..$ : chr [1:8] "AAA" "AA" "A" "BBB" ... } \usage{ data(tm_abs) } \description{ Matrix of Standard and Poor's Global Corporate Rating Transition Frequencies 2000 (NR Removed) } \examples{ data(tm_abs) } \references{ European Securities and Markets Authority, 2016 https://cerep.esma.europa.eu/cerep-web/statistics/transitionMatrice.xhtml } \keyword{datasets} markovchain/man/meanRecurrenceTime.Rd0000644000176200001440000000215014714756745017415 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/probabilistic.R \name{meanRecurrenceTime} \alias{meanRecurrenceTime} \title{Mean recurrence time} \usage{ meanRecurrenceTime(object) } \arguments{ \item{object}{the markovchain object} } \value{ For a Markov chain it outputs is a named vector with the expected time to first return to a state when the chain starts there. States present in the vector are only the recurrent ones. If the matrix is ergodic (i.e. irreducible), then all states are present in the output and order is the same as states order for the Markov chain } \description{ Computes the expected time to return to a recurrent state in case the Markov chain starts there } \examples{ m <- matrix(1 / 10 * c(6,3,1, 2,3,5, 4,1,5), ncol = 3, byrow = TRUE) mc <- new("markovchain", states = c("s","c","r"), transitionMatrix = m) meanRecurrenceTime(mc) } \references{ C. M. Grinstead and J. L. Snell. Introduction to Probability. American Mathematical Soc., 2012. } \author{ Ignacio Cordón } markovchain/man/is.TimeReversible.Rd0000644000176200001440000000201414714756745017172 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ctmcProbabilistic.R \name{is.TimeReversible} \alias{is.TimeReversible} \title{checks if ctmc object is time reversible} \usage{ is.TimeReversible(ctmc) } \arguments{ \item{ctmc}{a ctmc-class object} } \value{ Returns a boolean value stating whether ctmc object is time reversible a boolean value as described above } \description{ The function returns checks if provided function is time reversible } \examples{ energyStates <- c("sigma", "sigma_star") byRow <- TRUE gen <- matrix(data = c(-3, 3, 1, -1), nrow = 2, byrow = byRow, dimnames = list(energyStates, energyStates)) molecularCTMC <- new("ctmc", states = energyStates, byrow = byRow, generator = gen, name = "Molecular Transition Model") is.TimeReversible(molecularCTMC) } \references{ INTRODUCTION TO STOCHASTIC PROCESSES WITH R, ROBERT P. DOBROW, Wiley } \author{ Vandit Jain } markovchain/man/multinomialConfidenceIntervals.Rd0000644000176200001440000000237314714756745022047 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/fittingFunctions.R \name{multinomialConfidenceIntervals} \alias{multinomialConfidenceIntervals} \title{A function to compute multinomial confidence intervals of DTMC} \usage{ multinomialConfidenceIntervals( transitionMatrix, countsTransitionMatrix, confidencelevel = 0.95 ) } \arguments{ \item{transitionMatrix}{An estimated transition matrix.} \item{countsTransitionMatrix}{Empirical (conts) transition matrix, on which the \code{transitionMatrix} was performed.} \item{confidencelevel}{confidence interval level.} } \value{ Two matrices containing the confidence intervals. } \description{ Return estimated transition matrix assuming a Multinomial Distribution } \examples{ seq<-c("a", "b", "a", "a", "a", "a", "b", "a", "b", "a", "b", "a", "a", "b", "b", "b", "a") mcfit<-markovchainFit(data=seq,byrow=TRUE) seqmat<-createSequenceMatrix(seq) multinomialConfidenceIntervals(mcfit$estimate@transitionMatrix, seqmat, 0.95) } \references{ Constructing two-sided simultaneous confidence intervals for multinomial proportions for small counts in a large number of cells. Journal of Statistical Software 5(6) (2000) } \seealso{ \code{markovchainFit} } markovchain/man/ExpectedTime.Rd0000644000176200001440000000206614714756745016226 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ctmcProbabilistic.R \name{ExpectedTime} \alias{ExpectedTime} \title{Returns expected hitting time from state i to state j} \usage{ ExpectedTime(C,i,j,useRCpp) } \arguments{ \item{C}{A CTMC S4 object} \item{i}{Initial state i} \item{j}{Final state j} \item{useRCpp}{logical whether to use Rcpp} } \value{ A numerical value that returns expected hitting times from i to j } \description{ Returns expected hitting time from state i to state j } \details{ According to the theorem, holding times for all states except j should be greater than 0. } \examples{ states <- c("a","b","c","d") byRow <- TRUE gen <- matrix(data = c(-1, 1/2, 1/2, 0, 1/4, -1/2, 0, 1/4, 1/6, 0, -1/3, 1/6, 0, 0, 0, 0), nrow = 4,byrow = byRow, dimnames = list(states,states)) ctmc <- new("ctmc",states = states, byrow = byRow, generator = gen, name = "testctmc") ExpectedTime(ctmc,1,4,TRUE) } \references{ Markovchains, J. R. Norris, Cambridge University Press } \author{ Vandit Jain } markovchain/man/markovchain-class.Rd0000644000176200001440000002105514714756745017252 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/classesAndMethods.R \docType{class} \name{markovchain-class} \alias{markovchain-class} \alias{*,markovchain,markovchain-method} \alias{*,markovchain,matrix-method} \alias{*,markovchain,numeric-method} \alias{*,matrix,markovchain-method} \alias{*,numeric,markovchain-method} \alias{==,markovchain,markovchain-method} \alias{!=,markovchain,markovchain-method} \alias{absorbingStates,markovchain-method} \alias{transientStates,markovchain-method} \alias{recurrentStates,markovchain-method} \alias{transientClasses,markovchain-method} \alias{recurrentClasses,markovchain-method} \alias{communicatingClasses,markovchain-method} \alias{steadyStates,markovchain-method} \alias{meanNumVisits,markovchain-method} \alias{is.regular,markovchain-method} \alias{is.irreducible,markovchain-method} \alias{is.accessible,markovchain,character,character-method} \alias{is.accessible,markovchain,missing,missing-method} \alias{absorptionProbabilities,markovchain-method} \alias{meanFirstPassageTime,markovchain,character-method} \alias{meanFirstPassageTime,markovchain,missing-method} \alias{meanAbsorptionTime,markovchain-method} \alias{meanRecurrenceTime,markovchain-method} \alias{conditionalDistribution,markovchain-method} \alias{hittingProbabilities,markovchain-method} \alias{canonicForm,markovchain-method} \alias{coerce,data.frame,markovchain-method} \alias{coerce,markovchain,data.frame-method} \alias{coerce,table,markovchain-method} \alias{coerce,markovchain,igraph-method} \alias{coerce,markovchain,matrix-method} \alias{coerce,markovchain,sparseMatrix-method} \alias{coerce,sparseMatrix,markovchain-method} \alias{coerce,matrix,markovchain-method} \alias{coerce,Matrix,markovchain-method} \alias{coerce,msm,markovchain-method} \alias{coerce,msm.est,markovchain-method} \alias{coerce,etm,markovchain-method} \alias{dim,markovchain-method} \alias{initialize,markovchain-method} \alias{names<-,markovchain-method} \alias{plot,markovchain,missing-method} \alias{predict,markovchain-method} \alias{print,markovchain-method} \alias{show,markovchain-method} \alias{summary,markovchain-method} \alias{sort,markovchain-method} \alias{t,markovchain-method} \alias{[,markovchain,ANY,ANY,ANY-method} \alias{^,markovchain,numeric-method} \title{Markov Chain class} \arguments{ \item{states}{Name of the states. Must be the same of \code{colnames} and \code{rownames} of the transition matrix} \item{byrow}{TRUE or FALSE indicating whether the supplied matrix is either stochastic by rows or by columns} \item{transitionMatrix}{Square transition matrix} \item{name}{Optional character name of the Markov chain} } \description{ The S4 class that describes \code{markovchain} objects. } \note{ \enumerate{ \item \code{markovchain} object are backed by S4 Classes. \item Validation method is used to assess whether either columns or rows totals to one. Rounding is used up to \code{.Machine$double.eps * 100}. If state names are not properly defined for a probability \code{matrix}, coercing to \code{markovchain} object leads to overriding states name with artificial "s1", "s2", ... sequence. In addition, operator overloading has been applied for \eqn{+,*,^,==,!=} operators. } } \section{Creation of objects}{ Objects can be created by calls of the form \code{new("markovchain", states, byrow, transitionMatrix, ...)}. } \section{Methods}{ \describe{ \item{*}{\code{signature(e1 = "markovchain", e2 = "markovchain")}: multiply two \code{markovchain} objects} \item{*}{\code{signature(e1 = "markovchain", e2 = "matrix")}: markovchain by matrix multiplication} \item{*}{\code{signature(e1 = "markovchain", e2 = "numeric")}: markovchain by numeric vector multiplication } \item{*}{\code{signature(e1 = "matrix", e2 = "markovchain")}: matrix by markov chain} \item{*}{\code{signature(e1 = "numeric", e2 = "markovchain")}: numeric vector by \code{markovchain} multiplication } \item{[}{\code{signature(x = "markovchain", i = "ANY", j = "ANY", drop = "ANY")}: ... } \item{^}{\code{signature(e1 = "markovchain", e2 = "numeric")}: power of a \code{markovchain} object} \item{==}{\code{signature(e1 = "markovchain", e2 = "markovchain")}: equality of two \code{markovchain} object} \item{!=}{\code{signature(e1 = "markovchain", e2 = "markovchain")}: non-equality of two \code{markovchain} object} \item{absorbingStates}{\code{signature(object = "markovchain")}: method to get absorbing states } \item{canonicForm}{\code{signature(object = "markovchain")}: return a \code{markovchain} object into canonic form } \item{coerce}{\code{signature(from = "markovchain", to = "data.frame")}: coerce method from markovchain to \code{data.frame}} \item{conditionalDistribution}{\code{signature(object = "markovchain")}: returns the conditional probability of subsequent states given a state} \item{coerce}{\code{signature(from = "data.frame", to = "markovchain")}: coerce method from \code{data.frame} to \code{markovchain}} \item{coerce}{\code{signature(from = "table", to = "markovchain")}: coerce method from \code{table} to \code{markovchain} } \item{coerce}{\code{signature(from = "msm", to = "markovchain")}: coerce method from \code{msm} to \code{markovchain} } \item{coerce}{\code{signature(from = "msm.est", to = "markovchain")}: coerce method from \code{msm.est} (but only from a Probability Matrix) to \code{markovchain} } \item{coerce}{\code{signature(from = "etm", to = "markovchain")}: coerce method from \code{etm} to \code{markovchain} } \item{coerce}{\code{signature(from = "sparseMatrix", to = "markovchain")}: coerce method from \code{sparseMatrix} to \code{markovchain} } \item{coerce}{\code{signature(from = "markovchain", to = "igraph")}: coercing to \code{igraph} objects } \item{coerce}{\code{signature(from = "markovchain", to = "matrix")}: coercing to \code{matrix} objects } \item{coerce}{\code{signature(from = "markovchain", to = "sparseMatrix")}: coercing to \code{sparseMatrix} objects } \item{coerce}{\code{signature(from = "matrix", to = "markovchain")}: coercing to \code{markovchain} objects from \code{matrix} one } \item{dim}{\code{signature(x = "markovchain")}: method to get the size} \item{names}{\code{signature(x = "markovchain")}: method to get the names of states} \item{names<-}{\code{signature(x = "markovchain", value = "character")}: method to set the names of states} \item{initialize}{\code{signature(.Object = "markovchain")}: initialize method } \item{plot}{\code{signature(x = "markovchain", y = "missing")}: plot method for \code{markovchain} objects } \item{predict}{\code{signature(object = "markovchain")}: predict method } \item{print}{\code{signature(x = "markovchain")}: print method. } \item{show}{\code{signature(object = "markovchain")}: show method. } \item{sort}{\code{signature(x = "markovchain", decreasing=FALSE)}: sorting the transition matrix. } \item{states}{\code{signature(object = "markovchain")}: returns the names of states (as \code{names}. } \item{steadyStates}{\code{signature(object = "markovchain")}: method to get the steady vector. } \item{summary}{\code{signature(object = "markovchain")}: method to summarize structure of the markov chain } \item{transientStates}{\code{signature(object = "markovchain")}: method to get the transient states. } \item{t}{\code{signature(x = "markovchain")}: transpose matrix } \item{transitionProbability}{\code{signature(object = "markovchain")}: transition probability } } } \examples{ #show markovchain definition showClass("markovchain") #create a simple Markov chain transMatr<-matrix(c(0.4,0.6,.3,.7),nrow=2,byrow=TRUE) simpleMc<-new("markovchain", states=c("a","b"), transitionMatrix=transMatr, name="simpleMc") #power simpleMc^4 #some methods steadyStates(simpleMc) absorbingStates(simpleMc) simpleMc[2,1] t(simpleMc) is.irreducible(simpleMc) #conditional distributions conditionalDistribution(simpleMc, "b") #example for predict method sequence<-c("a", "b", "a", "a", "a", "a", "b", "a", "b", "a", "b", "a", "a", "b", "b", "b", "a") mcFit<-markovchainFit(data=sequence) predict(mcFit$estimate, newdata="b",n.ahead=3) #direct conversion myMc<-as(transMatr, "markovchain") #example of summary summary(simpleMc) \dontrun{plot(simpleMc)} } \references{ A First Course in Probability (8th Edition), Sheldon Ross, Prentice Hall 2010 } \seealso{ \code{\link{markovchainSequence}},\code{\link{markovchainFit}} } \author{ Giorgio Spedicato } \keyword{classes} markovchain/man/meanAbsorptionTime.Rd0000644000176200001440000000174014714756745017444 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/probabilistic.R \name{meanAbsorptionTime} \alias{meanAbsorptionTime} \title{Mean absorption time} \usage{ meanAbsorptionTime(object) } \arguments{ \item{object}{the markovchain object} } \value{ A named vector with the expected number of steps to go from a transient state to any of the recurrent ones } \description{ Computes the expected number of steps to go from any of the transient states to any of the recurrent states. The Markov chain should have at least one transient state for this method to work } \examples{ m <- matrix(c(1/2, 1/2, 0, 1/2, 1/2, 0, 0, 1/2, 1/2), ncol = 3, byrow = TRUE) mc <- new("markovchain", states = letters[1:3], transitionMatrix = m) times <- meanAbsorptionTime(mc) } \references{ C. M. Grinstead and J. L. Snell. Introduction to Probability. American Mathematical Soc., 2012. } \author{ Ignacio Cordón } markovchain/man/markovchainFit.Rd0000644000176200001440000001116014714756745016606 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RcppExports.R \name{createSequenceMatrix} \alias{createSequenceMatrix} \alias{markovchainFit} \title{Function to fit a discrete Markov chain} \usage{ createSequenceMatrix( stringchar, toRowProbs = FALSE, sanitize = FALSE, possibleStates = character() ) markovchainFit( data, method = "mle", byrow = TRUE, nboot = 10L, laplacian = 0, name = "", parallel = FALSE, confidencelevel = 0.95, confint = TRUE, hyperparam = matrix(), sanitize = FALSE, possibleStates = character() ) } \arguments{ \item{stringchar}{It can be a \deqn{n x n} matrix or a character vector or a list} \item{toRowProbs}{converts a sequence matrix into a probability matrix} \item{sanitize}{put 1 in all rows having rowSum equal to zero} \item{possibleStates}{Possible states which are not present in the given sequence} \item{data}{It can be a character vector or a \deqn{n x n} matrix or a \deqn{n x n} data frame or a list} \item{method}{Method used to estimate the Markov chain. Either "mle", "map", "bootstrap" or "laplace"} \item{byrow}{it tells whether the output Markov chain should show the transition probabilities by row.} \item{nboot}{Number of bootstrap replicates in case "bootstrap" is used.} \item{laplacian}{Laplacian smoothing parameter, default zero. It is only used when "laplace" method is chosen.} \item{name}{Optional character for name slot.} \item{parallel}{Use parallel processing when performing Boostrap estimates.} \item{confidencelevel}{\deqn{\alpha} level for conficence intervals width. Used only when \code{method} equal to "mle".} \item{confint}{a boolean to decide whether to compute Confidence Interval or not.} \item{hyperparam}{Hyperparameter matrix for the a priori distribution. If none is provided, default value of 1 is assigned to each parameter. This must be of size \deqn{k x k} where k is the number of states in the chain and the values should typically be non-negative integers.} } \value{ A list containing an estimate, log-likelihood, and, when "bootstrap" method is used, a matrix of standards deviations and the bootstrap samples. When the "mle", "bootstrap" or "map" method is used, the lower and upper confidence bounds are returned along with the standard error. The "map" method also returns the expected value of the parameters with respect to the posterior distribution. } \description{ Given a sequence of states arising from a stationary state, it fits the underlying Markov chain distribution using either MLE (also using a Laplacian smoother), bootstrap or by MAP (Bayesian) inference. } \details{ Disabling confint would lower the computation time on large datasets. If \code{data} or \code{stringchar} contain \code{NAs}, the related \code{NA} containing transitions will be ignored. } \note{ This function has been rewritten in Rcpp. Bootstrap algorithm has been defined "heuristically". In addition, parallel facility is not complete, involving only a part of the bootstrap process. When \code{data} is either a \code{data.frame} or a \code{matrix} object, only MLE fit is currently available. } \examples{ sequence <- c("a", "b", "a", "a", "a", "a", "b", "a", "b", "a", "b", "a", "a", "b", "b", "b", "a") sequenceMatr <- createSequenceMatrix(sequence, sanitize = FALSE) mcFitMLE <- markovchainFit(data = sequence) mcFitBSP <- markovchainFit(data = sequence, method = "bootstrap", nboot = 5, name = "Bootstrap Mc") na.sequence <- c("a", NA, "a", "b") # There will be only a (a,b) transition na.sequenceMatr <- createSequenceMatrix(na.sequence, sanitize = FALSE) mcFitMLE <- markovchainFit(data = na.sequence) # data can be a list of character vectors sequences <- list(x = c("a", "b", "a"), y = c("b", "a", "b", "a", "c")) mcFitMap <- markovchainFit(sequences, method = "map") mcFitMle <- markovchainFit(sequences, method = "mle") } \references{ A First Course in Probability (8th Edition), Sheldon Ross, Prentice Hall 2010 Inferring Markov Chains: Bayesian Estimation, Model Comparison, Entropy Rate, and Out-of-Class Modeling, Christopher C. Strelioff, James P. Crutchfield, Alfred Hubler, Santa Fe Institute Yalamanchi SB, Spedicato GA (2015). Bayesian Inference of First Order Markov Chains. R package version 0.2.5 } \seealso{ \code{\link{markovchainSequence}}, \code{\link{markovchainListFit}} } \author{ Giorgio Spedicato, Tae Seung Kang, Sai Bhargav Yalamanchi } markovchain/man/expectedRewardsBeforeHittingA.Rd0000644000176200001440000000203014714756745021541 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/probabilistic.R \name{expectedRewardsBeforeHittingA} \alias{expectedRewardsBeforeHittingA} \title{Expected first passage Rewards for a set of states in a markovchain} \usage{ expectedRewardsBeforeHittingA(markovchain, A, state, rewards, n) } \arguments{ \item{markovchain}{the markovchain-class object} \item{A}{set of states for first passage expected reward} \item{state}{initial state} \item{rewards}{vector depicting rewards coressponding to states} \item{n}{no of steps of the process} } \value{ returns a expected reward (numerical value) as described above } \description{ Given a markovchain object and reward values for every state, function calculates expected reward value for a set A of states after n steps. } \details{ The function returns the value of expected first passage rewards given rewards coressponding to every state, an initial state and number of steps. } \author{ Sai Bhargav Yalamanchi, Vandit Jain } markovchain/man/ctmc-class.Rd0000644000176200001440000000455514714756745015704 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ctmcClassesAndMethods.R \docType{class} \name{ctmc-class} \alias{ctmc-class} \alias{dim,ctmc-method} \alias{initialize,ctmc_method} \alias{states,ctmc-method} \alias{steadyStates,ctmc-method} \alias{plot,ctmc,missing-method} \title{Continuous time Markov Chains class} \arguments{ \item{states}{Name of the states. Must be the same of \code{colnames} and \code{rownames} of the generator matrix} \item{byrow}{TRUE or FALSE. Indicates whether the given matrix is stochastic by rows or by columns} \item{generator}{Square generator matrix} \item{name}{Optional character name of the Markov chain} } \description{ The S4 class that describes \code{ctmc} (continuous time Markov chain) objects. } \note{ \enumerate{ \item \code{ctmc} classes are written using S4 classes \item Validation method is used to assess whether either columns or rows totals to zero. Rounding is used up to 5th decimal. If state names are not properly defined for a generator \code{matrix}, coercing to \code{ctmc} object leads to overriding states name with artificial "s1", "s2", ... sequence } } \section{Methods}{ \describe{ \item{dim}{\code{signature(x = "ctmc")}: method to get the size} \item{initialize}{\code{signature(.Object = "ctmc")}: initialize method } \item{states}{\code{signature(object = "ctmc")}: states method. } \item{steadyStates}{\code{signature(object = "ctmc")}: method to get the steady state vector. } \item{plot}{\code{signature(x = "ctmc", y = "missing")}: plot method for \code{ctmc} objects } } } \examples{ energyStates <- c("sigma", "sigma_star") byRow <- TRUE gen <- matrix(data = c(-3, 3, 1, -1), nrow = 2, byrow = byRow, dimnames = list(energyStates, energyStates)) molecularCTMC <- new("ctmc", states = energyStates, byrow = byRow, generator = gen, name = "Molecular Transition Model") steadyStates(molecularCTMC) \dontrun{plot(molecularCTMC)} } \references{ Introduction to Stochastic Processes with Applications in the Biosciences (2013), David F. Anderson, University of Wisconsin at Madison. Sai Bhargav Yalamanchi, Giorgio Spedicato } \seealso{ \code{\link{generatorToTransitionMatrix}},\code{\link{rctmc}} } \keyword{classes} markovchain/man/firstPassageMultiple.Rd0000644000176200001440000000236714714756745020021 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/probabilistic.R \name{firstPassageMultiple} \alias{firstPassageMultiple} \title{function to calculate first passage probabilities} \usage{ firstPassageMultiple(object, state, set, n) } \arguments{ \item{object}{a markovchain-class object} \item{state}{intital state of the process (charactervector)} \item{set}{set of states A, first passage of which is to be calculated} \item{n}{Number of rows on which compute the distribution} } \value{ A vector of size n showing the first time proabilities } \description{ The function calculates first passage probability for a subset of states given an initial state. } \examples{ statesNames <- c("a", "b", "c") markovB <- new("markovchain", states = statesNames, transitionMatrix = matrix(c(0.2, 0.5, 0.3, 0, 1, 0, 0.1, 0.8, 0.1), nrow = 3, byrow = TRUE, dimnames = list(statesNames, statesNames) )) firstPassageMultiple(markovB,"a",c("b","c"),4) } \references{ Renaldo Feres, Notes for Math 450 Matlab listings for Markov chains; MIT OCW, course - 6.262, Discrete Stochastic Processes, course-notes, chap -05 } \seealso{ \code{\link{firstPassage}} } \author{ Vandit Jain } markovchain/man/ones.Rd0000644000176200001440000000047214714756745014611 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/matlab_package_functions.R \name{ones} \alias{ones} \title{Returns an Identity matrix} \usage{ ones(n) } \arguments{ \item{n}{size of the matrix} } \value{ a identity matrix } \description{ Returns an Identity matrix } markovchain/man/zeros.Rd0000644000176200001440000000047414714756746015012 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/matlab_package_functions.R \name{zeros} \alias{zeros} \title{Matrix to create zeros} \usage{ zeros(n) } \arguments{ \item{n}{size of the matrix} } \value{ a square matrix of zeros } \description{ Matrix to create zeros } markovchain/man/inferHyperparam.Rd0000644000176200001440000000440314714756745016777 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RcppExports.R \name{inferHyperparam} \alias{inferHyperparam} \title{Function to infer the hyperparameters for Bayesian inference from an a priori matrix or a data set} \usage{ inferHyperparam(transMatr = matrix(), scale = numeric(), data = character()) } \arguments{ \item{transMatr}{A valid transition matrix, with dimension names.} \item{scale}{A vector of scaling factors, each element corresponds to the row names of the provided transition matrix transMatr, in the same order.} \item{data}{A data set from which the hyperparameters are inferred.} } \value{ Returns the hyperparameter matrix in a list. } \description{ Since the Bayesian inference approach implemented in the package is based on conjugate priors, hyperparameters must be provided to model the prior probability distribution of the chain parameters. The hyperparameters are inferred from a given a priori matrix under the assumption that the matrix provided corresponds to the mean (expected) values of the chain parameters. A scaling factor vector must be provided too. Alternatively, the hyperparameters can be inferred from a data set. } \details{ transMatr and scale need not be provided if data is provided. } \note{ The hyperparameter matrix returned is such that the row and column names are sorted alphanumerically, and the elements in the matrix are correspondingly permuted. } \examples{ data(rain, package = "markovchain") inferHyperparam(data = rain$rain) weatherStates <- c("sunny", "cloudy", "rain") weatherMatrix <- matrix(data = c(0.7, 0.2, 0.1, 0.3, 0.4, 0.3, 0.2, 0.4, 0.4), byrow = TRUE, nrow = 3, dimnames = list(weatherStates, weatherStates)) inferHyperparam(transMatr = weatherMatrix, scale = c(10, 10, 10)) } \references{ Yalamanchi SB, Spedicato GA (2015). Bayesian Inference of First Order Markov Chains. R package version 0.2.5 } \seealso{ \code{\link{markovchainFit}}, \code{\link{predictiveDistribution}} } \author{ Sai Bhargav Yalamanchi, Giorgio Spedicato } markovchain/man/probabilityatT.Rd0000644000176200001440000000243614714756745016640 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ctmcProbabilistic.R \name{probabilityatT} \alias{probabilityatT} \title{Calculating probability from a ctmc object} \usage{ probabilityatT(C,t,x0,useRCpp) } \arguments{ \item{C}{A CTMC S4 object} \item{t}{final time t} \item{x0}{initial state} \item{useRCpp}{logical whether to use RCpp implementation} } \value{ returns a vector or a matrix in case \code{x0} is provided or not respectively. } \description{ This function returns the probability of every state at time t under different conditions } \details{ The initial state is not mandatory, In case it is not provided, function returns a matrix of transition function at time \code{t} else it returns vector of probaabilities of transition to different states if initial state was \code{x0} } \examples{ states <- c("a","b","c","d") byRow <- TRUE gen <- matrix(data = c(-1, 1/2, 1/2, 0, 1/4, -1/2, 0, 1/4, 1/6, 0, -1/3, 1/6, 0, 0, 0, 0), nrow = 4,byrow = byRow, dimnames = list(states,states)) ctmc <- new("ctmc",states = states, byrow = byRow, generator = gen, name = "testctmc") probabilityatT(ctmc,1,useRCpp = TRUE) } \references{ INTRODUCTION TO STOCHASTIC PROCESSES WITH R, ROBERT P. DOBROW, Wiley } \author{ Vandit Jain } markovchain/man/predictiveDistribution.Rd0000644000176200001440000000406714714756745020407 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RcppExports.R \name{predictiveDistribution} \alias{predictiveDistribution} \title{predictiveDistribution} \usage{ predictiveDistribution(stringchar, newData, hyperparam = matrix()) } \arguments{ \item{stringchar}{This is the data using which the Bayesian inference is performed.} \item{newData}{This is the data whose predictive probability is computed.} \item{hyperparam}{This determines the shape of the prior distribution of the parameters. If none is provided, default value of 1 is assigned to each parameter. This must be of size kxk where k is the number of states in the chain and the values should typically be non-negative integers.} } \value{ The log of the probability is returned. } \description{ The function computes the probability of observing a new data set, given a data set } \details{ The underlying method is Bayesian inference. The probability is computed by averaging the likelihood of the new data with respect to the posterior. Since the method assumes conjugate priors, the result can be represented in a closed form (see the vignette for more details), which is what is returned. } \examples{ sequence<- c("a", "b", "a", "a", "a", "a", "b", "a", "b", "a", "b", "a", "a", "b", "b", "b", "a") hyperMatrix<-matrix(c(1, 2, 1, 4), nrow = 2,dimnames=list(c("a","b"),c("a","b"))) predProb <- predictiveDistribution(sequence[1:10], sequence[11:17], hyperparam =hyperMatrix ) hyperMatrix2<-hyperMatrix[c(2,1),c(2,1)] predProb2 <- predictiveDistribution(sequence[1:10], sequence[11:17], hyperparam =hyperMatrix2 ) predProb2==predProb } \references{ Inferring Markov Chains: Bayesian Estimation, Model Comparison, Entropy Rate, and Out-of-Class Modeling, Christopher C. Strelioff, James P. Crutchfield, Alfred Hubler, Santa Fe Institute Yalamanchi SB, Spedicato GA (2015). Bayesian Inference of First Order Markov Chains. R package version 0.2.5 } \seealso{ \code{\link{markovchainFit}} } \author{ Sai Bhargav Yalamanchi } markovchain/man/markovchainList-class.Rd0000644000176200001440000000516714714756745020114 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/classesAndMethods.R \docType{class} \name{markovchainList-class} \alias{markovchainList-class} \alias{[[,markovchainList-method} \alias{dim,markovchainList-method} \alias{predict,markovchainList-method} \alias{print,markovchainList-method} \alias{show,markovchainList-method} \title{Non homogeneus discrete time Markov Chains class} \arguments{ \item{markovchains}{Object of class \code{"list"}: a list of markovchains} \item{name}{Object of class \code{"character"}: optional name of the class} } \description{ A class to handle non homogeneous discrete Markov chains } \note{ The class consists in a list of \code{markovchain} objects. It is aimed at working with non homogeneous Markov chains. } \section{Objects from the Class}{ A \code{markovchainlist} is a list of \code{markovchain} objects. They can be used to model non homogeneous discrete time Markov Chains, when transition probabilities (and possible states) change by time. } \section{Methods}{ \describe{ \item{[[}{\code{signature(x = "markovchainList")}: extract the i-th \code{markovchain} } \item{dim}{\code{signature(x = "markovchainList")}: number of \code{markovchain} underlying the matrix } \item{predict}{\code{signature(object = "markovchainList")}: predict from a \code{markovchainList} } \item{print}{\code{signature(x = "markovchainList")}: prints the list of markovchains } \item{show}{\code{signature(object = "markovchainList")}: same as \code{print} } } } \examples{ showClass("markovchainList") #define a markovchainList statesNames=c("a","b") mcA<-new("markovchain",name="MCA", transitionMatrix=matrix(c(0.7,0.3,0.1,0.9), byrow=TRUE, nrow=2, dimnames=list(statesNames,statesNames)) ) mcB<-new("markovchain", states=c("a","b","c"), name="MCB", transitionMatrix=matrix(c(0.2,0.5,0.3,0,1,0,0.1,0.8,0.1), nrow=3, byrow=TRUE)) mcC<-new("markovchain", states=c("a","b","c","d"), name="MCC", transitionMatrix=matrix(c(0.25,0.75,0,0,0.4,0.6, 0,0,0,0,0.1,0.9,0,0,0.7,0.3), nrow=4, byrow=TRUE) ) mcList<-new("markovchainList",markovchains=list(mcA, mcB, mcC), name="Non - homogeneous Markov Chain") } \references{ A First Course in Probability (8th Edition), Sheldon Ross, Prentice Hall 2010 } \seealso{ \code{\linkS4class{markovchain}} } \author{ Giorgio Spedicato } \keyword{classes} markovchain/man/ictmc-class.Rd0000644000176200001440000000122114714756745016040 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ctmcClassesAndMethods.R \docType{class} \name{ictmc-class} \alias{ictmc-class} \alias{ictmc} \title{An S4 class for representing Imprecise Continuous Time Markovchains} \description{ An S4 class for representing Imprecise Continuous Time Markovchains } \section{Slots}{ \describe{ \item{\code{states}}{a vector of states present in the ICTMC model} \item{\code{Q}}{matrix representing the generator demonstrated in the form of variables} \item{\code{range}}{a matrix that stores values of range of variables} \item{\code{name}}{name given to ICTMC} }} markovchain/man/fitHighOrderMultivarMC.Rd0000644000176200001440000000205414714756745020165 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hommc.R \name{fitHighOrderMultivarMC} \alias{fitHighOrderMultivarMC} \title{Function to fit Higher Order Multivariate Markov chain} \usage{ fitHighOrderMultivarMC(seqMat, order = 2, Norm = 2) } \arguments{ \item{seqMat}{a matrix or a data frame where each column is a categorical sequence} \item{order}{Multivariate Markov chain order. Default is 2.} \item{Norm}{Norm to be used. Default is 2.} } \value{ an hommc object } \description{ Given a matrix of categorical sequences it fits Higher Order Multivariate Markov chain. } \examples{ data <- matrix(c('2', '1', '3', '3', '4', '3', '2', '1', '3', '3', '2', '1', c('2', '4', '4', '4', '4', '2', '3', '3', '1', '4', '3', '3')), ncol = 2, byrow = FALSE) fitHighOrderMultivarMC(data, order = 2, Norm = 2) } \references{ W.-K. Ching et al. / Linear Algebra and its Applications } \author{ Giorgio Spedicato, Deepak Yadav } markovchain/man/blanden.Rd0000644000176200001440000000150714714756745015250 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{blanden} \alias{blanden} \title{Mobility between income quartiles} \format{ An object of class \code{table} with 4 rows and 4 columns. } \source{ Personal reworking } \usage{ data(blanden) } \description{ This table show mobility between income quartiles for father and sons for the 1970 cohort born } \details{ The rows represent fathers' income quartile when the son is aged 16, whilst the columns represent sons' income quartiles when he is aged 30 (in 2000). } \examples{ data(blanden) mobilityMc<-as(blanden, "markovchain") } \references{ Jo Blanden, Paul Gregg and Stephen Machin, Intergenerational Mobility in Europe and North America, Center for Economic Performances (2005) } \keyword{datasets} markovchain/man/hommc-class.Rd0000644000176200001440000000254414714756745016055 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hommc.R \docType{class} \name{hommc-class} \alias{hommc-class} \alias{hommc} \title{An S4 class for representing High Order Multivariate Markovchain (HOMMC)} \description{ An S4 class for representing High Order Multivariate Markovchain (HOMMC) } \section{Slots}{ \describe{ \item{\code{order}}{an integer equal to order of Multivariate Markovchain} \item{\code{states}}{a vector of states present in the HOMMC model} \item{\code{P}}{array of transition matrices} \item{\code{Lambda}}{a vector which stores the weightage of each transition matrices in P} \item{\code{byrow}}{if FALSE each column sum of transition matrix is 1 else row sum = 1} \item{\code{name}}{a name given to hommc} }} \examples{ statesName <- c("a", "b") P <- array(0, dim = c(2, 2, 4), dimnames = list(statesName, statesName)) P[,,1] <- matrix(c(0, 1, 1/3, 2/3), byrow = FALSE, nrow = 2) P[,,2] <- matrix(c(1/4, 3/4, 0, 1), byrow = FALSE, nrow = 2) P[,,3] <- matrix(c(1, 0, 1/3, 2/3), byrow = FALSE, nrow = 2) P[,,4] <- matrix(c(3/4, 1/4, 0, 1), byrow = FALSE, nrow = 2) Lambda <- c(0.8, 0.2, 0.3, 0.7) ob <- new("hommc", order = 1, states = statesName, P = P, Lambda = Lambda, byrow = FALSE, name = "FOMMC") } \author{ Giorgio Spedicato, Deepak Yadav } markovchain/man/markovchain.Rd0000644000176200001440000000337214714756745016151 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/markovchain.R \docType{package} \name{markovchain-package} \alias{markovchain} \alias{markovchain-package} \title{Easy Handling Discrete Time Markov Chains} \description{ The package contains classes and method to create and manage (plot, print, export for example) discrete time Markov chains (DTMC). In addition it provide functions to perform statistical (fitting and drawing random variates) and probabilistic (analysis of DTMC proprieties) analysis } \examples{ # create some markov chains statesNames=c("a","b") mcA<-new("markovchain", transitionMatrix=matrix(c(0.7,0.3,0.1,0.9),byrow=TRUE, nrow=2, dimnames=list(statesNames,statesNames))) statesNames=c("a","b","c") mcB<-new("markovchain", states=statesNames, transitionMatrix= matrix(c(0.2,0.5,0.3,0,1,0,0.1,0.8,0.1), nrow=3, byrow=TRUE, dimnames=list(statesNames, statesNames))) statesNames=c("a","b","c","d") matrice<-matrix(c(0.25,0.75,0,0,0.4,0.6,0,0,0,0,0.1,0.9,0,0,0.7,0.3), nrow=4, byrow=TRUE) mcC<-new("markovchain", states=statesNames, transitionMatrix=matrice) mcD<-new("markovchain", transitionMatrix=matrix(c(0,1,0,1), nrow=2,byrow=TRUE)) #operations with S4 methods mcA^2 steadyStates(mcB) absorbingStates(mcB) markovchainSequence(n=20, markovchain=mcC, include=TRUE) } \references{ Discrete-Time Markov Models, Bremaud, Springer 1999 } \seealso{ Useful links: \itemize{ \item \url{https://github.com/spedygiorgio/markovchain/} \item Report bugs at \url{https://github.com/spedygiorgio/markovchain/issues} } } \author{ Giorgio Alfredo Spedicato Maintainer: Giorgio Alfredo Spedicato } \keyword{package} markovchain/man/is.irreducible.Rd0000644000176200001440000000177514714756745016557 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/probabilistic.R \name{is.irreducible} \alias{is.irreducible} \title{Function to check if a Markov chain is irreducible (i.e. ergodic)} \usage{ is.irreducible(object) } \arguments{ \item{object}{A \code{markovchain} object} } \value{ A boolean values. } \description{ This function verifies whether a \code{markovchain} object transition matrix is composed by only one communicating class. } \details{ It is based on \code{.communicatingClasses} internal function. } \examples{ statesNames <- c("a", "b") mcA <- new("markovchain", transitionMatrix = matrix(c(0.7,0.3,0.1,0.9), byrow = TRUE, nrow = 2, dimnames = list(statesNames, statesNames) )) is.irreducible(mcA) } \references{ Feres, Matlab listings for Markov Chains. } \seealso{ \code{\link{summary}} } \author{ Giorgio Spedicato } markovchain/man/committorAB.Rd0000644000176200001440000000220314714756745016057 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/probabilistic.R \name{committorAB} \alias{committorAB} \title{Calculates committor of a markovchain object with respect to set A, B} \usage{ committorAB(object,A,B,p) } \arguments{ \item{object}{a markovchain class object} \item{A}{a set of states} \item{B}{a set of states} \item{p}{initial state (default value : 1)} } \value{ Return a vector of probabilities in case initial state is not provided else returns a number } \description{ Returns the probability of hitting states rom set A before set B with different initial states } \details{ The function solves a system of linear equations to calculate probaility that the process hits a state from set A before any state from set B } \examples{ transMatr <- matrix(c(0,0,0,1,0.5, 0.5,0,0,0,0, 0.5,0,0,0,0, 0,0.2,0.4,0,0, 0,0.8,0.6,0,0.5), nrow = 5) object <- new("markovchain", states=c("a","b","c","d","e"),transitionMatrix=transMatr) committorAB(object,c(5),c(3)) } markovchain/DESCRIPTION0000644000176200001440000000554314715236602014277 0ustar liggesusersPackage: markovchain Type: Package Title: Easy Handling Discrete Time Markov Chains Version: 0.10.0 Authors@R: c( person("Giorgio Alfredo", "Spedicato", role = c("aut", "cre"), email = "spedicato_giorgio@yahoo.it",comment = c(ORCID = "0000-0002-0315-8888")), person("Tae", "Seung Kang", role = "aut"), person("Sai", "Bhargav Yalamanchi", role = "aut"), person("Mildenberger", "Thoralf", role = "ctb", comment = c(ORCID = "0000-0001-7242-1873")), person("Deepak", "Yadav", role = "aut"), person("Ignacio", "Cordón", role = "aut", comment = c(ORCID = "0000-0002-3152-0231")), person("Vandit", "Jain", role = "ctb"), person("Toni", "Giorgino", role="ctb", comment = c(ORCID = "0000-0001-6449-0596")), person("Richèl J.C.", "Bilderbeek", role = "ctb", comment = c(ORCID = "0000-0003-1107-7049")), person("Daniel", "Ebbert", email = "daniel@ebbert.nrw", role = "ctb", comment = c(ORCID = "0000-0003-3666-7205")), person("Shreyash", "Maheshwari", email = "coolshreysh1000@gmail.com", role = "ctb"), person("Reinhold", "Koch", role = "ctb") ) Maintainer: Giorgio Alfredo Spedicato Description: Functions and S4 methods to create and manage discrete time Markov chains more easily. In addition functions to perform statistical (fitting and drawing random variates) and probabilistic (analysis of their structural proprieties) analysis are provided. See Spedicato (2017) . Some functions for continuous times Markov chains depend on the suggested ctmcd package. License: MIT + file LICENSE Depends: R (>= 4.2.0), Matrix (>= 1.5-0), methods Imports: igraph, expm, stats4, parallel, Rcpp (>= 1.0.2), RcppParallel, utils, stats, grDevices Suggests: knitr, testthat, diagram, DiagrammeR, msm, Rsolnp, rmarkdown, ctmcd, bookdown, rticles Enhances: etm VignetteBuilder: rmarkdown, knitr, bookdown, rticles LinkingTo: Rcpp, RcppParallel, RcppArmadillo (>= 0.9.600.4.0) SystemRequirements: GNU make LazyLoad: yes ByteCompile: yes Encoding: UTF-8 BugReports: https://github.com/spedygiorgio/markovchain/issues URL: https://github.com/spedygiorgio/markovchain/ RoxygenNote: 7.3.2 NeedsCompilation: yes Packaged: 2024-11-13 23:26:14 UTC; Utente Author: Giorgio Alfredo Spedicato [aut, cre] (), Tae Seung Kang [aut], Sai Bhargav Yalamanchi [aut], Mildenberger Thoralf [ctb] (), Deepak Yadav [aut], Ignacio Cordón [aut] (), Vandit Jain [ctb], Toni Giorgino [ctb] (), Richèl J.C. Bilderbeek [ctb] (), Daniel Ebbert [ctb] (), Shreyash Maheshwari [ctb], Reinhold Koch [ctb] Repository: CRAN Date/Publication: 2024-11-14 00:00:02 UTC