diff options
Diffstat (limited to 'R')
| -rw-r--r-- | R/check_inputs.R | 139 | ||||
| -rw-r--r-- | R/cv_loss.R | 28 | ||||
| -rw-r--r-- | R/plot_print_methods.R | 63 | ||||
| -rw-r--r-- | R/rmad.R | 42 | ||||
| -rw-r--r-- | R/rsc.R | 89 | ||||
| -rw-r--r-- | R/rsc_cv.R | 226 | ||||
| -rwxr-xr-x | R/zzz.R | 9 |
7 files changed, 402 insertions, 194 deletions
diff --git a/R/check_inputs.R b/R/check_inputs.R index 4cbcf0a..ccc54d4 100644 --- a/R/check_inputs.R +++ b/R/check_inputs.R @@ -1,64 +1,81 @@ -.check_input_data_matrix <- function(x, y, na.rm) { - if (is.null(y)) { - if (!is.array(x) & !is.data.frame(x) & !is.matrix(x)) { - stop("\"x\" must be a numeric matrix or any other array-type object that can be converted or a \"matrix\" object with with ncol>=2.\n\n") - } - if (is.vector(x)) { - stop("\"x\" must be a numeric matrix or any other array-type object that can be converted or a \"matrix\" object. with with ncol>=2.\n\n") - } - if (!is.matrix(x)) { - x <- data.matrix(x) - } - if (!is.numeric(x)) { - stop("\"x\" must be numeric.") - } - if (nrow(x) < 2 | ncol(x) < 2) { - stop("nrow(x)>=2 and ncol(xa)>=2 are required\n\n") - } - is_na_data <- is.na(x) - if (any(is_na_data)) { - if (na.rm == FALSE) { - stop("\"x\" contains NA records. You may want to filter NAs by setting \"na.rm=TRUE\" (see documentation for more details).\n\n") - } - else { - idx_na <- which(rowSums(is_na_data) >= 1) - x <- x[-idx_na, , drop = FALSE] - if (nrow(x) < 2) { - stop("nrow(x)<2 after NA removal.\n\n") +## Check input data and return a valid matrix object +## +.check_input_data_matrix <- function(x , y , na.rm){ + + if(is.null(y)){ + if(!is.array(x) & !is.data.frame(x) & !is.matrix(x)){ + stop('"x" must be a numeric matrix or any other array-type object that can be converted or a "matrix" object with with ncol>=2.\n\n') } - } - } - if (any(!is.finite(x))) { - stop("\"x\" contains Inf values\n\n") - } - } - else { - if (!is.vector(x) | !is.vector(y)) { - stop("If \"y\" is given, \"x\" and \"y\" must be both numeric.\n\n") - } - if (!is.numeric(x) | !is.numeric(y)) { - stop("\"x\" and \"y\" must be numeric.\n\n") - } - if (length(x) != length(y)) { - stop("\"x\" and \"y\" have different length.\n\n") - } - x <- cbind(x, y, deparse.level = 0) - is_na_data <- is.na(x) - if (any(is_na_data)) { - if (na.rm == FALSE) { - stop("\"x\" or \"y\" contains NA records. You may want to filter NAs by setting \"na.rm=TRUE\" (see documentation for more details).\n\n") - } - else { - idx_na <- which(rowSums(is_na_data) >= 1) - x <- x[-idx_na, , drop = FALSE] - if (nrow(x) < 2) { - stop("length(x)<2 and/or length(y)<2 after NA removal.\n\n") + + if(is.vector(x)){ + stop('"x" must be a numeric matrix or any other array-type object that can be converted or a "matrix" object. with with ncol>=2.\n\n') } - } - } - if (any(!is.finite(x))) { - stop("\"x\" and/or \"y\" contains Inf values\n\n") + + if(!is.matrix(x)){ + x <- data.matrix(x) + } + + if( !is.numeric(x) ){ + stop('"x" must be numeric.') + } + + if(nrow(x)<2 | ncol(x)<2){ + stop('nrow(x)>=2 and ncol(xa)>=2 are required\n\n') + } + + is_na_data <- is.na(x) + if(any(is_na_data)){ + if(na.rm==FALSE){ + stop('"x" contains NA records. You may want to filter NAs by setting "na.rm=TRUE" (see documentation for more details).\n\n') + }else{ + idx_na <- which( rowSums(is_na_data) >=1 ) + x <- x[-idx_na , , drop = FALSE] + if(nrow(x)<2){ + stop('nrow(x)<2 after NA removal.\n\n') + } + } + } + + if(any(!is.finite(x))){ + stop('"x" contains Inf values\n\n') + } + + }else{ + + if(!is.vector(x) | !is.vector(y)){ + stop('If "y" is given, "x" and "y" must be both numeric.\n\n') + } + + if(!is.numeric(x) | !is.numeric(y)){ + stop('"x" and "y" must be numeric.\n\n') + } + + if(length(x) != length(y)){ + stop('"x" and "y" have different length.\n\n') + } + + x <- cbind( x , y , deparse.level = 0) + + is_na_data <- is.na(x) + if(any(is_na_data)){ + if(na.rm==FALSE){ + stop('"x" or "y" contains NA records. You may want to filter NAs by setting "na.rm=TRUE" (see documentation for more details).\n\n') + }else{ + idx_na <- which( rowSums(is_na_data) >=1 ) + x <- x[-idx_na , , drop = FALSE] + if(nrow(x)<2){ + stop('length(x)<2 and/or length(y)<2 after NA removal.\n\n') + } + } + } + + if(any(!is.finite(x))){ + stop('"x" and/or "y" contains Inf values\n\n') + } } - } - return(x) -} + + + return(x) + +} ### END function + diff --git a/R/cv_loss.R b/R/cv_loss.R index ea46007..d855362 100644 --- a/R/cv_loss.R +++ b/R/cv_loss.R @@ -1,17 +1,29 @@ -.cv_loss <- function(idx, dat, evencorrection, threshold, grid.length, p, nc) { - res <- numeric(nc) +## Normalized squared Frobenius loss for all threshold values at a given train/test +## set, where +## +## * idx = TRUE for sample points into the train set +## * train set = dat[ idx , ] +## * test set = dat[ !idx , ] +## +.cv_loss <- function(idx, dat, evencorrection, threshold, grid.length, p) { + + + ## compute RMAD on train set n1 <- as.integer(sum(idx)) - C1 <- .Fortran("cormadvecdp", matrix = dat[idx, ], nrow = n1, ncol = p, res = res, - ressize = nc, correcteven = evencorrection, PACKAGE = "RSC")$res + C1 <- .Call(C_cormad_C, dat[idx, ], n1, p, evencorrection, num.threads = 1) + + ## compute RMAD on test set n2 <- as.integer(sum(!idx)) - C2 <- .Fortran("cormadvecdp", matrix = dat[!idx, ], nrow = n2, ncol = p, res = res, - ressize = nc, correcteven = evencorrection, PACKAGE = "RSC")$res + C2 <- .Call(C_cormad_C, dat[!idx, ], n2, p, correcteven = evencorrection, num.threads = 1) + + ## apply thresholds ans <- rep(0, times = grid.length) for (h in 1:grid.length) { - C1[abs(C1) < threshold[h]] <- 0 + C1[abs(C1) < threshold[h]] <- 0 ## fit on train set ans[h] <- sum(2 * { C1 - C2 - }^2)/p + }^2) / p } + return(ans) } diff --git a/R/plot_print_methods.R b/R/plot_print_methods.R index ca163cb..746179a 100644 --- a/R/plot_print_methods.R +++ b/R/plot_print_methods.R @@ -1,26 +1,41 @@ -print.rsc_cv <- function(x, ...) { - cat("\n") - cat("================================================\n") - cat(" Expected Normalized Squared Frobenius Loss \n") - cat("================================================\n") - print(x$loss) - cat("================================================\n") - cat("\n") + +## print method for the crsc_cv class +print.rsc_cv <-function(x, ...){ + cat("\n") + cat("================================================\n") + cat(" Expected Normalized Squared Frobenius Loss \n") + cat("================================================\n") + print(x$loss) + cat("================================================\n") + cat("\n") } -plot.rsc_cv <- function(x, ...) { - tstar <- which(x$loss$Flag == "minimum") - hstar <- x$loss$Threshold[tstar] - inf_loss <- x$loss$Average - x$loss$SE - sup_loss <- x$loss$Average + x$loss$SE - a <- inf_loss[tstar] - b <- sup_loss[tstar] - hstar1se <- max(x$loss$Threshold[which(x$loss$Flag == "*")]) - Ylim <- range(c(inf_loss, sup_loss)) - plot(x$loss$Threshold, x$loss$Average, t = "b", ylim = Ylim, pch = 20, col = "#0052A5", - lwd = 2, main = "RSC Optimal Threshold Selection", xlab = "Threshold", ylab = "Average loss", - ...) - arrows(x$loss$Threshold, inf_loss, x$loss$Threshold, sup_loss, length = 0.05, - angle = 90, code = 3, col = "#0052A5") - abline(v = hstar1se, col = "#31A853", lty = 2, lwd = 2) - abline(v = hstar, col = "#E0162B", lty = 2, lwd = 2) + + + +## ## ## plot method for the crsc_cv class +plot.rsc_cv <- function(x, ...){ + + ## add check object + + tstar <- which(x$loss$Flag == "minimum") + hstar <- x$loss$Threshold[tstar] + + inf_loss <- x$loss$Average - x$loss$SE + sup_loss <- x$loss$Average + x$loss$SE + a <- inf_loss[tstar] + b <- sup_loss[tstar] + hstar1se <- max(x$loss$Threshold[which(x$loss$Flag == "*")]) + + Ylim <- range(c(inf_loss, sup_loss)) + plot(x$loss$Threshold, x$loss$Average, t='b', ylim = Ylim , + pch=20 , col= "#0052A5", lwd = 2, + main = "RSC Optimal Threshold Selection", + xlab = "Threshold", + ylab = "Average loss", ...) + arrows(x$loss$Threshold, inf_loss, x$loss$Threshold, sup_loss , + length=.05, angle=90, code=3, col="#0052A5") + abline(v = hstar1se, col = "#31A853", lty=2, lwd=2) + abline(v = hstar, col = "#E0162B", lty=2, lwd=2) } + + @@ -1,31 +1,47 @@ -rmad <- function(x, y = NULL, na.rm = FALSE, even.correction = FALSE) { +rmad <- function(x, y = NULL, na.rm = FALSE, even.correction = FALSE, num.threads = "half-max") { + + ## check input data dat <- .check_input_data_matrix(x = x, y = y, na.rm = na.rm) colnames_original <- colnames(dat) storage.mode(dat) <- "double" n <- as.integer(nrow(dat)) p <- as.integer(ncol(dat)) - nc <- as.integer({ - p^2 - p - }/2) + + + ## set even correction if (even.correction) { evencorrection <- 1L - } - else { + } else { evencorrection <- 0L } - u <- .Fortran("cormadvecdp", matrix = dat, nrow = n, ncol = p, res = numeric(nc), - ressize = nc, correcteven = evencorrection, PACKAGE = "RSC")$res - if (!is.null(y)) { - return(u) + + ## set number of threads + if (num.threads == "half-max") { + num.threads <- 0L + } else { + storage.mode(num.threads) <- "integer" } - else { + + + ## Call C code + u <- .Call(C_cormad_C, dat, n, p, evencorrection, num.threads) + + + if (!is.null(y)) { ## 2-dimensional + return(u) + } else { ## p-dimensional + + ## assemble the matrix using the lower triangle R <- Matrix(1, nrow = p, ncol = p, sparse = FALSE) R[lower.tri(R, diag = FALSE)] <- u R <- forceSymmetric(R, uplo = "L") R <- as(R, "dspMatrix") + + ## attach dimnames if needed if (!is.null(colnames_original)) { dimnames(R)[[1]] <- dimnames(R)[[2]] <- colnames_original } + return(R) - } -} + } ## END if(!is.null(y)){ ## 2-dimensional +} ## END function @@ -1,42 +1,49 @@ -rsc <- function(cv, threshold = "minimum") { - if (class(cv) == "rsc_cv") { - if (is.numeric(threshold)) { - if (length(threshold) > 1) { - stop("if a specific value for 'threshold' is chosen, this must be a single numeric value in (0,1)") - } - else if (threshold <= 0 | threshold >= 1) { - stop("if a specific value for 'threshold' is chosen, this must be a single numeric value in (0,1)") - } - } - else { - if ({ - threshold != "minimum" - } & { - threshold != "minimum1se" - }) { - stop("'threshold' must be one of the following: 'minimum', 'minimum1se', a numeric value in (0,1).") - } - if (threshold == "minimum") { - threshold <- cv$minimum - } - else if (threshold == "minimum1se") { - threshold <- cv$minimum1se - } - } - cv$rmadvec[abs(cv$rmadvec) < threshold] <- 0 - nc <- length(cv$rmadvec) - p <- { - 1 + sqrt(1 + 8 * nc) - }/2 - R <- Matrix(1, nrow = p, ncol = p, sparse = TRUE) - R[lower.tri(R, diag = FALSE)] <- cv$rmadvec - R <- forceSymmetric(R, uplo = "L") - if (!is.null(cv$varnames)) { - dimnames(R)[[1]] <- dimnames(R)[[2]] <- cv$varnames - } - } - else { - stop("'cv' must be a an object of class 'rsc_cv' obtained from 'rsc::rsc_cv'") - } - return(R) +rsc <- function(cv, threshold = "minimum"){ + + ## inputs + ## cv = u ## a class cv_rsc or any other correlation matrix + ## threshold = "minimum" ## "minimum", "minimum1se" or numeric in (0,1) + + if(class(cv) == "rsc_cv"){ + + ## check threshold + if(is.numeric(threshold)){ + if(length(threshold)>1){ + stop("if a specific value for 'threshold' is chosen, this must be a single numeric value in (0,1)") + }else if(threshold <=0 | threshold >=1){ + stop("if a specific value for 'threshold' is chosen, this must be a single numeric value in (0,1)") + } + }else{ + if({threshold != "minimum"} & {threshold != "minimum1se"}){ + stop("'threshold' must be one of the following: 'minimum', 'minimum1se', a numeric value in (0,1).") + } + + if(threshold == "minimum"){ + threshold <- cv$minimum + }else if(threshold == "minimum1se"){ + threshold <- cv$minimum1se + } + } + + + ## threshold the rmadvec + cv$rmadvec[ abs(cv$rmadvec) < threshold ] <- 0 + + nc <- length(cv$rmadvec) + p <- {1 + sqrt( 1 + 8 * nc ) } / 2 + R <- Matrix(1, nrow = p, ncol = p, sparse = TRUE) + + R[lower.tri(R , diag = FALSE)] <- cv$rmadvec + R <- forceSymmetric(R , uplo="L") + + ## attach dimnames if needed + if(!is.null(cv$varnames)){ + dimnames(R)[[1]] <- dimnames(R)[[2]] <- cv$varnames + } + }else{ + stop("'cv' must be a an object of class 'rsc_cv' obtained from 'rsc::rsc_cv'") + } + + + return(R) } @@ -1,79 +1,140 @@ -rsc_cv <- function(x, cv.type = "kfold", R = 10, K = 10, threshold = seq(0.05, 0.95, - by = 0.025), even.correction = FALSE, na.rm = FALSE, ncores = NULL, monitor = TRUE) { +rsc_cv <- function(x, + cv.type = "kfold", + R = 10, + K = 10, + threshold = seq(0.05, 0.95, by = 0.025), + even.correction = FALSE, + na.rm = FALSE, + ncores = NULL, + monitor = TRUE) { + + ## ## ***************************************************************************** + ## ## RSC inputs + ## ## ***************************************************************************** + ## x = X + ## cv.type = "random" ## "kfold" "random" + ## R = 10 ## replicate (for K-fold) or splits for random + ## K = 10 ## folds in kfcv + ## threshold = seq(0.025, 0.975, by = 0.025) + ## opt = "min" , ## "min" "min1se" + ## even.correction = FALSE + ## na.rm = TRUE + ## ncores = 6 + ## monitor = TRUE + ## ## ***************************************************************************** + + + ## check input data dat <- .check_input_data_matrix(x = x, y = NULL, na.rm = na.rm) colnames_original <- colnames(dat) storage.mode(dat) <- "double" n <- as.integer(nrow(dat)) p <- as.integer(ncol(dat)) - nc <- as.integer({ - p^2 - p - }/2) + + ## check cv.type if ({ cv.type != "random" } & { cv.type != "kfold" }) { - stop("\"cv.type\" must be either \"random\" (default) or \"kfold\"") + stop('"cv.type" must be either "random" (default) or "kfold"') } + + + ## check R if (!is.numeric(R)) { - stop("\"R\" must be an integer > 1") - } - else if (R < 1) { - stop("\"R\" must be an integer > 1") + stop('"R" must be an integer > 1') + } else if (R < 1) { + stop('"R" must be an integer > 1') } + + + ## check K if (!is.numeric(K)) { - stop("\"K\" must be an integer > 1") - } - else if (R < 1) { - stop("\"K\" must be an integer > 1") + stop('"K" must be an integer > 1') + } else if (R < 1) { + stop('"K" must be an integer > 1') } + + + ## check threshold if (length(threshold) == 1) { if (threshold <= 0 | threshold >= 1) { - stop("\"threshold\" value does not belong to the interval (0,1).") + stop('"threshold" value does not belong to the interval (0,1).') } - } - else if (length(threshold) > 1) { + } else if (length(threshold) > 1) { + ## if (any(threshold < 0) | any(threshold >= 1)) { - stop("Some of the \"threshold\" values do not belong to the interval (0,1).") + stop('Some of the "threshold" values do not belong to the interval (0,1).') } grid.length <- length(threshold) } + + + + + + ## set even correction if (even.correction) { evencorrection <- 1L - } - else { + } else { evencorrection <- 0L } + + + + ## set and check ncores if (is.null(ncores)) { DetectedCores <- detectCores() if (DetectedCores <= 2) { ncores <- 1 - } - else { + } else { ncores <- { DetectedCores - 1 } } - } - else { + } else { ncores <- as.integer(ncores) if (ncores <= 0) { - stop("\"ncores\" must be an integer larger or equal to 1.") + stop('"ncores" must be an integer larger or equal to 1.') } } + + + + + + + + + + + ## compute the RMAD vec form if (monitor) { cat("\n") message("Computing the RMAD matrix") t0 <- Sys.time() } - rmad_vec <- .Fortran("cormadvecdp", matrix = dat, nrow = n, ncol = p, res = numeric(nc), - ressize = nc, correcteven = evencorrection, PACKAGE = "RSC")$res + + rmad_vec <- .Call(C_cormad_C, dat, n, p, evencorrection, num.threads = 1) + if (monitor) { t1 <- Sys.time() dt01 <- difftime(t1, t0, units = "auto") - message("* RMAD computing time:...... ", round(dt01, 2), " [", attributes(dt01)$units, - "]") + message( + "* RMAD computing time:...... ", round(dt01, 2), + " [", attributes(dt01)$units, "]" + ) } + + + + + + + + + if (cv.type == "random") { if (monitor) { cat("\n") @@ -81,28 +142,55 @@ rsc_cv <- function(x, cv.type = "kfold", R = 10, K = 10, threshold = seq(0.05, 0 t_hat <- round(1.2 * { { dt01 * R * 2 - }/ncores + } / ncores }, 2) message("* predicted end time (worst case):...... ", Sys.time() + t_hat) } - n1 <- n - floor(n/log(n)) + + + ## IDX[k,i] = TRUE means dat[i, ] is in train set at the k-th split + n1 <- n - floor(n / log(n)) ## train set IDX <- array(FALSE, dim = c(R, n)) for (r in 1:R) { IDX[r, ][sample(1:n, size = n1, replace = FALSE)] <- TRUE } + + ## register parallel backend registerDoParallel(ncores) + + ## parallel computation of losses over splits U <- foreach(r = 1:R) %dopar% { - .cv_loss(idx = IDX[r, ], dat = dat, evencorrection = evencorrection, - threshold = threshold, grid.length = grid.length, p = p, nc = nc) + .cv_loss( + idx = IDX[r, ], dat = dat, evencorrection = evencorrection, + threshold = threshold, grid.length = grid.length, + p = p + ) } + + ## stop parallel backend stopImplicitCluster() + + ## LOSS[split , threshold] + ## array with normalized squared Frobenius loss LOSS <- array(0, dim = c(R, grid.length)) for (r in 1:R) { LOSS[r, ] <- U[[r]] } + + ## Estimate average loss with std errors avg_loss <- apply(LOSS, 2, mean) - se_loss <- apply(LOSS, 2, sd)/sqrt(R) + se_loss <- apply(LOSS, 2, sd) / sqrt(R) } + + + + + + + + + + if (cv.type == "kfold") { if (monitor) { cat("\n") @@ -110,35 +198,59 @@ rsc_cv <- function(x, cv.type = "kfold", R = 10, K = 10, threshold = seq(0.05, 0 t_hat <- round(1.2 * { { dt01 * R * K * 2 - }/ncores + } / ncores }, 2) message("* predicted end time (worst case):...... ", Sys.time() + t_hat) } + + ## create K deterministic folds idx_fold <- cut(1:n, breaks = K, labels = FALSE) + + ## IDX :: indexes of all train sets + ## IDX[k , i] = TRUE means dat[i, ] is in the train set at some k-th split + ## rows {{r-1}*K + 1 }:{r*K} of IDX correspond to the r-th replica IDX <- array(TRUE, dim = c(R * K, n)) + + ## set initial IDX row counter row_count <- 1L for (r in 1:R) { + ## at each replicate r shuffle the original fold indexes idx_fold_shuffle <- sample(idx_fold, size = n, replace = FALSE) + + ## for each fold shuffle make up the K-fold for (k in 1:K) { IDX[row_count, ][idx_fold_shuffle == k] <- FALSE row_count <- 1L + row_count } } + + + ## register parallel backend registerDoParallel(ncores) + + ## parallel computation of losses over splits U <- foreach(r = 1:{ R * K }) %dopar% { - .cv_loss(idx = IDX[r, ], dat = dat, evencorrection = evencorrection, - threshold = threshold, grid.length = grid.length, p = p, nc = nc) + .cv_loss( + idx = IDX[r, ], dat = dat, evencorrection = evencorrection, + threshold = threshold, grid.length = grid.length, + p = p + ) } + + ## stop parallel backend stopImplicitCluster() + + + ## LOSS[fold , threshold, replica] if (R == 1) { LOSS <- array(0, dim = c(K, grid.length)) + ## names ?? for (k in 1:K) { LOSS[k, ] <- U[[k]] } - } - else { + } else { LOSS <- array(0, dim = c(K, grid.length, R)) dimnames(LOSS)[[3]] <- paste0("r", 1:R) dimnames(LOSS)[[1]] <- paste0("k", 1:K) @@ -150,21 +262,33 @@ rsc_cv <- function(x, cv.type = "kfold", R = 10, K = 10, threshold = seq(0.05, 0 } } } + + + ## compute average losses and standard errors avg_loss_r <- sd_loss_r <- matrix(0, nrow = R, ncol = grid.length) for (r in 1:R) { avg_loss_r[r, ] <- apply(LOSS[, , r], 2, mean) - sd_loss_r[r, ] <- apply(LOSS[, , r], 2, sd)/sqrt(K) + sd_loss_r[r, ] <- apply(LOSS[, , r], 2, sd) / sqrt(K) } avg_loss <- apply(avg_loss_r, 2, mean) se_loss <- apply(sd_loss_r, 2, mean) + + + if (monitor) { t2 <- Sys.time() dt02 <- difftime(t2, t0, units = "auto") } - } + } ## END if(cv.type == "kfold"){ + + + if (monitor) { message("* finished on:.......................... ", Sys.time()) } + + + ## Organize cross-validation results tstar <- which.min(avg_loss) flags <- rep("", grid.length) a <- avg_loss[tstar] - se_loss[tstar] @@ -175,9 +299,23 @@ rsc_cv <- function(x, cv.type = "kfold", R = 10, K = 10, threshold = seq(0.05, 0 avg_loss <= b }] <- "*" flags[tstar] <- "minimum" - res <- data.frame(Threshold = threshold, Average = avg_loss, SE = se_loss, Flag = flags) - ans <- list(rmadvec = rmad_vec, varnames = colnames_original, loss = res, minimum = threshold[tstar], - minimum1se = max(threshold[avg_loss >= a & avg_loss <= b])) + res <- data.frame( + Threshold = threshold, + Average = avg_loss, + SE = se_loss, + Flag = flags + ) + + ## output list + ans <- list( + rmadvec = rmad_vec, + varnames = colnames_original, + loss = res, + minimum = threshold[tstar], + minimum1se = max(threshold[avg_loss >= a & avg_loss <= b]) + ) + + class(ans) <- "rsc_cv" return(ans) } @@ -1,4 +1,7 @@ -.onAttach <- function(lib, pkg) { - packageStartupMessage("\nRSC: robust and sparse correlation matrix estimation\n Type 'citation(\"RSC\")' for citing this package\n") - invisible() +.onAttach <- function(lib, pkg){ + packageStartupMessage("\nRSC: robust and sparse correlation matrix estimation\n Type 'citation(\"RSC\")' for citing this package\n") + invisible() } + + + |