R/RcppExports.R

Defines functions varMTTF varBMP varA varR varP matrixConvolution convolution simulateNonParam simulateParam C_rdweibull computeKernelNonParamEndcensoring getCountingNiuj getCountingProcesses getProcesses getChain setSeed

Documented in setSeed

# Generated by using Rcpp::compileAttributes() -> do not edit by hand
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

#' Set the RNG Seed from within Rcpp
#' 
#' @param seed An \code{unsigned int} that is the seed one wishes to use.
#' @return A set RNG scope.
#' @examples
#' set.seed(10)
#' x <- rnorm(5, 0, 1)
#' setSeed(10)
#' y <- rnorm(5, 0, 1)
#' all.equal(x, y, check.attributes = FALSE)
#' 
#' @export
#' 
setSeed <- function(seed) {
    invisible(.Call(`_smmR_setSeed`, seed))
}

#' Return the semi-Markov chain given the processes J and T
#' 
#' @param J A vector giving the successively visited states.
#' @param T A vector giving the successive time points.
#' @return A vector giving the reconstructed semi-Markov chain.
#' 
#' @noRd
#' 
getChain <- function(J, T) {
    .Call(`_smmR_getChain`, J, T)
}

#' Return the processes Y, J, T, L and U given the sequences of states
#' 
#' @param sequences A list of sequences of states.
#' @return A list giving the processes.
#' 
#' @noRd
#' 
getProcesses <- function(sequences) {
    .Call(`_smmR_getProcesses`, sequences)
}

#' Give the values of the counting processes Nij, Ni, Nj...
#' 
#' @param Jm A list of sequences of states.
#' @param Lm A list of sojourn time processes.
#' @param s Cardinal of the state space S.
#' @param kmax Maximum length of the sojourn times.
#' @return A list giving the counting processes.
#' 
#' @noRd
#' 
getCountingProcesses <- function(Jm, Lm, s, kmax) {
    .Call(`_smmR_getCountingProcesses`, Jm, Lm, s, kmax)
}

#' Give the values of the counting processes (cf. article 
#' Exact MLE and asymptotic properties for nonparametric semi-Markov models)
#' 
#' @param Ym A list of sequences of states.
#' @param Um A list of backward recurrence time processes.
#' @param s Cardinal of the state space S.
#' @param kmax Maximum length of the sojourn times.
#' @return A list giving the counting processes.
#' 
#' @noRd
#' 
getCountingNiuj <- function(Ym, Um, s, kmax) {
    .Call(`_smmR_getCountingNiuj`, Ym, Um, s, kmax)
}

#' Give the values of the kernel q (cf. Proposition 3.1 article 
#' Exact MLE and asymptotic properties for nonparametric semi-Markov models)
#' 
#' @param p A cube representing the transition matrix of the chain (Y, U).
#' @return A cube giving the MLE of the kernel q.
#' 
#' @noRd
#' 
computeKernelNonParamEndcensoring <- function(p) {
    .Call(`_smmR_computeKernelNonParamEndcensoring`, p)
}

#' Generate random variable from a Discrete Weibull distribution of type 1
#' 
#' @param q The first parameter, \eqn{0 < q < 1}.
#' @param beta The second parameter, \eqn{\beta > 0}.
#' @return A random variable.
#' 
#' @noRd
#' 
C_rdweibull <- function(q, beta) {
    .Call(`_smmR_C_rdweibull`, q, beta)
}

