David-Hervas / sNPLS

Compare d5436df ... +2 ... d86c696

Coverage Reach
sNPLS_fit.R

No flags found

Use flags to group coverage reports by test type, project and/or folders.
Then setup custom commit statuses and notifications for each flag.

e.g., #unittest #integration

#production #enterprise

#frontend #backend

Learn more about Codecov Flags here.

Showing 1 of 9 files from the diff.
Other files ignored by Codecov
DESCRIPTION has changed.
man/cv_snpls.Rd has changed.
man/repeat_cv.Rd has changed.
man/sNPLS.Rd has changed.
man/plot.sNPLS.Rd has changed.
NAMESPACE has changed.
man/cv_fit.Rd has changed.

@@ -1,11 +1,11 @@
Loading
1 1
#' Fit a sNPLS model
2 2
#'
3 -
#' @description Fits a N-PLS regression model imposing a L1 penalization on \code{wj} and \code{wk} matrices
3 +
#' @description Fits a N-PLS regression model imposing sparsity on \code{wj} and \code{wk} matrices
4 4
#' @param XN A three-way array containing the predictors.
5 5
#' @param Y A matrix containing the response.
6 6
#' @param ncomp Number of components in the projection
7 -
#' @param threshold_j Threshold value for the L1 penalty on Wj (scaled between 0-1)
8 -
#' @param threshold_k Threshold value for the L1 penalty on Wk (scaled between 0-1)
7 +
#' @param threshold_j Threshold value on Wj. Scaled between [0, 1)
8 +
#' @param threshold_k Threshold value on Wk. scaled between [0, 1)
9 9
#' @param keepJ Number of variables to keep for each component, ignored if threshold_j is provided
10 10
#' @param keepK Number of 'times' to keep for each component, ignored if threshold_k is provided
11 11
#' @param scale.X Perform unit variance scaling on X?
@@ -22,10 +22,14 @@
Loading
22 22
#' @examples
23 23
#' X_npls<-array(rpois(7500, 10), dim=c(50, 50, 3))
24 24
#'
25 -
#' Y_npls<-matrix(2+0.4*X_npls[,5,1]+0.7*X_npls[,10,1]-0.9*X_npls[,15,1]+
25 +
#' Y_npls <- matrix(2+0.4*X_npls[,5,1]+0.7*X_npls[,10,1]-0.9*X_npls[,15,1]+
26 26
#' 0.6*X_npls[,20,1]- 0.5*X_npls[,25,1]+rnorm(50), ncol=1)
27 -
#'
28 -
#' fit<-sNPLS(X_npls, Y_npls, ncomp=3, keepJ = rep(2,3) , keepK = rep(1,3))
27 +
#' #Discrete thresholding
28 +
#' fit <- sNPLS(X_npls, Y_npls, ncomp=3, keepJ = rep(2,3) , keepK = rep(1,3))
29 +
#' #Continuous thresholding
30 +
#' fit2 <- sNPLS(X_npls, Y_npls, ncomp=3, threshold_j=0.5, threshold_k=0.5)
31 +
#' #USe sNPLS-SR method
32 +
#' fit3 <- sNPLS(X_npls, Y_npls, ncomp=3, threshold_j=0.5, threshold_k=0.5, method="sNPLS-SR")
29 33
#' @importFrom stats sd
30 34
#' @export
31 35
sNPLS <- function(XN, Y, ncomp = 2, threshold_j=0.5, threshold_k=0.5, keepJ = NULL, keepK = NULL, scale.X=TRUE, center.X=TRUE,
@@ -326,7 +330,7 @@
Loading
326 330
#' @param keepJ A vector with the different number of selected variables to test for discrete thresholding
327 331
#' @param keepK A vector with the different number of selected 'times' to test for discrete thresholding
328 332
#' @param nfold Number of folds for the cross-validation
329 -
#' @param parallel Should the computations be performed in parallel?
333 +
#' @param parallel Should the computations be performed in parallel? Set up strategy first with \code{future::plan()}
330 334
#' @param method Select between sNPLS, sNPLS-SR or sNPLS-VIP
331 335
#' @param ... Further arguments passed to sNPLS
332 336
#' @return A list with the best parameters for the model and the CV error
@@ -336,14 +340,17 @@
Loading
336 340
#'
337 341
#' Y_npls<-matrix(2+0.4*X_npls[,5,1]+0.7*X_npls[,10,1]-0.9*X_npls[,15,1]+
338 342
#' 0.6*X_npls[,20,1]- 0.5*X_npls[,25,1]+rnorm(50), ncol=1)
339 -
#'
343 +
#' #Grid search for discrete thresholding
340 344
#' cv1<- cv_snpls(X_npls, Y_npls, ncomp=1:2, keepJ = 1:3, keepK = 1:2, parallel = FALSE)
345 +
#' #Random search for continuous thresholding
346 +
#' cv2<- cv_snpls(X_npls, Y_npls, ncomp=1:2, samples=20, parallel = FALSE)
341 347
#' }
342 348
#' @importFrom stats runif
343 349
#' @export
344 350
cv_snpls <- function(X_npls, Y_npls, ncomp = 1:3, samples=20,
345 351
                     keepJ = NULL, keepK = NULL, nfold = 10, parallel = TRUE,  method="sNPLS", ...) {
346 352
353 +
  if(parallel) message("Your parallel configuration is ", attr(future::plan(), "class")[3])
347 354
  if(!method %in% c("sNPLS", "sNPLS-SR", "sNPLS-VIP")) stop("'method' not recognized")
348 355
  if(length(dim(Y_npls)) == 3) Y_npls <- unfold3w(Y_npls)
349 356
  top <- ceiling(dim(X_npls)[1]/nfold)
@@ -378,7 +385,7 @@
Loading
378 385
    })
