From 1a0d386afd12f8a81a491a29b2f494e84883719a Mon Sep 17 00:00:00 2001 From: Guillaume Cornu Date: Mon, 24 Feb 2025 13:59:49 +0100 Subject: [PATCH 1/4] try to circumvent Formula length bug with RStudio --- DESCRIPTION | 2 +- NAMESPACE | 1 + R/multivariateFormula.r | 5 +++++ R/scglr.r | 2 +- R/theme.r | 8 ++++---- 5 files changed, 12 insertions(+), 6 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 59fcbda..c374e0b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -25,5 +25,5 @@ Imports: Suggests: future,future.apply,progressr LazyData: yes -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.2 Encoding: UTF-8 diff --git a/NAMESPACE b/NAMESPACE index c358aa7..f13df11 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,6 +3,7 @@ S3method("$",MultivariateFormula) S3method(barplot,SCGLR) S3method(barplot,SCGLRTHM) +S3method(length,MultivariateFormula) S3method(pairs,SCGLR) S3method(plot,SCGLR) S3method(plot,SCGLRTHM) diff --git a/R/multivariateFormula.r b/R/multivariateFormula.r index 05e05a9..074356e 100644 --- a/R/multivariateFormula.r +++ b/R/multivariateFormula.r @@ -229,6 +229,11 @@ print.MultivariateFormula <- function(x, ...) { invisible(x) } +#' @export +length.MultivariateFormula <- function(x) { + 3 +} + # print(multivariateFormula("y","1")) # print(multivariateFormula(y1+y2~x1+x2|x3+x4|x5+x6*x7||a1+a2)) # print(multivariateFormula(c("y1","y2"),list(c("x1","x2"),c("x3","x4")),c("x5","x6*x7"),additional = TRUE)) diff --git a/R/scglr.r b/R/scglr.r index 9660c82..6a0989f 100644 --- a/R/scglr.r +++ b/R/scglr.r @@ -108,7 +108,7 @@ scglr <- function(formula,data,family,K=1,size=NULL,weights=NULL,offset=NULL,su y <- as.matrix(model.part(form,data=mf,lhs=1)) x <- model.part(form, data=mf, rhs = 1) - if(length(form)[2]==2){ + if(Formula:::length.Formula(form)[2]==2){ AX <- model.part(form, data=mf, lhs=0, rhs = 2) namesAx <- names(AX) AX <- model.matrix(form,data=mf,rhs=2)[,-1] diff --git a/R/theme.r b/R/theme.r index 4377b88..7cbbb11 100644 --- a/R/theme.r +++ b/R/theme.r @@ -72,7 +72,7 @@ scglrTheme <- function(formula, data, H, family, size = NULL, weights = NULL, # extract left-hand side (Y) # Y is a formula of the form ~... - if(length(formula)[1] != 1) + if(Formula:::length.Formula(formula)[1] != 1) stop("Left hand side part of formula (Y) must have ONE part!") theme_Y <- stats::terms(formula, lhs=1, rhs=0) Y_vars <- all.vars(theme_Y) @@ -114,7 +114,7 @@ scglrTheme <- function(formula, data, H, family, size = NULL, weights = NULL, # check and process themes ####################################################################### # check part counts - if(length(formula)[2] < 1+additional) + if(Formula:::length.Formula(formula)[2] < 1+additional) if(additional) { stop("Right hand side part of formula with additional variables must have at least TWO parts!") } else { @@ -122,7 +122,7 @@ scglrTheme <- function(formula, data, H, family, size = NULL, weights = NULL, } # theme count - theme_R <- length(formula)[2] - additional + theme_R <- Formula:::length.Formula(formula)[2] - additional # check H (number of components to keep per theme) H <- as.integer(H) @@ -154,7 +154,7 @@ scglrTheme <- function(formula, data, H, family, size = NULL, weights = NULL, # extract additional variables (A) # A is a formula of the form ~... if(additional) { - theme_A <- stats::terms(formula, lhs=0, rhs=length(formula)[[2]]) + theme_A <- stats::terms(formula, lhs=0, rhs=Formula:::length.Formula(formula)[[2]]) } else { theme_A <- NULL } From 99f99271e87f57ab99fbc0a158153fc06e8126e5 Mon Sep 17 00:00:00 2001 From: Guillaume Cornu Date: Mon, 24 Feb 2025 17:15:47 +0100 Subject: [PATCH 2/4] add missing documentation --- R/scglrCrossVal.r | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/scglrCrossVal.r b/R/scglrCrossVal.r index 24939a6..c9f1710 100644 --- a/R/scglrCrossVal.r +++ b/R/scglrCrossVal.r @@ -280,12 +280,17 @@ scglrCrossVal <- function(formula,data,family,K=1,folds=10,type="mspe",size=NUL return(cv) } +#' @export summary.SCGLRCV <- function(object, ...) { NextMethod(...) } + +#' @export print.SCGLRCV <- function(x, ...) { NextMethod(...) } + +#' @export plot.SCGLRCV <- function(x, ...) { tmp <- colMeans(log(x)) ggplot()+ From ebf883140bc19ea24e338d99e4178d499b9bb6bd Mon Sep 17 00:00:00 2001 From: Guillaume Cornu Date: Mon, 24 Feb 2025 17:27:06 +0100 Subject: [PATCH 3/4] avoid call to unexported function length from Formula --- R/scglr.r | 2 +- R/theme.r | 8 ++++---- R/utils.r | 4 ++++ 3 files changed, 9 insertions(+), 5 deletions(-) diff --git a/R/scglr.r b/R/scglr.r index 6a0989f..3fd5dcd 100644 --- a/R/scglr.r +++ b/R/scglr.r @@ -108,7 +108,7 @@ scglr <- function(formula,data,family,K=1,size=NULL,weights=NULL,offset=NULL,su y <- as.matrix(model.part(form,data=mf,lhs=1)) x <- model.part(form, data=mf, rhs = 1) - if(Formula:::length.Formula(form)[2]==2){ + if(length_Formula(form)[2]==2){ AX <- model.part(form, data=mf, lhs=0, rhs = 2) namesAx <- names(AX) AX <- model.matrix(form,data=mf,rhs=2)[,-1] diff --git a/R/theme.r b/R/theme.r index 7cbbb11..b1b82e2 100644 --- a/R/theme.r +++ b/R/theme.r @@ -72,7 +72,7 @@ scglrTheme <- function(formula, data, H, family, size = NULL, weights = NULL, # extract left-hand side (Y) # Y is a formula of the form ~... - if(Formula:::length.Formula(formula)[1] != 1) + if(length_Formula(formula)[1] != 1) stop("Left hand side part of formula (Y) must have ONE part!") theme_Y <- stats::terms(formula, lhs=1, rhs=0) Y_vars <- all.vars(theme_Y) @@ -114,7 +114,7 @@ scglrTheme <- function(formula, data, H, family, size = NULL, weights = NULL, # check and process themes ####################################################################### # check part counts - if(Formula:::length.Formula(formula)[2] < 1+additional) + if(length_Formula(formula)[2] < 1+additional) if(additional) { stop("Right hand side part of formula with additional variables must have at least TWO parts!") } else { @@ -122,7 +122,7 @@ scglrTheme <- function(formula, data, H, family, size = NULL, weights = NULL, } # theme count - theme_R <- Formula:::length.Formula(formula)[2] - additional + theme_R <- length_Formula(formula)[2] - additional # check H (number of components to keep per theme) H <- as.integer(H) @@ -154,7 +154,7 @@ scglrTheme <- function(formula, data, H, family, size = NULL, weights = NULL, # extract additional variables (A) # A is a formula of the form ~... if(additional) { - theme_A <- stats::terms(formula, lhs=0, rhs=Formula:::length.Formula(formula)[[2]]) + theme_A <- stats::terms(formula, lhs=0, rhs=length_Formula(formula)[[2]]) } else { theme_A <- NULL } diff --git a/R/utils.r b/R/utils.r index d446882..bc4b9e9 100644 --- a/R/utils.r +++ b/R/utils.r @@ -72,3 +72,7 @@ custom_stop <- function(subclass, ..., call=sys.call(-1)) { c <- condition(c(subclass, "error"), message=message, call=call) stop(c) } + +length_Formula <- function(x) { + c(length(attr(x, "lhs")), length(attr(x, "rhs"))) +} \ No newline at end of file From 3e955c04cc72b7973affb6f96c7e5b3b1ab3a574 Mon Sep 17 00:00:00 2001 From: Guillaume Cornu Date: Mon, 24 Feb 2025 17:27:38 +0100 Subject: [PATCH 4/4] update news & description --- DESCRIPTION | 2 +- NAMESPACE | 3 +++ NEWS.md | 1 + 3 files changed, 5 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index c374e0b..f7415e6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -5,7 +5,7 @@ Description: An extension of the Fisher Scoring Algorithm to combine PLS regression with GLM estimation in the multivariate context. Covariates can also be grouped in themes. Version: 3.0.9000 -Date: 2022-12-14 +Date: 2024-02-24 Authors@R: c( person("Guillaume","Cornu",,"gcornu@cirad.fr", role=c("aut","cre"), comment=c(ORCID="0000-0002-7523-5176")), person("Frederic","Mortier",,"fmortier@cirad.fr",role="aut", comment=c(ORCID="0000-0001-5473-709X")), diff --git a/NAMESPACE b/NAMESPACE index f13df11..cc8ed83 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,13 +6,16 @@ S3method(barplot,SCGLRTHM) S3method(length,MultivariateFormula) S3method(pairs,SCGLR) S3method(plot,SCGLR) +S3method(plot,SCGLRCV) S3method(plot,SCGLRTHM) S3method(print,MultivariateFormula) S3method(print,SCGLR) +S3method(print,SCGLRCV) S3method(print,summary.SCGLR) S3method(screeplot,SCGLR) S3method(screeplot,SCGLRTHM) S3method(summary,SCGLR) +S3method(summary,SCGLRCV) export(critConvergence) export(infoCriterion) export(kCompRand) diff --git a/NEWS.md b/NEWS.md index e62c2d7..060702a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -10,6 +10,7 @@ - fix contrasts error in `scglrTheme` (issue #20) - fix some URL in docs - move from `plsdepot::plsreg2` to `pls::plsr` to initialize mixed model components (issue #22) +- fix rstudio bug displaying error message when printing a MultivariateFormula (in fact a Formula) (issue #23). ## New features - preliminary integration of code from `SCnext/mixedSCGLR` written by Jocelyn Chauvet (issue #11)