R/RcppExports.R

In Marie-PerrotDockes/sanssouci.hmm: Confindence bound on the FDP after post-selection under an HMM

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

#' Perform the forward backward algorithm (see Rabiner 89)
#'
#' @param m the number of positions (hypothesis)
#' @param A a matrix 2 * 2 the transition probabilities
#' @param f0x a vector of the values of the density under the null hypothesis on the observations
#' @param f1x a vector of the values of the density under the alternative hypothesis on the observations
#' @param Pi a vector of the initial state probabilities
#'
#' @return alpha the forward variables, the lines corespond to the position, the first column is for state 0 and the second for state one
#' @return beta the backward variables (same as alpha)
#' @return gamma  matrix such that gamma\[i , 0\] = \eqn{P(\theta_i = 0 | X)}, gamma\[i,1\]  = \eqn{P(\theta_i = 1 | X)}
#' @return ksi  matrix such that ksi\[i , 0\] = \eqn{P(\theta_i = 0 | X)}, ksi\[i,1\]  = \eqn{P(\theta_i = 1 | X)}
#' @export
#'
#' @examples
#'  m <-  10
#'  A <- matrix(c(0.95, 0.05, 0.2, 0.80), 2, 2, byrow = T)
#'  f0 <- c(0, 1)
#'  f1 <- c(2, 1)
#'  Pi <- c( 0.9, 0.1)
#'  rdata <- sim_hmm_2states(m, Pi, A, f0, f1)
#'  x <- rdata$x
#'  theta <- rdata$theta
#'  mod <- for_back(m, A, f0x = dnorm(x), f1x = dnorm(x, 1,2), Pi)
for_back <- function(m, A, f0x, f1x, Pi) {
    .Call('_hmm_sanssouci_for_back', PACKAGE = 'hmm.sanssouci', m, A, f0x, f1x, Pi)
}

#' Use EM algorithm to estimate the parameters A and Pi of an HMM
#'
#' @param m the number of positions (hypothesis)
#' @param alpha a matrix m * 2  containing the forward variables
#' @param beta a matrix m * 2  containing the backward variables
#' @param A a matrix 2 * 2 the transition probabilities
#' @param f0x a vector of the values of the density under the null hypothesis on the observations
#' @param f1x a vector of the values of the density under the alternative hypothesis on the observations
#' @param Pi a vector of the initial state probabilities
#' @param eps the value ta reach for the convergence
#' @param maxit integer, the maximum number of iteration
#'
#' @return Product of matrices
#' @export
#'
#' @examples
#'  m <-  10
#'  A <- matrix(c(0.95, 0.05, 0.2, 0.80), 2, 2, byrow = T)
#'  f0 <- c(0, 1)
#'  f1 <- c(2, 1)
#'  Pi <- c( 0.9, 0.1)
#'  rdata <- simulate.data.hmm.2states(m, Pi, A, f0, f1)
#'  x <- rdata$x
#'  theta <- rdata$theta
#'  mod <- for_back(m, A, f0x, f1x, Pi)
#'  f0x <- dnorm(x, f0[1], f0[2])
#'  f1x <- dnorm(x, f1[1], f1[2])
#'  alpha <- mod$alpha
#'  beta <- mod$beta
Em_hmm <- function(m, A, f0x, f1x, Pi, eps, maxit) {
    .Call('_hmm_sanssouci_Em_hmm', PACKAGE = 'hmm.sanssouci', m, A, f0x, f1x, Pi, eps, maxit)
}

