Merge pull request #16 from SchisslerGroup/cran

CRAN ready version of bigsimr

.travis.yml

@@ -1,8 +1,4 @@
 language: R
-cache:
-  packages: true
-  directories:
-    - "$HOME/.cache/pip"
 R:
   - 3.6
   - release
@@ -13,17 +9,23 @@ arch:
   - x64
 dist:
   - bionic
+env:
+  global:
+    - PATH=/opt/python/3.8.1/bin:$PATH
+
+r_packages:
+  - reticulate
+  - testthat
 
-addons:
-  apt:
-    sources: ubuntu-toolchain-r-test
-    packages:
-      - python3-dev
+cache:
+  packages: true
+  directories:
+    - "$HOME/.cache/pip"
 
 before_install:
-  - pip install --user numpy
-  - pip install --user scipy
-  - pip install --user --upgrade jax jaxlib
+  - pip3 install --user numpy
+  - pip3 install --user scipy
+  - pip3 install --user --upgrade jax jaxlib
 
 pandoc: true
 latex: false

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: bigsimr
 Title: An R Package for Generating High-Dimensional Random Vectors
-Version: 0.7.4
+Version: 0.8.0
 Authors@R:
     c(person(given = "Alex",
              family = "Knudson",
@@ -9,7 +9,8 @@ Authors@R:
       person(given = "Grant",
              family = "Schissler",
              role = "aut"))
-Description: This package simulates multivariate data with arbitrary marginal distributions.
+Maintainer: Alex Knudson <[email protected]>
+Description: Simulate multivariate data with arbitrary marginal distributions.
 URL: https://github.com/SchisslerGroup/bigsimr
 BugReports: https://github.com/SchisslerGroup/bigsimr/issues
 Depends: R (>= 3.5.0)
@@ -30,16 +31,13 @@ Imports:
     pcaPP,
     Rcpp,
     RcppArmadillo,
-    fastrank,
     foreach,
     parallel,
     doParallel,
     rlang,
     assertthat,
     reticulate,
     rstudioapi
-Remotes:
-    douglasgscofield/fastrank
 LinkingTo:
     Rcpp,
     RcppArmadillo

R/cor_bounds.R

@@ -3,7 +3,7 @@
 #'
 #' @param margins The parameters of the marginals.
 #' @param type The type of correlation matrix that is being passed.
-#' @param cores The number of cores to utilize.
+#' @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
@@ -26,78 +26,29 @@ cor_bounds <- function(margins,
 
   # Generate random samples for each margin and sort the vectors
   # The sorted vectors are used for computing the bounds
-  if (cores == 1) {
-    sim_data <- sapply(1:d, function(i) {
-      # Replace the quantile function with the RNG function (e.g. qnorm -> rnorm)
-      margins[[i]][[1]] <- q2r(margins[[i]][[1]])
-      # Add the number of reps as an argument
-      margins[[i]]$n <- quote(reps)
-      # the below statement equates to: sort(rdist(n, params...))
-      eval(rlang::call2("sort", margins[[i]]))
-    })
-
-    # Upper bounds
-    rho_upper <- cor_fast(sim_data, method = type)
-
-    # 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)
-
-    rho_lower <- matrix(0, d, d)
-    diag(rho_lower) <- 0.5
-    rho_lower[lower.tri(rho_lower)] <- rho_lower_values
-    rho_lower <- rho_lower + t(rho_lower)
-
-  } else {
-    # Set up the parallel computing environment
-    `%dopar%` <- foreach::`%dopar%`
-    cl <- parallel::makeCluster(cores, type = "FORK")
-    doParallel::registerDoParallel(cl)
-
-    sim_data <- foreach::foreach(i = 1:d, .combine = "cbind") %dopar% {
-      margins[[i]][[1]] <- q2r(margins[[i]][[1]])
-      margins[[i]]$n <- quote(reps)
-      eval(rlang::call2("sort", margins[[i]]))
-    }
-
-    # Upper bounds
-    rho_upper_values <- parallel::parApply(
-      cl = cl,
-      X = index_mat,
-      MARGIN = 2,
-      FUN = function(index, data, ...){
-        cor_fast(x = data[, index[1]],
-                 y = data[, index[2]],
-                 method = type)
-      }, data = sim_data, method = type)
-
-    rho_upper <- matrix(0, d, d)
-    diag(rho_upper) <- 0.5
-    rho_upper[lower.tri(rho_upper)] <- rho_upper_values
-    rho_upper <- rho_upper + t(rho_upper)
-
-    # Lower bounds
-    rho_lower_values <- parallel::parApply(
-      cl     = cl,
-      X      = index_mat,
-      MARGIN = 2,
-      FUN    = function(index, data, ...){
-        cor_fast(x      = data[, index[1]],
-                 y      = rev(data[, index[2]]),
-                 method = type)
-      }, data = sim_data, method = type)
-
-    rho_lower <- matrix(0, d, d)
-    diag(rho_lower) <- 0.5
-    rho_lower[lower.tri(rho_lower)] <- rho_lower_values
-    rho_lower <- rho_lower + t(rho_lower)
-
-    # Shut down the parallel cluster
-    parallel::stopCluster(cl)
-  }
+  sim_data <- sapply(1:d, function(i) {
+    # Replace the quantile function with the RNG function (e.g. qnorm -> rnorm)
+    margins[[i]][[1]] <- q2r(margins[[i]][[1]])
+    # Add the number of reps as an argument
+    margins[[i]]$n <- quote(reps)
+    # the below statement equates to: sort(rdist(n, params...))
+    eval(rlang::call2("sort", margins[[i]]))
+  })
+
+  # Upper bounds
+  rho_upper <- cor_fast(sim_data, method = type)
+
+  # 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)
+
+  rho_lower <- matrix(0, d, d)
+  diag(rho_lower) <- 0.5
+  rho_lower[lower.tri(rho_lower)] <- rho_lower_values
+  rho_lower <- rho_lower + t(rho_lower)
 
   list(lower = rho_lower, upper = rho_upper)
 }

R/cor_fast.R

@@ -25,10 +25,10 @@ cor_fast <- function(x, y = NULL, method = c("pearson", "kendall", "spearman"))
 
   } else if (method == "spearman") {
     if (is.null(y)) {
-      coop::pcor(apply(x, 2, fastrank::fastrank_num_avg))
+      coop::pcor(apply(x, 2, fastrank_num_avg))
     } else {
-      coop::pcor(fastrank::fastrank_num_avg(x),
-                 fastrank::fastrank_num_avg(y))
+      coop::pcor(fastrank_num_avg(x),
+                 fastrank_num_avg(y))
     }
 
   } else {
@@ -41,3 +41,7 @@ cor_fast <- function(x, y = NULL, method = c("pearson", "kendall", "spearman"))
   }
 
 }