379 386
  }
380 387
  if (parallel) {
381 -
    cv_res <- future.apply::future_apply(search.grid, 1, applied_fun)
388 +
    cv_res <- future.apply::future_apply(search.grid, 1, applied_fun, future.seed=TRUE)
382 389
  } else {
383 390
    cv_res <- pbapply::pbapply(search.grid, 1, applied_fun)
384 391
  }
@@ -398,10 +405,10 @@
Loading
398 405
#' @param xval A three-way test array
399 406
#' @param yval A response test matrix
400 407
#' @param ncomp Number of components for the sNPLS model
401 -
#' @param threshold_j Threshold value for the L1 penalty on Wj (scaled between 0-1)
402 -
#' @param threshold_k Threshold value for the L1 penalty on Wk (scaled between 0-1)
403 -
#' @param keepJ Number of variables to keep for each component
404 -
#' @param keepK Number of 'times' to keep for each component
408 +
#' @param threshold_j Threshold value on Wj. Scaled between [0, 1)
409 +
#' @param threshold_k Threshold value on Wk. Scaled between [0, 1)
410 +
#' @param keepJ Number of variables to keep for each component, ignored if threshold_j is provided
411 +
#' @param keepK Number of 'times' to keep for each component, ignored if threshold_k is provided
405 412
#' @param method Select between sNPLS, sNPLS-SR or sNPLS-VIP
406 413
#' @param ... Further arguments passed to sNPLS
407 414
#' @return Returns the CV mean squared error
@@ -419,13 +426,12 @@
Loading
419 426
#'
420 427
#' @description Different plots for sNPLS model fits
421 428
#' @param x A sNPLS model fit
422 -
#' @param comps A vector of length two with the components to plot
429 +
#' @param comps Vector with the components to plot. It can be of length \code{ncomp} for types "time" and "variables" and of length 2 otherwise.
423 430
#' @param type The type of plot. One of those: "T", "U", "Wj", "Wk", "time" or "variables"
424 431
#' @param labels Should rownames be added as labels to the plot?
425 -
#' @param group Vector with categorical variable defining groups
432 +
#' @param group Vector with categorical variable defining groups (optional)
426 433
#' @param ... Not used
427 434
#' @return A plot of the type specified in the \code{type} parameter
428 -
#' @importFrom graphics abline matplot plot text layout par plot.new
429 435
#' @export
430 436
plot.sNPLS <- function(x, type = "T", comps = c(1, 2), labels=TRUE, group=NULL, ...) {
431 437
  if (type == "T")
@@ -643,18 +649,19 @@
Loading
643 649
#' @param Y_npls A matrix containing the response.
644 650
#' @param ncomp A vector with the different number of components to test
645 651
#' @param samples Number of samples for performing random search in continuous thresholding
646 -
#' @param keepJ A vector with the different number of selected variables to test
647 -
#' @param keepK A vector with the different number of selected 'times' to test
652 +
#' @param keepJ A vector with the different number of selected variables to test in discrete thresholding
653 +
#' @param keepK A vector with the different number of selected 'times' to test in discrete thresholding
648 654
#' @param nfold Number of folds for the cross-validation
649 655
#' @param times Number of repetitions of the cross-validation
650 -
#' @param parallel Should the computations be performed in parallel?
656 +
#' @param parallel Should the computations be performed in parallel? Set up strategy first with \code{future::plan()}
651 657
#' @param method Select between sNPLS, sNPLS-SR or sNPLS-VIP
652 658
#' @param ... Further arguments passed to cv_snpls
653 659
#' @return A density plot with the results of the cross-validation and an (invisible) \code{data.frame} with these results
654 660
#' @importFrom stats var
655 661
#' @export
656 662
repeat_cv <- function(X_npls, Y_npls, ncomp = 1:3, samples=20, keepJ=NULL, keepK=NULL, nfold = 10, times=30, parallel = TRUE, method="sNPLS", ...){
657 663
  if(!method %in% c("sNPLS", "sNPLS-SR", "sNPLS-VIP")) stop("'method' not recognized")
664 +
  if(parallel) message("Your parallel configuration is ", attr(future::plan(), "class")[3])
658 665
  if(is.null(keepJ) | is.null(keepK)){
659 666
    cont_thresholding <- TRUE
660 667
    message("Using continuous thresholding")
@@ -663,7 +670,7 @@
Loading
663 670
    message("Using discrete thresholding")
664 671
  }
665 672
  if(parallel){
666 -
    rep_cv<-future.apply::future_sapply(1:times, function(x) suppressMessages(cv_snpls(X_npls, Y_npls, ncomp=ncomp, parallel = FALSE, nfold = nfold, samples=samples, keepJ=keepJ, keepK=keepK, method=method, ...)))
673 +
    rep_cv<-future.apply::future_sapply(1:times, function(x) suppressMessages(cv_snpls(X_npls, Y_npls, ncomp=ncomp, parallel = FALSE, nfold = nfold, samples=samples, keepJ=keepJ, keepK=keepK, method=method, ...)), future.seed=TRUE)
667 674
  } else {
668 675
    rep_cv<-pbapply::pbreplicate(times, suppressMessages(cv_snpls(X_npls, Y_npls, ncomp=ncomp, parallel = FALSE, nfold = nfold, samples=samples, keepJ=keepJ, keepK=keepK, method=method, ...)))
669 676
  }
@@ -679,7 +686,7 @@
Loading
679 686
#' @description Plots a grid of slices from the 3-D kernel denity estimates of the repeat_cv function
680 687
#' @param x A repeatcv object
681 688
#' @param ... Further arguments passed to plot
682 -
#' @return A grid of slices from of a 3-D density plot of the results of the repeated cross-validation
689 +
#' @return A grid of slices from a 3-D density plot of the results of the repeated cross-validation
683 690
#' @importFrom grDevices colorRampPalette
684 691
#' @importFrom stats ftable density setNames
685 692
#' @export
@@ -745,9 +752,9 @@
Loading
745 752
#' @importFrom stats coef
746 753
#' @export
747 754
summary.sNPLS <- function(object, ...){
748 -
  cat("sNPLS model with", object$ncomp, "components and squared error of", round(object$SqrdE,3), "\n", "\n")
755 +
  cat(object$Method, "model with", object$ncomp, "components and squared error of", round(object$SqrdE,3), "\n", "\n")
749 756
  cat("Coefficients: \n")
750 -
  round(coef(object, as.matrix=TRUE),3)
757 +
  round(coef(object, as.matrix=TRUE), 3)
751 758
}
752 759
753 760
#' Compute Selectivity Ratio for a sNPLS model

Everything is accounted for!

No changes detected that need to be reviewed.
What changes does Codecov check for?
Lines, not adjusted in diff, that have changed coverage data.
Files that introduced coverage data that had none before.
Files that have missing coverage data that once were tracked.
Files Coverage
R/sNPLS_fit.R 0.00%
Project Totals (1 files) 0.00%
Loading