R/RcppExports.R

In CollinErickson/GauPro: Gaussian Process Fitting

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

Gaussian_deviance_part <- function(theta, nug, X, Z, Kinv) {
    .Call(`_GauPro_Gaussian_deviance_part`, theta, nug, X, Z, Kinv)
}

#' Calculate the Gaussian deviance in C
#' @param X Matrix X
#' @param Z Matrix Z
#' @param theta Theta vector
#' @param nug Nugget
#' @return Correlation matrix
#' @examples
#' Gaussian_devianceC(c(1,1), 1e-8, matrix(c(1,0,0,1),2,2), matrix(c(1,0),2,1))
#' @export
Gaussian_devianceC <- function(theta, nug, X, Z) {
    .Call(`_GauPro_Gaussian_devianceC`, theta, nug, X, Z)
}

#' Gaussian hessian in C
#'
#' @param XX point to find Hessian at
#' @param X matrix of data points
#' @param Z matrix of output
#' @param Kinv inverse of correlation matrix
#' @param mu_hat mean estimate
#' @param theta correlation parameters
#'
#' @return Hessian matrix
#' @export
Gaussian_hessianCC <- function(XX, X, Z, Kinv, mu_hat, theta) {
    .Call(`_GauPro_Gaussian_hessianCC`, XX, X, Z, Kinv, mu_hat, theta)
}

#' Cube multiply over first dimension
#'
#' The result is transposed since that is what apply will give you
#'
#' @param cub A cube (3D array)
#' @param v A vector
#' @return Transpose of multiplication over first dimension of cub time v
#' @examples
#' d1 <- 10
#' d2 <- 1e2
#' d3 <- 2e2
#' aa <- array(data = rnorm(d1*d2*d3), dim = c(d1, d2, d3))
#' bb <- rnorm(d3)
#' t1 <- apply(aa, 1, function(U) {U%*%bb})
#' t2 <- arma_mult_cube_vec(aa, bb)
#' dd <- t1 - t2
#'
#' summary(dd)
#' image(dd)
#' table(dd)
#' # microbenchmark::microbenchmark(apply(aa, 1, function(U) {U%*%bb}),
#' #                                arma_mult_cube_vec(aa, bb))
#' @export
arma_mult_cube_vec <- function(cub, v) {
    .Call(`_GauPro_arma_mult_cube_vec`, cub, v)
}

cholC <- function(x) {
    .Call(`_GauPro_cholC`, x)
}

solveC <- function(A, b) {
    .Call(`_GauPro_solveC`, A, b)
}

corr_cubic_matrixC <- function(x, y, theta) {
    .Call(`_GauPro_corr_cubic_matrixC`, x, y, theta)
}

#' Correlation Cubic matrix in C (symmetric)
#' @param x Matrix x
#' @param theta Theta vector
#' @return Correlation matrix
#' @export
#' @examples
#' corr_cubic_matrix_symC(matrix(c(1,0,0,1),2,2),c(1,1))
corr_cubic_matrix_symC <- function(x, theta) {
    .Call(`_GauPro_corr_cubic_matrix_symC`, x, theta)
}

corr_cubic_matrixvecC <- function(x, y, theta) {
    .Call(`_GauPro_corr_cubic_matrixvecC`, x, y, theta)
}

#' Derivative of cubic kernel covariance matrix in C
#' @param x Matrix x
#' @param theta Theta vector
#' @param C_nonug cov mat without nugget
#' @param s2_est whether s2 is being estimated
#' @param beta_est Whether theta/beta is being estimated
#' @param lenparams_D Number of parameters the derivative is being calculated for
#' @param s2_nug s2 times the nug
#' @param s2 s2
#' @return Correlation matrix
#' @export
kernel_cubic_dC <- function(x, theta, C_nonug, s2_est, beta_est, lenparams_D, s2_nug, s2) {
    .Call(`_GauPro_kernel_cubic_dC`, x, theta, C_nonug, s2_est, beta_est, lenparams_D, s2_nug, s2)
}

corr_exponential_matrixC <- function(x, y, theta) {
    .Call(`_GauPro_corr_exponential_matrixC`, x, y, theta)
}

#' Correlation Gaussian matrix in C (symmetric)
#' @param x Matrix x
#' @param theta Theta vector
#' @return Correlation matrix
#' @export
#' @examples
#' corr_gauss_matrix_symC(matrix(c(1,0,0,1),2,2),c(1,1))
corr_exponential_matrix_symC <- function(x, theta) {
    .Call(`_GauPro_corr_exponential_matrix_symC`, x, theta)
}

