R/RcppExports.R

Defines functions .optimize_nugget_cpp .invchol_cpp .fitGLS_cpp .crosspart_worker_cpp

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

#' Worker function 2 for partitioned GLS
#'
#' @details this is the second worker function for the partitioned GLS analysis.
#'
#' NOTE: currently, there is no parallel functionality and the partitioned
#' form of the GLS is not implemented entirely in C++. Instead, the R function
#' fitGLS.partition_rcpp() weaves between R and C++ on a single core. While
#' this method is still much faster than the purely R implementation, migration
#' to entirely C++ will greatly improve speed further. This migration requires
#' calculating geographic distances with C++ which I've not yet written.
#'
#' Additionally, there seems to be a memory-related issue with this code. I've
#' successfully used this function when partitions have 100 or fewer rows (too
#' small). However, larger partitions cause a fatal error that causes a crash.
#'
#' @param xxi numeric matrix xx from  partition i
#' @param xxj numeric matrix xx from  partition j
#' @param xxi0 numeric matrix xx0 from  partition i
#' @param xxj0 numeric matrix xx0 from  partition j
#' @param invCholV_i numeric matrix invcholV from  partition i
#' @param invCholV_j numeric matrix invcholV from  partition j
#' @param Vsub numeric variance matrix for Xij (upper block)
#' @param nug_i nugget from partition i
#' @param nug_j nugget from partition j
#' @param df1 first degree of freedom
#' @param df2 second degree of freedom
#' @param Vcoef logical indicating if the coefficient covariance matrix
#' should be returned
#' @param ncores integer indicating nubmer of cores to use
#'
.crosspart_worker_cpp <- function(xxi, xxj, xxi0, xxj0, invCholV_i, invCholV_j, Vsub, nug_i, nug_j, df1, df2, Vcoef, ncores) {
    .Call(`_remotePARTS_crosspart_worker_cpp`, xxi, xxj, xxi0, xxj0, invCholV_i, invCholV_j, Vsub, nug_i, nug_j, df1, df2, Vcoef, ncores)
}

#' Fit GLS to remote sensing data
#'
#' @param X numeric model matrix
#' @param V numeric covariance matrix
#' @param y numeric resposne vector
#' @param X0 numeric null model matrix
#' @param nugget numeric nugget
#' @param save_xx logical: should cross-partition stats be saved
#' @param save_invchol logical: should invCholV be returned?
#' @param LL_only logical: should only log-liklihood be computed?
#' @param no_F logical: should calculations F-test calculations be skipped?
#' @param optimize_nugget logical: should the ML nugget be obtained?
#' @param nug_l numeric lower value for nugget search
#' @param nug_u numeric upper value for nugget search
#' @param nug_tol numeric tolerance for nugget search
#' @param invCholV numeric inverse cholesky matrix
#' @param use_invCholV logical: should invCholV be used instead of V
#' @param ncores integer indicating cores to use
#'
#' @examples
#' #   data.file = system.file("extdata", "AK_ndvi_common-land.csv", package = "remotePARTS")
#' #
#' #   n = 1000
#' #
#' #   df = data.table::fread(data.file, nrows = n) # read first 1000 rows
#' #
#' #   ## format data
#' #   datalist = part_data(1, part_form = cls.coef ~ 0 + land, part_df = df,
#' #             part_mat = matrix(1:n, ncol = 1))
#' #
#' #   ## fit covariance matrix
#' #   V = covar_exp(distm_km(cbind(df$lng, df$lat)), range = .01)
#' #
#' #   # use V matrix
#' #   .fitGLS_cpp(X = datalist$X, V = V, y = datalist$y, X0 = datalist$X0, invCholV = diag(1),
#' #                nugget = 0.0, save_xx = FALSE, save_invchol = FALSE, LL_only = FALSE, no_F = FALSE,
#' #                use_invCholV = FALSE, optimize_nugget = FALSE, nug_l = 0.0, nug_u = 1.0, nug_tol = 1e-7)
#' #
#' #   # use inverse cholesky instead
#' #   .fitGLS_cpp(X = datalist$X, V = diag(1), y = datalist$y, X0 = datalist$X0, invCholV = invert_chol(V),
#' #                nugget = 0.0, save_xx = FALSE, save_invchol = FALSE, LL_only = FALSE, no_F = FALSE,
#' #                use_invCholV = TRUE, optimize_nugget = FALSE, nug_l = 0.0, nug_u = 1.0, nug_tol = 1e-7)
#' #
#' #   # optimize nugget
#' #   .fitGLS_cpp(X = datalist$X, V = V, y = datalist$y, X0 = datalist$X0, invCholV = diag(1),
#' #                nugget = 0.0, save_xx = FALSE, save_invchol = FALSE, LL_only = FALSE, no_F = FALSE,
#' #                use_invCholV = FALSE, optimize_nugget = TRUE, nug_l = 0.0, nug_u = 1.0, nug_tol = 1e-7)
#'
.fitGLS_cpp <- function(X, V, y, X0, nugget, save_xx, save_invchol, LL_only, no_F, optimize_nugget, nug_l, nug_u, nug_tol, invCholV, use_invCholV, ncores) {
    .Call(`_remotePARTS_fitGLS_cpp`, X, V, y, X0, nugget, save_xx, save_invchol, LL_only, no_F, optimize_nugget, nug_l, nug_u, nug_tol, invCholV, use_invCholV, ncores)
}

