version 1.0.7

cran · Oct 17, 2023 · d92514e · d92514e
commit d92514e
Show file tree

Hide file tree

Showing 101 changed files with 12,651 additions and 0 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -0,0 +1,36 @@
+Package: flashier
+Type: Package
+Date: 2023-10-16
+Title: Empirical Bayes Matrix Factorization
+Version: 1.0.7
+Authors@R: c(person("Jason", "Willwerscheid", role = c("aut", "cre"),
+                    email = "jwillwer@providence.edu"),
+             person("Peter", "Carbonetto", role = "aut"),
+             person("Wei", "Wang", role = "aut"),
+             person("Matthew", "Stephens", role = "aut"),
+             person("Eric", "Weine", role = "ctb"),
+             person("Gao", "Wang", role = "ctb"))
+URL: https://github.com/willwerscheid/flashier
+BugReports: https://github.com/willwerscheid/flashier/issues
+Description: Methods for matrix factorization based on Wang and Stephens (2021) 
+    <https://jmlr.org/papers/v22/20-589.html>.
+Depends: R (>= 3.4), ebnm (>= 0.1-21), magrittr
+Imports: Matrix, parallel, dplyr, stringr, tibble, tidyr, softImpute,
+        irlba, ggplot2
+Suggests: ashr, cowplot, testthat, knitr, rmarkdown, RcppML, rsvd
+License: BSD_3_clause + file LICENSE
+Encoding: UTF-8
+LazyData: true
+RoxygenNote: 7.2.3
+VignetteBuilder: knitr
+NeedsCompilation: no
+Packaged: 2023-10-16 16:37:23 UTC; jwillwer
+Author: Jason Willwerscheid [aut, cre],
+  Peter Carbonetto [aut],
+  Wei Wang [aut],
+  Matthew Stephens [aut],
+  Eric Weine [ctb],
+  Gao Wang [ctb]
+Maintainer: Jason Willwerscheid <jwillwer@providence.edu>
+Repository: CRAN
+Date/Publication: 2023-10-17 09:40:02 UTC
diff --git a/LICENSE b/LICENSE
@@ -0,0 +1,3 @@
+YEAR: 2018-2023
+COPYRIGHT HOLDER: Jason Willwerscheid, Peter Carbonetto, Matthew Stephens
+ORGANIZATION: Providence College, University of Chicago
diff --git a/MD5 b/MD5
@@ -0,0 +1,100 @@
+126614c5076f2ccb8e72387e4b3eea84 *DESCRIPTION
+62b0658fef0712715b2f20d73550b054 *LICENSE
+a79f707984d2e553e129796452af9398 *NAMESPACE
+7ece8b9cd162d262abe02d991aecc06c *R/arg_checks.R
+2fe9e17022e5d281eaa740eea1014655 *R/backfit.R
+e6c6e81d2c928b0ced226c3a9ac6d3fe *R/backfit_parallel.R
+8697562693aee6b41028c7d5b2b1d4e7 *R/data.R
+09d2891d6d198aa148391d15a7285d5c *R/extrapolate.R
+49c35d03abbbc3cae967bcef74be3b38 *R/factor_add.R
+f9fa9dea967a9fd8162d06312f587173 *R/factor_init.R
+430ffa29eed2253cd18e60ff70cc9b5d *R/factor_update.R
+f032019fde5e9114712bb1857f489660 *R/flash.R
+99517c38ac6f6ac6d6e9e3a04aae537c *R/flash_add_intercept.R
+469c132b89b0fa1fb483e03a1bfbefe8 *R/flash_backfit.R
+b09da9d8c9c3c61846c8c870d8c7a47b *R/flash_conv_crit_fns.R
+4f501180404191c3c009da9513012aa8 *R/flash_ebnm.R
+18a302caa07450dee6d8fe8e7f8924bb *R/flash_factors_fix.R
+8e1e2dc809f1f011f75a70fb6666b748 *R/flash_factors_init.R
+3a6b6fec51083a9723c99bd04d0a7ded *R/flash_factors_remove.R
+4e667526b32f439d034ba89bb62147f5 *R/flash_factors_reorder.R
+335f99432d42e286619bf580f1062536 *R/flash_fit_object.R
+12b518c8b201205eb26ca2f43c1ab702 *R/flash_greedy.R
+5d71e21ad48e354f3b4804fe8932206a *R/flash_greedy_init_fns.R
+06f2bfdc5c628daec525fcf5c1ee148b *R/flash_init.R
+3c4f059014497f4a789848eaf1675471 *R/flash_methods.R
+e9dd0be96c313340bf3ec7f0a0172c83 *R/flash_nullcheck.R
+3b96fbb049ad49cf246e6c5c12298b04 *R/flash_set_conv_crit.R
+f39e9c4a1ea103825dd1d07cdb35123e *R/flash_set_timeout.R
+12233bc38e0a7f8af209e9404623353a *R/flash_set_verbose.R
+c1ff3178bb4c6fa90b2dfab67b713ad6 *R/flash_verbose_fns.R
+a1961f689bf39b10731f7623a2e7d48f *R/helpers.R
+bbfd562115632a5634f3512fa8ac3657 *R/objective.R
+4462425401f68f561dd2066f554418dc *R/ops_fullrank.R
+8d1a9897e4bcf5f628e11c1c2c9f8ef4 *R/ops_lowrank.R
+94b8a863abae15ebaa96d436f4a1fb1c *R/ops_nmode_products.R
+d82daea12d07a7d199f8f5feb83bf77e *R/ops_r1.R
+275ee01ab32f060bfce6cf1657bf7f17 *R/residuals_and_R2.R
+e0b7c8cf5f11b29e802b7facaea2023e *R/sampler.R
+03ba21c2978ba2f82bddd48a868a720a *R/set_data.R
+e4959aa932f77dab0db74e6963625ecb *R/tau.R
+d176a495e33ba919e39b7d28c269c992 *R/verbose_announcements.R
+4c0312f3464d9a20625b2768e16a6a16 *R/warmstart_sanity_check.R
+ce170a73b5d7a9fb76a1e458321f52d1 *R/wrapup.R
+21ddfc7ab6a388d4c8b6274802c369e6 *README.md
+d88968165bab146b8b432d65139a7dca *build/vignette.rds
+f03edd66c5718c49d068472eb15e5a6a *data/gtex.rda
+068a0da05d7573910642206d29cd0a1c *data/gtex_colors.rda
+c14a82b97ed28c42f122f42ffcb7b855 *inst/doc/advanced.R
+f9a71c611d8dcb455d05b580f932feeb *inst/doc/advanced.Rmd
+0b6f995aa6e13660f1d5ed4742683063 *inst/doc/advanced.html
+e702fc089264a253c310a83edf1ed027 *inst/doc/intro.R
+ccadca15b6eff24e87ab0eba948c75a1 *inst/doc/intro.Rmd
+eb45498e50c9ca6701d5221ccfda77af *inst/doc/intro.html
+ed8525e1ef1dfc100f1bdd0f2f2e367a *man/fitted.flash.Rd
+f839419f4a308e954d60bb7afd60e756 *man/fitted.flash_fit.Rd
+f29637b622afc3eab4f6e43811051191 *man/flash.Rd
+d92643a44fe4dac1b7b3a58a0c09de80 *man/flash_add_intercept.Rd
+0b73745ff6cc4e2700d93962e0c1b247 *man/flash_backfit.Rd
+ce2aa33a4ac5ab6a1ac8c33743054199 *man/flash_clear_timeout.Rd
+a14d515ffaddd993a0ed779540fcd020 *man/flash_conv_crit_elbo_diff.Rd
+aad578b22f3af770b8c59bc8881b3594 *man/flash_conv_crit_max_chg.Rd
+a6ad68aae46a4e0530603d49c76e94bf *man/flash_conv_crit_max_chg_F.Rd
+bb51c18bb6973d689d523be8d8cefe70 *man/flash_conv_crit_max_chg_L.Rd
+b3ab5e446b160ecaa8de47ab7b2337f9 *man/flash_ebnm.Rd
+b470341a18a871023bf5567e07789be5 *man/flash_factors_fix.Rd
+c562499ea1d921c994f3c636bb9c4ce8 *man/flash_factors_init.Rd
+50ab44fc42d4bd76f7f93fb7138da4e7 *man/flash_factors_remove.Rd
+9b3d5f03d147730692cc2ab5404d071e *man/flash_factors_reorder.Rd
+3142dcd9ea2bc5259fd0f9316f61b007 *man/flash_factors_set_to_zero.Rd
+cfb2691e785d7ef1a7bf3a5ea57afbc3 *man/flash_factors_unfix.Rd
+efb0795e00176b7dd538ca96d8234370 *man/flash_fit.Rd
+b27e5d84aa5d34e92f42dff0807f5b5b *man/flash_greedy.Rd
+61742c86474c9b8ff105c6797176e484 *man/flash_greedy_init_default.Rd
+1c7c7e58985e05f19473dcaf514cd195 *man/flash_greedy_init_irlba.Rd
+bfad1b58e17e49b56b6f392693b4ff58 *man/flash_greedy_init_softImpute.Rd
+03c997d11cb3ff7ef8a031774e04c2de *man/flash_init.Rd
+78d576c5e2b21e548192c7b5e8cc2556 *man/flash_nullcheck.Rd
+a1324ddba9a9743dc7c2f3034ff65fc7 *man/flash_set_conv_crit.Rd
+1c8b89fb55a3ed2254aaaa384429826c *man/flash_set_timeout.Rd
+94f60bcbf1c5202c75b966b015218507 *man/flash_set_verbose.Rd
+af99ffdc26a55a0997201471566ddd64 *man/flash_verbose_elbo.Rd
+888b18c8b5cceb3c2a477cfc44836a93 *man/flash_verbose_elbo_diff.Rd
+98a39f36c9cabf9cf7c93d4898c70031 *man/flash_verbose_max_chg.Rd
+1bbf8a1ccbc6630dcb1bfbcba7cbf18f *man/flash_verbose_max_chg_F.Rd
+095937029f90b89cad83b53d78e66afc *man/flash_verbose_max_chg_L.Rd
+b3e1f8ce2286ec5e9f813ae97f7288bc *man/gtex.Rd
+99365b90a12a6abc1f4f2ea892ad2ee4 *man/gtex_colors.Rd
+04f73d35809451db0fb64eafe8d88c35 *man/ldf.Rd
+97a980cf696af5f8d0a0f023c69f320f *man/plot.flash.Rd
+b7139e4f6f5b1b4fe80b260f575335b5 *man/residuals.flash.Rd
+e1055dad369589e4e4757a0f6658982f *man/residuals.flash_fit.Rd
+ea2a0a6c2cf1c115688c18ba452a6332 *tests/testthat/test_dense_no_missing.R
+abdae41c784eab127ae42da3d0280ce4 *tests/testthat/test_fixed_factors.R
+1b6f552d1bd0b2baa9f1bc48310dda1b *tests/testthat/test_lowrank.R
+fe468ee16ee292ee21dff9df08351e1d *tests/testthat/test_ops.R
+beaf775a8ad7059da45ffd473d7683b0 *tests/testthat/test_sparse_missing.R
+fe040bf4c28265b5fea1cf0f5f79a697 *tests/testthat/test_tensor.R
+553dfd0636fe27401ca7443234cb98e6 *tests/testthat/test_var_types.R
+f9a71c611d8dcb455d05b580f932feeb *vignettes/advanced.Rmd
+ccadca15b6eff24e87ab0eba948c75a1 *vignettes/intro.Rmd
diff --git a/NAMESPACE b/NAMESPACE
@@ -0,0 +1,92 @@
+# Generated by roxygen2: do not edit by hand
+
+S3method(fitted,flash)
+S3method(fitted,flash_fit)
+S3method(ldf,flash)
+S3method(ldf,flash_fit)
+S3method(plot,flash)
+S3method(print,flash)
+S3method(residuals,flash)
+S3method(residuals,flash_fit)
+export(flash)
+export(flash_add_intercept)
+export(flash_backfit)
+export(flash_clear_timeout)
+export(flash_conv_crit_elbo_diff)
+export(flash_conv_crit_max_chg)
+export(flash_conv_crit_max_chg_F)
+export(flash_conv_crit_max_chg_L)
+export(flash_ebnm)
+export(flash_factors_fix)
+export(flash_factors_init)
+export(flash_factors_remove)
+export(flash_factors_reorder)
+export(flash_factors_set_to_zero)
+export(flash_factors_unfix)
+export(flash_fit)
+export(flash_fit_get_KL)
+export(flash_fit_get_elbo)
+export(flash_fit_get_est_tau)
+export(flash_fit_get_fixed_tau)
+export(flash_fit_get_g)
+export(flash_fit_get_p2m)
+export(flash_fit_get_pm)
+export(flash_fit_get_tau)
+export(flash_greedy)
+export(flash_greedy_init_default)
+export(flash_greedy_init_irlba)
+export(flash_greedy_init_softImpute)
+export(flash_init)
+export(flash_nullcheck)
+export(flash_set_conv_crit)
+export(flash_set_timeout)
+export(flash_set_verbose)
+export(flash_verbose_elbo)
+export(flash_verbose_elbo_diff)
+export(flash_verbose_max_chg)
+export(flash_verbose_max_chg_F)
+export(flash_verbose_max_chg_L)
+export(ldf)
+importFrom(dplyr,left_join)
+importFrom(dplyr,mutate)
+importFrom(ebnm,ebnm)
+importFrom(ebnm,ebnm_group)
+importFrom(ebnm,ebnm_point_normal)
+importFrom(ggplot2,aes)
+importFrom(ggplot2,after_stat)
+importFrom(ggplot2,element_blank)
+importFrom(ggplot2,facet_wrap)
+importFrom(ggplot2,geom_col)
+importFrom(ggplot2,geom_histogram)
+importFrom(ggplot2,geom_line)
+importFrom(ggplot2,geom_point)
+importFrom(ggplot2,geom_vline)
+importFrom(ggplot2,ggplot)
+importFrom(ggplot2,guides)
+importFrom(ggplot2,labs)
+importFrom(ggplot2,scale_color_brewer)
+importFrom(ggplot2,scale_color_manual)
+importFrom(ggplot2,scale_fill_brewer)
+importFrom(ggplot2,scale_fill_manual)
+importFrom(ggplot2,scale_x_continuous)
+importFrom(ggplot2,scale_y_log10)
+importFrom(ggplot2,theme)
+importFrom(ggplot2,theme_minimal)
+importFrom(grDevices,devAskNewPage)
+importFrom(irlba,irlba)
+importFrom(magrittr,"%>%")
+importFrom(parallel,makeCluster)
+importFrom(parallel,parLapply)
+importFrom(parallel,stopCluster)
+importFrom(softImpute,softImpute)
+importFrom(stats,coef)
+importFrom(stats,density)
+importFrom(stats,fitted)
+importFrom(stats,optimize)
+importFrom(stats,pnorm)
+importFrom(stats,residuals)
+importFrom(stats,rnorm)
+importFrom(stringr,str_remove)
+importFrom(tibble,rownames_to_column)
+importFrom(tidyr,pivot_longer)
+importFrom(utils,modifyList)
diff --git a/R/arg_checks.R b/R/arg_checks.R
@@ -0,0 +1,144 @@
+must.be.numeric <- function(x, allow.infinite = TRUE, allow.null = TRUE) {
+  error.msg <- paste0("Invalid argument to ", deparse(substitute(x)), ".")
+  if (is.null(x) && !allow.null)
+    stop(error.msg)
+  if (!is.null(x) && is.infinite(x) && !allow.infinite)
+    stop(error.msg)
+  if (!is.null(x) && (!(is.numeric(x) && length(x) == 1)))
+    stop(error.msg)
+}
+
+must.be.integer <- function(x, lower = NULL, upper = NULL, allow.null = TRUE) {
+  error.msg <- paste0("Invalid argument to ", deparse(substitute(x)), ".")
+  if (is.null(x) && !allow.null)
+    stop(error.msg)
+  if (!is.null(x) && (!(is.numeric(x)
+                        && is.finite(x)
+                        && as.integer(x) == x
+                        && (is.null(lower) || x >= lower)
+                        && (is.null(upper) || x <= upper))))
+    stop(error.msg)
+}
+
+must.be.valid.kset <- function(flash, kset) {
+  for (k in kset) {
+    must.be.integer(k, lower = 1, upper = get.n.factors(flash),
+                    allow.null = FALSE)
+  }
+  if (!identical(kset, unique(kset))) {
+    stop("kset must not contain repeated elements.")
+  }
+}
+
+must.be.list.of.named.lists <- function(x, valid.fields) {
+  error.msg <- paste0("Invalid argument to ", deparse(substitute(x)), ".")
+  if (!is.list(x) || !all(sapply(x, is.list)))
+    stop(error.msg)
+  if (!all(unlist(lapply(x, names)) %in% valid.fields))
+    stop(error.msg)
+}
+
+must.be.supported.data.type <- function(X,
+                                        allow.null = TRUE,
+                                        allow.vector = FALSE,
+                                        allow.lowrank = FALSE) {
+  error.msg <- paste0("Invalid argument to ", deparse(substitute(X)), ".")
+  if (!(is.matrix(X)
+        || inherits(X, "Matrix")
+        || (is.array(X) && length(dim(X)) == 3)
+        || (allow.null && is.null(X))
+        || (allow.vector && is.vector(X))
+        || (allow.lowrank && (inherits(X, "lowrank") || is.udv(X)))))
+    stop(error.msg)
+}
+
+is.udv <- function(X) {
+  if (!is.list(X))
+    return(FALSE)
+
+  # Must have fields d, u, and v.
+  if (is.null(X$d) || is.null(X$u) || is.null(X$v))
+    return(FALSE)
+
+  # Check u and v.
+  if (!is.matrix(X$u) || !is.matrix(X$v))
+    return(FALSE)
+  if (!identical(ncol(X$u), ncol(X$v)))
+    return(FALSE)
+  if (anyNA(X$u) || anyNA(X$v))
+    return(FALSE)
+
+  # Check d.
+  if (!is.numeric(X$d) || (length(X$d) < ncol(X$u)))
+    return(FALSE)
+
+  return(TRUE)
+}
+
+must.be.compatible.data.types <- function(X, Y) {
+  error.msg <- paste0("If either ", deparse(substitute(X)), " or ",
+                      deparse(substitute(Y)), " is of class Matrix, then both",
+                      " must be.")
+  if ((inherits(X, "Matrix") && is.matrix(Y))
+      || (is.matrix(X) && inherits(Y, "Matrix")))
+    stop(error.msg)
+}
+
+must.be.valid.var.type <- function(x, data.dim, allow.null = TRUE) {
+  error.msg <- "Invalid var.type."
+  if (is.null(x) && !allow.null)
+    stop(error.msg)
+  for (val in x) {must.be.integer(val, lower = 0, upper = data.dim)}
+  # No repeats.
+  if (!identical(x, unique(x)))
+    stop(error.msg)
+  # If zero appears (meaning "constant" var.type), it must be alone.
+  if ((0 %in% x) && (length(x) > 1))
+    stop(error.msg)
+}
+
+must.not.have.zero.slices <- function(Y) {
+  # Skip this test for tensors.
+  if (length(dim(Y)) > 2)
+    return()
+
+  error.msg <- paste("The data matrix must not have any rows or",
+                     "columns whose entries are either identically zero",
+                     "or all missing.")
+  if (inherits(Y, "lowrank")) {
+    for (n in 1:length(Y)) {
+      nz <- (Y[[n]] != 0)
+      if (any(rowSums(nz) == 0) || any(colSums(nz) == 0))
+        stop(error.msg)
+    }
+  } else {
+    nz <- (Y != 0)
+    for (n in 1:length(dim(Y))) {
+      n.nonzero <- nmode.prod.vec(nz, 1, n)
+      if (any(n.nonzero == 0))
+        stop(error.msg)
+    }
+  }
+}
+
+dims.must.match <- function(X, Y, Y.dim = NULL) {
+  error.msg <- paste("Dimensions of", deparse(substitute(X)), "and",
+                     deparse(substitute(Y)), "do not match.")
+  if (inherits(X, "lowrank")) {
+    dim.X <- sapply(X, nrow)
+  } else {
+    dim.X <- dim(X)
+  }
+  # If Y.dim is NULL, then Y must be a matrix or array.
+  if (is.null(Y.dim)) {
+    if (!is.null(X) && !is.null(Y) && !identical(dim.X, dim(Y)))
+      stop(error.msg)
+  } else {
+    # If Y.dim is zero, then Y must be a scalar.
+    if (Y.dim == 0 && (!is.vector(Y) || (length(Y) != 1)))
+      stop(error.msg)
+    # Otherwise, Y must be a vector that can be aligned with X.
+    if (Y.dim > 0 && (!is.vector(Y) || (length(Y) != dim.X[Y.dim])))
+      stop(error.msg)
+  }
+}