Running 'CER-funCER-Rcode-constr.R' [1s/1s]
  Running 'CER-funCER-Rcode-constrjoint.R' [1s/1s]
  Running 'CER-funCER-Rcode-joint.R' [1s/1s]
  Running 'GNEceq-examples.R' [1s/2s]
  Running 'GNEnseq-examples.R' [1s/2s]
  Running 'NIR-func-Rcode.R' [1s/1s]
  Running 'NIRandVIPexample.R' [1s/2s]
  Running 'SSR-Rcode-funSSRcheck-constrjoint.R' [1s/1s]
  Running 'SSR-funSSR-Rcode-constr.R' [1s/1s]
  Running 'SSR-funSSR-funSSRcheck-constr.R' [1s/1s]
  Running 'SSR-funSSR-funSSRcheck-constrjoint.R' [1s/1s]
  Running 'SSR-testarg.R' [0s/1s]
  Running 'complfunc-3Dplot.R' [1s/1s]
  Running 'complfunc-funcFB.R' [0s/1s]
  Running 'complfunc-limitgraph.R' [1s/1s]
  Running 'sensi-analysis-duopoly.R' [1s/1s]
  Running 'sensi-analysis-genduopoly.R' [2s/3s]
  Running 'sensi-analysis-riverbasinpollution.R' [1s/2s]
  Running 'util-testfunc.R' [0s/1s]
Running the tests in 'tests/GNEceq-examples.R' failed.
Complete output:
  > if(!require("GNE"))stop("this test requires package GNE.")
  Loading required package: GNE
  Loading required package: alabama
  Loading required package: numDeriv
  Loading required package: nleqslv
  Loading required package: BB
  Loading required package: SQUAREM
  > 
  > itermax <- 10
  > 
  > #-------------------------------------------------------------------------------
  > # (1) Example 5 of von Facchinei et al. (2007)
  > #-------------------------------------------------------------------------------
  > 
  > dimx <- c(1, 1)
  > #Gr_x_j O_i(x)
  > grobj <- function(x, i, j)
  + {
  + 	if(i == 1)
  + 		res <- c(2*(x[1]-1), 0)
  + 	if(i == 2)
  + 		res <- c(0, 2*(x[2]-1/2))
  + 	res[j]	
  + }
  > #Gr_x_k Gr_x_j O_i(x)
  > heobj <- function(x, i, j, k)
  + 	2 * (i == j && j == k)
  > 
  > dimlam <- c(1, 1)
  > #constraint function g_i(x)
  > g <- function(x, i)
  + 	sum(x[1:2]) - 1
  > #Gr_x_j g_i(x)
  > grg <- function(x, i, j)
  + 	1
  > #Gr_x_k Gr_x_j g_i(x)
  > heg <- function(x, i, j, k)
  + 	0
  > 
  > 
  > x0 <- rep(0, sum(dimx))
  > z0 <- c(x0, 2, 2, max(10, 5-g(x0, 1) ), max(10, 5-g(x0, 2) ) )
  > 
  > #true value is (3/4, 1/4, 1/2, 1/2)
  > GNE.ceq(z0, dimx, dimlam, grobj=grobj, heobj=heobj, 
  + 	constr=g, grconstr=grg, heconstr=heg, method="PR",
  + 	control=list(trace=0, maxit=itermax))
   ----------- FAILURE REPORT -------------- 
   --- failure: the condition has length > 1 ---
   --- srcref --- 
  : 
   --- package (from environment) --- 
  GNE
   --- call from context --- 
  GNE.ceq(z0, dimx, dimlam, grobj = grobj, heobj = heobj, constr = g, 
      grconstr = grg, heconstr = heg, method = "PR", control = list(trace = 0, 
          maxit = itermax))
   --- call from argument --- 
  if (class(test.try) == "try-error") return(list(par = NA, value = NA, 
      counts = NA, iter = NA, code = 100, message = "Can't evaluate Jac H(init).", 
      fvec = NA))
   --- R stacktrace ---
  where 1: GNE.ceq(z0, dimx, dimlam, grobj = grobj, heobj = heobj, constr = g, 
      grconstr = grg, heconstr = heg, method = "PR", control = list(trace = 0, 
          maxit = itermax))
  
   --- value of length: 2 type: logical ---
  [1] FALSE FALSE
   --- function from context --- 
  function (init, dimx, dimlam, grobj, arggrobj, heobj, argheobj, 
      constr, argconstr, grconstr, arggrconstr, heconstr, argheconstr, 
      dimmu, joint, argjoint, grjoint, arggrjoint, hejoint, arghejoint, 
      method = "PR", control = list(), silent = TRUE, ...) 
  {
      if (method == "default") 
          method <- "PR"
      argtest1 <- testargfunCER(init, dimx, dimlam, grobj, arggrobj, 
          constr, argconstr, grconstr, arggrconstr, dimmu, joint, 
          argjoint, grjoint, arggrjoint)
      test.try <- try(funCER(init, dimx, dimlam, grobj, arggrobj, 
          constr, argconstr, grconstr, arggrconstr, dimmu, joint, 
          argjoint, grjoint, arggrjoint), silent = silent)
      if (class(test.try) == "try-error") 
          return(list(par = NA, value = NA, counts = NA, iter = NA, 
              code = 100, message = "Can't evalate H(init).", fvec = NA))
      if (any(is.nan(test.try)) || any(is.infinite(test.try))) 
          return(list(par = NA, value = NA, counts = NA, iter = NA, 
              code = 100, message = "H(init) has infinite or NaN values.", 
              fvec = NA))
      argtest2 <- testargjacCER(init, dimx, dimlam, heobj, argheobj, 
          constr, argconstr, grconstr, arggrconstr, heconstr, argheconstr, 
          dimmu, joint, argjoint, grjoint, arggrjoint, hejoint, 
          arghejoint)
      test.try <- try(jacCER(init, dimx, dimlam, heobj, argheobj, 
          constr, argconstr, grconstr, arggrconstr, heconstr, argheconstr, 
          dimmu, joint, argjoint, grjoint, arggrjoint, hejoint, 
          arghejoint), silent = silent)
      if (class(test.try) == "try-error") 
          return(list(par = NA, value = NA, counts = NA, iter = NA, 
              code = 100, message = "Can't evaluate Jac H(init).", 
              fvec = NA))
      if (any(is.nan(test.try)) || any(is.infinite(test.try))) 
          return(list(par = NA, value = NA, counts = NA, iter = NA, 
              code = 100, message = "Jac H(init) has infinite or NaN values.", 
              fvec = NA))
      myfunCER <- function(x, argfun, argjac) evalwitharglist(funCER, 
          x, argfun)
      myjacCER <- function(x, argfun, argjac) evalwitharglist(jacCER, 
          x, argjac)
      arg1 <- list(dimx = argtest1$dimx, dimlam = argtest1$dimlam, 
          grobj = argtest1$grobj, arggrobj = argtest1$arggrobj, 
          constr = argtest1$constr, argconstr = argtest1$argconstr, 
          grconstr = argtest1$grconstr, arggrconstr = argtest1$arggrconstr, 
          dimmu = argtest1$dimmu, joint = argtest1$joint, argjoint = argtest1$argjoint, 
          grjoint = argtest1$grjoint, arggrjoint = argtest1$arggrjoint)
      arg2 <- list(argtest2$dimx, argtest2$dimlam, argtest2$heobj, 
          argtest2$argheobj, argtest2$constr, argtest2$argconstr, 
          argtest2$grconstr, argtest2$arggrconstr, argtest2$heconstr, 
          argtest2$argheconstr, argtest2$dimmu, argtest2$joint, 
          argtest2$argjoint, argtest2$grjoint, argtest2$arggrjoint, 
          argtest2$hejoint, argtest2$arghejoint)
      if (!silent) 
          print("init completed.")
      res <- ceq(init, dimx, dimlam, Hfinal = myfunCER, jacHfinal = myjacCER, 
          argfun = arg1, argjac = arg2, method = method, control = control, 
          silent = silent, ...)
      class(res) <- "GNE"
      if (!silent) 
          print("computation completed.")
      res
  }
  <bytecode: 0x4ef4c78>
  <environment: namespace:GNE>
   --- function search by body ---
  Function GNE.ceq in namespace GNE has this body.
   ----------- END OF FAILURE REPORT -------------- 
  Fatal error: the condition has length > 1