#' Invert the cholesky decomposition of V
#'
#' @param V numeric matrix
#' @param nugget numeric nugget to add to variance matrix
#' @param ncores integer indicating number of cores to use
#'
.invchol_cpp <- function(V, nugget, ncores) {
    .Call(`_remotePARTS_invchol_cpp`, V, nugget, ncores)
}

#' Find the maximum likelihood estimate of the nugget
#'
#' @details this is the C++ version of `optimize()` which is specific to
#' finding the nugget value that maximizes the log-likelihood of `fitGLS_cpp()`
#' by minimizing the partial log likelihood (i.e., fitGLS_cpp(LL_only = TRUE)[["logLik"]] )
#'
#' This function is a translation from the forchan algorithm fmin into C++:
#' http://www.netlib.org/fmm/fmin.f
#'
#' @param X numeric model matrix
#' @param X0 numeric null model matrix (needed but not used)
#' @param V numeric covariance matrix
#' @param y numeric resposne vector
#' @param lower lower boundary for nugget search
#' @param upper upper boundary for nugget search
#' @param tol desired tolerance for nugget search
#' @param invchol numeric inverse cholesky matrix
#' @param use_invchol logical: should invchol be used instead of V?
#' @param debug logical: debug mode?
#' @param ncores integer indicating number of cores to use
#'
#' @examples
#' #   data.file = system.file("extdata", "AK_ndvi_common-land.csv", package = "remotePARTS")
#' #
#' #   n = 1000
#' #
#' #   df = data.table::fread(data.file, nrows = n) # read first 1000 rows
#' #
#' #   ## format data
#' #   datalist = part_data(1, part_form = cls.coef ~ 0 + land, part_df = df,
#' #             part_mat = matrix(1:n, ncol = 1))
#' #
#' #   ## fit covariance matrix
#' #   V = covar_exp(distm_km(cbind(df$lng, df$lat)), range = .01)
#' #
#' #  .optimize_nugget_cpp(X = datalist$X, X0 = datalist$X0, V = V, y = datalist$y,
#' #                       lower = 0, upper = 1, tol = 1e-10, invchol = diag(1),
#' #                       use_invchol = FALSE, debug = TRUE)
#' #
#' #  .optimize_nugget_cpp(X = datalist$X, X0 = datalist$X0, V = diag(1), y = datalist$y,
#' #                       lower = 0, upper = 1, tol = 1e-10, invchol = invert_chol(V),
#' #                       use_invchol = TRUE, debug = TRUE)
#' #
#' #  warning("optimize_nugget_cpp CANNOT recycle the invchol matrix!! remove this functionality")
#'
.optimize_nugget_cpp <- function(X, X0, V, y, lower, upper, tol, invchol, use_invchol, debug, ncores) {
    .Call(`_remotePARTS_optimize_nugget_cpp`, X, X0, V, y, lower, upper, tol, invchol, use_invchol, debug, ncores)
}
morrowcj/remotePARTS documentation built on Sept. 17, 2023, 5:42 p.m.