#' Simulate parametric semi-Markov chain
#' 
#' @param seed A \code{unsigned int} that is the seed one wishes to use.
#' @param nsim A vector of integers specifying the length of the sequences.
#' @param init Vector of initial distribution of length s.
#' @param ptrans Matrix of transition probabilities of the embedded Markov chain.
#' @param distr A matrix giving the conditional sojourn time distributions for
#'   each transition from the current state \eqn{i} to the next state \eqn{j}.
#'   The values of the elements of the matrix \code{distr} are:
#'   \itemize{
#'     \item 0: if the sojourn time distribution is a uniform distribution;
#'     \item 1: if the sojourn time distribution is a geometric distribution;
#'     \item 2: if the sojourn time distribution is a poisson distribution;
#'     \item 3: if the sojourn time distribution is a discrete weibull 
#'       distribution;
#'     \item 4: if the sojourn time distribution is a negative binomial 
#'       distribution.
#'   }
#' @param param1 A matrix giving the first parameters of the sojourn time 
#'   distributions.
#' @param param2 A matrix giving the second parameters (if necessary, 
#'   otherwise the value is NA) of the sojourn time distributions.
#' @param censBeg A logical value indicating whether or not sequences are 
#'   censored at the beginning.
#' @param censEnd A logical value indicating whether or not sequences are 
#'   censored at the end.
#'   
#' @return A list of vectors representing the simulated semi-Markov chains.
#' 
#' @noRd
#' 
simulateParam <- function(seed, nsim, init, ptrans, distr, param1, param2, censBeg = FALSE, censEnd = FALSE) {
    .Call(`_smmR_simulateParam`, seed, nsim, init, ptrans, distr, param1, param2, censBeg, censEnd)
}

#' Simulate nonparametric semi-Markov chain
#' 
#' @param seed A \code{unsigned int} that is the seed one wishes to use.
#' @param nsim A vector of integers specifying the length of the sequences.
#' @param init Vector of initial distribution of length s.
#' @param ptrans Matrix of transition probabilities of the embedded Markov chain.
#' @param distr A cube giving the conditional sojourn time distributions for
#'   each transition from the current state \eqn{i} to the next state \eqn{j}.
#' @param censBeg A logical value indicating whether or not sequences are 
#'   censored at the beginning.
#' @param censEnd A logical value indicating whether or not sequences are 
#'   censored at the end.
#'   
#' @return A list of vectors representing the simulated semi-Markov chains.
#' 
#' @noRd
#' 
simulateNonParam <- function(seed, nsim, init, ptrans, distr, censBeg = FALSE, censEnd = FALSE) {
    .Call(`_smmR_simulateNonParam`, seed, nsim, init, ptrans, distr, censBeg, censEnd)
}

#' Discrete-time convolution product of \eqn{f} and \eqn{g} 
#'   (See definition 2.2 p. 20)
#' 
#' @param f A vector giving the values of the function \eqn{f} for each 
#'   \eqn{k \in \mathbb{N}}.
#' @param g A vector giving the values of the function \eqn{g} for each 
#'   \eqn{k \in \mathbb{N}}.
#'   
#' @return A vector giving the values of the discrete-time convolution of 
#'   \eqn{f} and \eqn{g} for each \eqn{k \in \mathbb{N}}.
#' 
#' @noRd
#' 
convolution <- function(f, g) {
    .Call(`_smmR_convolution`, f, g)
}

#' Discrete-time matrix convolution product 
#'   (See definition 3.5 p. 48)
#' 
#' @param A A cube of dimension \eqn{(S, S, k + 1)}.
#' @param B A cube of dimension \eqn{(S, S, k + 1)}.
#'   
#' @return A cube of dimension \eqn{(S, S, k + 1)} giving the discrete-time 
#'   matrix convolution product for each \eqn{k \in \mathbb{N}}.
#' 
#' @noRd
#' 
matrixConvolution <- function(A, B) {
    .Call(`_smmR_matrixConvolution`, A, B)
}

