Merge pull request #21 from SchisslerGroup/develop

ready for release-0.10

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: bigsimr
 Title: Fast Generation of High-Dimensional Random Vectors
-Version: 0.9.0
+Version: 0.10.0
 Authors@R:
     c(person(given = "Alex",
              family = "Knudson",
@@ -38,7 +38,8 @@ Imports:
     rlang,
     reticulate,
     rstudioapi,
-    mvnfast
+    mvnfast,
+    matrixcalc
 LinkingTo:
     Rcpp,
     RcppArmadillo

NAMESPACE

@@ -3,26 +3,19 @@
 export(cor_bounds)
 export(cor_convert)
 export(cor_fast)
-export(cor_nearPSD)
+export(cor_nearPD)
 export(cor_randPD)
 export(cor_randPSD)
 export(have_conda)
 export(have_jax)
 export(have_numpy)
 export(have_python)
 export(install_bigsimr)
+export(is_valid_correlation)
 export(jax_rmvn)
 export(jax_rmvu)
 export(mlist)
 export(rvec)
 import(RcppArmadillo)
 importFrom(Rcpp,sourceCpp)
-importFrom(reticulate,conda_binary)
-importFrom(reticulate,py_available)
-importFrom(reticulate,py_module_available)
-importFrom(stats,cov2cor)
-importFrom(stats,rbeta)
-importFrom(stats,rnorm)
-importFrom(stats,runif)
-importFrom(utils,combn)
 useDynLib(bigsimr, .registration = TRUE)

R/RcppExports.R

@@ -9,21 +9,8 @@
     .Call(`_bigsimr_cor_convert_matrix`, X, CASE)
 }
 
-#' Calculate the nearest positive semi-definite correlation matrix
-#'
-#' @param G the input correlation matrix
-#' @param tau A user-dependent tuning parameter that determines the accuracy
-#'     of the final correlation matrix. Smaller values generally mean faster
-#'     convergence
-#' @param iter_outer the max number of iterations in the outer loop
-#' @param iter_inner the max number of iterations in the inner loop
-#' @param maxit Maximum number of iterations in the pre_cg routine
-#' @param err_tol the error tolerance for the stopping criteria
-#' @param precg_err_tol the error tolerance in the pre-conjugate gradient method
-#' @param newton_err_tol the error tolerance in Newton's method
-#' @export
-cor_nearPSD <- function(G, tau = 1e-5, iter_outer = 200L, iter_inner = 20L, maxit = 200L, err_tol = 1e-6, precg_err_tol = 1e-2, newton_err_tol = 1e-4) {
-    .Call(`_bigsimr_cor_nearPSD`, G, tau, iter_outer, iter_inner, maxit, err_tol, precg_err_tol, newton_err_tol)
+.cor_randPSD <- function(d, k) {
+    .Call(`_bigsimr_cor_randPSD`, d, k)
 }
 
 hermite <- function(x, n) {

R/cor_bounds.R

@@ -2,20 +2,19 @@
 #'   given a set of marginals
 #'
 #' @param margins The parameters of the marginals.
-#' @param type The type of correlation matrix that is being passed.
+#' @param method The type of correlation matrix that is being passed.
 #' @param cores NOT YET IMPLEMENTED
 #' @param reps The number of sims used to estimate the bounds.
 #' @return A list containing the theoretical upper and lower bounds
-#' @importFrom utils combn
 #' @export
 cor_bounds <- function(margins,
-                       type = c("pearson", "kendall", "spearman"),
+                       method = c("pearson", "kendall", "spearman"),
                        cores = 1,
                        reps = 1e5){
 
-  type <- match.arg(type)
+  method <- match.arg(method)
   d <- length(margins)
-  index_mat <- combn(x = d, m = 2)
+  index_mat <- utils::combn(x = d, m = 2)
 
   # Replace the quantile function with the RNG function (e.g. qnorm -> rnorm)
   q2r <- function(x) {
@@ -36,14 +35,14 @@ cor_bounds <- function(margins,
   })
 
   # Upper bounds
-  rho_upper <- cor_fast(sim_data, method = type)
+  rho_upper <- cor_fast(sim_data, method = method)
 
   # Lower bounds
   rho_lower_values <- apply(index_mat, 2, function(index, data, ...){
     cor_fast(data[, index[1]],
              rev(data[, index[2]]),
-             method = type)
-  }, data = sim_data, method = type)
+             method = method)
+  }, data = sim_data, method = method)
 
   rho_lower <- matrix(0, d, d)
   diag(rho_lower) <- 0.5

R/cor_convert.R

@@ -25,8 +25,11 @@ cor_convert <- function(rho,
   )
 
   if (is.matrix(rho)) {
-    .cor_convert_matrix(rho, CASE)
+    x <- .cor_convert_matrix(rho, CASE)
+    x <- (x + t(x)) / 2
+    diag(x) <- 1
+    return(x)
   } else {
-    .cor_convert_double(rho, CASE)
+    return(.cor_convert_double(rho, CASE))
   }
 }