Skip to content

Commit

Permalink
Imporved UX in SFPCA::interpolate
Browse files Browse the repository at this point in the history
  • Loading branch information
@Banana1530
Banana1530 committed Jul 13, 2019
1 parent 09dff04 commit 2dedb5a
Show file tree
Hide file tree
Showing 2 changed files with 150 additions and 63 deletions.
94 changes: 59 additions & 35 deletions R/moma_sfpca.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -46,6 +46,8 @@ SFPCA <- R6::R6Class("SFPCA",
private = list(
check_input_index = TRUE,
private_get_mat_by_index = function(alpha_u = 1, alpha_v = 1, lambda_u = 1, lambda_v = 1) {
# private functions can be called only by
# internal functions
private$check_input_index <- FALSE
res <- self$get_mat_by_index(
alpha_u, alpha_v, lambda_u, lambda_v
Expand Down Expand Up @@ -169,9 +171,9 @@ SFPCA <- R6::R6Class("SFPCA",
)
fixed_list <- list(
# "Fixed" parameters are those
# i) that are chosen by BIC, or ",
# ii) that are not specified during initialization of the SFCPA object, or "
# iii) that are scalars during initialization of the SFCPA object."
# i) that are chosen by BIC, or
# ii) that are not specified during initialization of the SFCPA object, or
# iii) that are scalars as opposed to vectors during initialization of the SFCPA object.
is_alpha_u_fixed = FALSE,
is_alpha_v_fixed = FALSE,
is_lambda_u_fixed = FALSE,
Expand Down Expand Up @@ -239,8 +241,6 @@ SFPCA <- R6::R6Class("SFPCA",
if (private$check_input_index) {
chkDots(...)
}
# Sanity check: if a parameter has been chosen by BIC, then
# the index for that parameter should not be specified.

# they should be of length 1
if (any(c(length(alpha_u), length(alpha_v), length(lambda_u), length(lambda_v)) > 1 ||
Expand All @@ -258,9 +258,16 @@ SFPCA <- R6::R6Class("SFPCA",
moma_error("SFPCA::get_mat_by_index takes integer indices.")
}

# A "fixed" parameter should not be specified
# at all (this is a bit stringent, can be improved later).
# "Fixed" parameters are those
# i) that are chosen by BIC, or
# ii) that are not specified during initialization of the SFCPA object, or
# iii) that are scalars as opposed to vectors during initialization of the SFCPA object.
if (private$check_input_index) {
missing_list <- list(missing(alpha_u), missing(alpha_v), missing(lambda_u), missing(lambda_v))
if (any(self$fixed_list == TRUE & missing_list != TRUE)) {
is_missing <- list(missing(alpha_u), missing(alpha_v), missing(lambda_u), missing(lambda_v))
is_fixed <- self$fixed_list
if (any(is_fixed == TRUE & is_missing == FALSE)) {
moma_error(
paste0(
"Invalid index in SFPCA::get_mat_by_index. Do not specify indexes of parameters ",
Expand Down Expand Up @@ -308,23 +315,52 @@ SFPCA <- R6::R6Class("SFPCA",
interpolate = function(..., alpha_u = 0, alpha_v = 0, lambda_u = 0, lambda_v = 0, exact = FALSE) {
chkDots(...)


# If BIC scheme has been used for any parameters, exit.
if (any(self$selection_scheme_list != 0)) {
moma_error("R6 ojbect SFPCA do not support interpolation when BIC selection scheme has been used.")
}

# Reject inputs like alpha_u = "1" or "alpha_u" = c(1,2,3)
if (!is.numeric(c(alpha_u, alpha_v, lambda_u, lambda_v)) ||
any(c(length(alpha_u), length(alpha_v), length(lambda_u), length(lambda_v)) > 1)) {
moma_error("Non-scalar input in SFPCA::interpolate.")
}

missing_list <- list(missing(alpha_u), missing(alpha_v), missing(lambda_u), missing(lambda_v))

# Parameters that are specified explictly is not "fixed".
# Parameters that are "fixed" must not be specified.
is_missing <- list(missing(alpha_u), missing(alpha_v), missing(lambda_u), missing(lambda_v))
is_fixed <- self$fixed_list == TRUE
param_str_list <- c("alpha_u", "alpha_v", "lambda_u", "lambda_v")
if (any(is_missing == FALSE & is_fixed == TRUE)) {
output_para <- is_missing == FALSE & is_fixed == TRUE
moma_error(
paste0(
"Invalid index in SFPCA::interpolate: ",
paste(param_str_list[output_para], collapse = ","),
". Do not specify indexes of parameters ",
"i) that are chosen by BIC, or ",
"ii) that are not specified during initialization of the SFCPA object, or ",
"iii) that are scalars during initialization of the SFCPA object."
)
)
}
if (any(is_missing == TRUE & is_fixed == FALSE)) {
output_para <- is_missing == TRUE & is_fixed == FALSE
moma_error(
paste0(
"Please spesify the following argument(s): ",
paste(param_str_list[output_para], collapse = ","),
"."
)
)
}

if (exact) {
# TODO: for moma_spca, moma_twspca etc., this can be relaxed
if (any(missing_list == TRUE)) {
moma_error("SFPCA::interpolate does not support exact mode unless all parameters are specified.")
}
alpha_u <- ifelse(self$fixed_list$is_alpha_u_fixed, self$alpha_u, alpha_u)
alpha_v <- ifelse(self$fixed_list$is_alpha_v_fixed, self$alpha_v, alpha_v)
lambda_u <- ifelse(self$fixed_list$is_lambda_u_fixed, self$lambda_u, lambda_u)
lambda_v <- ifelse(self$fixed_list$is_lambda_v_fixed, self$lambda_v, lambda_v)

a <- moma_svd(
X = self$X,
Expand All @@ -340,17 +376,7 @@ SFPCA <- R6::R6Class("SFPCA",
return(list(U = a$u, V = a$v))
}

if (any(self$fixed_list == TRUE & missing_list != TRUE)) {
moma_error(
paste0(
"Invalid index in SFPCA::interpolate. Do not specify indexes of parameters ",
"i) that are chosen by BIC, or ",
"ii) that are not specified during initialization of the SFCPA object, or ",
"iii) that are scalars during initialization of the SFCPA object."
)
)
}

# Function `findInterval` requires sorted breakpoints
if (is.unsorted(self$alpha_u) ||
is.unsorted(self$alpha_v) ||
is.unsorted(self$lambda_u) ||
Expand All @@ -371,7 +397,8 @@ SFPCA <- R6::R6Class("SFPCA",
!self$fixed_list$is_alpha_v_fixed &&
!self$fixed_list$is_lambda_v_fixed

if (!xor(inter_u, inter_v)) {
# If both of them are ture or false at the same time, exit.
if (inter_u == inter_v) {
moma_error("SFPCA::interpolate only supports one-sided interpolation.")
}

Expand All @@ -381,19 +408,17 @@ SFPCA <- R6::R6Class("SFPCA",
if (alpha_v >= max(self$alpha_v) || alpha_v <= min(self$alpha_v)) {
moma_error("Invalid range: alpha_v.")
}

# find the cloest alpha
alpha_v_i <- which.min(abs(self$alpha_v - alpha_v))


# find the bin where lambda lies in
if (lambda_v >= max(self$lambda_v) || lambda_v <= min(self$lambda_v)) {
moma_error("Invalid range: lambda_v.")
}
lambda_v_i_lo <- findInterval(lambda_v, self$lambda_v)
lambda_v_i_hi <- lambda_v_i_lo + 1


if (lambda_v_i_hi > length(self$lambda_v)) {
if (lambda_v_i_hi > length(self$lambda_v) || lambda_v_i_lo <= 0) {
moma_error("SFPCA::interpolate, error in findInterval")
}

Expand All @@ -403,7 +428,6 @@ SFPCA <- R6::R6Class("SFPCA",
lambda_u = 1,
lambda_v = lambda_v_i_lo
)

result_hi <- private$private_get_mat_by_index(
alpha_u = 1,
alpha_v = alpha_v_i,
Expand Down Expand Up @@ -436,8 +460,7 @@ SFPCA <- R6::R6Class("SFPCA",
}
lambda_u_i_lo <- findInterval(lambda_u, self$lambda_u)
lambda_u_i_hi <- lambda_u_i_lo + 1

if (lambda_u_i_hi > length(self$lambda_u)) {
if (lambda_u_i_hi > length(self$lambda_u) || lambda_u_i_lo <= 0) {
moma_error("SFPCA::interpolate, error in findInterval.")
}

Expand All @@ -447,7 +470,6 @@ SFPCA <- R6::R6Class("SFPCA",
lambda_v = 1,
lambda_u = lambda_u_i_lo
)

result_hi <- private$private_get_mat_by_index(
alpha_v = 1,
alpha_u = alpha_u_i,
Expand All @@ -457,6 +479,7 @@ SFPCA <- R6::R6Class("SFPCA",

U <- 0.5 * (result_lo$U + result_hi$U)
V <- 0.5 * (result_lo$V + result_hi$V)
return(list(U = U, V = V))
}
else {
moma_error("UNKNOWN.")
Expand Down Expand Up @@ -491,8 +514,9 @@ SFPCA <- R6::R6Class("SFPCA",
alpha_u = 1, alpha_v = 1, lambda_u = 1, lambda_v = 1) {

# check indexes
missing_list <- list(missing(alpha_u), missing(alpha_v), missing(lambda_u), missing(lambda_v))
if (any(self$fixed_list == TRUE & missing_list != TRUE)) {
is_missing <- list(missing(alpha_u), missing(alpha_v), missing(lambda_u), missing(lambda_v))
is_fixed <- self$fixed_list
if (any(is_fixed == TRUE & is_missing == FALSE)) {
moma_error(
paste0(
"Invalid index in SFPCA::get_mat_by_index. Do not specify indexes of parameters ",
Expand Down
119 changes: 91 additions & 28 deletions tests/testthat/test_sfpca_wrapper.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -149,7 +149,6 @@ test_that("SFPCA object: left-project fucntion", {
lambda_v = c(6),
selection_scheme_str = "bbbb"
)
SFPCA$debug("left_project")
expect_error(
a$left_project(matrix(0, 4, 1)),
"`newX` is incompatible with orignal data."
Expand Down Expand Up @@ -703,6 +702,8 @@ test_that("SFPCA object: interpolate, exact mode", {
"R6 ojbect SFPCA do not support interpolation when BIC selection scheme has been used."
)

# case 1: interpolate cannot be used if all
# parameters are specified as scalars
a <- moma_sfpca(X,
u_sparsity = lasso(), v_sparsity = lasso(),
lambda_u = 1.2, lambda_v = 1,
Expand All @@ -713,25 +714,87 @@ test_that("SFPCA object: interpolate, exact mode", {
a$interpolate(
alpha_u = 1, exact = TRUE
),
"SFPCA::interpolate does not support exact mode unless all parameters are specified."
"Invalid index in SFPCA::interpolate: alpha_u."
)
expect_error(
a$interpolate(
alpha_v = 1, exact = TRUE
),
"Invalid index in SFPCA::interpolate: alpha_v."
)
expect_error(
a$interpolate(
lambda_u = 1, exact = TRUE
),
"Invalid index in SFPCA::interpolate: lambda_u."
)
expect_error(
a$interpolate(
lambda_v = 1, exact = TRUE
),
"Invalid index in SFPCA::interpolate: lambda_v."
)

SFPCA$debug("interpolate")
internal_call <- a$interpolate(
alpha_u = 1, alpha_v = 1,
lambda_v = 1, lambda_u = 1,
exact = TRUE

# case 2: interpolation on v side, both alpha and lambda are vectors
a <- moma_sfpca(X,
u_sparsity = lasso(), v_sparsity = lasso(),
alpha_v = seq(0.1, 1, 0.15), alpha_u = 0.32,
Omega_v = second_diff_mat(8), Omega_u = second_diff_mat(17),
lambda_v = seq(0.1, 1, 0.2), lambda_u = 2.1
)
# incomplete arguments
expect_error(
a$interpolate(
lambda_v = 1, exact = TRUE
),
"Please spesify the following argument(s): alpha_v.",
fixed = TRUE
)
# extra arguments
expect_error(
a$interpolate(
lambda_v = 1, alpha_v = 1, alpha_u = 1,
exact = TRUE
),
"Invalid index in SFPCA::interpolate: alpha_u."
)
# alpha_v too large
expect_error(
a$interpolate(
lambda_v = 0.21, alpha_v = 1
),
"Invalid range: alpha_v."
)

dir_call <- moma_svd(
scale(X, center = a$center, scale = a$scale),
# case 3: interpolation on v side, only lambda is a vector
a <- moma_sfpca(X,
u_sparsity = lasso(), v_sparsity = lasso(),
alpha_u = 1, alpha_v = 1,
lambda_v = 1, lambda_u = 1,
Omega_u = second_diff_mat(17), Omega_v = second_diff_mat(8)
alpha_v = 0.12, alpha_u = 0.32,
Omega_v = second_diff_mat(8), Omega_u = second_diff_mat(17),
lambda_v = seq(0.1, 1, 0.2), lambda_u = 2.1
)
# correct arguments
expect_no_error(
a$interpolate(
lambda_v = 1, exact = TRUE
)
)
# extra arguments
expect_error(
a$interpolate(
lambda_v = 1, alpha_v = 1, alpha_u = 1,
exact = TRUE
),
"Invalid index in SFPCA::interpolate: alpha_u."
)
# alpha_v must not be specified
expect_error(
a$interpolate(
lambda_v = 0.21, alpha_v = 0.09
),
"Invalid index in SFPCA::interpolate: alpha_v."
)
expect_equal(internal_call$U, dir_call$u)
expect_equal(internal_call$V, dir_call$v)
})


Expand All @@ -753,29 +816,29 @@ test_that("SFPCA object: interpolate, inexact mode", {
# error becasue both alpha_v and lambda_v should be specified
expect_error(
a$interpolate(alpha_v = 0.23),
"SFPCA::interpolate only supports one-sided interpolation."
"Please spesify the following argument(s): lambda_v.",
fixed = TRUE
)
expect_error(
a$interpolate(),
"lease spesify the following argument(s): alpha_v,lambda_v.",
fixed = TRUE
)

# error becasue alpha_u is a scalar during initialization
expect_error(
a$interpolate(alpha_u = 0.2323),
paste0(
"Invalid index in SFPCA::interpolate. Do not specify indexes of parameters ",
"i) that are chosen by BIC, or ",
"ii) that are not specified during initialization of the SFCPA object, or ",
"iii) that are scalars during initialization of the SFCPA object."
)
"Invalid index in SFPCA::interpolate: alpha_u"
)

# error becasue both alpha_u should not be specified
# error becasue alpha_u should not be specified
expect_error(
a$interpolate(alpha_v = 0.23, lambda_v = 0.121, alpha_u = 1),
paste0(
"Invalid index in SFPCA::interpolate. Do not specify indexes of parameters ",
"i) that are chosen by BIC, or ",
"ii) that are not specified during initialization of the SFCPA object, or ",
"iii) that are scalars during initialization of the SFCPA object."
)
"Invalid index in SFPCA::interpolate: alpha_u"
)
expect_error(
a$interpolate(alpha_v = 0.23, lambda_v = 0.121, alpha_u = 1, lambda_u = 1.3),
"Invalid index in SFPCA::interpolate: alpha_u,lambda_u."
)

# unsorted alpha_v
Expand Down

0 comments on commit 2dedb5a

Please sign in to comment.