Running the tests in 'tests/GNEnseq-examples.R' failed.
Complete output:
  > if(!require("GNE"))stop("this test requires package GNE.")
  Loading required package: GNE
  Loading required package: alabama
  Loading required package: numDeriv
  Loading required package: nleqslv
  Loading required package: BB
  Loading required package: SQUAREM
  > 
  > itermax <- 10
  > 
  > #-------------------------------------------------------------------------------
  > # (1) Example 5 of von Facchinei et al. (2007)
  > #-------------------------------------------------------------------------------
  > 
  > dimx <- c(1, 1)
  > #Gr_x_j O_i(x)
  > grobj <- function(x, i, j)
  + {
  + 	if(i == 1)
  + 		res <- c(2*(x[1]-1), 0)
  + 	if(i == 2)
  + 		res <- c(0, 2*(x[2]-1/2))
  + 	res[j]	
  + }
  > #Gr_x_k Gr_x_j O_i(x)
  > heobj <- function(x, i, j, k)
  + 	2 * (i == j && j == k)
  > 
  > dimlam <- c(1, 1)
  > #constraint function g_i(x)
  > g <- function(x, i)
  + 	sum(x[1:2]) - 1
  > #Gr_x_j g_i(x)
  > grg <- function(x, i, j)
  + 	1
  > #Gr_x_k Gr_x_j g_i(x)
  > heg <- function(x, i, j, k)
  + 	0
  > 
  > 
  > 
  > #true value is (3/4, 1/4, 1/2, 1/2)
  > 
  > z0 <- rep(0, sum(dimx)+sum(dimlam))
  > 
  > funSSR(z0, dimx, dimlam, grobj=grobj, constr=g, grconstr=grg, compl=phiFB, echo=FALSE)
  [1] -2 -1  0  0
  > 
  > 	
  > jacSSR(z0, dimx, dimlam, heobj=heobj, constr=g, grconstr=grg, 
  + 	heconstr=heg, gcompla=GrAphiFB, gcomplb=GrBphiFB)
       [,1] [,2] [,3] [,4]
  [1,]    2    0    1    0
  [2,]    0    2    0    1
  [3,]    0    0   -1    0
  [4,]    0    0    0   -1
  > 
  > 
  > GNE.nseq(z0, dimx, dimlam, grobj=grobj, NULL, heobj=heobj, NULL, 
  + 	constr=g, NULL, grconstr=grg, NULL, heconstr=heg, NULL, 
  + 	compl=phiFB, gcompla=GrAphiFB, gcomplb=GrBphiFB, method="Newton", 
  + 	control=list(trace=1, maxit=itermax))
   ----------- FAILURE REPORT -------------- 
   --- failure: the condition has length > 1 ---
   --- srcref --- 
  : 
   --- package (from environment) --- 
  GNE
   --- call from context --- 
  GNE.nseq(z0, dimx, dimlam, grobj = grobj, NULL, heobj = heobj, 
      NULL, constr = g, NULL, grconstr = grg, NULL, heconstr = heg, 
      NULL, compl = phiFB, gcompla = GrAphiFB, gcomplb = GrBphiFB, 
      method = "Newton", control = list(trace = 1, maxit = itermax))
   --- call from argument --- 
  if (class(test.try) == "try-error") return(list(par = NA, value = NA, 
      counts = NA, iter = NA, code = 100, message = "Can't evaluate Jac Phi(init).", 
      fvec = NA))
   --- R stacktrace ---
  where 1: GNE.nseq(z0, dimx, dimlam, grobj = grobj, NULL, heobj = heobj, 
      NULL, constr = g, NULL, grconstr = grg, NULL, heconstr = heg, 
      NULL, compl = phiFB, gcompla = GrAphiFB, gcomplb = GrBphiFB, 
      method = "Newton", control = list(trace = 1, maxit = itermax))
  
   --- value of length: 2 type: logical ---
  [1] FALSE FALSE
   --- function from context --- 
  function (init, dimx, dimlam, grobj, arggrobj, heobj, argheobj, 
      constr, argconstr, grconstr, arggrconstr, heconstr, argheconstr, 
      compl, gcompla, gcomplb, argcompl, dimmu, joint, argjoint, 
      grjoint, arggrjoint, hejoint, arghejoint, method = "default", 
      control = list(), silent = TRUE, ...) 
  {
      if (method == "default") 
          method <- "Newton"
      argtest1 <- testargfunSSR(init, dimx, dimlam, grobj, arggrobj, 
          constr, argconstr, grconstr, arggrconstr, compl, argcompl, 
          dimmu, joint, argjoint, grjoint, arggrjoint)
      test.try <- try(funSSR(init, dimx, dimlam, grobj, arggrobj, 
          constr, argconstr, grconstr, arggrconstr, compl, argcompl, 
          dimmu, joint, argjoint, grjoint, arggrjoint), silent = silent)
      if (class(test.try) == "try-error") 
          return(list(par = NA, value = NA, counts = NA, iter = NA, 
              code = 100, message = "Can't evalate Phi(init).", 
              fvec = NA))
      if (any(is.nan(test.try)) || any(is.infinite(test.try))) 
          return(list(par = NA, value = NA, counts = NA, iter = NA, 
              code = 100, message = "Phi(init) has infinite or NaN values.", 
              fvec = NA))
      argtest2 <- testargjacSSR(init, dimx, dimlam, heobj, argheobj, 
          constr, argconstr, grconstr, arggrconstr, heconstr, argheconstr, 
          gcompla, gcomplb, argcompl, dimmu, joint, argjoint, grjoint, 
          arggrjoint, hejoint, arghejoint)
      test.try <- try(jacSSR(init, dimx, dimlam, heobj, argheobj, 
          constr, argconstr, grconstr, arggrconstr, heconstr, argheconstr, 
          gcompla, gcomplb, argcompl, dimmu, joint, argjoint, grjoint, 
          arggrjoint, hejoint, arghejoint), silent = silent)
      if (class(test.try) == "try-error") 
          return(list(par = NA, value = NA, counts = NA, iter = NA, 
              code = 100, message = "Can't evaluate Jac Phi(init).", 
              fvec = NA))
      if (any(is.nan(test.try)) || any(is.infinite(test.try))) 
          return(list(par = NA, value = NA, counts = NA, iter = NA, 
              code = 100, message = "Jac Phi(init) has infinite or NaN values.", 
              fvec = NA))
      myfunSSR <- function(x, argfun, argjac) evalwitharglist(funSSR, 
          x, argfun)
      myjacSSR <- function(x, argfun, argjac) evalwitharglist(jacSSR, 
          x, argjac)
      arg1 <- list(argtest1$dimx, argtest1$dimlam, argtest1$grobj, 
          argtest1$arggrobj, argtest1$constr, argtest1$argconstr, 
          argtest1$grconstr, argtest1$arggrconstr, argtest1$compl, 
          argtest1$argcompl, argtest1$dimmu, argtest1$joint, argtest1$argjoint, 
          argtest1$grjoint, argtest1$arggrjoint)
      arg2 <- list(argtest2$dimx, argtest2$dimlam, argtest2$heobj, 
          argtest2$argheobj, argtest2$constr, argtest2$argconstr, 
          argtest2$grconstr, argtest2$arggrconstr, argtest2$heconstr, 
          argtest2$argheconstr, argtest2$gcompla, argtest2$gcomplb, 
          argtest2$argcompl, argtest2$dimmu, argtest2$joint, argtest2$argjoint, 
          argtest2$grjoint, argtest2$arggrjoint, argtest2$hejoint, 
          argtest2$arghejoint)
      if (!silent) 
          print("init completed.")
      res <- nseq(init, myfunSSR, myjacSSR, argfun = arg1, argjac = arg2, 
          method = method, control = control, silent = silent, 
          ...)
      class(res) <- "GNE"
      if (!silent) 
          print("computation completed.")
      res
  }
  <bytecode: 0x1d72fa8>
  <environment: namespace:GNE>
   --- function search by body ---
  Function GNE.nseq in namespace GNE has this body.
   ----------- END OF FAILURE REPORT -------------- 
  Fatal error: the condition has length > 1