+
+fastrank_num_avg <- function(x) {
+  .Call("fastrank_num_avg_", x, PACKAGE = "bigsimr")
+}

R/rand_vec.R

@@ -22,15 +22,16 @@
 rvec <- function(n, rho, margins, type = c("pearson", "kendall", "spearman"),
                  ensure_PSD=FALSE, cores = 1L){
 
-  type  <- match.arg(type)
-  rho   <- cor_convert(rho, from = type, to = "pearson")
+  type <- match.arg(type)
+  rho  <- cor_convert(rho, from = type, to = "pearson")
+  d    <- length(margins)
 
   if (ensure_PSD)
     rho <- cor_nearPSD(rho)
 
   if (!is.integer(cores)) {
-    warning("The number of cores must be a positive integer. Defaulting to 1 core.")
-    cores <- 1L
+    message("Number of cores implicitly cast as an integer.")
+    cores <- as.integer(cores)
   }
 
   # generate multivariate uniform distribution (via Z -> U)

bigsimr.Rproj

@@ -18,4 +18,5 @@ StripTrailingWhitespace: Yes
 BuildType: Package
 PackageUseDevtools: Yes
 PackageInstallArgs: --no-multiarch --with-keep.source
+PackageCheckArgs: --as-cran
 PackageRoxygenize: rd,collate,namespace

pkgdown/_pkgdown.yml

@@ -31,7 +31,7 @@ reference:
 
   - title: Utilities
     contents:
-    # - mlist
+    - mlist
     - install_bigsimr
     - starts_with("have_")
 

src/Makevars

@@ -1,3 +1,5 @@
 CXX_STD = CXX11
 PKG_CXXFLAGS = $(SHLIB_OPENMP_CXXFLAGS)
 PKG_LIBS = $(SHLIB_OPENMP_CXXFLAGS) $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS)
+CC = gcc
+

src/Makevars.win

@@ -1,3 +1,5 @@
 CXX_STD = CXX11
 PKG_CXXFLAGS = $(SHLIB_OPENMP_CXXFLAGS)
 PKG_LIBS = $(SHLIB_OPENMP_CXXFLAGS) $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS)
+CC = gcc
+

src/RcppExports.cpp

@@ -61,11 +61,14 @@ BEGIN_RCPP
 END_RCPP
 }
 
+RcppExport SEXP fastrank_num_avg_(SEXP);
+
 static const R_CallMethodDef CallEntries[] = {
     {"_bigsimr_cor_convert_double", (DL_FUNC) &_bigsimr_cor_convert_double, 2},
     {"_bigsimr_cor_convert_matrix", (DL_FUNC) &_bigsimr_cor_convert_matrix, 2},
     {"_bigsimr_cor_nearPSD", (DL_FUNC) &_bigsimr_cor_nearPSD, 8},
     {"_bigsimr_hermite", (DL_FUNC) &_bigsimr_hermite, 2},
+    {"fastrank_num_avg_", (DL_FUNC) &fastrank_num_avg_, 1},
     {NULL, NULL, 0}
 };