corr_exponential_matrixvecC <- function(x, y, theta) {
    .Call(`_GauPro_corr_exponential_matrixvecC`, x, y, theta)
}

#' Derivative of Matern 5/2 kernel covariance matrix in C
#' @param x Matrix x
#' @param theta Theta vector
#' @param C_nonug cov mat without nugget
#' @param s2_est whether s2 is being estimated
#' @param beta_est Whether theta/beta is being estimated
#' @param lenparams_D Number of parameters the derivative is being calculated for
#' @param s2_nug s2 times the nug
#' @param s2 s2 parameter
#' @return Correlation matrix
#' @export
kernel_exponential_dC <- function(x, theta, C_nonug, s2_est, beta_est, lenparams_D, s2_nug, s2) {
    .Call(`_GauPro_kernel_exponential_dC`, x, theta, C_nonug, s2_est, beta_est, lenparams_D, s2_nug, s2)
}

#' Correlation Gaussian matrix gradient in C using Armadillo
#' @param XX Matrix XX to get gradient for
#' @param X Matrix X GP was fit to
#' @param theta Theta vector
#' @param s2 Variance parameter
#' @return 3-dim array of correlation derivative
#' @examples
#' # corr_gauss_dCdX(matrix(c(1,0,0,1),2,2),c(1,1))
#' @export
corr_gauss_dCdX <- function(XX, X, theta, s2) {
    .Call(`_GauPro_corr_gauss_dCdX`, XX, X, theta, s2)
}

#' Correlation Gaussian matrix in C using Rcpp
#' @param x Matrix x
#' @param y Matrix y, must have same number of columns as x
#' @param theta Theta vector
#' @return Correlation matrix
#' @examples
#' corr_gauss_matrixC(matrix(c(1,0,0,1),2,2), matrix(c(1,0,1,1),2,2), c(1,1))
#' @export
corr_gauss_matrixC <- function(x, y, theta) {
    .Call(`_GauPro_corr_gauss_matrixC`, x, y, theta)
}

#' Correlation Gaussian matrix in C (symmetric)
#' @param x Matrix x
#' @param theta Theta vector
#' @return Correlation matrix
#' @export
#' @examples
#' corr_gauss_matrix_symC(matrix(c(1,0,0,1),2,2),c(1,1))
corr_gauss_matrix_symC <- function(x, theta) {
    .Call(`_GauPro_corr_gauss_matrix_symC`, x, theta)
}

corr_gauss_matrixvecC <- function(x, y, theta) {
    .Call(`_GauPro_corr_gauss_matrixvecC`, x, y, theta)
}

#' Correlation Gaussian matrix in C using Armadillo (symmetric)
#'
#' About 30% faster than Rcpp version.
#' @param x Matrix x
#' @param theta Theta vector
#' @return Correlation matrix
#' @examples
#' corr_gauss_matrix_sym_armaC(matrix(c(1,0,0,1),2,2),c(1,1))
#'
#' x3 <- matrix(runif(1e3*6), ncol=6)
#' th <- runif(6)
#' t3 <- corr_gauss_matrix_symC(x3, th)
#' t4 <- corr_gauss_matrix_sym_armaC(x3, th)
#' identical(t3, t4)
#' # microbenchmark::microbenchmark(corr_gauss_matrix_symC(x3, th),
#' #                     corr_gauss_matrix_sym_armaC(x3, th), times=50)
#' @export
corr_gauss_matrix_sym_armaC <- function(x, theta) {
    .Call(`_GauPro_corr_gauss_matrix_sym_armaC`, x, theta)
}

#' Correlation Gaussian matrix in C using Armadillo
#'
#' 20-25% faster than Rcpp version.
#' @param x Matrix x
#' @param y Matrix y, must have same number of columns as x
#' @param theta Theta vector
#' @param s2 Variance to multiply matrix by
#' @return Correlation matrix
#' @examples
#' corr_gauss_matrix_armaC(matrix(c(1,0,0,1),2,2),matrix(c(1,0,1,1),2,2),c(1,1))
#'
#' x1 <- matrix(runif(100*6), nrow=100, ncol=6)
#' x2 <- matrix(runif(1e4*6), ncol=6)
#' th <- runif(6)
#' t1 <- corr_gauss_matrixC(x1, x2, th)
#' t2 <- corr_gauss_matrix_armaC(x1, x2, th)
#' identical(t1, t2)
#' # microbenchmark::microbenchmark(corr_gauss_matrixC(x1, x2, th),
#' #                                corr_gauss_matrix_armaC(x1, x2, th))
#' @export
corr_gauss_matrix_armaC <- function(x, y, theta, s2 = 1.0) {
    .Call(`_GauPro_corr_gauss_matrix_armaC`, x, y, theta, s2)
}

