[R] Error generated by nlme::gnls

[Bill Dunlap]

I think the intent of this code was to see if the formula had solely a
literal 1 on the right hand side.
Then !identical(pp[[3]], 1) would do it, avoiding the overhead of calling
deparse.  Note that the
1 might be an integer, which the current code would (erroneously) not
catch, so
   !identical(pp[[3]], 1) && !identical(pp[[3]], 1L)
or something equivalent would be better.

-Bill

On Sun, Jul 24, 2022 at 5:58 AM Ivan Krylov <krylov.r00t using gmail.com> wrote:

> Sorry for being too terse in my previous e-mail!
>
> On Sun, 24 Jul 2022 23:03:02 +1200
> Rolf Turner <r.turner using auckland.ac.nz> wrote:
>
> > The maintainer of the nlme package (who is, according to maintainer(),
> > "R-core") could change the code so that it uses invokes deparse1()
> > rather than deparse, but the user cannot do so, not without in effect
> > re-creating the package.
>
> You're right. I think there's a buglet in nlme::gnls that nobody
> noticed until R 4.2.0 was released *and* Aaron Crowley used the
> function with a sufficiently long formula.
>
> > Also, the question remains:  why did Aaron Crowley's code work in the
> > past, whereas now it throws an error?  What changed?
>
> gnls() may have been performing the `if (deparse(...) != '1')` test for
> a long time, but never crashed before because it wasn't a fatal error
> until R 4.2.0. Previously, if() would issue a warning and use the first
> element of the boolean vector.
>
> R 4.2.0 was released this April, which was less than 6 months ago. I
> think it all fits.
>
> A temporary solution would be to make use of the fact that R is a very
> dynamic language and perform surgery on a live function inside a loaded
> package:
>
> library(codetools)
>
> nlme <- loadNamespace('nlme')
> unlockBinding('gnls', nlme)
> nlme$gnls <- `body<-`(fun = nlme$gnls, value = walkCode(
>         body(nlme$gnls), makeCodeWalker(
>                 call = function(e, w)
>                         as.call(lapply(as.list(e), function(ee)
>                                 if (!missing(ee)) walkCode(ee, w)
>                         )),
>                 leaf = function(e, w)
>                         if (is.symbol(e) && e == 'deparse') {
>                                 as.name('deparse1')
>                         } else e
>         )
> ))
> lockBinding('gnls', nlme)
> rm(nlme)
>
> grep('deparse', deparse(nlme::gnls), value = TRUE)
> # [1] "                deparse1(pp[[3]]), sep = \"~\"), collapse =
> \",\"), " # [2] "        if (deparse1(params[[nm]][[3]]) != \"1\") {"
> # [3] "        list(row.names(dataModShrunk), deparse1(form[[2]]))), "
>
> Aaron's example seems to work after this, modulo needing 12 starting
> values instead of 13.
>
> --
> Best regards,
> Ivan
>
> ______________________________________________
> R-help using r-project.org mailing list -- To UNSUBSCRIBE and more, see
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide
> http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.
>

	[[alternative HTML version deleted]]