Running the tests in 'tests/NIR-func-Rcode.R' failed.
Complete output:
  > if(!require("GNE"))stop("this test requires package GNE.")
  Loading required package: GNE
  Loading required package: alabama
  Loading required package: numDeriv
  Loading required package: nleqslv
  Loading required package: BB
  Loading required package: SQUAREM
  > 
  > 
  > 
  > #-------------------------------------------------------------------------------
  > # (1) Example 5 of von Facchinei et al. (2007)
  > #-------------------------------------------------------------------------------
  > 
  > dimx <- c(1, 1)
  > #O_i(x)
  > obj <- function(x, i)
  + {
  + 	if(i == 1)
  + 		res <- (x[1]-1)^2
  + 	if(i == 2)
  + 		res <- 2*(x[2]-1/2)^2
  + 	res	
  + }
  > #Gr_x_j O_i(x)
  > grobj <- function(x, i, j)
  + {
  + 	if(i == 1)
  + 		res <- c(2*(x[1]-1), 0)
  + 	if(i == 2)
  + 		res <- c(0, 2*(x[2]-1/2))
  + 	res[j]	
  + }
  > #Gr_x_k Gr_x_j O_i(x)
  > heobj <- function(x, i, j, k)
  + 	2 * (i == j && j == k)
  > 
  > dimlam <- c(1, 1)
  > #constraint function g_i(x)
  > h <- function(x)
  + 	sum(x[1:2]) - 1
  > 	
  > #Gr_x_j h(x)
  > jach <- function(x)
  + 	matrix(c(1, 1), 1)
  > 
  > 
  > x0 <- rexp(sum(dimx))
  > y <- rexp(sum(dimx))
  > xy1 <- c(y[1], x0[2])
  > xy2 <- c(x0[1], y[2])
  > alpha <- 0.1
  > 
  > resgap <- gapNIR(x0, y, dimx, obj=obj, echo=TRUE)
  > gapcheck <- obj(x0, 1) - obj(c(y[1], x0[2]), 1) - alpha/2*(x0[1]-y[1])^2 + obj(x0, 2) - obj(c(x0[1], y[2]), 2) - alpha/2*(x0[2]-y[2])^2
  > 
  > tol <- .Machine$double.eps^(1/2)
  > if(abs(resgap - gapcheck) > tol)
  + 	stop("wrong result 1")
  > 
  > resgrgap <- gradxgapNIR(x0, y, dimx, grobj=grobj) 
  > 
  > grcheck <- c(grobj(x0, 1, 1) - grobj(xy1, 1, 1) + grobj(x0, 2, 1) - grobj(xy2, 2, 1),
  + grobj(x0, 1, 2) - grobj(xy1, 1, 2) + grobj(x0, 2, 2) - grobj(xy2, 2, 2))
  > grcheck <- grcheck + c(grobj(xy1, 1, 1),  grobj(xy2, 2, 2))- alpha*(x0-y)
  > 
  > 
  > if(sum(abs(resgrgap - grcheck)) > tol)
  + 	stop("wrong result 2")
  > 	
  > 
  > resgrgap <- gradygapNIR(x0, y, dimx, grobj=grobj)
  > 
  > grcheck <- c( - grobj(xy1, 1, 1)  - grobj(xy2, 2, 1),
  +  - grobj(xy1, 1, 2) - grobj(xy2, 2, 2)) + alpha*(x0-y)
  > 
  > 
  > if(sum(abs(resgrgap - grcheck)) > tol)
  + 	stop("wrong result 3")
  > 	
  > 	 
  > 	
  > 	
  > fpNIR(x0, dimx, obj=obj, grobj=grobj, joint=h, jacjoint=jach, echo=FALSE, control=list(eps=1e-10))	
   ----------- FAILURE REPORT -------------- 
   --- failure: the condition has length > 1 ---
   --- srcref --- 
  : 
   --- package (from environment) --- 
  GNE
   --- call from context --- 
  testfunc(jacjointfinal, z, arg = argjacjoint, echo = echo, errmess = str)
   --- call from argument --- 
  if (class(test.try) == "try-error") {
      if (echo >= 1) {
          cat("Error when calling function, below the try output.\n")
          print(test.try)
          cat("Arguments are:\n")
          print(arglist)
          stop(errmess)
      }
  } else if (echo >= 2) print(test.try)
   --- R stacktrace ---
  where 1: testfunc(jacjointfinal, z, arg = argjacjoint, echo = echo, errmess = str)
  where 2: testargfpNIR(x, dimx, obj, argobj, joint, argjoint, grobj, arggrobj, 
      jacjoint, argjacjoint, echo)
  where 3: fpNIR(x0, dimx, obj = obj, grobj = grobj, joint = h, jacjoint = jach, 
      echo = FALSE, control = list(eps = 1e-10))
  
   --- value of length: 2 type: logical ---
  [1] FALSE FALSE
   --- function from context --- 
  function (f, x = NULL, arg = NULL, echo = TRUE, errmess = "", 
      tobelisted = TRUE) 
  {
      nbtotarg <- length(formals(f))
      if (is.logical(echo)) 
          echo <- 1
      if (echo >= 2) 
          print(formals(f))
      if (!is.null(arg) && tobelisted) 
          arg <- list(arg)
      if (!is.null(x)) {
          if (!is.null(arg)) {
              if (nbtotarg < 2) 
                  stop("wrong number of arguments.")
              else if (nbtotarg == 2) 
                  arglist <- c(list(x), arg)
              else if (nbtotarg >= 3) 
                  arglist <- c(list(x), as.list(rep(1, nbtotarg - 
                    2)), arg)
          }
          else {
              if (nbtotarg < 1) 
                  stop("wrong number of arguments.")
              else if (nbtotarg == 1) 
                  arglist <- list(x)
              else if (nbtotarg >= 2) 
                  arglist <- c(list(x), as.list(rep(1, nbtotarg - 
                    1)))
          }
      }
      else {
          if (!is.null(arg)) {
              if (nbtotarg < 1) 
                  stop("wrong number of arguments.")
              else if (nbtotarg == 1) 
                  arglist <- arg
              else if (nbtotarg >= 2) 
                  arglist <- c(as.list(rep(1, nbtotarg - 1)), arg)
          }
          else {
              if (nbtotarg == 0) 
                  arglist <- list()
              else if (nbtotarg >= 1) 
                  arglist <- as.list(rep(1, nbtotarg))
          }
      }
      if (echo >= 2) {
          print(is.function(f))
          print(f)
          print(arglist)
      }
      if (length(arglist) != nbtotarg) 
          stop("wrong number of arguments when testing function.")
      test.try <- try(do.call(f, arglist), silent = echo >= 2)
      if (class(test.try) == "try-error") {
          if (echo >= 1) {
              cat("Error when calling function, below the try output.\n")
              print(test.try)
              cat("Arguments are:\n")
              print(arglist)
              stop(errmess)
          }
      }
      else if (echo >= 2) 
          print(test.try)
      invisible()
  }
  <bytecode: 0x3c22348>
  <environment: namespace:GNE>
   --- function search by body ---
  Function testfunc in namespace GNE has this body.
   ----------- END OF FAILURE REPORT -------------- 
  Fatal error: the condition has length > 1