#' Use EM algorithm to estimate the parameters A and Pi of an HMM
#'
#' @param m the number of positions (hypothesis)
#' @param alpha a matrix m * 2  containing the forward variables
#' @param beta a matrix m * 2  containing the backward variables
#' @param A a matrix 2 * 2 the transition probabilities
#' @param f0x a vector of the values of the density under the null hypothesis on the observations
#' @param f1x a vector of the values of the density under the alternative hypothesis on the observations
#' @param Pi a vector of the initial state probabilities
#' @param eps the value ta reach for the convergence
#' @param maxit integer, the maximum number of iteration
#'
#' @return Product of matrices
#' @export
#'
#' @examples
#'  m <-  10
#'  A <- matrix(c(0.95, 0.05, 0.2, 0.80), 2, 2, byrow = T)
#'  f0 <- c(0, 1)
#'  f1 <- c(2, 1)
#'  Pi <- c( 0.9, 0.1)
#'  rdata <- simulate.data.hmm.2states(m, Pi, A, f0, f1)
#'  x <- rdata$x
#'  theta <- rdata$theta
#'  mod <- for_back(m, A, f0x, f1x, Pi)
#'  f0x <- dnorm(x, f0[1], f0[2])
#'  f1x <- dnorm(x, f1[1], f1[2])
#'  alpha <- mod$alpha
#'  beta <- mod$beta
Em_f1 <- function(m, A, Pi, f0x, f1x, fw_bc_EM, x, eps, maxit, h) {
    .Call('_hmm_sanssouci_Em_f1', PACKAGE = 'hmm.sanssouci', m, A, Pi, f0x, f1x, fw_bc_EM, x, eps, maxit, h)
}

#' Use EM algorithm to estimate the parameters A  Pi and f1 of an HMM
#'
#' @param m the number of positions (hypothesis)
#' @param alpha a matrix m * 2  containing the forward variables
#' @param beta a matrix m * 2  containing the backward variables
#' @param A a matrix 2 * 2 the transition probabilities
#' @param f0x a vector of the values of the density under the null hypothesis on the observations
#' @param f1x a vector of the values of the density under the alternative hypothesis on the observations
#' @param Pi a vector of the initial state probabilities
#' @param eps the value ta reach for the convergence
#' @param maxit integer, the maximum number of iteration
#'
#' @return Product of matrices
#' @export
#'
#' @examples
#'  m <-  10
#'  A <- matrix(c(0.95, 0.05, 0.2, 0.80), 2, 2, byrow = T)
#'  f0 <- c(0, 1)
#'  f1 <- c(2, 1)
#'  Pi <- c( 0.9, 0.1)
#'  rdata <- simulate.data.hmm.2states(m, Pi, A, f0, f1)
#'  x <- rdata$x
#'  theta <- rdata$theta
#'  mod <- for_back(m, A, f0x, f1x, Pi)
#'  f0x <- dnorm(x, f0[1], f0[2])
#'  f1x <- dnorm(x, f1[1], f1[2])
#'  alpha <- mod$alpha
#'  beta <- mod$beta
Em_tot <- function(m, A, Pi, f0x, f1x, x, eps, maxit, h) {
    .Call('_hmm_sanssouci_Em_tot', PACKAGE = 'hmm.sanssouci', m, A, Pi, f0x, f1x, x, eps, maxit, h)
}

#' Use EM algorithm to estimate the parameters A and Pi of an HMM
#'
#' @param m the number of positions (hypothesis)
#' @param alpha a matrix m * 2  containing the forward variables
#' @param beta a matrix m * 2  containing the backward variables
#' @param A a matrix 2 * 2 the transition probabilities
#' @param f0x a vector of the values of the density under the null hypothesis on the observations
#' @param f1x a vector of the values of the density under the alternative hypothesis on the observations
#' @param Pi a vector of the initial state probabilities
#' @param eps the value ta reach for the convergence
#' @param maxit integer, the maximum number of iteration
#'
#' @return Product of matrices
#' @export
#'
#' @examples
#'  m <-  10
#'  A <- matrix(c(0.95, 0.05, 0.2, 0.80), 2, 2, byrow = T)
#'  f0 <- c(0, 1)
#'  f1 <- c(2, 1)
#'  Pi <- c( 0.9, 0.1)
#'  rdata <- simulate.data.hmm.2states(m, Pi, A, f0, f1)
#'  x <- rdata$x
#'  theta <- rdata$theta
#'  mod <- for_back(m, A, f0x, f1x, Pi)
#'  f0x <- dnorm(x, f0[1], f0[2])
#'  f1x <- dnorm(x, f1[1], f1[2])
#'  alpha <- mod$alpha
#'  beta <- mod$beta
Em_tot_01 <- function(m, A, Pi, f0x, f1x, x, eps, maxit, h) {
    .Call('_hmm_sanssouci_Em_tot_01', PACKAGE = 'hmm.sanssouci', m, A, Pi, f0x, f1x, x, eps, maxit, h)
}

