Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

R6 PCA wrappers #42

Merged
merged 34 commits into from
Aug 5, 2019
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
34 commits
Select commit Hold shift + click to select a range
99aaf41
Optimize MoMA::criterion_search
Banana1530 Jul 8, 2019
e2c2e61
R6 SFPCA object
Banana1530 Jul 9, 2019
789e86a
Wrappers around SFPCA object, and special-case functions
Banana1530 Jul 9, 2019
64296c5
Optimize `check_omega`
Banana1530 Jul 9, 2019
a71c165
Tests
Banana1530 Jul 9, 2019
a6e654c
Update test names
Banana1530 Jul 9, 2019
8bda1c9
Add TODO
Banana1530 Jul 9, 2019
d309ec2
Omage -> Omega
Banana1530 Jul 9, 2019
414c02f
Add a test (when empty list is passed in)
Banana1530 Jul 10, 2019
7516228
set_*_gric -> construct_*_search
Banana1530 Jul 9, 2019
7482aab
Merge branch 'master' into r6pcawrapper
Banana1530 Jul 10, 2019
29acaf8
Add documentations
Banana1530 Jul 10, 2019
feb992c
Add documentations for R6 object SFPCA
Banana1530 Jul 10, 2019
f37529d
Add more documentations to fix the build
Banana1530 Jul 10, 2019
a1ad193
t(V) %%*% V -> crossprod(V)
Banana1530 Jul 11, 2019
50b07b3
get_mat -> get_mat_by_id, and dots
Banana1530 Jul 11, 2019
1c4b917
Add is.wholenumber(rank) and tests
Banana1530 Jul 11, 2019
041ef1b
strsplit -> substr
Banana1530 Jul 11, 2019
c9fdb8d
Add SFPCA::interpolate with exact
Banana1530 Jul 11, 2019
c79b375
Add `SFPCA::fixed_list` and check indices
Banana1530 Jul 12, 2019
1ca99e8
Add exact mode and tests
Banana1530 Jul 12, 2019
0cb125b
Add interpolate (inexact) and some tests
Banana1530 Jul 12, 2019
09dff04
More comments
Banana1530 Jul 12, 2019
8242f10
Imporved UX in SFPCA::interpolate
Banana1530 Jul 13, 2019
c696f0f
Fix typo and more comments
Banana1530 Jul 14, 2019
bec0c76
Add `set.seed`
Banana1530 Jul 14, 2019
12d67f0
More comments for tests for interpolate
Banana1530 Jul 14, 2019
ef9bb20
Add test "SFPCA object: X contains string"
Banana1530 Jul 15, 2019
948feae
Replace is.null with %||%
Banana1530 Jul 17, 2019
70f35b0
Expect warning in `test_sfpca_wrapper.R `
Banana1530 Jul 15, 2019
0dedb2a
Add `d` in SFPCA$get_mat_by_id
Banana1530 Jul 17, 2019
8ca7000
Add a comment
Banana1530 Jul 19, 2019
8cbbfa8
Add `is.double(X)`
Banana1530 Aug 5, 2019
be02e5c
Merge branch 'master' into r6pcawrapper
Banana1530 Aug 5, 2019
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,7 @@ Authors@R: c(
Description: Unified approach to modern multivariate analysis providing sparse,
smooth, and structured versions of PCA, PLS, LDA, and CCA.
License: GPL (>= 2)
Imports: Rcpp
Imports: Rcpp, R6
Suggests:
knitr,
rmarkdown,
Expand Down
32 changes: 32 additions & 0 deletions R/moma_arguments.R
Original file line number Diff line number Diff line change
@@ -1,3 +1,20 @@
#' Sparsity-inducing penalty in \code{MoMA}
#' In the package \code{MoMA}, we support the following sparsity-inducing
#' penalty functions.
#' \itemize{
#' \item{\code{\link{lasso}}} TODO
#' \item{\code{\link{mcp}}} TODO
#' \item{\code{\link{scad}}} TODO
#' \item{\code{\link{slope}}} TODO
#' \item{\code{\link{grplasso}}} TODO
#' \item{\code{\link{fusedlasso}}} TODO
#' \item{\code{\link{l1tf}}} TODO
#' \item{\code{\link{spfusedlasso}}} TODO
#' \item{\code{\link{cluster}}} TODO
#' }
#' @name moma_sparsity
NULL

# Check whether `x` is a boolean value
is_logical_scalar <- function(x) {
return(is.logical(x) && (length(x) == 1) && !is.na(x))
Expand Down Expand Up @@ -312,6 +329,21 @@ cluster <- function(..., w = NULL, ADMM = FALSE,
return(arglist)
}


#' Algorithm settings for solving a penalzied SVD problem
#'
#' To find an (approximate) solution to a penalized SVD (Singular Value Decomposition) problem is to solve two
#' penalized regression problems iteratively (outer loop). Each penalized regression (inner loop)
#' is solved using one of the three algorithms: ISTA (Iterative Shrinkage-Thresholding Algorithm),
#' FISTA (Fast Iterative Shrinkage-Thresholding Algorithm) and
#' One-step ISTA (an approximated version of ISTA).
#' @param ... to force users to specify arguments by names
#' @param EPS precision for outer loop
#' @param MAX_ITER the maximum number of iterations for outer loop
#' @param EPS_inner precision for inner loop
#' @param MAX_ITER_inner the maximum number of iterations for inner loop
#' @param solver a string in \code{c("ista", "fista", "onestepista")}.
#' @export
moma_pg_settings <- function(..., EPS = 1e-10, MAX_ITER = 1000,
EPS_inner = 1e-10, MAX_ITER_inner = 1e+5,
solver = c("ista", "fista", "onestepista")) {
Expand Down
15 changes: 14 additions & 1 deletion R/moma_expose.R
Original file line number Diff line number Diff line change
Expand Up @@ -28,19 +28,31 @@ add_default_prox_args <- function(sparsity_type) {
return(modifyList(MOMA_DEFAULT_PROX, sparsity_type))
}

is.wholenumber <-
function(x, tol = .Machine$double.eps^0.5) abs(x - round(x)) < tol

# This function checks the validity of Omega and alpha
check_omega <- function(Omega, alpha, n) {

# check if Omega is a matrix
if (!is.matrix(Omega) && !is.null(Omega)) {
moma_error("Omega_u/v is not a matrix.")
}

# TODO: store them as sparse matrices using the package Matrix
if (length(alpha) == 1 && alpha == 0) {
# discard the Omega matrix specified by users
Omega <- diag(n)
}
else if (is.null(Omega)) {
# The user wants smooth penalty
# but does not specify Omega matrix
Omega <- second_diff_mat(n)
Omega <- second_diff_mat(n) # TODO: should not overwrite
}
else {
# At this point, users have specified an Omega and
# non-zero penalty levels explicitly

# Check validity of Omega if users speicify both alpha and Omega
if (dim(Omega)[1] != dim(Omega)[2]) {
moma_error(
Expand All @@ -55,6 +67,7 @@ check_omega <- function(Omega, alpha, n) {
", but is actually ", dim(Omega)[1], "x", dim(Omega)[1]
)
}
# TODO: check definiteness and symmetry of Omega
}
return(Omega)
}
Expand Down
Loading