Running the tests in 'tests/NIRandVIPexample.R' failed.
Complete output:
  > if(!require("GNE"))stop("this test requires package GNE.")
  Loading required package: GNE
  Loading required package: alabama
  Loading required package: numDeriv
  Loading required package: nleqslv
  Loading required package: BB
  Loading required package: SQUAREM
  > 
  > #-------------------------------------------------------------------------------
  > # (4) Example of GNE with 4 solutions(!)
  > #-------------------------------------------------------------------------------
  > 
  > myarg <- list(C=c(2, 3), D=c(4,0))
  > 
  > dimx <- c(1, 1)
  > 
  > 
  > #O_i(x)
  > obj <- function(x, i, arg)
  + 	(x[i] - arg$C[i])^2*(x[-i] - arg$D[i])^4
  > 
  > 
  > 
  > 
  > #Gr_x_j O_i(x)
  > grobj <- function(x, i, j, arg)
  + {
  + 	dij <- 1*(i == j)
  + 	other <- ifelse(i == 1, 2, 1)
  + 	2*(x[i] - arg$C[i])*(x[other] - arg$D[i])^4*dij + 4*(x[i] - arg$C[i])^2*(x[other] - arg$D[i])^3*(1-dij) 
  + }
  > #Gr_x_k Gr_x_j O_i(x)
  > heobj <- function(x, i, j, k, arg)
  + {
  + 	dij <- 1*(i == j)
  + 	dik <- 1*(i == k)
  + 	other <- ifelse(i == 1, 2, 1)
  + 	res <- 2*(x[other] - arg$D[i])^4*dij*dik + 8*(x[i] - arg$C[i])*(x[other] - arg$D[i])^3*dij*(1-dik)
  + 	res <- res + 8*(x[i] - arg$C[i])*(x[other] - arg$D[i])^3*(1-dij)*dik
  + 	res + 12*(x[i] - arg$C[i])^2*(x[other] - arg$D[i])^2*(1-dij)*(1-dik)
  + }
  > 
  > dimlam <- c(1, 1)
  > #g(x)
  > gtot <- function(x)
  + 	sum(x[1:2]) - 1
  > #	c(sum(x[1:2]) - 1, 2*x[1]+x[2]-2)
  > #Gr_x_j g(x)
  > jacgtot <- function(x)
  + 	cbind(1, 1)
  > #	cbind(c(1, 1), c(2, 1))
  > 
  > 
  > 
  > 
  > z0 <- rexp(sum(dimx))
  > 
  > fpNIR(z0, dimx, obj, myarg, gtot, NULL, grobj, myarg, jacgtot, NULL)
   ----------- FAILURE REPORT -------------- 
   --- failure: the condition has length > 1 ---
   --- srcref --- 
  : 
   --- package (from environment) --- 
  GNE
   --- call from context --- 
  testfunc(jacjointfinal, z, arg = argjacjoint, echo = echo, errmess = str)
   --- call from argument --- 
  if (class(test.try) == "try-error") {
      if (echo >= 1) {
          cat("Error when calling function, below the try output.\n")
          print(test.try)
          cat("Arguments are:\n")
          print(arglist)
          stop(errmess)
      }
  } else if (echo >= 2) print(test.try)
   --- R stacktrace ---
  where 1: testfunc(jacjointfinal, z, arg = argjacjoint, echo = echo, errmess = str)
  where 2: testargfpNIR(x, dimx, obj, argobj, joint, argjoint, grobj, arggrobj, 
      jacjoint, argjacjoint, echo)
  where 3: fpNIR(z0, dimx, obj, myarg, gtot, NULL, grobj, myarg, jacgtot, 
      NULL)
  
   --- value of length: 2 type: logical ---
  [1] FALSE FALSE
   --- function from context --- 
  function (f, x = NULL, arg = NULL, echo = TRUE, errmess = "", 
      tobelisted = TRUE) 
  {
      nbtotarg <- length(formals(f))
      if (is.logical(echo)) 
          echo <- 1
      if (echo >= 2) 
          print(formals(f))
      if (!is.null(arg) && tobelisted) 
          arg <- list(arg)
      if (!is.null(x)) {
          if (!is.null(arg)) {
              if (nbtotarg < 2) 
                  stop("wrong number of arguments.")
              else if (nbtotarg == 2) 
                  arglist <- c(list(x), arg)
              else if (nbtotarg >= 3) 
                  arglist <- c(list(x), as.list(rep(1, nbtotarg - 
                    2)), arg)
          }
          else {
              if (nbtotarg < 1) 
                  stop("wrong number of arguments.")
              else if (nbtotarg == 1) 
                  arglist <- list(x)
              else if (nbtotarg >= 2) 
                  arglist <- c(list(x), as.list(rep(1, nbtotarg - 
                    1)))
          }
      }
      else {
          if (!is.null(arg)) {
              if (nbtotarg < 1) 
                  stop("wrong number of arguments.")
              else if (nbtotarg == 1) 
                  arglist <- arg
              else if (nbtotarg >= 2) 
                  arglist <- c(as.list(rep(1, nbtotarg - 1)), arg)
          }
          else {
              if (nbtotarg == 0) 
                  arglist <- list()
              else if (nbtotarg >= 1) 
                  arglist <- as.list(rep(1, nbtotarg))
          }
      }
      if (echo >= 2) {
          print(is.function(f))
          print(f)
          print(arglist)
      }
      if (length(arglist) != nbtotarg) 
          stop("wrong number of arguments when testing function.")
      test.try <- try(do.call(f, arglist), silent = echo >= 2)
      if (class(test.try) == "try-error") {
          if (echo >= 1) {
              cat("Error when calling function, below the try output.\n")
              print(test.try)
              cat("Arguments are:\n")
              print(arglist)
              stop(errmess)
          }
      }
      else if (echo >= 2) 
          print(test.try)
      invisible()
  }
  <bytecode: 0x325a6d8>
  <environment: namespace:GNE>
   --- function search by body ---
  Function testfunc in namespace GNE has this body.
   ----------- END OF FAILURE REPORT -------------- 
  Fatal error: the condition has length > 1