#' Simple matrix multiplication
#'
#' @param m the number of positions (hypothesis)
#' @param alpha a matrix m * 2  containing the forward variables
#' @param beta a matrix m * 2  containing the backward variables
#' @param A a matrix 2 * 2 the transition probabilities
#' @param f0x a vector of the values of the density under the null hypothesis on the observations
#' @param f1x a vector of the values of the density under the alternative hypothesis on the observations
#' @param i the position (hypothesis) for wich we want the posterior transition matrix.
#' @return Product of matrices
#' @export
#'
#' @examples
#' A <- matrix(1:9, 3, 3)
#' B <- matrix(11:19, 3, 3)
#' matrix_mult_cpp(A, B)
get_A_old <- function(m, alpha, beta, A, f0x, f1x, i) {
    .Call('_hmm_sanssouci_get_A_old', PACKAGE = 'hmm.sanssouci', m, alpha, beta, A, f0x, f1x, i)
}

#' Simple matrix multiplication
#'
#' @param m the number of positions (hypothesis)
#' @param alpha a matrix m * 2  containing the forward variables
#' @param beta a matrix m * 2  containing the backward variables
#' @param A a matrix 2 * 2 the transition probabilities
#' @param f0x a vector of the values of the density under the null hypothesis on the observations
#' @param f1x a vector of the values of the density under the alternative hypothesis on the observations
#' @param i the position (hypothesis) for wich we want the posterior transition matrix.
#' @return Product of matrices
#' @export
#'
#' @examples
#' m <-  100
#' A <- matrix(c(0.95, 0.05, 0.2, 0.80), 2, 2, byrow = T)
#'   rdata <- sim_hmm_2states(m, Pi, A, f0 = c(0,1), f1= c(2,1))
#'  x <- rdata$x
#'  f0x <- dnorm(x)
#'  f1x <- dnorm(x, 1,2)
#'   mod <- for_back(m, A, f0x, f1x, Pi)
#'     Pis_est <- lapply(2:m, function(i){
#'  get_A( m,alpha = mod$alpha, beta = mod$beta, A, f0x, 
#'         f1x, i = i)
#'  })
#' Pis_est2 <- lapply(2:m, function(i){
#'  get_A_old( m,alpha = mod$alpha, beta = mod$beta, A, f0x, 
#'         f1x, i = i)
#'  })
get_A <- function(m, alpha, beta, A, f0x, f1x, i) {
    .Call('_hmm_sanssouci_get_A', PACKAGE = 'hmm.sanssouci', m, alpha, beta, A, f0x, f1x, i)
}

#' Simple matrix multiplication
#'
#' @param m the number of positions (hypothesis)
#' @param alpha a matrix m * 2  containing the forward variables
#' @param beta a matrix m * 2  containing the backward variables
#' @param A a matrix 2 * 2 the transition probabilities
#' @param f0x a vector of the values of the density under the null hypothesis on the observations
#' @param f1x a vector of the values of the density under the alternative hypothesis on the observations
#'
#' @return Product of matrices
#' @export
#'
#' @examples
#' A <- matrix(1:9, 3, 3)
#' B <- matrix(11:19, 3, 3)
#' matrix_mult_cpp(A, B)
get_L1 <- function(A, m, alpha, beta, f0x, f1x) {
    .Call('_hmm_sanssouci_get_L1', PACKAGE = 'hmm.sanssouci', A, m, alpha, beta, f0x, f1x)
}

