try to circumvent Formula length bug with RStudio (#24)

* try to circumvent Formula length bug with RStudio

* add missing documentation

* avoid call to unexported function length from Formula

* update news & description

---------

Co-authored-by: Guillaume Cornu <gcornu@cirad.fr>

Author: billy34

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")),
@@ -25,5 +25,5 @@ Imports:
 Suggests:
     future,future.apply,progressr
 LazyData: yes
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2
 Encoding: UTF-8

NAMESPACE

@@ -3,15 +3,19 @@
 S3method("$",MultivariateFormula)
 S3method(barplot,SCGLR)
 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)

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)

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))

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(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]

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()+

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(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,15 +114,15 @@ scglrTheme <- function(formula, data, H, family, size = NULL, weights = NULL,
   # check and process themes #######################################################################
 
   # check part counts
-  if(length(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 {
       stop("Right hand side part of formula must have at least ONE part!")
     }
 
   # theme count
-  theme_R <- length(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=length(formula)[[2]])
+    theme_A <- stats::terms(formula, lhs=0, rhs=length_Formula(formula)[[2]])
   } else {
     theme_A <- NULL
   }

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")))
+}