R/RcppExports.R

In lamortenera/kfoots: Model multivariate count data with a mixture model

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

#' Forward-backward algorithm
#'
#' Forward-backward algorithm using the scaling technique.
#' That's more stable (and maybe even faster) than the method with the logarithm.
#' Warning: this function overwrites the lliks matrix. 
#' @param initP matrix of initial probabilities: each column corresponds to a sequence
#' @param trans transition matrix (rows are previous state, columns are next state)
#' @param lliks matrix with emission probabilities for each datapoint and each state.
#' Columns are datapoints and rows are states.
#' @param seqlens length of each subsequence of datapoints (set this to ncol(lliks)
#' if there is only one sequence).
#' @param posteriors the posteriors matrix where the posteriors will be written.
#' its value when the function is called does not matter, but it needs to have
#' the right dimensions (rows are states and columns are observations).
#' @param nthreads number of threads used. Sequences of observations are
#' processed independently by different threads (if \code{length(seqlens) > 1}).
#' @return a list with the following arguments:
#'    \item{posteriors}{posterior probability of being in a certain state for a certain datapoint.
#'     Same matrix used as input argument.}
#'    \item{tot_llik}{total log-likelihood of the data given the hmm model.}
#'    \item{new_trans}{update for the transition probabilities (it is already normalized).}
#' @export
forward_backward <- function(initP, trans, lliks, seqlens, posteriors, nthreads = 1L) {
    .Call('kfoots_forward_backward', PACKAGE = 'kfoots', initP, trans, lliks, seqlens, posteriors, nthreads)
}

#' Viterbi algorithm
#'
#' Standard viterbi algorithm in the log space
#' @param initP matrix of initial probabilities: each column corresponds to a sequence
#' @param trans transition matrix (rows are previous state, columns are next state)
#' @param lliks matrix with emission probabilities for each datapoint and each state.
#' Columns are datapoints and rows are states.
#' @param seqlens length of each subsequence of datapoints (set this to ncol(lliks)
#' if there is only one sequence).
#' @return a list with the following arguments:
#'    \item{vpath}{viterbi path}
#'    \item{vllik}{log-likelihood of the viterbi path}
#' @export
viterbi <- function(initP, trans, lliks, seqlens) {
    .Call('kfoots_viterbi', PACKAGE = 'kfoots', initP, trans, lliks, seqlens)
}

testSchedule <- function(jobs, nthreads, type) {
    .Call('kfoots_testSchedule', PACKAGE = 'kfoots', jobs, nthreads, type)
}

testColPost <- function(post, m2u, nthreads) {
    .Call('kfoots_testColPost', PACKAGE = 'kfoots', post, m2u, nthreads)
}

tabFast <- function(counts) {
    .Call('kfoots_tabFast', PACKAGE = 'kfoots', counts)
}

labelCounts <- function(empirical, theoretical) {
    .Call('kfoots_labelCounts', PACKAGE = 'kfoots', empirical, theoretical)
}

clusterAverages2 <- function(counts, coords, clusters, nthreads = 1L) {
    .Call('kfoots_clusterAverages2', PACKAGE = 'kfoots', counts, coords, clusters, nthreads)
}

clusterAverages <- function(counts, clusters, nthreads = 1L) {
    .Call('kfoots_clusterAverages', PACKAGE = 'kfoots', counts, clusters, nthreads)
}

fillPosteriors <- function(coords, clusters, nclust, nthreads = 1L) {
    .Call('kfoots_fillPosteriors', PACKAGE = 'kfoots', coords, clusters, nclust, nthreads)
}

rowdotprod <- function(counts, besselCorr = TRUE, nthreads = 1L) {
    .Call('kfoots_rowdotprod', PACKAGE = 'kfoots', counts, besselCorr, nthreads)
}

discretizeRows <- function(scores, nlevels, nthreads = 1L) {
    .Call('kfoots_discretizeRows', PACKAGE = 'kfoots', scores, nlevels, nthreads)
}

splitAxes <- function(scores, nsplit, nthreads = 1L) {
    .Call('kfoots_splitAxes', PACKAGE = 'kfoots', scores, nsplit, nthreads)
}