#' New way of finding Bin ! (Now A)
#'
#' @param A a matrix 2 * 2 the transition probabilities
#' @param m the number of positions (hypothesis)
#' @param alpha a matrix m * 2  containing the forward variables
#' @param beta a matrix m * 2  containing the backward variables
#' @param f0x a vector of the values of the density under the null hypothesis on the observations
#' @param f1x a vector of the values of the density under the alternative hypothesis on the observations
#'
#' @return Product of matrices
#' @export
#'
#' @examples
#' A <- matrix(1:9, 3, 3)
#' B <- matrix(11:19, 3, 3)
#' matrix_mult_cpp(A, B)
getA01 <- function(m, li0, f0x, f1x, Pis) {
    .Call('_hmm_sanssouci_getA01', PACKAGE = 'hmm.sanssouci', m, li0, f0x, f1x, Pis)
}

#' New way of finding Bin ! (Now A)
#'
#' @param A a matrix 2 * 2 the transition probabilities
#' @param m the number of positions (hypothesis)
#' @param alpha a matrix m * 2  containing the forward variables
#' @param beta a matrix m * 2  containing the backward variables
#' @param f0x a vector of the values of the density under the null hypothesis on the observations
#' @param f1x a vector of the values of the density under the alternative hypothesis on the observations
#'
#' @return Product of matrices
#' @export
#'
#' @examples
#' A <- matrix(1:9, 3, 3)
#' B <- matrix(11:19, 3, 3)
#' matrix_mult_cpp(A, B)
getbound <- function(m, alpha, li0, f0x, f1x, Pis) {
    .Call('_hmm_sanssouci_getbound', PACKAGE = 'hmm.sanssouci', m, alpha, li0, f0x, f1x, Pis)
}

#' New way of finding Bin ! (Now A)
#'
#' @param A a matrix 2 * 2 the transition probabilities
#' @param m the number of positions (hypothesis)
#' @param alpha a matrix m * 2  containing the forward variables
#' @param beta a matrix m * 2  containing the backward variables
#' @param f0x a vector of the values of the density under the null hypothesis on the observations
#' @param f1x a vector of the values of the density under the alternative hypothesis on the observations
#'
#' @return Product of matrices
#' @export
#'
#' @examples
#' m <-  100
#' A <- matrix(c(0.95, 0.05, 0.2, 0.80), 2, 2, byrow = T)
#'   rdata <- sim_hmm_2states(m, Pi, A, f0 = c(0,1), f1= c(2,1))
#'  x <- rdata$x
#'  f0x <- dnorm(x)
#'  f1x <- dnorm(x, 1,2)
#'   mod <- for_back(m, A, f0x, f1x, Pi)
#'     Pis_est <- lapply(2:m, function(i){
#'  get_A( m,alpha = mod$alpha, beta = mod$beta, A, f0x, 
#'         f1x, i = i)
#'  })
#'  alpha <- 0.1
#' getIC(length(x), alpha, mod$gamma[,1], f0x, f1x, Pis_est)
#' quant <- get_quantiles(sel = 1:m, li0 = mod$gamma[, 1], 
#'  Pis = Pis_est, f0x = f0x, f1x = f1x)
#'  borne(type_borne = "HMM", sel = 1:m, a = quant, alpha )
#'  borne(type_borne = "HMM_small", sel = 1:m, a = quant, alpha)
getIC <- function(m, alpha, li0, f0x, f1x, Pis) {
    .Call('_hmm_sanssouci_getIC', PACKAGE = 'hmm.sanssouci', m, alpha, li0, f0x, f1x, Pis)
}