#' Derivative of Gaussian kernel covariance matrix in C
#' @param x Matrix x
#' @param theta Theta vector
#' @param C_nonug cov mat without nugget
#' @param s2_est whether s2 is being estimated
#' @param beta_est Whether theta/beta is being estimated
#' @param lenparams_D Number of parameters the derivative is being calculated for
#' @param s2_nug s2 times the nug
#' @return Correlation matrix
#' @export
kernel_gauss_dC <- function(x, theta, C_nonug, s2_est, beta_est, lenparams_D, s2_nug) {
    .Call(`_GauPro_kernel_gauss_dC`, x, theta, C_nonug, s2_est, beta_est, lenparams_D, s2_nug)
}

#' Correlation Latent factor  matrix in C (symmetric)
#' @param x Matrix x
#' @param theta Theta vector
#' @param xindex Index to use
#' @param latentdim Number of latent dimensions
#' @param offdiagequal What to set off-diagonal values with matching values to.
#' @return Correlation matrix
#' @export
#' @examples
#' corr_latentfactor_matrix_symC(matrix(c(1,.5, 2,1.6, 1,0),ncol=2,byrow=TRUE),
#'                               c(1.5,1.8), 1, 1, 1-1e-6)
#' corr_latentfactor_matrix_symC(matrix(c(0,0,0,1,0,0,0,2,0,0,0,3,0,0,0,4),
#'                                      ncol=4, byrow=TRUE),
#'   c(0.101, -0.714, 0.114, -0.755, 0.117, -0.76, 0.116, -0.752),
#'   4, 2, 1-1e-6) * 6.85
corr_latentfactor_matrix_symC <- function(x, theta, xindex, latentdim, offdiagequal) {
    .Call(`_GauPro_corr_latentfactor_matrix_symC`, x, theta, xindex, latentdim, offdiagequal)
}

#' Correlation Latent factor  matrix in C (symmetric)
#' @param x Matrix x
#' @param y Matrix y
#' @param theta Theta vector
#' @param xindex Index to use
#' @param latentdim Number of latent dimensions
#' @param offdiagequal What to set off-diagonal values with matching values to.
#' @return Correlation matrix
#' @export
#' @examples
#' corr_latentfactor_matrixmatrixC(matrix(c(1,.5, 2,1.6, 1,0),ncol=2,byrow=TRUE),
#'                                 matrix(c(2,1.6, 1,0),ncol=2,byrow=TRUE),
#'                                 c(1.5,1.8), 1, 1, 1-1e-6)
#' corr_latentfactor_matrixmatrixC(matrix(c(0,0,0,1,0,0,0,2,0,0,0,3,0,0,0,4),
#'                                   ncol=4, byrow=TRUE),
#'                                 matrix(c(0,0,0,2,0,0,0,4,0,0,0,1),
#'                                   ncol=4, byrow=TRUE),
#'   c(0.101, -0.714, 0.114, -0.755, 0.117, -0.76, 0.116, -0.752),
#'   4, 2, 1-1e-6) * 6.85
corr_latentfactor_matrixmatrixC <- function(x, y, theta, xindex, latentdim, offdiagequal) {
    .Call(`_GauPro_corr_latentfactor_matrixmatrixC`, x, y, theta, xindex, latentdim, offdiagequal)
}

#' Derivative of covariance matrix of X with respect to kernel
#' parameters for the Latent Factor Kernel
#' @param x Matrix x
#' @param pf pf vector
#' @param C_nonug cov mat without nugget
#' @param s2_est whether s2 is being estimated
#' @param p_est Whether theta/beta is being estimated
#' @param lenparams_D Number of parameters the derivative is being calculated for
#' @param s2_nug s2 times the nug
#' @param latentdim Number of latent dimensions
#' @param xindex Which column of x is the indexing variable
#' @param nlevels Number of levels
#' @param s2 Value of s2
#' @return Correlation matrix
#' @export
kernel_latentFactor_dC <- function(x, pf, C_nonug, s2_est, p_est, lenparams_D, s2_nug, latentdim, xindex, nlevels, s2) {
    .Call(`_GauPro_kernel_latentFactor_dC`, x, pf, C_nonug, s2_est, p_est, lenparams_D, s2_nug, latentdim, xindex, nlevels, s2)
}

corr_matern32_matrixC <- function(x, y, theta) {
    .Call(`_GauPro_corr_matern32_matrixC`, x, y, theta)
}