Running the tests in 'tests/sensi-analysis-duopoly.R' failed.
Complete output:
  > if(!require("GNE"))stop("this test requires package GNE.")
  Loading required package: GNE
  Loading required package: alabama
  Loading required package: numDeriv
  Loading required package: nleqslv
  Loading required package: BB
  Loading required package: SQUAREM
  > 
  > #-------------------------------------------------------------------------------
  > # (2) Duopoly game of Krawczyk and Stanislav Uryasev (2000)
  > #-------------------------------------------------------------------------------
  > 
  > 
  > #constants
  > myarg <- list(d= 20, lambda= 4, rho= 1)
  > 
  > dimx <- c(1, 1)
  > #Gr_x_j O_i(x)
  > grobj <- function(x, i, j, arg)
  + {
  + 	res <- -arg$rho * x[i]
  + 	if(i == j)
  + 		res <- res + arg$d - arg$lambda - arg$rho*(x[1]+x[2])
  + 	-res
  + }
  > #Gr_x_k Gr_x_j O_i(x)
  > heobj <- function(x, i, j, k, arg)
  + 	arg$rho * (i == j) + arg$rho * (j == k)	
  > 
  > 
  > dimlam <- c(1, 1)
  > #constraint function g_i(x)
  > g <- function(x, i)
  + 	-x[i]
  > #Gr_x_j g_i(x)
  > grg <- function(x, i, j)
  + 	-1*(i == j)
  > #Gr_x_k Gr_x_j g_i(x)
  > heg <- function(x, i, j, k)
  + 	0
  > 
  > #true value is ((d-lambda)/3*rho, (d-lambda)/3*rho, 0, 0) 
  > 
  > 
  > getNE <- function(myarg, control=list(itermax=100, trace=0))
  + {
  + 	z0 <- rep(0, sum(dimx)+sum(dimlam))
  + 	GNE.nseq(z0, dimx, dimlam, grobj=grobj, myarg, heobj=heobj, myarg, 
  + 	constr=g, NULL, grconstr=grg, NULL, heconstr=heg, NULL, 
  + 	compl=phiFB, gcompla=GrAphiFB, gcomplb=GrBphiFB, method="Newton", 
  + 	control=list(trace=control$trace, maxit=control$itermax))$par[1:length(dimx)]
  + }
  > getNE4sobol <- function(x, control=list(itermax=100, trace=0))
  + {
  + #	res <- vector("numeric", NROW(x))
  + 	print(dim(x))
  + 	
  + 	#for(i in 1:NROW(x))
  + 	res <- sapply(1:NROW(x), function(i) 
  + 	{		
  + 		myarg <- list(d=x[i,1], lambda=x[i,2], rho=x[i,3])
  + 		z0 <- rep(0, sum(dimx)+sum(dimlam))
  + 		GNE.nseq(z0, dimx, dimlam, grobj=grobj, myarg, heobj=heobj, myarg, 
  + 			constr=g, NULL, grconstr=grg, NULL, heconstr=heg, NULL, 
  + 			compl=phiFB, gcompla=GrAphiFB, gcomplb=GrBphiFB, method="Newton", 
  + 			control=list(trace=control$trace, 
  + 			maxit=control$itermax))$par[1]
  + 	}
  + 	)
  + 	res
  + }
  > 
  > checkNE <- function(myarg)
  + {
  + 	rep((myarg$d-myarg$lambda)/(3*myarg$rho), 2)
  + }
  > 
  > getNE(myarg)
   ----------- FAILURE REPORT -------------- 
   --- failure: the condition has length > 1 ---
   --- srcref --- 
  : 
   --- package (from environment) --- 
  GNE
   --- call from context --- 
  GNE.nseq(z0, dimx, dimlam, grobj = grobj, myarg, heobj = heobj, 
      myarg, constr = g, NULL, grconstr = grg, NULL, heconstr = heg, 
      NULL, compl = phiFB, gcompla = GrAphiFB, gcomplb = GrBphiFB, 
      method = "Newton", control = list(trace = control$trace, 
          maxit = control$itermax))
   --- call from argument --- 
  if (class(test.try) == "try-error") return(list(par = NA, value = NA, 
      counts = NA, iter = NA, code = 100, message = "Can't evaluate Jac Phi(init).", 
      fvec = NA))
   --- R stacktrace ---
  where 1: GNE.nseq(z0, dimx, dimlam, grobj = grobj, myarg, heobj = heobj, 
      myarg, constr = g, NULL, grconstr = grg, NULL, heconstr = heg, 
      NULL, compl = phiFB, gcompla = GrAphiFB, gcomplb = GrBphiFB, 
      method = "Newton", control = list(trace = control$trace, 
          maxit = control$itermax))
  where 2: getNE(myarg)
  
   --- value of length: 2 type: logical ---
  [1] FALSE FALSE
   --- function from context --- 
  function (init, dimx, dimlam, grobj, arggrobj, heobj, argheobj, 
      constr, argconstr, grconstr, arggrconstr, heconstr, argheconstr, 
      compl, gcompla, gcomplb, argcompl, dimmu, joint, argjoint, 
      grjoint, arggrjoint, hejoint, arghejoint, method = "default", 
      control = list(), silent = TRUE, ...) 
  {
      if (method == "default") 
          method <- "Newton"
      argtest1 <- testargfunSSR(init, dimx, dimlam, grobj, arggrobj, 
          constr, argconstr, grconstr, arggrconstr, compl, argcompl, 
          dimmu, joint, argjoint, grjoint, arggrjoint)
      test.try <- try(funSSR(init, dimx, dimlam, grobj, arggrobj, 
          constr, argconstr, grconstr, arggrconstr, compl, argcompl, 
          dimmu, joint, argjoint, grjoint, arggrjoint), silent = silent)
      if (class(test.try) == "try-error") 
          return(list(par = NA, value = NA, counts = NA, iter = NA, 
              code = 100, message = "Can't evalate Phi(init).", 
              fvec = NA))
      if (any(is.nan(test.try)) || any(is.infinite(test.try))) 
          return(list(par = NA, value = NA, counts = NA, iter = NA, 
              code = 100, message = "Phi(init) has infinite or NaN values.", 
              fvec = NA))
      argtest2 <- testargjacSSR(init, dimx, dimlam, heobj, argheobj, 
          constr, argconstr, grconstr, arggrconstr, heconstr, argheconstr, 
          gcompla, gcomplb, argcompl, dimmu, joint, argjoint, grjoint, 
          arggrjoint, hejoint, arghejoint)
      test.try <- try(jacSSR(init, dimx, dimlam, heobj, argheobj, 
          constr, argconstr, grconstr, arggrconstr, heconstr, argheconstr, 
          gcompla, gcomplb, argcompl, dimmu, joint, argjoint, grjoint, 
          arggrjoint, hejoint, arghejoint), silent = silent)
      if (class(test.try) == "try-error") 
          return(list(par = NA, value = NA, counts = NA, iter = NA, 
              code = 100, message = "Can't evaluate Jac Phi(init).", 
              fvec = NA))
      if (any(is.nan(test.try)) || any(is.infinite(test.try))) 
          return(list(par = NA, value = NA, counts = NA, iter = NA, 
              code = 100, message = "Jac Phi(init) has infinite or NaN values.", 
              fvec = NA))
      myfunSSR <- function(x, argfun, argjac) evalwitharglist(funSSR, 
          x, argfun)
      myjacSSR <- function(x, argfun, argjac) evalwitharglist(jacSSR, 
          x, argjac)
      arg1 <- list(argtest1$dimx, argtest1$dimlam, argtest1$grobj, 
          argtest1$arggrobj, argtest1$constr, argtest1$argconstr, 
          argtest1$grconstr, argtest1$arggrconstr, argtest1$compl, 
          argtest1$argcompl, argtest1$dimmu, argtest1$joint, argtest1$argjoint, 
          argtest1$grjoint, argtest1$arggrjoint)
      arg2 <- list(argtest2$dimx, argtest2$dimlam, argtest2$heobj, 
          argtest2$argheobj, argtest2$constr, argtest2$argconstr, 
          argtest2$grconstr, argtest2$arggrconstr, argtest2$heconstr, 
          argtest2$argheconstr, argtest2$gcompla, argtest2$gcomplb, 
          argtest2$argcompl, argtest2$dimmu, argtest2$joint, argtest2$argjoint, 
          argtest2$grjoint, argtest2$arggrjoint, argtest2$hejoint, 
          argtest2$arghejoint)
      if (!silent) 
          print("init completed.")
      res <- nseq(init, myfunSSR, myjacSSR, argfun = arg1, argjac = arg2, 
          method = method, control = control, silent = silent, 
          ...)
      class(res) <- "GNE"
      if (!silent) 
          print("computation completed.")
      res
  }
  <bytecode: 0x3f4bf18>
  <environment: namespace:GNE>
   --- function search by body ---
  Function GNE.nseq in namespace GNE has this body.
   ----------- END OF FAILURE REPORT -------------- 
  Fatal error: the condition has length > 1