#' New way of finding Bin ! (Now A)
#'
#' @param A a matrix 2 * 2 the transition probabilities
#' @param m the number of positions (hypothesis)
#' @param alpha a matrix m * 2  containing the forward variables
#' @param beta a matrix m * 2  containing the backward variables
#' @param f0x a vector of the values of the density under the null hypothesis on the observations
#' @param f1x a vector of the values of the density under the alternative hypothesis on the observations
#'
#' @return Product of matrices
#' @export
#'
#' @examples
#' m <-  100
#' A <- matrix(c(0.95, 0.05, 0.2, 0.80), 2, 2, byrow = T)
#'   rdata <- sim_hmm_2states(m, Pi, A, f0 = c(0,1), f1= c(2,1))
#'  x <- rdata$x
#'  f0x <- dnorm(x)
#'  f1x <- dnorm(x, 1,2)
#'   mod <- for_back(m, A, f0x, f1x, Pi)
#'     Pis_est <- lapply(2:m, function(i){
#'  get_A( m,alpha = mod$alpha, beta = mod$beta, A, f0x, 
#'         f1x, i = i)
#'  })
#'  alpha <- 0.1
#' getIC(length(x), alpha, mod$gamma[,1], f0x, f1x, Pis_est)
#' quant <- get_quantiles(sel = 1:m, li0 = mod$gamma[, 1], 
#'  Pis = Pis_est, f0x = f0x, f1x = f1x)
#'  borne(type_borne = "HMM", sel = 1:m, a = quant, alpha )
#'  borne(type_borne = "HMM_small", sel = 1:m, a = quant, alpha)
getprobs <- function(m, prob, size_prob, petit_grand, li0, f0x, f1x, Pis) {
    .Call('_hmm_sanssouci_getprobs', PACKAGE = 'hmm.sanssouci', m, prob, size_prob, petit_grand, li0, f0x, f1x, Pis)
}

rcpparma_hello_world <- function() {
    .Call('_hmm_sanssouci_rcpparma_hello_world', PACKAGE = 'hmm.sanssouci')
}

rcpparma_outerproduct <- function(x) {
    .Call('_hmm_sanssouci_rcpparma_outerproduct', PACKAGE = 'hmm.sanssouci', x)
}

rcpparma_innerproduct <- function(x) {
    .Call('_hmm_sanssouci_rcpparma_innerproduct', PACKAGE = 'hmm.sanssouci', x)
}

rcpparma_bothproducts <- function(x) {
    .Call('_hmm_sanssouci_rcpparma_bothproducts', PACKAGE = 'hmm.sanssouci', x)
}

#' Simple matrix multiplication
#'
#' @param A Matrix
#' @param B Matrix
#'
#' @return Product of matrices
#' @export
#'
#' @examples
#' A <- matrix(1:9, 3, 3)
#' B <- matrix(11:19, 3, 3)
#' matrix_mult_cpp(A, B)
sim_markov <- function(m, Pi, A) {
    .Call('_hmm_sanssouci_sim_markov', PACKAGE = 'hmm.sanssouci', m, Pi, A)
}

#' Simulate a processus from  an heterogeneuous markov chain. This heterogeneous markov Chain is the low of the state of an HMM given the obervation.
#'
#' @param alpha a matrix m * 2  containing the forward variables
#' @param beta a matrix m * 2  containing the backward variables
#' @param A a matrix 2 * 2 the transition probabilities
#' @param f0x a vector of the values of the density under the null hypothesis on the observations
#' @param f1x a vector of the values of the density under the alternative hypothesis on the observations
#' @param Pi vector of the initial state probabilities for each state.
#'
#' @return Product of matrices
#' @export
#'
#' @examples
#'  m <-  10
#'  A <- matrix(c(0.95, 0.05, 0.2, 0.80), 2, 2, byrow = T)
#'  f0 <- c(0, 1)
#'  f1 <- c(2, 1)
#'  Pi <- c( 0.9, 0.1)
#'  rdata <- simulate.data.hmm.2states(m, Pi, A, f0, f1)
#'  x <- rdata$x
#'  theta <- rdata$theta
#'  mod <- for_back(m, A, f0x, f1x, Pi)
#'  f0x <- dnorm(x, f0[1], f0[2])
#'  f1x <- dnorm(x, f1[1], f1[2])
#'  alpha <- mod$alpha
#'  beta <- mod$beta
#'  sim_x_kn(m, alpha, beta, A, Pi, f0x, f1x)
sim_x_kn <- function(m, alpha, beta, A, Pi, f0x, f1x) {
    .Call('_hmm_sanssouci_sim_x_kn', PACKAGE = 'hmm.sanssouci', m, alpha, beta, A, Pi, f0x, f1x)
}