#' Correlation Matern 3/2 matrix in C (symmetric)
#' @param x Matrix x
#' @param theta Theta vector
#' @return Correlation matrix
#' @export
#' @examples
#' corr_gauss_matrix_symC(matrix(c(1,0,0,1),2,2),c(1,1))
corr_matern32_matrix_symC <- function(x, theta) {
    .Call(`_GauPro_corr_matern32_matrix_symC`, x, theta)
}

corr_matern32_matrixvecC <- function(x, y, theta) {
    .Call(`_GauPro_corr_matern32_matrixvecC`, x, y, theta)
}

#' Derivative of Matern 5/2 kernel covariance matrix in C
#' @param x Matrix x
#' @param theta Theta vector
#' @param C_nonug cov mat without nugget
#' @param s2_est whether s2 is being estimated
#' @param beta_est Whether theta/beta is being estimated
#' @param lenparams_D Number of parameters the derivative is being calculated for
#' @param s2_nug s2 times the nug
#' @return Correlation matrix
#' @export
kernel_matern32_dC <- function(x, theta, C_nonug, s2_est, beta_est, lenparams_D, s2_nug) {
    .Call(`_GauPro_kernel_matern32_dC`, x, theta, C_nonug, s2_est, beta_est, lenparams_D, s2_nug)
}

corr_matern52_matrixC <- function(x, y, theta) {
    .Call(`_GauPro_corr_matern52_matrixC`, x, y, theta)
}

#' Correlation Gaussian matrix in C (symmetric)
#' @param x Matrix x
#' @param theta Theta vector
#' @return Correlation matrix
#' @export
#' @examples
#' corr_matern52_matrix_symC(matrix(c(1,0,0,1),2,2),c(1,1))
corr_matern52_matrix_symC <- function(x, theta) {
    .Call(`_GauPro_corr_matern52_matrix_symC`, x, theta)
}

corr_matern52_matrixvecC <- function(x, y, theta) {
    .Call(`_GauPro_corr_matern52_matrixvecC`, x, y, theta)
}

#' Derivative of Matern 5/2 kernel covariance matrix in C
#' @param x Matrix x
#' @param theta Theta vector
#' @param C_nonug cov mat without nugget
#' @param s2_est whether s2 is being estimated
#' @param beta_est Whether theta/beta is being estimated
#' @param lenparams_D Number of parameters the derivative is being calculated for
#' @param s2_nug s2 times the nug
#' @return Correlation matrix
#' @export
kernel_matern52_dC <- function(x, theta, C_nonug, s2_est, beta_est, lenparams_D, s2_nug) {
    .Call(`_GauPro_kernel_matern52_dC`, x, theta, C_nonug, s2_est, beta_est, lenparams_D, s2_nug)
}

#' Correlation ordered factor  matrix in C (symmetric)
#' @param x Matrix x
#' @param theta Theta vector
#' @param xindex Index to use
#' @param offdiagequal What to set off-diagonal values with matching values to.
#' @return Correlation matrix
#' @export
#' @examples
#' corr_orderedfactor_matrix_symC(matrix(c(1,.5, 2,1.6, 1,0),ncol=2,byrow=TRUE),
#'                               c(1.5,1.8), 1, 1-1e-6)
#' corr_orderedfactor_matrix_symC(matrix(c(0,0,0,1,0,0,0,2,0,0,0,3,0,0,0,4),
#'                                      ncol=4, byrow=TRUE),
#'   c(0.101, -0.714, 0.114, -0.755, 0.117, -0.76, 0.116, -0.752),
#'   4, 1-1e-6) * 6.85
corr_orderedfactor_matrix_symC <- function(x, theta, xindex, offdiagequal) {
    .Call(`_GauPro_corr_orderedfactor_matrix_symC`, x, theta, xindex, offdiagequal)
}

#' Correlation ordered factor matrix in C (symmetric)
#' @param x Matrix x
#' @param y Matrix y
#' @param theta Theta vector
#' @param xindex Index to use
#' @param offdiagequal What to set off-diagonal values with matching values to.
#' @return Correlation matrix
#' @export
#' @examples
#' corr_orderedfactor_matrixmatrixC(matrix(c(1,.5, 2,1.6, 1,0),ncol=2,byrow=TRUE),
#'                                 matrix(c(2,1.6, 1,0),ncol=2,byrow=TRUE),
#'                                 c(1.5,1.8), 1, 1-1e-6)
#' corr_orderedfactor_matrixmatrixC(matrix(c(0,0,0,1,0,0,0,2,0,0,0,3,0,0,0,4),
#'                                   ncol=4, byrow=TRUE),
#'                                 matrix(c(0,0,0,2,0,0,0,4,0,0,0,1),
#'                                   ncol=4, byrow=TRUE),
#'   c(0.101, -0.714, 0.114, -0.755, 0.117, -0.76, 0.116, -0.752),
#'   4, 1-1e-6) * 6.85
corr_orderedfactor_matrixmatrixC <- function(x, y, theta, xindex, offdiagequal) {
    .Call(`_GauPro_corr_orderedfactor_matrixmatrixC`, x, y, theta, xindex, offdiagequal)
}

