Skip to content

Commit

Permalink
Add the function 'get.psi' to compute the matrix-valued function
Browse files Browse the repository at this point in the history
Add the function 'get.psi' to compute the matrix-valued function psi based on a given semi-Markov kernel 'q'
  • Loading branch information
Florian-Lecocq committed May 25, 2021
1 parent acfd3df commit 0af0f3e
Show file tree
Hide file tree
Showing 6 changed files with 68 additions and 37 deletions.
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -54,6 +54,7 @@ export(get.H)
export(get.P)
export(get.Py)
export(get.f)
export(get.psi)
export(get.qy)
export(getKernel)
export(is.mm)
Expand Down
2 changes: 1 addition & 1 deletion R/get.H.R
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@
}


#' Function to compute the value of \eqn{H}
#' Function to compute the value of the sojourn time cumulative distribution \eqn{H}
#'
#' @description Function to compute the value of \eqn{H} (See equation (3.4) p.46).
#'
Expand Down
44 changes: 44 additions & 0 deletions R/get.psi.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,44 @@
# Function to compute the value of \eqn{\psi}
.get.psi <- function(q) {

k <- dim(q)[3] - 1

psi <- array(data = 0, dim = c(nrow(q), ncol(q), k + 1)) # (S, S, k + 1)
psi[, , 1] <- diag(x = 1, nrow = nrow(q), ncol = ncol(q)) # k = 0

for (j in 1:k) {

psi[, , j + 1] <-
-Reduce('+', lapply(
X = 0:(j - 1),
FUN = function(l)
psi[, , l + 1] %*% (-q[, , j - l + 1])
))
}

return(psi)

}

#' Function to compute the value of the matrix-valued function \eqn{\psi}
#'
#' @description Function to compute the value of \eqn{\psi}, the matrix-valued
#' function (See equation (3.16) p.53).
#'
#' @param q An array giving the values of the kernel for a giving time horizon
#' \eqn{[0, \dots, k]} (This kernel `q` is the output of the method `getKernel`
#' or `.get.qy`).
#' @return An array giving the value of \eqn{\psi(k)} at each time between 0
#' and `k`.
#'
#' @export
#'
get.psi <- function(q) {

.is.kernel(q)

psi <- .get.psi(q)

return(psi)

}
35 changes: 0 additions & 35 deletions R/smm.R
Original file line number Diff line number Diff line change
Expand Up @@ -72,41 +72,6 @@ get.qy <- function(x, k, upstates = x$states) {
}


#' Method to compute the value of \eqn{\psi}
#'
#' @description Method to compute the value of \eqn{\psi}
#' (See equation (3.16) p.53).
#'
#' @param q An array giving the values of the kernel for a giving time horizon
#' \eqn{[0, \dots, k]} (This kernel `q` is the output of the method `getKernel`
#' or `.get.qy`).
#' @return An array giving the value of \eqn{\psi(k)} at each time between 0
#' and `k`.
#'
#' @noRd
#'
.get.psi <- function(q) {

k <- dim(q)[3] - 1

psi <- array(data = 0, dim = c(nrow(q), ncol(q), k + 1)) # (S, S, k + 1)
psi[, , 1] <- diag(x = 1, nrow = nrow(q), ncol = ncol(q)) # k = 0

for (j in 1:k) {

psi[, , j + 1] <-
-Reduce('+', lapply(
X = 0:(j - 1),
FUN = function(l)
psi[, , l + 1] %*% (-q[, , j - l + 1])
))
}

return(psi)

}


# Method to compute the value of \eqn{P}
.get.P <- function(x, k, states = x$states, var = FALSE, klim = 10000) {

Expand Down
2 changes: 1 addition & 1 deletion man/get.H.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

21 changes: 21 additions & 0 deletions man/get.psi.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit 0af0f3e

Please sign in to comment.