splitAxesInt <- function(scores, nsplit, nthreads = 1L) {
    .Call('kfoots_splitAxesInt', PACKAGE = 'kfoots', scores, nsplit, nthreads)
}

KL_dist_mat <- function(nbs, r, nthreads = 1L) {
    .Call('kfoots_KL_dist_mat', PACKAGE = 'kfoots', nbs, r, nthreads)
}

findUniqueSeeds <- function(counts, permutation, k) {
    .Call('kfoots_findUniqueSeeds', PACKAGE = 'kfoots', counts, permutation, k)
}

support_openmp <- function() {
    .Call('kfoots_support_openmp', PACKAGE = 'kfoots')
}

llik2posteriors <- function(lliks, mix_coeff, posteriors, nthreads = 1L) {
    .Call('kfoots_llik2posteriors', PACKAGE = 'kfoots', lliks, mix_coeff, posteriors, nthreads)
}

#' Group unique values of a vector
#'
#' @param values a vector of integers. If they are not integers they will be
#'     casted to integers.
#' @return a list with the following items:
#'        \item{values}{unique and sorted values of \code{v}}
#'        \item{map}{a vector such that \code{v[i] = values[map[i]+1]} for every i}
#'    @export
mapToUnique <- function(values) {
    .Call('kfoots_mapToUnique', PACKAGE = 'kfoots', values)
}

getMultinomConst <- function(counts, nthreads = 1L) {
    .Call('kfoots_getMultinomConst', PACKAGE = 'kfoots', counts, nthreads)
}

getMultinomConstSW <- function(counts, nthreads = 1L) {
    .Call('kfoots_getMultinomConstSW', PACKAGE = 'kfoots', counts, nthreads)
}

sumAt <- function(values, map, size, zeroIdx = FALSE) {
    .Call('kfoots_sumAt', PACKAGE = 'kfoots', values, map, size, zeroIdx)
}

colSumsInt <- function(nums, nthreads = 1L) {
    .Call('kfoots_colSumsInt', PACKAGE = 'kfoots', nums, nthreads)
}

colSumsDouble <- function(nums, nthreads = 1L) {
    .Call('kfoots_colSumsDouble', PACKAGE = 'kfoots', nums, nthreads)
}

rowSumsDouble <- function(mat, nthreads = 1L) {
    .Call('kfoots_rowSumsDouble', PACKAGE = 'kfoots', mat, nthreads)
}

lLikMat <- function(counts, models, ucs, mConst, lliks, nthreads = 1L) {
    invisible(.Call('kfoots_lLikMat', PACKAGE = 'kfoots', counts, models, ucs, mConst, lliks, nthreads))
}

lLikGapMat <- function(counts, models, ucs, mConst, lliks, nthreads = 1L) {
    invisible(.Call('kfoots_lLikGapMat', PACKAGE = 'kfoots', counts, models, ucs, mConst, lliks, nthreads))
}

pwhichmax <- function(posteriors, nthreads = 1L) {
    .Call('kfoots_pwhichmax', PACKAGE = 'kfoots', posteriors, nthreads)
}

fitNB_inner <- function(counts, posteriors, initR = -1, tol = 1e-8, nthreads = 1L) {
    .Call('kfoots_fitNB_inner', PACKAGE = 'kfoots', counts, posteriors, initR, tol, nthreads)
}

fitModels <- function(counts, posteriors, models, ucs, type = "indep", tol = 1e-8, nthreads = 1L) {
    .Call('kfoots_fitModels', PACKAGE = 'kfoots', counts, posteriors, models, ucs, type, tol, nthreads)
}

fitModelsGapMat <- function(counts, posteriors, models, ucs, type = "indep", tol = 1e-8, nthreads = 1L) {
    .Call('kfoots_fitModelsGapMat', PACKAGE = 'kfoots', counts, posteriors, models, ucs, type, tol, nthreads)
}

checkInterrupt <- function() {
    invisible(.Call('kfoots_checkInterrupt', PACKAGE = 'kfoots'))
}