#' Derivative of covariance matrix of X with respect to kernel
#' parameters for the Ordered Factor Kernel
#' @param x Matrix x
#' @param pf pf vector
#' @param C_nonug cov mat without nugget
#' @param s2_est whether s2 is being estimated
#' @param p_est Whether theta/beta is being estimated
#' @param lenparams_D Number of parameters the derivative is being calculated for
#' @param s2_nug s2 times the nug
#' @param xindex Which column of x is the indexing variable
#' @param nlevels Number of levels
#' @param s2 Value of s2
#' @return Correlation matrix
#' @export
kernel_orderedFactor_dC <- function(x, pf, C_nonug, s2_est, p_est, lenparams_D, s2_nug, xindex, nlevels, s2) {
    .Call(`_GauPro_kernel_orderedFactor_dC`, x, pf, C_nonug, s2_est, p_est, lenparams_D, s2_nug, xindex, nlevels, s2)
}

deviance_part <- function(theta, nug, X, Z, Kinv) {
    .Call(`_GauPro_deviance_part`, theta, nug, X, Z, Kinv)
}

devianceC <- function(theta, nug, X, Z, K) {
    .Call(`_GauPro_devianceC`, theta, nug, X, Z, K)
}

deviance_fngr_theta <- function(X, Z, K) {
    .Call(`_GauPro_deviance_fngr_theta`, X, Z, K)
}

deviance_fngr_nug <- function(X, Z, K) {
    .Call(`_GauPro_deviance_fngr_nug`, X, Z, K)
}

deviance_fngr_joint <- function(X, Z, K) {
    .Call(`_GauPro_deviance_fngr_joint`, X, Z, K)
}

deviance_grad_theta <- function(X, K, Kinv, y) {
    .Call(`_GauPro_deviance_grad_theta`, X, K, Kinv, y)
}

deviance_grad_nug <- function(X, K, Kinv, y) {
    .Call(`_GauPro_deviance_grad_nug`, X, K, Kinv, y)
}

deviance_grad_joint <- function(X, K, Kinv, y) {
    .Call(`_GauPro_deviance_grad_joint`, X, K, Kinv, y)
}

#' Calculate gradfunc in optimization to speed up.
#' NEEDS TO APERM dC_dparams
#' Doesn't need to be exported, should only be useful in functions.
#' @param dC_dparams Derivative matrix for covariance function wrt kernel parameters
#' @param Cinv Inverse of covariance matrix
#' @param Cinv_yminusmu Vector that is the inverse of C times y minus the mean.
#' @return Vector, one value for each parameter
#' @examples
#' gradfuncarray(array(dim=c(2,4,4), data=rnorm(32)), matrix(rnorm(16),4,4), rnorm(4))
#' @export
gradfuncarray <- function(dC_dparams, Cinv, Cinv_yminusmu) {
    .Call(`_GauPro_gradfuncarray`, dC_dparams, Cinv, Cinv_yminusmu)
}

pred_meanC <- function(XX, kx_xx, mu_hat, Kinv, Z) {
    .Call(`_GauPro_pred_meanC`, XX, kx_xx, mu_hat, Kinv, Z)
}

pred_var <- function(XX, kxx, kx_xx, s2_hat, Kinv, Z) {
    .Call(`_GauPro_pred_var`, XX, kxx, kx_xx, s2_hat, Kinv, Z)
}

pred_cov <- function(XX, kxx, kx_xx, s2_hat, Kinv, Z) {
    .Call(`_GauPro_pred_cov`, XX, kxx, kx_xx, s2_hat, Kinv, Z)
}

pred_meanC_mumat <- function(XX, kx_xx, mu_hatX, mu_hatXX, Kinv, Z) {
    .Call(`_GauPro_pred_meanC_mumat`, XX, kx_xx, mu_hatX, mu_hatXX, Kinv, Z)
}

pred_meanC_mumat_fast <- function(XX, kx_xx, Kinv_Z_minus_mu_hatX, mu_hatXX) {
    .Call(`_GauPro_pred_meanC_mumat_fast`, XX, kx_xx, Kinv_Z_minus_mu_hatX, mu_hatXX)
}