CRAN Package Check Results for Package TVsMiss

Last updated on 2020-02-19 10:49:14 CET.

Additional issues

rchk

Check Details

Version: 0.1.1
Check: examples
Result: ERROR
    Running examples in 'TVsMiss-Ex.R' failed
    The error most likely occurred in:
    
    > base::assign(".ptime", proc.time(), pos = "CheckExEnv")
    > ### Name: plot.TVsMiss
    > ### Title: plot solution path from the fitted "TVsMiss" object
    > ### Aliases: plot.TVsMiss
    >
    > ### ** Examples
    >
    > n <- 50
    > p <- 8
    > beta <- c(3,0,1.5,0,2,rep(0,p-5))
    > xm <- matrix(rnorm(n*p),ncol = p, nrow = n)
    > y <- xm %*% beta + rnorm(n)
    > colnames(xm) <- paste0("Var_",1:p)
    >
    > fit01 <- tvsmiss(x=xm,y=y)
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
    :
     --- package (from environment) ---
    TVsMiss
     --- call from context ---
    tvsmiss(x = xm, y = y)
     --- call from argument ---
    if (class(x) != "matrix") {
     tmp <- try(x <- model.matrix(~0 + ., data = x), silent = TRUE)
     if (class(tmp)[1] == "try-error")
     stop("x must be a matrix or able to be coerced to a matrix")
    }
     --- R stacktrace ---
    where 1: tvsmiss(x = xm, y = y)
    
     --- value of length: 2 type: logical ---
    [1] FALSE TRUE
     --- function from context ---
    function (x, y, penalty = c("lasso", "MCP", "SCAD"), method = c("CV",
     "BIC", "BIC1", "BIC2", "sBIC", "sBIC1", "sBIC2", "sVS", "sEST"),
     lambda = NULL, fold = 5, cv.ind = NULL, repeat_b = 20, alpha_n = 0.1,
     refit = F, gamma = switch(penalty, SCAD = 3.7, MCP = 3, lasso = NA),
     use.penalty = T)
    {
     penalty <- match.arg(penalty)
     method <- match.arg(method)
     this.call = match.call()
     if (class(x) != "matrix") {
     tmp <- try(x <- model.matrix(~0 + ., data = x), silent = TRUE)
     if (class(tmp)[1] == "try-error")
     stop("x must be a matrix or able to be coerced to a matrix")
     }
     if (storage.mode(x) == "integer")
     storage.mode(x) <- "double"
     if (class(y) != "numeric") {
     tmp <- try(y <- as.numeric(y), silent = TRUE)
     if (class(tmp)[1] == "try-error")
     stop("y must numeric or able to be coerced to numeric")
     }
     if (length(y) != nrow(x))
     stop("x and y do not have the same number of observations")
     colnames(x) <- if (is.null(colnames(x)))
     paste("V", 1:ncol(x), sep = "")
     else colnames(x)
     data <- cbind(y, x)
     complete_idx <- c(1:length(y))[complete.cases(data)]
     y_complete <- y[complete_idx]
     x_complete <- x[complete_idx, ]
     sample_no_missing <- cbind(y_complete, x_complete)
     logistic_sample <- pairdata(sample_no_missing)
     if (use.penalty) {
     if (is.null(cv.ind)) {
     if (fold < 2 | fold > nrow(sample_no_missing))
     stop("fold should be greater than 1 and less than the rows in the complete data(after deleting missing)")
     cv.ind <- ceiling(sample(1:nrow(sample_no_missing))/(nrow(sample_no_missing) +
     sqrt(.Machine$double.eps)) * fold)
     }
     else {
     if (length(cv.ind) != nrow(sample_no_missing) | max(cv.ind) >
     nrow(sample_no_missing))
     stop("cv.ind is not match to the complete data")
     }
     sample_no_missing_list <- list()
     for (i in 1:max(cv.ind)) {
     sample_no_missing_list[[i]] <- sample_no_missing[cv.ind ==
     i, ]
     }
     logistic_list_estimation <- cv_logistic_prepare(complete_data = sample_no_missing,
     cv.ind = cv.ind)
     current_model <- model_est_path(logistic_sample = logistic_sample,
     lambda = lambda, penalty = penalty, gamma = gamma)
     beta_matrix <- t(as.matrix(coef(current_model)))[, -1]
     lambda <- current_model$lambda
     if (method == "CV") {
     begin_time <- proc.time()
     selection_res <- cv_sel(logistic_list = logistic_list_estimation,
     complete_data_list = sample_no_missing_list,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "BIC") {
     begin_time <- proc.time()
     selection_res <- BIC_log_cal(complete_dataset = sample_no_missing,
     beta_matrix = beta_matrix)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sBIC") {
     begin_time <- proc.time()
     selection_res <- sBIC(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sBIC1") {
     begin_time <- proc.time()
     selection_res <- sBIChigh(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sBIC2") {
     begin_time <- proc.time()
     selection_res <- sBICultrahigh(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sVS") {
     if (fold == 2) {
     begin_time <- proc.time()
     selection_res <- VSS(complete_data = sample_no_missing,
     lambda = lambda, repeat_b = repeat_b, alpha_n = alpha_n,
     penalty = penalty, gamma = gamma)
     selection_idx <- which(lambda == selection_res$selection_lambda_value)
     selection_lambda <- selection_res$selection_lambda_value
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx,
     ]
     final_time <- proc.time() - begin_time
     }
     else {
     begin_time <- proc.time()
     selection_res <- fleiss(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, alpha_n = alpha_n, gamma = gamma)
     selection_idx <- which(lambda == selection_res$selection_lambda_value)
     selection_lambda <- selection_res$selection_lambda_value
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx,
     ]
     final_time <- proc.time() - begin_time
     }
     }
     else if (method == "sEST") {
     begin_time <- proc.time()
     selection_res <- sEST(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "BIC1") {
     begin_time <- proc.time()
     selection_res <- BIC_high(complete_dataset = sample_no_missing,
     beta_matrix = beta_matrix)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "BIC2") {
     begin_time <- proc.time()
     selection_res <- BIC_ultrahigh(complete_dataset = sample_no_missing,
     beta_matrix = beta_matrix)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     }
     else {
     begin_time <- proc.time()
     glm_model <- glm(logistic_sample[, 1] ~ -1 + logistic_sample[,
     -1], family = binomial(link = "logit"))
     current_model = glm_model
     beta_matrix = NULL
     lambda = NULL
     cv.ind = NULL
     selection_idx = NULL
     selection_lambda = NULL
     selection_path = NULL
     selection_cv.ind = NULL
     selection_beta = current_model$coefficients
     names(selection_beta) <- colnames(logistic_sample)[-1]
     final_time <- proc.time() - begin_time
     }
     deviance.ratio = 1 + loglikelihood_r(c(0, selection_beta),
     sample_no_missing)/log(2)
     if (refit & use.penalty) {
     if (sum(selection_beta != 0) == 0) {
     refit_beta = selection_beta
     }
     else {
     refit_model <- glm(logistic_sample[, 1] ~ -1 + logistic_sample[,
     -1][, which(selection_beta != 0)], family = binomial(link = "logit"))
     refit_beta <- rep(0, ncol(logistic_sample) - 1)
     refit_beta[which(selection_beta != 0)] <- refit_model$coefficients
     names(refit_beta) <- colnames(logistic_sample)[-1]
     }
     }
     else {
     refit_beta = NULL
     }
     res <- list(ls = logistic_sample, c_idx = complete_idx, model = current_model,
     beta_matrix = beta_matrix, lambda = lambda, cv.ind = cv.ind,
     fold = fold, selection_idx = selection_idx, selection_lambda = selection_lambda,
     selection_path = selection_path, selection_cv.ind = selection_cv.ind,
     selection_beta = selection_beta, refit_beta = refit_beta,
     null.deviance = 2 * log(2), deviance.ratio = deviance.ratio,
     gamma = gamma, call = this.call, running_time = final_time)
     class(res) = "TVsMiss"
     return(res)
    }
    <bytecode: 0xb659f00>
    <environment: namespace:TVsMiss>
     --- function search by body ---
    Function tvsmiss in namespace TVsMiss has this body.
     ----------- END OF FAILURE REPORT --------------
    Error in if (class(x) != "matrix") { : the condition has length > 1
    Calls: tvsmiss
    Execution halted
Flavor: r-devel-linux-x86_64-debian-clang

Version: 0.1.1
Check: tests
Result: ERROR
     Running 'test.R' [3s/3s]
    Running the tests in 'tests/test.R' failed.
    Complete output:
     > rm(list = ls())
     > library(TVsMiss)
     > n <- 50
     > p <- 8
     > beta <- c(3,0,1.5,0,2,rep(0,p-5))
     > xm <- matrix(rnorm(n*p),ncol = p, nrow = n)
     > y <- xm %*% beta + rnorm(n)
     > colnames(xm) <- paste0("Var_",1:p)
     >
     > fit01 <- tvsmiss(x=xm,y=y)
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
     :
     --- package (from environment) ---
     TVsMiss
     --- call from context ---
     tvsmiss(x = xm, y = y)
     --- call from argument ---
     if (class(x) != "matrix") {
     tmp <- try(x <- model.matrix(~0 + ., data = x), silent = TRUE)
     if (class(tmp)[1] == "try-error")
     stop("x must be a matrix or able to be coerced to a matrix")
     }
     --- R stacktrace ---
     where 1: tvsmiss(x = xm, y = y)
    
     --- value of length: 2 type: logical ---
     [1] FALSE TRUE
     --- function from context ---
     function (x, y, penalty = c("lasso", "MCP", "SCAD"), method = c("CV",
     "BIC", "BIC1", "BIC2", "sBIC", "sBIC1", "sBIC2", "sVS", "sEST"),
     lambda = NULL, fold = 5, cv.ind = NULL, repeat_b = 20, alpha_n = 0.1,
     refit = F, gamma = switch(penalty, SCAD = 3.7, MCP = 3, lasso = NA),
     use.penalty = T)
     {
     penalty <- match.arg(penalty)
     method <- match.arg(method)
     this.call = match.call()
     if (class(x) != "matrix") {
     tmp <- try(x <- model.matrix(~0 + ., data = x), silent = TRUE)
     if (class(tmp)[1] == "try-error")
     stop("x must be a matrix or able to be coerced to a matrix")
     }
     if (storage.mode(x) == "integer")
     storage.mode(x) <- "double"
     if (class(y) != "numeric") {
     tmp <- try(y <- as.numeric(y), silent = TRUE)
     if (class(tmp)[1] == "try-error")
     stop("y must numeric or able to be coerced to numeric")
     }
     if (length(y) != nrow(x))
     stop("x and y do not have the same number of observations")
     colnames(x) <- if (is.null(colnames(x)))
     paste("V", 1:ncol(x), sep = "")
     else colnames(x)
     data <- cbind(y, x)
     complete_idx <- c(1:length(y))[complete.cases(data)]
     y_complete <- y[complete_idx]
     x_complete <- x[complete_idx, ]
     sample_no_missing <- cbind(y_complete, x_complete)
     logistic_sample <- pairdata(sample_no_missing)
     if (use.penalty) {
     if (is.null(cv.ind)) {
     if (fold < 2 | fold > nrow(sample_no_missing))
     stop("fold should be greater than 1 and less than the rows in the complete data(after deleting missing)")
     cv.ind <- ceiling(sample(1:nrow(sample_no_missing))/(nrow(sample_no_missing) +
     sqrt(.Machine$double.eps)) * fold)
     }
     else {
     if (length(cv.ind) != nrow(sample_no_missing) | max(cv.ind) >
     nrow(sample_no_missing))
     stop("cv.ind is not match to the complete data")
     }
     sample_no_missing_list <- list()
     for (i in 1:max(cv.ind)) {
     sample_no_missing_list[[i]] <- sample_no_missing[cv.ind ==
     i, ]
     }
     logistic_list_estimation <- cv_logistic_prepare(complete_data = sample_no_missing,
     cv.ind = cv.ind)
     current_model <- model_est_path(logistic_sample = logistic_sample,
     lambda = lambda, penalty = penalty, gamma = gamma)
     beta_matrix <- t(as.matrix(coef(current_model)))[, -1]
     lambda <- current_model$lambda
     if (method == "CV") {
     begin_time <- proc.time()
     selection_res <- cv_sel(logistic_list = logistic_list_estimation,
     complete_data_list = sample_no_missing_list,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "BIC") {
     begin_time <- proc.time()
     selection_res <- BIC_log_cal(complete_dataset = sample_no_missing,
     beta_matrix = beta_matrix)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sBIC") {
     begin_time <- proc.time()
     selection_res <- sBIC(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sBIC1") {
     begin_time <- proc.time()
     selection_res <- sBIChigh(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sBIC2") {
     begin_time <- proc.time()
     selection_res <- sBICultrahigh(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sVS") {
     if (fold == 2) {
     begin_time <- proc.time()
     selection_res <- VSS(complete_data = sample_no_missing,
     lambda = lambda, repeat_b = repeat_b, alpha_n = alpha_n,
     penalty = penalty, gamma = gamma)
     selection_idx <- which(lambda == selection_res$selection_lambda_value)
     selection_lambda <- selection_res$selection_lambda_value
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx,
     ]
     final_time <- proc.time() - begin_time
     }
     else {
     begin_time <- proc.time()
     selection_res <- fleiss(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, alpha_n = alpha_n, gamma = gamma)
     selection_idx <- which(lambda == selection_res$selection_lambda_value)
     selection_lambda <- selection_res$selection_lambda_value
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx,
     ]
     final_time <- proc.time() - begin_time
     }
     }
     else if (method == "sEST") {
     begin_time <- proc.time()
     selection_res <- sEST(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "BIC1") {
     begin_time <- proc.time()
     selection_res <- BIC_high(complete_dataset = sample_no_missing,
     beta_matrix = beta_matrix)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "BIC2") {
     begin_time <- proc.time()
     selection_res <- BIC_ultrahigh(complete_dataset = sample_no_missing,
     beta_matrix = beta_matrix)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     }
     else {
     begin_time <- proc.time()
     glm_model <- glm(logistic_sample[, 1] ~ -1 + logistic_sample[,
     -1], family = binomial(link = "logit"))
     current_model = glm_model
     beta_matrix = NULL
     lambda = NULL
     cv.ind = NULL
     selection_idx = NULL
     selection_lambda = NULL
     selection_path = NULL
     selection_cv.ind = NULL
     selection_beta = current_model$coefficients
     names(selection_beta) <- colnames(logistic_sample)[-1]
     final_time <- proc.time() - begin_time
     }
     deviance.ratio = 1 + loglikelihood_r(c(0, selection_beta),
     sample_no_missing)/log(2)
     if (refit & use.penalty) {
     if (sum(selection_beta != 0) == 0) {
     refit_beta = selection_beta
     }
     else {
     refit_model <- glm(logistic_sample[, 1] ~ -1 + logistic_sample[,
     -1][, which(selection_beta != 0)], family = binomial(link = "logit"))
     refit_beta <- rep(0, ncol(logistic_sample) - 1)
     refit_beta[which(selection_beta != 0)] <- refit_model$coefficients
     names(refit_beta) <- colnames(logistic_sample)[-1]
     }
     }
     else {
     refit_beta = NULL
     }
     res <- list(ls = logistic_sample, c_idx = complete_idx, model = current_model,
     beta_matrix = beta_matrix, lambda = lambda, cv.ind = cv.ind,
     fold = fold, selection_idx = selection_idx, selection_lambda = selection_lambda,
     selection_path = selection_path, selection_cv.ind = selection_cv.ind,
     selection_beta = selection_beta, refit_beta = refit_beta,
     null.deviance = 2 * log(2), deviance.ratio = deviance.ratio,
     gamma = gamma, call = this.call, running_time = final_time)
     class(res) = "TVsMiss"
     return(res)
     }
     <bytecode: 0xae5b8c8>
     <environment: namespace:TVsMiss>
     --- function search by body ---
     Function tvsmiss in namespace TVsMiss has this body.
     ----------- END OF FAILURE REPORT --------------
     Error in if (class(x) != "matrix") { : the condition has length > 1
     Calls: tvsmiss
     Execution halted
Flavor: r-devel-linux-x86_64-debian-clang

Version: 0.1.1
Check: examples
Result: ERROR
    Running examples in ‘TVsMiss-Ex.R’ failed
    The error most likely occurred in:
    
    > base::assign(".ptime", proc.time(), pos = "CheckExEnv")
    > ### Name: plot.TVsMiss
    > ### Title: plot solution path from the fitted "TVsMiss" object
    > ### Aliases: plot.TVsMiss
    >
    > ### ** Examples
    >
    > n <- 50
    > p <- 8
    > beta <- c(3,0,1.5,0,2,rep(0,p-5))
    > xm <- matrix(rnorm(n*p),ncol = p, nrow = n)
    > y <- xm %*% beta + rnorm(n)
    > colnames(xm) <- paste0("Var_",1:p)
    >
    > fit01 <- tvsmiss(x=xm,y=y)
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
    :
     --- package (from environment) ---
    TVsMiss
     --- call from context ---
    tvsmiss(x = xm, y = y)
     --- call from argument ---
    if (class(x) != "matrix") {
     tmp <- try(x <- model.matrix(~0 + ., data = x), silent = TRUE)
     if (class(tmp)[1] == "try-error")
     stop("x must be a matrix or able to be coerced to a matrix")
    }
     --- R stacktrace ---
    where 1: tvsmiss(x = xm, y = y)
    
     --- value of length: 2 type: logical ---
    [1] FALSE TRUE
     --- function from context ---
    function (x, y, penalty = c("lasso", "MCP", "SCAD"), method = c("CV",
     "BIC", "BIC1", "BIC2", "sBIC", "sBIC1", "sBIC2", "sVS", "sEST"),
     lambda = NULL, fold = 5, cv.ind = NULL, repeat_b = 20, alpha_n = 0.1,
     refit = F, gamma = switch(penalty, SCAD = 3.7, MCP = 3, lasso = NA),
     use.penalty = T)
    {
     penalty <- match.arg(penalty)
     method <- match.arg(method)
     this.call = match.call()
     if (class(x) != "matrix") {
     tmp <- try(x <- model.matrix(~0 + ., data = x), silent = TRUE)
     if (class(tmp)[1] == "try-error")
     stop("x must be a matrix or able to be coerced to a matrix")
     }
     if (storage.mode(x) == "integer")
     storage.mode(x) <- "double"
     if (class(y) != "numeric") {
     tmp <- try(y <- as.numeric(y), silent = TRUE)
     if (class(tmp)[1] == "try-error")
     stop("y must numeric or able to be coerced to numeric")
     }
     if (length(y) != nrow(x))
     stop("x and y do not have the same number of observations")
     colnames(x) <- if (is.null(colnames(x)))
     paste("V", 1:ncol(x), sep = "")
     else colnames(x)
     data <- cbind(y, x)
     complete_idx <- c(1:length(y))[complete.cases(data)]
     y_complete <- y[complete_idx]
     x_complete <- x[complete_idx, ]
     sample_no_missing <- cbind(y_complete, x_complete)
     logistic_sample <- pairdata(sample_no_missing)
     if (use.penalty) {
     if (is.null(cv.ind)) {
     if (fold < 2 | fold > nrow(sample_no_missing))
     stop("fold should be greater than 1 and less than the rows in the complete data(after deleting missing)")
     cv.ind <- ceiling(sample(1:nrow(sample_no_missing))/(nrow(sample_no_missing) +
     sqrt(.Machine$double.eps)) * fold)
     }
     else {
     if (length(cv.ind) != nrow(sample_no_missing) | max(cv.ind) >
     nrow(sample_no_missing))
     stop("cv.ind is not match to the complete data")
     }
     sample_no_missing_list <- list()
     for (i in 1:max(cv.ind)) {
     sample_no_missing_list[[i]] <- sample_no_missing[cv.ind ==
     i, ]
     }
     logistic_list_estimation <- cv_logistic_prepare(complete_data = sample_no_missing,
     cv.ind = cv.ind)
     current_model <- model_est_path(logistic_sample = logistic_sample,
     lambda = lambda, penalty = penalty, gamma = gamma)
     beta_matrix <- t(as.matrix(coef(current_model)))[, -1]
     lambda <- current_model$lambda
     if (method == "CV") {
     begin_time <- proc.time()
     selection_res <- cv_sel(logistic_list = logistic_list_estimation,
     complete_data_list = sample_no_missing_list,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "BIC") {
     begin_time <- proc.time()
     selection_res <- BIC_log_cal(complete_dataset = sample_no_missing,
     beta_matrix = beta_matrix)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sBIC") {
     begin_time <- proc.time()
     selection_res <- sBIC(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sBIC1") {
     begin_time <- proc.time()
     selection_res <- sBIChigh(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sBIC2") {
     begin_time <- proc.time()
     selection_res <- sBICultrahigh(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sVS") {
     if (fold == 2) {
     begin_time <- proc.time()
     selection_res <- VSS(complete_data = sample_no_missing,
     lambda = lambda, repeat_b = repeat_b, alpha_n = alpha_n,
     penalty = penalty, gamma = gamma)
     selection_idx <- which(lambda == selection_res$selection_lambda_value)
     selection_lambda <- selection_res$selection_lambda_value
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx,
     ]
     final_time <- proc.time() - begin_time
     }
     else {
     begin_time <- proc.time()
     selection_res <- fleiss(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, alpha_n = alpha_n, gamma = gamma)
     selection_idx <- which(lambda == selection_res$selection_lambda_value)
     selection_lambda <- selection_res$selection_lambda_value
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx,
     ]
     final_time <- proc.time() - begin_time
     }
     }
     else if (method == "sEST") {
     begin_time <- proc.time()
     selection_res <- sEST(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "BIC1") {
     begin_time <- proc.time()
     selection_res <- BIC_high(complete_dataset = sample_no_missing,
     beta_matrix = beta_matrix)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "BIC2") {
     begin_time <- proc.time()
     selection_res <- BIC_ultrahigh(complete_dataset = sample_no_missing,
     beta_matrix = beta_matrix)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     }
     else {
     begin_time <- proc.time()
     glm_model <- glm(logistic_sample[, 1] ~ -1 + logistic_sample[,
     -1], family = binomial(link = "logit"))
     current_model = glm_model
     beta_matrix = NULL
     lambda = NULL
     cv.ind = NULL
     selection_idx = NULL
     selection_lambda = NULL
     selection_path = NULL
     selection_cv.ind = NULL
     selection_beta = current_model$coefficients
     names(selection_beta) <- colnames(logistic_sample)[-1]
     final_time <- proc.time() - begin_time
     }
     deviance.ratio = 1 + loglikelihood_r(c(0, selection_beta),
     sample_no_missing)/log(2)
     if (refit & use.penalty) {
     if (sum(selection_beta != 0) == 0) {
     refit_beta = selection_beta
     }
     else {
     refit_model <- glm(logistic_sample[, 1] ~ -1 + logistic_sample[,
     -1][, which(selection_beta != 0)], family = binomial(link = "logit"))
     refit_beta <- rep(0, ncol(logistic_sample) - 1)
     refit_beta[which(selection_beta != 0)] <- refit_model$coefficients
     names(refit_beta) <- colnames(logistic_sample)[-1]
     }
     }
     else {
     refit_beta = NULL
     }
     res <- list(ls = logistic_sample, c_idx = complete_idx, model = current_model,
     beta_matrix = beta_matrix, lambda = lambda, cv.ind = cv.ind,
     fold = fold, selection_idx = selection_idx, selection_lambda = selection_lambda,
     selection_path = selection_path, selection_cv.ind = selection_cv.ind,
     selection_beta = selection_beta, refit_beta = refit_beta,
     null.deviance = 2 * log(2), deviance.ratio = deviance.ratio,
     gamma = gamma, call = this.call, running_time = final_time)
     class(res) = "TVsMiss"
     return(res)
    }
    <bytecode: 0x55b3c4c03750>
    <environment: namespace:TVsMiss>
     --- function search by body ---
    Function tvsmiss in namespace TVsMiss has this body.
     ----------- END OF FAILURE REPORT --------------
    Error in if (class(x) != "matrix") { : the condition has length > 1
    Calls: tvsmiss
    Execution halted
Flavor: r-devel-linux-x86_64-debian-gcc

Version: 0.1.1
Check: tests
Result: ERROR
     Running ‘test.R’ [2s/5s]
    Running the tests in ‘tests/test.R’ failed.
    Complete output:
     > rm(list = ls())
     > library(TVsMiss)
     > n <- 50
     > p <- 8
     > beta <- c(3,0,1.5,0,2,rep(0,p-5))
     > xm <- matrix(rnorm(n*p),ncol = p, nrow = n)
     > y <- xm %*% beta + rnorm(n)
     > colnames(xm) <- paste0("Var_",1:p)
     >
     > fit01 <- tvsmiss(x=xm,y=y)
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
     :
     --- package (from environment) ---
     TVsMiss
     --- call from context ---
     tvsmiss(x = xm, y = y)
     --- call from argument ---
     if (class(x) != "matrix") {
     tmp <- try(x <- model.matrix(~0 + ., data = x), silent = TRUE)
     if (class(tmp)[1] == "try-error")
     stop("x must be a matrix or able to be coerced to a matrix")
     }
     --- R stacktrace ---
     where 1: tvsmiss(x = xm, y = y)
    
     --- value of length: 2 type: logical ---
     [1] FALSE TRUE
     --- function from context ---
     function (x, y, penalty = c("lasso", "MCP", "SCAD"), method = c("CV",
     "BIC", "BIC1", "BIC2", "sBIC", "sBIC1", "sBIC2", "sVS", "sEST"),
     lambda = NULL, fold = 5, cv.ind = NULL, repeat_b = 20, alpha_n = 0.1,
     refit = F, gamma = switch(penalty, SCAD = 3.7, MCP = 3, lasso = NA),
     use.penalty = T)
     {
     penalty <- match.arg(penalty)
     method <- match.arg(method)
     this.call = match.call()
     if (class(x) != "matrix") {
     tmp <- try(x <- model.matrix(~0 + ., data = x), silent = TRUE)
     if (class(tmp)[1] == "try-error")
     stop("x must be a matrix or able to be coerced to a matrix")
     }
     if (storage.mode(x) == "integer")
     storage.mode(x) <- "double"
     if (class(y) != "numeric") {
     tmp <- try(y <- as.numeric(y), silent = TRUE)
     if (class(tmp)[1] == "try-error")
     stop("y must numeric or able to be coerced to numeric")
     }
     if (length(y) != nrow(x))
     stop("x and y do not have the same number of observations")
     colnames(x) <- if (is.null(colnames(x)))
     paste("V", 1:ncol(x), sep = "")
     else colnames(x)
     data <- cbind(y, x)
     complete_idx <- c(1:length(y))[complete.cases(data)]
     y_complete <- y[complete_idx]
     x_complete <- x[complete_idx, ]
     sample_no_missing <- cbind(y_complete, x_complete)
     logistic_sample <- pairdata(sample_no_missing)
     if (use.penalty) {
     if (is.null(cv.ind)) {
     if (fold < 2 | fold > nrow(sample_no_missing))
     stop("fold should be greater than 1 and less than the rows in the complete data(after deleting missing)")
     cv.ind <- ceiling(sample(1:nrow(sample_no_missing))/(nrow(sample_no_missing) +
     sqrt(.Machine$double.eps)) * fold)
     }
     else {
     if (length(cv.ind) != nrow(sample_no_missing) | max(cv.ind) >
     nrow(sample_no_missing))
     stop("cv.ind is not match to the complete data")
     }
     sample_no_missing_list <- list()
     for (i in 1:max(cv.ind)) {
     sample_no_missing_list[[i]] <- sample_no_missing[cv.ind ==
     i, ]
     }
     logistic_list_estimation <- cv_logistic_prepare(complete_data = sample_no_missing,
     cv.ind = cv.ind)
     current_model <- model_est_path(logistic_sample = logistic_sample,
     lambda = lambda, penalty = penalty, gamma = gamma)
     beta_matrix <- t(as.matrix(coef(current_model)))[, -1]
     lambda <- current_model$lambda
     if (method == "CV") {
     begin_time <- proc.time()
     selection_res <- cv_sel(logistic_list = logistic_list_estimation,
     complete_data_list = sample_no_missing_list,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "BIC") {
     begin_time <- proc.time()
     selection_res <- BIC_log_cal(complete_dataset = sample_no_missing,
     beta_matrix = beta_matrix)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sBIC") {
     begin_time <- proc.time()
     selection_res <- sBIC(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sBIC1") {
     begin_time <- proc.time()
     selection_res <- sBIChigh(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sBIC2") {
     begin_time <- proc.time()
     selection_res <- sBICultrahigh(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sVS") {
     if (fold == 2) {
     begin_time <- proc.time()
     selection_res <- VSS(complete_data = sample_no_missing,
     lambda = lambda, repeat_b = repeat_b, alpha_n = alpha_n,
     penalty = penalty, gamma = gamma)
     selection_idx <- which(lambda == selection_res$selection_lambda_value)
     selection_lambda <- selection_res$selection_lambda_value
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx,
     ]
     final_time <- proc.time() - begin_time
     }
     else {
     begin_time <- proc.time()
     selection_res <- fleiss(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, alpha_n = alpha_n, gamma = gamma)
     selection_idx <- which(lambda == selection_res$selection_lambda_value)
     selection_lambda <- selection_res$selection_lambda_value
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx,
     ]
     final_time <- proc.time() - begin_time
     }
     }
     else if (method == "sEST") {
     begin_time <- proc.time()
     selection_res <- sEST(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "BIC1") {
     begin_time <- proc.time()
     selection_res <- BIC_high(complete_dataset = sample_no_missing,
     beta_matrix = beta_matrix)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "BIC2") {
     begin_time <- proc.time()
     selection_res <- BIC_ultrahigh(complete_dataset = sample_no_missing,
     beta_matrix = beta_matrix)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     }
     else {
     begin_time <- proc.time()
     glm_model <- glm(logistic_sample[, 1] ~ -1 + logistic_sample[,
     -1], family = binomial(link = "logit"))
     current_model = glm_model
     beta_matrix = NULL
     lambda = NULL
     cv.ind = NULL
     selection_idx = NULL
     selection_lambda = NULL
     selection_path = NULL
     selection_cv.ind = NULL
     selection_beta = current_model$coefficients
     names(selection_beta) <- colnames(logistic_sample)[-1]
     final_time <- proc.time() - begin_time
     }
     deviance.ratio = 1 + loglikelihood_r(c(0, selection_beta),
     sample_no_missing)/log(2)
     if (refit & use.penalty) {
     if (sum(selection_beta != 0) == 0) {
     refit_beta = selection_beta
     }
     else {
     refit_model <- glm(logistic_sample[, 1] ~ -1 + logistic_sample[,
     -1][, which(selection_beta != 0)], family = binomial(link = "logit"))
     refit_beta <- rep(0, ncol(logistic_sample) - 1)
     refit_beta[which(selection_beta != 0)] <- refit_model$coefficients
     names(refit_beta) <- colnames(logistic_sample)[-1]
     }
     }
     else {
     refit_beta = NULL
     }
     res <- list(ls = logistic_sample, c_idx = complete_idx, model = current_model,
     beta_matrix = beta_matrix, lambda = lambda, cv.ind = cv.ind,
     fold = fold, selection_idx = selection_idx, selection_lambda = selection_lambda,
     selection_path = selection_path, selection_cv.ind = selection_cv.ind,
     selection_beta = selection_beta, refit_beta = refit_beta,
     null.deviance = 2 * log(2), deviance.ratio = deviance.ratio,
     gamma = gamma, call = this.call, running_time = final_time)
     class(res) = "TVsMiss"
     return(res)
     }
     <bytecode: 0x557cd6572868>
     <environment: namespace:TVsMiss>
     --- function search by body ---
     Function tvsmiss in namespace TVsMiss has this body.
     ----------- END OF FAILURE REPORT --------------
     Error in if (class(x) != "matrix") { : the condition has length > 1
     Calls: tvsmiss
     Execution halted
Flavor: r-devel-linux-x86_64-debian-gcc

Version: 0.1.1
Check: dependencies in R code
Result: NOTE
    Namespace in Imports field not imported from: ‘Rcpp’
     All declared Imports should be used.
Flavors: r-devel-linux-x86_64-fedora-clang, r-devel-linux-x86_64-fedora-gcc, r-patched-solaris-x86, r-release-osx-x86_64, r-oldrel-osx-x86_64

Version: 0.1.1
Check: examples
Result: ERROR
    Running examples in ‘TVsMiss-Ex.R’ failed
    The error most likely occurred in:
    
    > ### Name: plot.TVsMiss
    > ### Title: plot solution path from the fitted "TVsMiss" object
    > ### Aliases: plot.TVsMiss
    >
    > ### ** Examples
    >
    > n <- 50
    > p <- 8
    > beta <- c(3,0,1.5,0,2,rep(0,p-5))
    > xm <- matrix(rnorm(n*p),ncol = p, nrow = n)
    > y <- xm %*% beta + rnorm(n)
    > colnames(xm) <- paste0("Var_",1:p)
    >
    > fit01 <- tvsmiss(x=xm,y=y)
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
    :
     --- package (from environment) ---
    TVsMiss
     --- call from context ---
    tvsmiss(x = xm, y = y)
     --- call from argument ---
    if (class(x) != "matrix") {
     tmp <- try(x <- model.matrix(~0 + ., data = x), silent = TRUE)
     if (class(tmp)[1] == "try-error")
     stop("x must be a matrix or able to be coerced to a matrix")
    }
     --- R stacktrace ---
    where 1: tvsmiss(x = xm, y = y)
    
     --- value of length: 2 type: logical ---
    [1] FALSE TRUE
     --- function from context ---
    function (x, y, penalty = c("lasso", "MCP", "SCAD"), method = c("CV",
     "BIC", "BIC1", "BIC2", "sBIC", "sBIC1", "sBIC2", "sVS", "sEST"),
     lambda = NULL, fold = 5, cv.ind = NULL, repeat_b = 20, alpha_n = 0.1,
     refit = F, gamma = switch(penalty, SCAD = 3.7, MCP = 3, lasso = NA),
     use.penalty = T)
    {
     penalty <- match.arg(penalty)
     method <- match.arg(method)
     this.call = match.call()
     if (class(x) != "matrix") {
     tmp <- try(x <- model.matrix(~0 + ., data = x), silent = TRUE)
     if (class(tmp)[1] == "try-error")
     stop("x must be a matrix or able to be coerced to a matrix")
     }
     if (storage.mode(x) == "integer")
     storage.mode(x) <- "double"
     if (class(y) != "numeric") {
     tmp <- try(y <- as.numeric(y), silent = TRUE)
     if (class(tmp)[1] == "try-error")
     stop("y must numeric or able to be coerced to numeric")
     }
     if (length(y) != nrow(x))
     stop("x and y do not have the same number of observations")
     colnames(x) <- if (is.null(colnames(x)))
     paste("V", 1:ncol(x), sep = "")
     else colnames(x)
     data <- cbind(y, x)
     complete_idx <- c(1:length(y))[complete.cases(data)]
     y_complete <- y[complete_idx]
     x_complete <- x[complete_idx, ]
     sample_no_missing <- cbind(y_complete, x_complete)
     logistic_sample <- pairdata(sample_no_missing)
     if (use.penalty) {
     if (is.null(cv.ind)) {
     if (fold < 2 | fold > nrow(sample_no_missing))
     stop("fold should be greater than 1 and less than the rows in the complete data(after deleting missing)")
     cv.ind <- ceiling(sample(1:nrow(sample_no_missing))/(nrow(sample_no_missing) +
     sqrt(.Machine$double.eps)) * fold)
     }
     else {
     if (length(cv.ind) != nrow(sample_no_missing) | max(cv.ind) >
     nrow(sample_no_missing))
     stop("cv.ind is not match to the complete data")
     }
     sample_no_missing_list <- list()
     for (i in 1:max(cv.ind)) {
     sample_no_missing_list[[i]] <- sample_no_missing[cv.ind ==
     i, ]
     }
     logistic_list_estimation <- cv_logistic_prepare(complete_data = sample_no_missing,
     cv.ind = cv.ind)
     current_model <- model_est_path(logistic_sample = logistic_sample,
     lambda = lambda, penalty = penalty, gamma = gamma)
     beta_matrix <- t(as.matrix(coef(current_model)))[, -1]
     lambda <- current_model$lambda
     if (method == "CV") {
     begin_time <- proc.time()
     selection_res <- cv_sel(logistic_list = logistic_list_estimation,
     complete_data_list = sample_no_missing_list,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "BIC") {
     begin_time <- proc.time()
     selection_res <- BIC_log_cal(complete_dataset = sample_no_missing,
     beta_matrix = beta_matrix)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sBIC") {
     begin_time <- proc.time()
     selection_res <- sBIC(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sBIC1") {
     begin_time <- proc.time()
     selection_res <- sBIChigh(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sBIC2") {
     begin_time <- proc.time()
     selection_res <- sBICultrahigh(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sVS") {
     if (fold == 2) {
     begin_time <- proc.time()
     selection_res <- VSS(complete_data = sample_no_missing,
     lambda = lambda, repeat_b = repeat_b, alpha_n = alpha_n,
     penalty = penalty, gamma = gamma)
     selection_idx <- which(lambda == selection_res$selection_lambda_value)
     selection_lambda <- selection_res$selection_lambda_value
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx,
     ]
     final_time <- proc.time() - begin_time
     }
     else {
     begin_time <- proc.time()
     selection_res <- fleiss(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, alpha_n = alpha_n, gamma = gamma)
     selection_idx <- which(lambda == selection_res$selection_lambda_value)
     selection_lambda <- selection_res$selection_lambda_value
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx,
     ]
     final_time <- proc.time() - begin_time
     }
     }
     else if (method == "sEST") {
     begin_time <- proc.time()
     selection_res <- sEST(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "BIC1") {
     begin_time <- proc.time()
     selection_res <- BIC_high(complete_dataset = sample_no_missing,
     beta_matrix = beta_matrix)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "BIC2") {
     begin_time <- proc.time()
     selection_res <- BIC_ultrahigh(complete_dataset = sample_no_missing,
     beta_matrix = beta_matrix)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     }
     else {
     begin_time <- proc.time()
     glm_model <- glm(logistic_sample[, 1] ~ -1 + logistic_sample[,
     -1], family = binomial(link = "logit"))
     current_model = glm_model
     beta_matrix = NULL
     lambda = NULL
     cv.ind = NULL
     selection_idx = NULL
     selection_lambda = NULL
     selection_path = NULL
     selection_cv.ind = NULL
     selection_beta = current_model$coefficients
     names(selection_beta) <- colnames(logistic_sample)[-1]
     final_time <- proc.time() - begin_time
     }
     deviance.ratio = 1 + loglikelihood_r(c(0, selection_beta),
     sample_no_missing)/log(2)
     if (refit & use.penalty) {
     if (sum(selection_beta != 0) == 0) {
     refit_beta = selection_beta
     }
     else {
     refit_model <- glm(logistic_sample[, 1] ~ -1 + logistic_sample[,
     -1][, which(selection_beta != 0)], family = binomial(link = "logit"))
     refit_beta <- rep(0, ncol(logistic_sample) - 1)
     refit_beta[which(selection_beta != 0)] <- refit_model$coefficients
     names(refit_beta) <- colnames(logistic_sample)[-1]
     }
     }
     else {
     refit_beta = NULL
     }
     res <- list(ls = logistic_sample, c_idx = complete_idx, model = current_model,
     beta_matrix = beta_matrix, lambda = lambda, cv.ind = cv.ind,
     fold = fold, selection_idx = selection_idx, selection_lambda = selection_lambda,
     selection_path = selection_path, selection_cv.ind = selection_cv.ind,
     selection_beta = selection_beta, refit_beta = refit_beta,
     null.deviance = 2 * log(2), deviance.ratio = deviance.ratio,
     gamma = gamma, call = this.call, running_time = final_time)
     class(res) = "TVsMiss"
     return(res)
    }
    <bytecode: 0xc42b1b8>
    <environment: namespace:TVsMiss>
     --- function search by body ---
    Function tvsmiss in namespace TVsMiss has this body.
     ----------- END OF FAILURE REPORT --------------
    Error in if (class(x) != "matrix") { : the condition has length > 1
    Calls: tvsmiss
    Execution halted
Flavor: r-devel-linux-x86_64-fedora-clang

Version: 0.1.1
Check: tests
Result: ERROR
     Running ‘test.R’
    Running the tests in ‘tests/test.R’ failed.
    Complete output:
     > rm(list = ls())
     > library(TVsMiss)
     > n <- 50
     > p <- 8
     > beta <- c(3,0,1.5,0,2,rep(0,p-5))
     > xm <- matrix(rnorm(n*p),ncol = p, nrow = n)
     > y <- xm %*% beta + rnorm(n)
     > colnames(xm) <- paste0("Var_",1:p)
     >
     > fit01 <- tvsmiss(x=xm,y=y)
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
     :
     --- package (from environment) ---
     TVsMiss
     --- call from context ---
     tvsmiss(x = xm, y = y)
     --- call from argument ---
     if (class(x) != "matrix") {
     tmp <- try(x <- model.matrix(~0 + ., data = x), silent = TRUE)
     if (class(tmp)[1] == "try-error")
     stop("x must be a matrix or able to be coerced to a matrix")
     }
     --- R stacktrace ---
     where 1: tvsmiss(x = xm, y = y)
    
     --- value of length: 2 type: logical ---
     [1] FALSE TRUE
     --- function from context ---
     function (x, y, penalty = c("lasso", "MCP", "SCAD"), method = c("CV",
     "BIC", "BIC1", "BIC2", "sBIC", "sBIC1", "sBIC2", "sVS", "sEST"),
     lambda = NULL, fold = 5, cv.ind = NULL, repeat_b = 20, alpha_n = 0.1,
     refit = F, gamma = switch(penalty, SCAD = 3.7, MCP = 3, lasso = NA),
     use.penalty = T)
     {
     penalty <- match.arg(penalty)
     method <- match.arg(method)
     this.call = match.call()
     if (class(x) != "matrix") {
     tmp <- try(x <- model.matrix(~0 + ., data = x), silent = TRUE)
     if (class(tmp)[1] == "try-error")
     stop("x must be a matrix or able to be coerced to a matrix")
     }
     if (storage.mode(x) == "integer")
     storage.mode(x) <- "double"
     if (class(y) != "numeric") {
     tmp <- try(y <- as.numeric(y), silent = TRUE)
     if (class(tmp)[1] == "try-error")
     stop("y must numeric or able to be coerced to numeric")
     }
     if (length(y) != nrow(x))
     stop("x and y do not have the same number of observations")
     colnames(x) <- if (is.null(colnames(x)))
     paste("V", 1:ncol(x), sep = "")
     else colnames(x)
     data <- cbind(y, x)
     complete_idx <- c(1:length(y))[complete.cases(data)]
     y_complete <- y[complete_idx]
     x_complete <- x[complete_idx, ]
     sample_no_missing <- cbind(y_complete, x_complete)
     logistic_sample <- pairdata(sample_no_missing)
     if (use.penalty) {
     if (is.null(cv.ind)) {
     if (fold < 2 | fold > nrow(sample_no_missing))
     stop("fold should be greater than 1 and less than the rows in the complete data(after deleting missing)")
     cv.ind <- ceiling(sample(1:nrow(sample_no_missing))/(nrow(sample_no_missing) +
     sqrt(.Machine$double.eps)) * fold)
     }
     else {
     if (length(cv.ind) != nrow(sample_no_missing) | max(cv.ind) >
     nrow(sample_no_missing))
     stop("cv.ind is not match to the complete data")
     }
     sample_no_missing_list <- list()
     for (i in 1:max(cv.ind)) {
     sample_no_missing_list[[i]] <- sample_no_missing[cv.ind ==
     i, ]
     }
     logistic_list_estimation <- cv_logistic_prepare(complete_data = sample_no_missing,
     cv.ind = cv.ind)
     current_model <- model_est_path(logistic_sample = logistic_sample,
     lambda = lambda, penalty = penalty, gamma = gamma)
     beta_matrix <- t(as.matrix(coef(current_model)))[, -1]
     lambda <- current_model$lambda
     if (method == "CV") {
     begin_time <- proc.time()
     selection_res <- cv_sel(logistic_list = logistic_list_estimation,
     complete_data_list = sample_no_missing_list,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "BIC") {
     begin_time <- proc.time()
     selection_res <- BIC_log_cal(complete_dataset = sample_no_missing,
     beta_matrix = beta_matrix)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sBIC") {
     begin_time <- proc.time()
     selection_res <- sBIC(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sBIC1") {
     begin_time <- proc.time()
     selection_res <- sBIChigh(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sBIC2") {
     begin_time <- proc.time()
     selection_res <- sBICultrahigh(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sVS") {
     if (fold == 2) {
     begin_time <- proc.time()
     selection_res <- VSS(complete_data = sample_no_missing,
     lambda = lambda, repeat_b = repeat_b, alpha_n = alpha_n,
     penalty = penalty, gamma = gamma)
     selection_idx <- which(lambda == selection_res$selection_lambda_value)
     selection_lambda <- selection_res$selection_lambda_value
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx,
     ]
     final_time <- proc.time() - begin_time
     }
     else {
     begin_time <- proc.time()
     selection_res <- fleiss(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, alpha_n = alpha_n, gamma = gamma)
     selection_idx <- which(lambda == selection_res$selection_lambda_value)
     selection_lambda <- selection_res$selection_lambda_value
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx,
     ]
     final_time <- proc.time() - begin_time
     }
     }
     else if (method == "sEST") {
     begin_time <- proc.time()
     selection_res <- sEST(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "BIC1") {
     begin_time <- proc.time()
     selection_res <- BIC_high(complete_dataset = sample_no_missing,
     beta_matrix = beta_matrix)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "BIC2") {
     begin_time <- proc.time()
     selection_res <- BIC_ultrahigh(complete_dataset = sample_no_missing,
     beta_matrix = beta_matrix)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     }
     else {
     begin_time <- proc.time()
     glm_model <- glm(logistic_sample[, 1] ~ -1 + logistic_sample[,
     -1], family = binomial(link = "logit"))
     current_model = glm_model
     beta_matrix = NULL
     lambda = NULL
     cv.ind = NULL
     selection_idx = NULL
     selection_lambda = NULL
     selection_path = NULL
     selection_cv.ind = NULL
     selection_beta = current_model$coefficients
     names(selection_beta) <- colnames(logistic_sample)[-1]
     final_time <- proc.time() - begin_time
     }
     deviance.ratio = 1 + loglikelihood_r(c(0, selection_beta),
     sample_no_missing)/log(2)
     if (refit & use.penalty) {
     if (sum(selection_beta != 0) == 0) {
     refit_beta = selection_beta
     }
     else {
     refit_model <- glm(logistic_sample[, 1] ~ -1 + logistic_sample[,
     -1][, which(selection_beta != 0)], family = binomial(link = "logit"))
     refit_beta <- rep(0, ncol(logistic_sample) - 1)
     refit_beta[which(selection_beta != 0)] <- refit_model$coefficients
     names(refit_beta) <- colnames(logistic_sample)[-1]
     }
     }
     else {
     refit_beta = NULL
     }
     res <- list(ls = logistic_sample, c_idx = complete_idx, model = current_model,
     beta_matrix = beta_matrix, lambda = lambda, cv.ind = cv.ind,
     fold = fold, selection_idx = selection_idx, selection_lambda = selection_lambda,
     selection_path = selection_path, selection_cv.ind = selection_cv.ind,
     selection_beta = selection_beta, refit_beta = refit_beta,
     null.deviance = 2 * log(2), deviance.ratio = deviance.ratio,
     gamma = gamma, call = this.call, running_time = final_time)
     class(res) = "TVsMiss"
     return(res)
     }
     <bytecode: 0xac462e0>
     <environment: namespace:TVsMiss>
     --- function search by body ---
     Function tvsmiss in namespace TVsMiss has this body.
     ----------- END OF FAILURE REPORT --------------
     Error in if (class(x) != "matrix") { : the condition has length > 1
     Calls: tvsmiss
     Execution halted
Flavor: r-devel-linux-x86_64-fedora-clang

Version: 0.1.1
Check: examples
Result: ERROR
    Running examples in ‘TVsMiss-Ex.R’ failed
    The error most likely occurred in:
    
    > ### Name: plot.TVsMiss
    > ### Title: plot solution path from the fitted "TVsMiss" object
    > ### Aliases: plot.TVsMiss
    >
    > ### ** Examples
    >
    > n <- 50
    > p <- 8
    > beta <- c(3,0,1.5,0,2,rep(0,p-5))
    > xm <- matrix(rnorm(n*p),ncol = p, nrow = n)
    > y <- xm %*% beta + rnorm(n)
    > colnames(xm) <- paste0("Var_",1:p)
    >
    > fit01 <- tvsmiss(x=xm,y=y)
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
    :
     --- package (from environment) ---
    TVsMiss
     --- call from context ---
    tvsmiss(x = xm, y = y)
     --- call from argument ---
    if (class(x) != "matrix") {
     tmp <- try(x <- model.matrix(~0 + ., data = x), silent = TRUE)
     if (class(tmp)[1] == "try-error")
     stop("x must be a matrix or able to be coerced to a matrix")
    }
     --- R stacktrace ---
    where 1: tvsmiss(x = xm, y = y)
    
     --- value of length: 2 type: logical ---
    [1] FALSE TRUE
     --- function from context ---
    function (x, y, penalty = c("lasso", "MCP", "SCAD"), method = c("CV",
     "BIC", "BIC1", "BIC2", "sBIC", "sBIC1", "sBIC2", "sVS", "sEST"),
     lambda = NULL, fold = 5, cv.ind = NULL, repeat_b = 20, alpha_n = 0.1,
     refit = F, gamma = switch(penalty, SCAD = 3.7, MCP = 3, lasso = NA),
     use.penalty = T)
    {
     penalty <- match.arg(penalty)
     method <- match.arg(method)
     this.call = match.call()
     if (class(x) != "matrix") {
     tmp <- try(x <- model.matrix(~0 + ., data = x), silent = TRUE)
     if (class(tmp)[1] == "try-error")
     stop("x must be a matrix or able to be coerced to a matrix")
     }
     if (storage.mode(x) == "integer")
     storage.mode(x) <- "double"
     if (class(y) != "numeric") {
     tmp <- try(y <- as.numeric(y), silent = TRUE)
     if (class(tmp)[1] == "try-error")
     stop("y must numeric or able to be coerced to numeric")
     }
     if (length(y) != nrow(x))
     stop("x and y do not have the same number of observations")
     colnames(x) <- if (is.null(colnames(x)))
     paste("V", 1:ncol(x), sep = "")
     else colnames(x)
     data <- cbind(y, x)
     complete_idx <- c(1:length(y))[complete.cases(data)]
     y_complete <- y[complete_idx]
     x_complete <- x[complete_idx, ]
     sample_no_missing <- cbind(y_complete, x_complete)
     logistic_sample <- pairdata(sample_no_missing)
     if (use.penalty) {
     if (is.null(cv.ind)) {
     if (fold < 2 | fold > nrow(sample_no_missing))
     stop("fold should be greater than 1 and less than the rows in the complete data(after deleting missing)")
     cv.ind <- ceiling(sample(1:nrow(sample_no_missing))/(nrow(sample_no_missing) +
     sqrt(.Machine$double.eps)) * fold)
     }
     else {
     if (length(cv.ind) != nrow(sample_no_missing) | max(cv.ind) >
     nrow(sample_no_missing))
     stop("cv.ind is not match to the complete data")
     }
     sample_no_missing_list <- list()
     for (i in 1:max(cv.ind)) {
     sample_no_missing_list[[i]] <- sample_no_missing[cv.ind ==
     i, ]
     }
     logistic_list_estimation <- cv_logistic_prepare(complete_data = sample_no_missing,
     cv.ind = cv.ind)
     current_model <- model_est_path(logistic_sample = logistic_sample,
     lambda = lambda, penalty = penalty, gamma = gamma)
     beta_matrix <- t(as.matrix(coef(current_model)))[, -1]
     lambda <- current_model$lambda
     if (method == "CV") {
     begin_time <- proc.time()
     selection_res <- cv_sel(logistic_list = logistic_list_estimation,
     complete_data_list = sample_no_missing_list,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "BIC") {
     begin_time <- proc.time()
     selection_res <- BIC_log_cal(complete_dataset = sample_no_missing,
     beta_matrix = beta_matrix)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sBIC") {
     begin_time <- proc.time()
     selection_res <- sBIC(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sBIC1") {
     begin_time <- proc.time()
     selection_res <- sBIChigh(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sBIC2") {
     begin_time <- proc.time()
     selection_res <- sBICultrahigh(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sVS") {
     if (fold == 2) {
     begin_time <- proc.time()
     selection_res <- VSS(complete_data = sample_no_missing,
     lambda = lambda, repeat_b = repeat_b, alpha_n = alpha_n,
     penalty = penalty, gamma = gamma)
     selection_idx <- which(lambda == selection_res$selection_lambda_value)
     selection_lambda <- selection_res$selection_lambda_value
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx,
     ]
     final_time <- proc.time() - begin_time
     }
     else {
     begin_time <- proc.time()
     selection_res <- fleiss(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, alpha_n = alpha_n, gamma = gamma)
     selection_idx <- which(lambda == selection_res$selection_lambda_value)
     selection_lambda <- selection_res$selection_lambda_value
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx,
     ]
     final_time <- proc.time() - begin_time
     }
     }
     else if (method == "sEST") {
     begin_time <- proc.time()
     selection_res <- sEST(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "BIC1") {
     begin_time <- proc.time()
     selection_res <- BIC_high(complete_dataset = sample_no_missing,
     beta_matrix = beta_matrix)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "BIC2") {
     begin_time <- proc.time()
     selection_res <- BIC_ultrahigh(complete_dataset = sample_no_missing,
     beta_matrix = beta_matrix)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     }
     else {
     begin_time <- proc.time()
     glm_model <- glm(logistic_sample[, 1] ~ -1 + logistic_sample[,
     -1], family = binomial(link = "logit"))
     current_model = glm_model
     beta_matrix = NULL
     lambda = NULL
     cv.ind = NULL
     selection_idx = NULL
     selection_lambda = NULL
     selection_path = NULL
     selection_cv.ind = NULL
     selection_beta = current_model$coefficients
     names(selection_beta) <- colnames(logistic_sample)[-1]
     final_time <- proc.time() - begin_time
     }
     deviance.ratio = 1 + loglikelihood_r(c(0, selection_beta),
     sample_no_missing)/log(2)
     if (refit & use.penalty) {
     if (sum(selection_beta != 0) == 0) {
     refit_beta = selection_beta
     }
     else {
     refit_model <- glm(logistic_sample[, 1] ~ -1 + logistic_sample[,
     -1][, which(selection_beta != 0)], family = binomial(link = "logit"))
     refit_beta <- rep(0, ncol(logistic_sample) - 1)
     refit_beta[which(selection_beta != 0)] <- refit_model$coefficients
     names(refit_beta) <- colnames(logistic_sample)[-1]
     }
     }
     else {
     refit_beta = NULL
     }
     res <- list(ls = logistic_sample, c_idx = complete_idx, model = current_model,
     beta_matrix = beta_matrix, lambda = lambda, cv.ind = cv.ind,
     fold = fold, selection_idx = selection_idx, selection_lambda = selection_lambda,
     selection_path = selection_path, selection_cv.ind = selection_cv.ind,
     selection_beta = selection_beta, refit_beta = refit_beta,
     null.deviance = 2 * log(2), deviance.ratio = deviance.ratio,
     gamma = gamma, call = this.call, running_time = final_time)
     class(res) = "TVsMiss"
     return(res)
    }
    <bytecode: 0xb9c5ab8>
    <environment: namespace:TVsMiss>
     --- function search by body ---
    Function tvsmiss in namespace TVsMiss has this body.
     ----------- END OF FAILURE REPORT --------------
    Error in if (class(x) != "matrix") { : the condition has length > 1
    Calls: tvsmiss
    Execution halted
Flavor: r-devel-linux-x86_64-fedora-gcc

Version: 0.1.1
Check: tests
Result: ERROR
     Running ‘test.R’ [4s/13s]
    Running the tests in ‘tests/test.R’ failed.
    Complete output:
     > rm(list = ls())
     > library(TVsMiss)
     > n <- 50
     > p <- 8
     > beta <- c(3,0,1.5,0,2,rep(0,p-5))
     > xm <- matrix(rnorm(n*p),ncol = p, nrow = n)
     > y <- xm %*% beta + rnorm(n)
     > colnames(xm) <- paste0("Var_",1:p)
     >
     > fit01 <- tvsmiss(x=xm,y=y)
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
     :
     --- package (from environment) ---
     TVsMiss
     --- call from context ---
     tvsmiss(x = xm, y = y)
     --- call from argument ---
     if (class(x) != "matrix") {
     tmp <- try(x <- model.matrix(~0 + ., data = x), silent = TRUE)
     if (class(tmp)[1] == "try-error")
     stop("x must be a matrix or able to be coerced to a matrix")
     }
     --- R stacktrace ---
     where 1: tvsmiss(x = xm, y = y)
    
     --- value of length: 2 type: logical ---
     [1] FALSE TRUE
     --- function from context ---
     function (x, y, penalty = c("lasso", "MCP", "SCAD"), method = c("CV",
     "BIC", "BIC1", "BIC2", "sBIC", "sBIC1", "sBIC2", "sVS", "sEST"),
     lambda = NULL, fold = 5, cv.ind = NULL, repeat_b = 20, alpha_n = 0.1,
     refit = F, gamma = switch(penalty, SCAD = 3.7, MCP = 3, lasso = NA),
     use.penalty = T)
     {
     penalty <- match.arg(penalty)
     method <- match.arg(method)
     this.call = match.call()
     if (class(x) != "matrix") {
     tmp <- try(x <- model.matrix(~0 + ., data = x), silent = TRUE)
     if (class(tmp)[1] == "try-error")
     stop("x must be a matrix or able to be coerced to a matrix")
     }
     if (storage.mode(x) == "integer")
     storage.mode(x) <- "double"
     if (class(y) != "numeric") {
     tmp <- try(y <- as.numeric(y), silent = TRUE)
     if (class(tmp)[1] == "try-error")
     stop("y must numeric or able to be coerced to numeric")
     }
     if (length(y) != nrow(x))
     stop("x and y do not have the same number of observations")
     colnames(x) <- if (is.null(colnames(x)))
     paste("V", 1:ncol(x), sep = "")
     else colnames(x)
     data <- cbind(y, x)
     complete_idx <- c(1:length(y))[complete.cases(data)]
     y_complete <- y[complete_idx]
     x_complete <- x[complete_idx, ]
     sample_no_missing <- cbind(y_complete, x_complete)
     logistic_sample <- pairdata(sample_no_missing)
     if (use.penalty) {
     if (is.null(cv.ind)) {
     if (fold < 2 | fold > nrow(sample_no_missing))
     stop("fold should be greater than 1 and less than the rows in the complete data(after deleting missing)")
     cv.ind <- ceiling(sample(1:nrow(sample_no_missing))/(nrow(sample_no_missing) +
     sqrt(.Machine$double.eps)) * fold)
     }
     else {
     if (length(cv.ind) != nrow(sample_no_missing) | max(cv.ind) >
     nrow(sample_no_missing))
     stop("cv.ind is not match to the complete data")
     }
     sample_no_missing_list <- list()
     for (i in 1:max(cv.ind)) {
     sample_no_missing_list[[i]] <- sample_no_missing[cv.ind ==
     i, ]
     }
     logistic_list_estimation <- cv_logistic_prepare(complete_data = sample_no_missing,
     cv.ind = cv.ind)
     current_model <- model_est_path(logistic_sample = logistic_sample,
     lambda = lambda, penalty = penalty, gamma = gamma)
     beta_matrix <- t(as.matrix(coef(current_model)))[, -1]
     lambda <- current_model$lambda
     if (method == "CV") {
     begin_time <- proc.time()
     selection_res <- cv_sel(logistic_list = logistic_list_estimation,
     complete_data_list = sample_no_missing_list,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "BIC") {
     begin_time <- proc.time()
     selection_res <- BIC_log_cal(complete_dataset = sample_no_missing,
     beta_matrix = beta_matrix)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sBIC") {
     begin_time <- proc.time()
     selection_res <- sBIC(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sBIC1") {
     begin_time <- proc.time()
     selection_res <- sBIChigh(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sBIC2") {
     begin_time <- proc.time()
     selection_res <- sBICultrahigh(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "sVS") {
     if (fold == 2) {
     begin_time <- proc.time()
     selection_res <- VSS(complete_data = sample_no_missing,
     lambda = lambda, repeat_b = repeat_b, alpha_n = alpha_n,
     penalty = penalty, gamma = gamma)
     selection_idx <- which(lambda == selection_res$selection_lambda_value)
     selection_lambda <- selection_res$selection_lambda_value
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx,
     ]
     final_time <- proc.time() - begin_time
     }
     else {
     begin_time <- proc.time()
     selection_res <- fleiss(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, alpha_n = alpha_n, gamma = gamma)
     selection_idx <- which(lambda == selection_res$selection_lambda_value)
     selection_lambda <- selection_res$selection_lambda_value
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx,
     ]
     final_time <- proc.time() - begin_time
     }
     }
     else if (method == "sEST") {
     begin_time <- proc.time()
     selection_res <- sEST(complete_data = sample_no_missing,
     cv.fold = fold, cv.ind = cv.ind, penalty = penalty,
     lambda = lambda, gamma = gamma)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- selection_res$cv.ind
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "BIC1") {
     begin_time <- proc.time()
     selection_res <- BIC_high(complete_dataset = sample_no_missing,
     beta_matrix = beta_matrix)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     else if (method == "BIC2") {
     begin_time <- proc.time()
     selection_res <- BIC_ultrahigh(complete_dataset = sample_no_missing,
     beta_matrix = beta_matrix)
     selection_idx <- selection_res$lambda_idx
     selection_lambda <- lambda[selection_res$lambda_idx]
     selection_path <- selection_res$selection_path
     selection_cv.ind <- NULL
     selection_beta <- beta_matrix[selection_idx, ]
     final_time <- proc.time() - begin_time
     }
     }
     else {
     begin_time <- proc.time()
     glm_model <- glm(logistic_sample[, 1] ~ -1 + logistic_sample[,
     -1], family = binomial(link = "logit"))
     current_model = glm_model
     beta_matrix = NULL
     lambda = NULL
     cv.ind = NULL
     selection_idx = NULL
     selection_lambda = NULL
     selection_path = NULL
     selection_cv.ind = NULL
     selection_beta = current_model$coefficients
     names(selection_beta) <- colnames(logistic_sample)[-1]
     final_time <- proc.time() - begin_time
     }
     deviance.ratio = 1 + loglikelihood_r(c(0, selection_beta),
     sample_no_missing)/log(2)
     if (refit & use.penalty) {
     if (sum(selection_beta != 0) == 0) {
     refit_beta = selection_beta
     }
     else {
     refit_model <- glm(logistic_sample[, 1] ~ -1 + logistic_sample[,
     -1][, which(selection_beta != 0)], family = binomial(link = "logit"))
     refit_beta <- rep(0, ncol(logistic_sample) - 1)
     refit_beta[which(selection_beta != 0)] <- refit_model$coefficients
     names(refit_beta) <- colnames(logistic_sample)[-1]
     }
     }
     else {
     refit_beta = NULL
     }
     res <- list(ls = logistic_sample, c_idx = complete_idx, model = current_model,
     beta_matrix = beta_matrix, lambda = lambda, cv.ind = cv.ind,
     fold = fold, selection_idx = selection_idx, selection_lambda = selection_lambda,
     selection_path = selection_path, selection_cv.ind = selection_cv.ind,
     selection_beta = selection_beta, refit_beta = refit_beta,
     null.deviance = 2 * log(2), deviance.ratio = deviance.ratio,
     gamma = gamma, call = this.call, running_time = final_time)
     class(res) = "TVsMiss"
     return(res)
     }
     <bytecode: 0xa666dc8>
     <environment: namespace:TVsMiss>
     --- function search by body ---
     Function tvsmiss in namespace TVsMiss has this body.
     ----------- END OF FAILURE REPORT --------------
     Error in if (class(x) != "matrix") { : the condition has length > 1
     Calls: tvsmiss
     Execution halted
Flavor: r-devel-linux-x86_64-fedora-gcc