#' Perform the forward backward algorithm (see Rabiner 89)
#'
#' @param m the number of positions (hypothesis)
#' @param A a matrix 2 * 2 the transition probabilities
#' @param f0x a vector of the values of the density under the null hypothesis on the observations
#' @param f1x a vector of the values of the density under the alternative hypothesis on the observations
#' @param Pi a vector of the initial state probabilities
#'
#' @return alpha the forward variables, the lines corespond to the position, the first column is for state 0 and the second for state one
#' @return beta the backward variables (same as alpha)
#' @return gamma  matrix such that gamma\[i , 0\] = \eqn{P(\theta_i = 0 | X)}, gamma\[i,1\]  = \eqn{P(\theta_i = 1 | X)}
#' @return ksi  matrix such that ksi\[i , 0\] = \eqn{P(\theta_i = 0 | X)}, ksi\[i,1\]  = \eqn{P(\theta_i = 1 | X)}
#' @export
#'
#' @examples
#'  m <-  10
#'  A <- matrix(c(0.95, 0.05, 0.2, 0.80), 2, 2, byrow = T)
#'  f0 <- c(0, 1)
#'  f1 <- c(2, 1)
#'  Pi <- c( 0.9, 0.1)
#'  rdata <- simulate.data.hmm.2states(m, Pi, A, f0, f1)
#'  x <- rdata$x
#'  theta <- rdata$theta
#'  mod <- for_back(m, A, f0x, f1x, Pi)
viterbi <- function(m, A, f0x, f1x, Pi) {
    .Call('_hmm_sanssouci_viterbi', PACKAGE = 'hmm.sanssouci', m, A, f0x, f1x, Pi)
}

#' Perform the forward backward algorithm (see Rabiner 89)
#'
#' @param m the number of positions (hypothesis)
#' @param A a matrix 2 * 2 the transition probabilities
#' @param f0x a vector of the values of the density under the null hypothesis on the observations
#' @param f1x a vector of the values of the density under the alternative hypothesis on the observations
#' @param Pi a vector of the initial state probabilities
#'
#' @return alpha the forward variables, the lines corespond to the position, the first column is for state 0 and the second for state one
#' @return beta the backward variables (same as alpha)
#' @return gamma  matrix such that gamma\[i , 0\] = \eqn{P(\theta_i = 0 | X)}, gamma\[i,1\]  = \eqn{P(\theta_i = 1 | X)}
#' @return ksi  matrix such that ksi\[i , 0\] = \eqn{P(\theta_i = 0 | X)}, ksi\[i,1\]  = \eqn{P(\theta_i = 1 | X)}
#' @export
#'
#' @examples
#'  m <-  10
#'  A <- matrix(c(0.95, 0.05, 0.2, 0.80), 2, 2, byrow = T)
#'  f0 <- c(0, 1)
#'  f1 <- c(2, 1)
#'  Pi <- c( 0.9, 0.1)
#'  rdata <- simulate.data.hmm.2states(m, Pi, A, f0, f1)
#'  x <- rdata$x
#'  theta <- rdata$theta
#'  mod <- for_back(m, A, f0x, f1x, Pi)
viterbi_log <- function(m, A_log, f0x_log, f1x_log, Pi_log) {
    .Call('_hmm_sanssouci_viterbi_log', PACKAGE = 'hmm.sanssouci', m, A_log, f0x_log, f1x_log, Pi_log)
}