R/RcppExports.R

In PennStateDEPENdLab/dependlab: Useful functions for the UNC Chapel Hill DEPENd Lab (Director: Michael Hallquist)

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

#' Internal function to convolve two vectors using nested for loop
#'
#' @name convolve_cpp
#' @param a A vector
#' @param b A vector
#' @return A vector containing the convolution of a and b
#'
#' @details This is an internal function
#'       Same result as, in R:
#'       convolve(a, b, conj=TRUE, type="open")
NULL

#' @author Dirk Eddelbuettel
NULL

convolve_cpp <- function(a, b) {
    .Call(`_dependlab_convolve_cpp`, a, b)
}

#' This function convolves a stimulus vector with the double-gamma hrf
#'
#' @name convolve_double_gamma
#' @param x A vector of volume numbers used to evaluate the function at each value
#' @param a1 The a1 parameter of the double gamma
#' @param a2 The a2 parameter of the double gamma
#' @param b1 The b1 parameter of the double gamma
#' @param b2 The b2 parameter of the double gamma
#' @param cc The cc parameter of the double gamma
#' @return A vector of the double-gamma HRF at each value of \code{x}
#'
#' @details This is an internal function that is used by convolve_hrf
#' @author Michael Hallquist
NULL

convolve_double_gamma <- function(stimulus, a1 = 6.0, a2 = 12.0, b1 = 0.9, b2 = 0.9, cc = 0.35) {
    .Call(`_dependlab_convolve_double_gamma`, stimulus, a1, a2, b1, b2, cc)
}

#' Internal function to convolve two vectors using FFT
#'
#' @name convolve_fft_cpp
#' @param a A vector
#' @param b A vector
#' @return A vector containing the convolution of a and b
#'
#' @details This is an internal function
#'       Same result as, in R:
#'       convolve(a, b, conj=TRUE, type="open")
NULL

#' @author Michael Hallquist
NULL

convolve_fft_cpp <- function(a, b) {
    .Call(`_dependlab_convolve_fft_cpp`, a, b)
}

#' C++ port of Bush and Cisler 2013, Magnetic Resonance Imaging
#' Adapted from the original provided by Keith Bush
#' as well as C++ code from Jiang Bian
#'
#' @name deconvolve_nlreg
#' @param BOLDobs matrix of observed BOLD timeseries (n_timepoints x n_signals)
#' @param kernel  assumed kernel of the BOLD signal (e.g., from spm_hrf)
#' @param nev_lr  learning rate for the assignment of neural events. Default: .01
#' @param epsilon relative error change (termination condition). Default: .005
#' @param beta slope of the sigmoid transfer function (higher = more nonlinear)
#' @param normalize whether to unit-normalize (z-score) \code{BOLDobs} before deconvolution. Default: TRUE
#' @param trim_kernel whether to remove the first K time points from the deconvolved vector, corresponding to
#'            kernel leftovers from convolution. Default: TRUE
#'
#' @details
#' This function deconvolves the BOLD signal using Bush 2011 method
#'
#' Author:      Keith Bush, PhD
#' Institution: University of Arkansas at Little Rock
#' Date:        Aug. 9, 2013
#'
#' The original code did not unit normalize the BOLD signal in advance, but in my testing, this
#' proves useful in many cases (unless you want to mess with the learning rate a lot), especially
#' when the time series has a non-zero mean (e.g., mean 100).
#'
#' @return A time series of the same length containing reconstructed neural events
#' @author Michael Hallquist
#' @export
NULL

deconvolve_nlreg <- function(BOLDobs, kernel, nev_lr = .01, epsilon = .005, beta = 40, normalize = TRUE, trim_kernel = TRUE) {
    .Call(`_dependlab_deconvolve_nlreg`, BOLDobs, kernel, nev_lr, epsilon, beta, normalize, trim_kernel)
}

#' Dsigmoid transform
#'
#' @name dsigmoid
#' @param x value to be transformed
#' @param beta slope (steepness) of sigmoid transform
#' @keywords internal
NULL

dsigmoid <- function(x, beta = 1) {
    .Call(`_dependlab_dsigmoid`, x, beta)
}

#' This function creates K shifts of a neural events vector according to the kernel length, K.
#'
#' @name generate_feature
#' @param encoding The neural events vector (same length as BOLD time series)
#' @param K The length of the kernel
#' @return A matrix of length(encoding) rows and K columns, where each column contains a successively
#'    lagged copy of the encoding vector
#'
#' @details This is an internal function that is used inside a while loop by deconvolve_nlreg.
#'   Profiling of the algorithm revealed that this is the primary bottleneck, so I ported it to
#'   an Rcpp function
#' @author Michael Hallquist
NULL

generate_feature <- function(encoding, K) {
    .Call(`_dependlab_generate_feature`, encoding, K)
}

#' This function creates K shifts of a neural events vector according to the kernel length, K.
#'
#' @name generate_feature_armadillo
#' @param encoding The neural events vector (same length as BOLD time series)
#' @param K The length of the kernel
#' @return A matrix of length(encoding) rows and K columns, where each column contains a successively
#'    lagged copy of the encoding vector
#'
#' @details This is an internal function that is used inside a while loop by deconvolve_nlreg.
#'   Profiling of the algorithm revealed that this is the primary bottleneck, so I ported it to
#'   an Rcpp function
#' @author Michael Hallquist
NULL

generate_feature_armadillo <- function(encoding, K) {
    .Call(`_dependlab_generate_feature_armadillo`, encoding, K)
}

#' Sigmoid transform
#'
#' @name sigmoid
#' @param x value to be transformed by sigmoid
#' @param beta beta slope (steepness) of sigmoid transform
#'
#' @keywords internal
NULL

sigmoid <- function(x, beta = 1) {
    .Call(`_dependlab_sigmoid`, x, beta)
}