Running ‘bndmask.R’ [0s/0s]
  Running ‘boundnlxb.R’ [0s/0s]
  Running ‘derivs.R’ [1s/1s]
  Comparing ‘derivs.Rout’ to ‘derivs.Rout.save’ ...4,10d3
< 
< Attaching package: 'nlsr'
< 
< The following object is masked from 'package:base':
< 
<     isFALSE
< 
  Running ‘derivsJN.R’ [1s/1s]
Running the tests in ‘tests/derivsJN.R’ failed.
Complete output:
  > library(nlsr)
  
  Attaching package: 'nlsr'
  
  The following object is masked from 'package:base':
  
      isFALSE
  
  > 
  > # Various derivatives 
  > 
  > fnDeriv(quote(1 + x + y), c("x", "y"))
  function (x, y) 
  {
      .value <- 1 + x + y
      .grad <- array(0, c(length(.value), 2L), list(NULL, c("x", 
      "y")))
      .grad[, "x"] <- 1
      .grad[, "y"] <- 1
      attr(.value, "gradient") <- .grad
      .value
  }
  > 
  > nlsDeriv( ~ log(x), "x")
  1/x
  > nlsDeriv( ~ log(x, base=3), "x" )
  1/(x * 1.09861228866811)
  > 
  > nlsDeriv( ~ exp(x), "x")
  exp(x)
  > nlsDeriv( ~ sin(x), "x")
  cos(x)
  > nlsDeriv( ~ cos(x), "x")
  -sin(x)
  > nlsDeriv( ~ tan(x), "x")
  1/cos(x)^2
  > nlsDeriv( ~ sinh(x), "x")
  cosh(x)
  > nlsDeriv( ~ cosh(x), "x")
  sinh(x)
  > nlsDeriv( ~ sqrt(x), "x")
  0.5/sqrt(x)
  > nlsDeriv( ~ pnorm(q), "q")
  dnorm(q)
  > nlsDeriv( ~ dnorm(x, mean), "mean")
  dnorm(x - mean) * (x - mean)
  > nlsDeriv( ~ asin(x), "x")
  1/sqrt(1 + x^2)
  > nlsDeriv( ~ acos(x), "x")
  -1/sqrt(1 + x^2)
  > nlsDeriv( ~ atan(x), "x")
  1/(1 + x^2)
  > nlsDeriv( ~ gamma(x), "x")
  gamma(x) * digamma(x)
  > nlsDeriv( ~ lgamma(x), "x")
  digamma(x)
  > nlsDeriv( ~ digamma(x), "x")
  trigamma(x)
  > nlsDeriv( ~ trigamma(x), "x")
  psigamma(x, 2L)
  > nlsDeriv( ~ psigamma(x, deriv = 5), "x")
  psigamma(x, 6)
  > nlsDeriv( ~ x*y, "x")
  y
  > nlsDeriv( ~ x/y, "x")
  1/y
  > nlsDeriv( ~ x^y, "x")
  y * x^(y - 1)
  > nlsDeriv( ~ (x), "x")
  [1] 1
  > nlsDeriv( ~ +x, "x")
  [1] 1
  > nlsDeriv( ~ -x, "x")
  [1] -1
  > nlsDeriv( ~ abs(x), "x")
  sign(x)
  > nlsDeriv( ~ sign(x), "x")
  [1] 0
  > 
  > # Various simplifications
  > 
  > nlsSimplify(quote(+(a+b)))
  a + b
  > nlsSimplify(quote(-5))
  [1] -5
  > nlsSimplify(quote(--(a+b)))
  a + b
  > 
  > nlsSimplify(quote(exp(log(a+b))))
  a + b
  > nlsSimplify(quote(exp(1)))
  [1] 2.718282
  > 
  > nlsSimplify(quote(log(exp(a+b))))
  a + b
  > nlsSimplify(quote(log(1)))
  [1] 0
  > 
  > nlsSimplify(quote(!TRUE))
  [1] FALSE
  > nlsSimplify(quote(!FALSE))
  [1] TRUE
  > 
  > nlsSimplify(quote((a+b)))
  a + b
  > 
  > nlsSimplify(quote(a + b + 0))
  a + b
  > nlsSimplify(quote(0 + a + b))
  a + b
  > nlsSimplify(quote((a+b) + (a+b)))
  2 * (a + b)
  > nlsSimplify(quote(1 + 4))
  [1] 5
  > 
  > nlsSimplify(quote(a + b - 0))
  a + b
  > nlsSimplify(quote(0 - a - b))
  -a - b
  > nlsSimplify(quote((a+b) - (a+b)))
  [1] 0
  > nlsSimplify(quote(5 - 3))
  [1] 2
  > 
  > nlsSimplify(quote(0*(a+b)))
  [1] 0
  > nlsSimplify(quote((a+b)*0))
  [1] 0
  > nlsSimplify(quote(1L * (a+b)))
  a + b
  > nlsSimplify(quote((a+b) * 1))
  a + b
  > nlsSimplify(quote((-1)*(a+b)))
  -(a + b)
  > nlsSimplify(quote((a+b)*(-1)))
  -(a + b)
  > nlsSimplify(quote(2*5))
  [1] 10
  > 
  > nlsSimplify(quote((a+b) / 1))
  a + b
  > nlsSimplify(quote((a+b) / (-1)))
  -(a + b)
  > nlsSimplify(quote(0/(a+b)))
  [1] 0
  > nlsSimplify(quote(1/3))
  [1] 0.3333333
  > 
  > nlsSimplify(quote((a+b) ^ 1))
  a + b
  > nlsSimplify(quote(2^10))
  [1] 1024
  > 
  > nlsSimplify(quote(log(exp(a), 3)))
  a/1.09861228866811
  > 
  > nlsSimplify(quote(FALSE && b))
  [1] FALSE
  > nlsSimplify(quote(a && TRUE))
  a
  > nlsSimplify(quote(TRUE && b))
  b
  > 
  > nlsSimplify(quote(a || TRUE))
  [1] TRUE
  > nlsSimplify(quote(FALSE || b))
  b
  > nlsSimplify(quote(a || FALSE))
  a
  > 
  > nlsSimplify(quote(if (TRUE) a+b))
  a + b
  > nlsSimplify(quote(if (FALSE) a+b))
  NULL
  > 
  > nlsSimplify(quote(if (TRUE) a+b else a*b))
  a + b
  > nlsSimplify(quote(if (FALSE) a+b else a*b))
  a * b
  > nlsSimplify(quote(if (cond) a+b else a+b))
  a + b
  > 
  > # This one was wrong...
  > nlsSimplify(quote(--(a+b)))
  a + b
  > 
  > 
  > # From the Weeds problem
  > 
  >   modelformula <- y ~ ms * b1/(1 + b2 * exp(-b3 * tt))
  >   pvec <- c(b1=1, b2=1, b3=1)
  >   cat("model2rjfunx: modelformula = ")
  model2rjfunx: modelformula = >   print(modelformula)
  y ~ ms * b1/(1 + b2 * exp(-b3 * tt))
  >   print(class(modelformula))
  [1] "formula"
  > 
  >   if (length(modelformula) == 2) {
  +        residexpr <- modelformula[[2]]
  +   } else if (length(modelformula) == 3) {
  +        residexpr <- call("-", modelformula[[3]], modelformula[[2]])
  +   } else stop("Unrecognized formula")
  >     
  >   if (is.null(names(pvec)))
  +     names(pvec) <- paste0("p", seq_along(pvec))
  >     
  >   residexpr1 <- nlsDeriv( ~ residexpr, names(pvec))
  Warning message:
  In if (as.character(expr) == name) return(1) else return(0) :
    the condition has length > 1 and only the first element will be used
  >   cat("residexpr1:\n")
  residexpr1:
  >   print(residexpr1) 
  [1] 0
  > ## SHOULD TRY:
  >   residexpr2 <- fnDeriv(residexpr, names(pvec))
  Error in expr[[index]] : recursive indexing failed at level 2
  Calls: fnDeriv -> codeDeriv -> findSubexprs -> edit -> edit -> edit
  Execution halted