Running the tests in 'tests/sensi-analysis-riverbasinpollution.R' failed.
Complete output:
  > if(!require("GNE"))stop("this test requires package GNE.")
  Loading required package: GNE
  Loading required package: alabama
  Loading required package: numDeriv
  Loading required package: nleqslv
  Loading required package: BB
  Loading required package: SQUAREM
  > 
  > #-------------------------------------------------------------------------------
  > # (3) River basin pollution game of Krawczyk and Stanislav Uryasev (2000)
  > #-------------------------------------------------------------------------------
  > 
  > myarg0 <- list(
  + C = cbind(c(.1, .12, .15), c(.01, .05, .01)),
  + U = cbind(c(6.5, 5, 5.5), c(4.583, 6.25, 3.75)),
  + K = c(100, 100),
  + E = c(.5, .25, .75),
  + D = c(3, .01)
  + )
  > 
  > 
  > 
  > dimx <- c(1, 1, 1)
  > #Gr_x_j O_i(x)
  > grobj <- function(x, i, j, arg)
  + {
  + 	dij <- 1*(i == j)
  + 	res <- -(-arg$D[2] - arg$C[i, 2]*dij) * x[i] 
  + 	res - (arg$D[1] - arg$D[2]*sum(x[1:3]) - arg$C[i, 1] - arg$C[i, 2]*x[i]) * dij
  + }
  > #Gr_x_k Gr_x_j O_i(x)
  > heobj <- function(x, i, j, k, arg)
  + {
  + 	dij <- 1*(i == j)
  + 	dik <- 1*(i == k)
  + 	
  + 	arg$D[2] * dik + arg$D[2] * dij + 2 * arg$C[i, 2] * dij * dik
  + }
  > 
  > dimlam <- c(2, 2, 2)
  > #g_i(x)
  > g <- function(x, i, arg)
  + 	c(sum(arg$U[, 1] * arg$E * x[1:3]) - arg$K[1],
  + 	  sum(arg$U[, 2] * arg$E * x[1:3]) - arg$K[2],
  + 	  -x[1],
  + 	  -x[2],
  + 	  -x[3])
  > #Gr_x_j g_i(x)
  > grg <- function(x, i, j, arg)
  + 	c(arg$U[j, 1] * arg$E[j], 
  + 	arg$U[j, 2] * arg$E[j], 
  + 	-1*(i ==j), 
  + 	-1*(i ==j), 
  + 	-1*(i ==j))
  > #Gr_x_k Gr_x_j g_i(x)
  > heg <- function(x, i, j, k, arg)
  + 	c(0, 0, 0, 0, 0)
  > 
  > #true value around (21.146, 16.027, 2.724, 0.574, 0.000)
  > z0 <- rep(0, sum(dimx)+sum(dimlam))
  > 
  > getNE <- function(x, control=list(maxit=100, trace=0), check=TRUE)
  + {
  + 	res <- sapply(1:NROW(x), function(i)
  + 	{
  + 		myarg <- list(
  + 			C = cbind(x[i,paste("C",1:3,sep="")], x[i,paste("C",1:3+3,sep="")]),
  + 			U = cbind(x[i,paste("U",1:3,sep="")], x[i,paste("U",1:3+3,sep="")]),
  + 			K = x[i,paste("K",1:2,sep="")],
  + 			E = x[i,paste("E",1:3,sep="")],
  + 			D = x[i,paste("D",1:2,sep="")]
  + 		)
  + 
  + 		res <- GNE.nseq(z0, dimx, dimlam, grobj=grobj, myarg, heobj=heobj, myarg, 
  + 			constr=g, myarg, grconstr=grg, myarg, heconstr=heg, myarg, 
  + 			compl=phiFB, gcompla=GrAphiFB, gcomplb=GrBphiFB, method="Newton", 
  + 			control=control)
  + 
  + 		if(any(res$par[1:3] < 0) && check)
  + 			return(rep(NA, 3))
  + 		else 
  + 			return(res$par[1:3])
  + 	}
  + 	)
  + }
  > 
  > n <- 10
  > Xinputmatrix <- t(replicate(n, unlist(myarg0) * (1 + rnorm(19, 0, .1))))
  > X2inputmatrix <- t(replicate(n, unlist(myarg0) * (1 + rnorm(19, 0, .1))))
  > 
  > Youtputs <- t(getNE(Xinputmatrix))
   ----------- FAILURE REPORT -------------- 
   --- failure: the condition has length > 1 ---
   --- srcref --- 
  : 
   --- package (from environment) --- 
  GNE
   --- call from context --- 
  GNE.nseq(z0, dimx, dimlam, grobj = grobj, myarg, heobj = heobj, 
      myarg, constr = g, myarg, grconstr = grg, myarg, heconstr = heg, 
      myarg, compl = phiFB, gcompla = GrAphiFB, gcomplb = GrBphiFB, 
      method = "Newton", control = control)
   --- call from argument --- 
  if (class(test.try) == "try-error") return(list(par = NA, value = NA, 
      counts = NA, iter = NA, code = 100, message = "Can't evaluate Jac Phi(init).", 
      fvec = NA))
   --- R stacktrace ---
  where 1: GNE.nseq(z0, dimx, dimlam, grobj = grobj, myarg, heobj = heobj, 
      myarg, constr = g, myarg, grconstr = grg, myarg, heconstr = heg, 
      myarg, compl = phiFB, gcompla = GrAphiFB, gcomplb = GrBphiFB, 
      method = "Newton", control = control)
  where 2: FUN(X[[i]], ...)
  where 3: lapply(X = X, FUN = FUN, ...)
  where 4: sapply(1:NROW(x), function(i) {
      myarg <- list(C = cbind(x[i, paste("C", 1:3, sep = "")], 
          x[i, paste("C", 1:3 + 3, sep = "")]), U = cbind(x[i, 
          paste("U", 1:3, sep = "")], x[i, paste("U", 1:3 + 3, 
          sep = "")]), K = x[i, paste("K", 1:2, sep = "")], E = x[i, 
          paste("E", 1:3, sep = "")], D = x[i, paste("D", 1:2, 
          sep = "")])
      res <- GNE.nseq(z0, dimx, dimlam, grobj = grobj, myarg, heobj = heobj, 
          myarg, constr = g, myarg, grconstr = grg, myarg, heconstr = heg, 
          myarg, compl = phiFB, gcompla = GrAphiFB, gcomplb = GrBphiFB, 
          method = "Newton", control = control)
      if (any(res$par[1:3] < 0) && check) 
          return(rep(NA, 3))
      else return(res$par[1:3])
  })
  where 5: getNE(Xinputmatrix)
  where 6: t(getNE(Xinputmatrix))
  
   --- value of length: 2 type: logical ---
  [1] FALSE FALSE
   --- function from context --- 
  function (init, dimx, dimlam, grobj, arggrobj, heobj, argheobj, 
      constr, argconstr, grconstr, arggrconstr, heconstr, argheconstr, 
      compl, gcompla, gcomplb, argcompl, dimmu, joint, argjoint, 
      grjoint, arggrjoint, hejoint, arghejoint, method = "default", 
      control = list(), silent = TRUE, ...) 
  {
      if (method == "default") 
          method <- "Newton"
      argtest1 <- testargfunSSR(init, dimx, dimlam, grobj, arggrobj, 
          constr, argconstr, grconstr, arggrconstr, compl, argcompl, 
          dimmu, joint, argjoint, grjoint, arggrjoint)
      test.try <- try(funSSR(init, dimx, dimlam, grobj, arggrobj, 
          constr, argconstr, grconstr, arggrconstr, compl, argcompl, 
          dimmu, joint, argjoint, grjoint, arggrjoint), silent = silent)
      if (class(test.try) == "try-error") 
          return(list(par = NA, value = NA, counts = NA, iter = NA, 
              code = 100, message = "Can't evalate Phi(init).", 
              fvec = NA))
      if (any(is.nan(test.try)) || any(is.infinite(test.try))) 
          return(list(par = NA, value = NA, counts = NA, iter = NA, 
              code = 100, message = "Phi(init) has infinite or NaN values.", 
              fvec = NA))
      argtest2 <- testargjacSSR(init, dimx, dimlam, heobj, argheobj, 
          constr, argconstr, grconstr, arggrconstr, heconstr, argheconstr, 
          gcompla, gcomplb, argcompl, dimmu, joint, argjoint, grjoint, 
          arggrjoint, hejoint, arghejoint)
      test.try <- try(jacSSR(init, dimx, dimlam, heobj, argheobj, 
          constr, argconstr, grconstr, arggrconstr, heconstr, argheconstr, 
          gcompla, gcomplb, argcompl, dimmu, joint, argjoint, grjoint, 
          arggrjoint, hejoint, arghejoint), silent = silent)
      if (class(test.try) == "try-error") 
          return(list(par = NA, value = NA, counts = NA, iter = NA, 
              code = 100, message = "Can't evaluate Jac Phi(init).", 
              fvec = NA))
      if (any(is.nan(test.try)) || any(is.infinite(test.try))) 
          return(list(par = NA, value = NA, counts = NA, iter = NA, 
              code = 100, message = "Jac Phi(init) has infinite or NaN values.", 
              fvec = NA))
      myfunSSR <- function(x, argfun, argjac) evalwitharglist(funSSR, 
          x, argfun)
      myjacSSR <- function(x, argfun, argjac) evalwitharglist(jacSSR, 
          x, argjac)
      arg1 <- list(argtest1$dimx, argtest1$dimlam, argtest1$grobj, 
          argtest1$arggrobj, argtest1$constr, argtest1$argconstr, 
          argtest1$grconstr, argtest1$arggrconstr, argtest1$compl, 
          argtest1$argcompl, argtest1$dimmu, argtest1$joint, argtest1$argjoint, 
          argtest1$grjoint, argtest1$arggrjoint)
      arg2 <- list(argtest2$dimx, argtest2$dimlam, argtest2$heobj, 
          argtest2$argheobj, argtest2$constr, argtest2$argconstr, 
          argtest2$grconstr, argtest2$arggrconstr, argtest2$heconstr, 
          argtest2$argheconstr, argtest2$gcompla, argtest2$gcomplb, 
          argtest2$argcompl, argtest2$dimmu, argtest2$joint, argtest2$argjoint, 
          argtest2$grjoint, argtest2$arggrjoint, argtest2$hejoint, 
          argtest2$arghejoint)
      if (!silent) 
          print("init completed.")
      res <- nseq(init, myfunSSR, myjacSSR, argfun = arg1, argjac = arg2, 
          method = method, control = control, silent = silent, 
          ...)
      class(res) <- "GNE"
      if (!silent) 
          print("computation completed.")
      res
  }
  <bytecode: 0x25fc2b8>
  <environment: namespace:GNE>
   --- function search by body ---
  Function GNE.nseq in namespace GNE has this body.
   ----------- END OF FAILURE REPORT -------------- 
  Fatal error: the condition has length > 1