#' Compute the variance of the estimator of the transition function P 
#'   (See equation (4.29), p.91)
#'   
#'   @details The decomposition of the variance is as follows: 
#'     \deqn{\sigma_{P}^{2}(i, j, k)) = \sum_{m = 1}^{s} \mu_{mm} \left\{ \underbrace{\sum_{r = 1}^{s} \underbrace{\left[\delta_{mj}\Psi_{ij} - \underbrace{(1 - H_{j}) * \psi_{im} * \psi_{rj}}_{\text{part11}} \right]^2}_{\text{part12}} * \ q_{mr}(k)}_{\text{part1}} - \left[ \underbrace{\delta_{mj} \psi_{ij} * H_{m}(k)}_{\text{part22}} - \underbrace{\sum_{r = 1}^{s} (1 - H_{j}) * \psi_{im} * \psi_{rj} * q_{mr}}_{\text{part21}} \right]^{2}(k) \right\}}
#'   
#' @return A cube of dimension \eqn{(S, S, k + 1)} giving the values of the 
#'   variances for each transition from \eqn{i} to \eqn{j} and each time 
#'   horizon \eqn{k \in \mathbb{N}}.
#' 
#' @noRd
#' 
varP <- function(mu, q, psi, Psi, H) {
    .Call(`_smmR_varP`, mu, q, psi, Psi, H)
}

#' Compute the variance of the estimator of the reliability R 
#'   (See equation (5.29), p.116)
#'   
#'   @details Be careful, in the formula (5.29), we use \eqn{q_{Y}} 
#'     (See proposition 5.1 p.105-106) instead of \eqn{q}, and every others 
#'     quantities such as \eqn{\psi}, \eqn{\Psi},\dots derive from \eqn{q_{Y}}.
#'     
#'   The decomposition of the variance is as follows: 
#'     \deqn{\sigma_{R}^{2}(k) = \sum_{i = 1}^{s} \mu_{ii} \left\{ \underbrace{\sum_{j = 1}^{s} \underbrace{\left[ D^{U}_{ij} - \mathbb{1}_{i \in U} \sum_{t \in U} \alpha_{t} \Psi_{ti} \right]^{2}}_{\text{part11}} * q_{ij}(k)}_{\text{part1}} - \left[ \underbrace{\sum_{j = 1}^{s} \left( \underbrace{D^{U}_{ij} * q_{ij}}_{\text{part22}} - \mathbb{1}_{i \in U} \underbrace{\sum_{t \in U} \alpha_{t} \psi_{ti} * Q_{ij}}_{\text{part21}} \right)}_{\text{part2}} \right]^{2}(k) \right\}}
#'   
#'     \deqn{D^{U}_{ij} := \sum_{n \in U} \sum_{r \in U} \alpha_{n} \psi_{ni} * \psi_{jr} * (\text{I} - diag(\text{Q.1}))_{rr}}
#'   
#' @return A vector giving the values of the variance of the reliability for 
#'   each time horizon \eqn{k \in \mathbb{N}}.
#' 
#' @noRd
#' 
varR <- function(alpha1, mu1, qy, psi, Psi, H, Q) {
    .Call(`_smmR_varR`, alpha1, mu1, qy, psi, Psi, H, Q)
}

#' Compute the variance of the estimator of the availability A
#'   (See equation (5.34), p.118)
#'   
#'   @details The decomposition of the variance is as follows: 
#'     \deqn{\sigma_{A}^{2}(k) = \sum_{i = 1}^{s} \mu_{ii} \left\{ \underbrace{\sum_{j = 1}^{s} \underbrace{\left[ D_{ij} - \mathbb{1}_{i \in U} \sum_{t = 1}^{s} \alpha_{t} \Psi_{ti} \right]^{2}}_{\text{part11}} * q_{ij}(k)}_{\text{part1}} - \left[ \underbrace{\sum_{j = 1}^{s} \left( \underbrace{D_{ij} * q_{ij}}_{\text{part22}} - \underbrace{\mathbb{1}_{i \in U} \sum_{t = 1}^{s} \alpha_{t} \psi_{ti} * Q_{ij}}_{\text{part21}} \right)}_{\text{part2}} \right]^{2}(k) \right\}}
#'   
#'     \deqn{D_{ij} := \sum_{n = 1}^{s} \sum_{r \in U} \alpha_{n} \psi_{ni} * \psi_{jr} * (\text{I} - diag(\text{Q.1}))_{rr}}
#'   
#' @return A vector giving the values of the variance of the availability for 
#'   each time horizon \eqn{k \in \mathbb{N}}.
#' 
#' @noRd
#' 
varA <- function(indices_u, alpha, mu, q, psi, Psi, H, Q) {
    .Call(`_smmR_varA`, indices_u, alpha, mu, q, psi, Psi, H, Q)
}

#' Compute the variance of the BMP-failure rate \eqn{\lambda}
#'   (See equation (5.35), p.119)
#'   
#'   @details Be careful, in the formula (5.29), we use \eqn{q_{Y}} 
#'     (See proposition 5.1 p.105-106) instead of \eqn{q}, and every others 
#'     quantities such as \eqn{\psi}, \eqn{\Psi},\dots derive from \eqn{q_{Y}}.
#'     
#'   The decomposition of the variance is as follows: 
#'     \deqn{\sigma_{1}^{2}(k) = \sum_{i = 1}^{s} \mu_{ii} \left\{ R^{2}(k) \sum_{j = 1}^{s} \underbrace{\left[ D^{U}_{ij} - \mathbb{1}_{i \in U} \sum_{t \in U} \alpha_{t} \Psi_{ti} \right]^{2}}_{\text{part11}} * q_{ij}(k - 1) + R^{2}(k - 1) \underbrace{\sum_{j = 1}^{s} \left[ D^{U}_{ij} - \mathbb{1}_{i \in U} \sum_{t \in U} \alpha_{t} \Psi_{ti} \right]^{2} * q_{ij}(k)}_{\text{part1}} - T^{2}(k) + 2 R(k - 1) R(k) \underbrace{\sum_{j = 1}^{s} \underbrace{\left[ \mathbb{1}_{i \in U} D^{U}_{ij} \sum_{t \in U} \alpha_{t} \Psi_{ti}^{+} + \mathbb{1}_{i \in U} (D^{U}_{ij})^{+} \sum_{t \in U} \alpha_{t} \Psi_{ti} - (D^{U}_{ij})^{+} D^{U}_{ij} - \mathbb{1}_{i \in U} \left( \sum_{t \in U} \alpha_{t} \Psi_{ti} \right ) \left( \sum_{t \in U} \alpha_{t} \Psi_{ti}^{+} \right ) \right]}_{\text{part21}} * q_{ij}(k - 1)}_{\text{part2}} \right\}}
#'   
#'     \deqn{T_{i}(k) := \sum_{j = 1}^{s} \left[ R(k) D^{U}_{ij} * q_{ij}(k - 1) - R(k - 1) D^{U}_{ij} * q_{ij}(k) - R(k) \mathbb{1}_{i \in U} \sum_{t \in U} \alpha_{t} \Psi_{ti} * Q_{ij}(k - 1) + R(k - 1) \mathbb{1}_{i \in U} \sum_{t \in U} \alpha_{t} \Psi_{ti} * Q_{ij}(k) \right]}
#'   
#' @return A vector giving the values of the variance of BMP-failure 
#'   rate for each time horizon \eqn{k \in \mathbb{N}}.
#' 
#' @noRd
#' 
varBMP <- function(reliab, alpha1, mu1, qy, psi, Psi, H, Q) {
    .Call(`_smmR_varBMP`, reliab, alpha1, mu1, qy, psi, Psi, H, Q)
}

#' Compute the variance of the mean time to failure (MTTF)
#'   (See Votsi & A. Brouste (2019): Confidence interval for the 
#'   mean time to failure in semi-Markov models: an application to 
#'   wind energy production, Journal of Applied Statistics, 
#'   DOI: 10.1080/02664763.2019.1566449)
#'   
#' @return A vector giving the values of the variances of the 
#'   mean time to failure for each upstate.
#' 
#' @noRd
#' 
varMTTF <- function(indices_u, indices_d, m, mu, p, q) {
    .Call(`_smmR_varMTTF`, indices_u, indices_d, m, mu, p, q)
}

Try the smmR package in your browser

Any scripts or data that you put into this service are public.

smmR documentation built on Aug. 3, 2021, 5:07 p.m.