Running ‘CER-funCER-Rcode-constr.R’ [0s/1s]
  Running ‘CER-funCER-Rcode-constrjoint.R’ [0s/1s]
  Running ‘CER-funCER-Rcode-joint.R’ [0s/1s]
  Running ‘GNEceq-examples.R’ [1s/1s]
  Running ‘GNEnseq-examples.R’ [0s/1s]
  Running ‘NIR-func-Rcode.R’ [4s/8s]
  Running ‘NIRandVIPexample.R’ [1s/2s]
  Running ‘SSR-Rcode-funSSRcheck-constrjoint.R’ [0s/1s]
  Running ‘SSR-funSSR-Rcode-constr.R’ [0s/1s]
  Running ‘SSR-funSSR-funSSRcheck-constr.R’ [0s/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’ [0s/1s]
  Running ‘sensi-analysis-genduopoly.R’ [5s/8s]
  Running ‘sensi-analysis-riverbasinpollution.R’ [0s/1s]
  Running ‘util-testfunc.R’ [0s/1s]
Running the tests in ‘tests/CER-funCER-Rcode-constr.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) associated objective functions
  > #
  > 
  > dimx <- c(2, 2, 3)
  > 
  > #Gr_x_j O_i(x)
  > grfullob <- function(x, i, j)
  + {
  + 	x <- x[1:7]	
  + 	if(i == 1)
  + 	{
  + 		grad <- 3*(x - 1:7)^2
  + 	}
  + 	if(i == 2)
  + 	{
  + 		grad <- 1:7*(x - 1:7)^(0:6)
  + 	}
  + 	if(i == 3)
  + 	{
  + 		s <- x[5]^2 + x[6]^2 + x[7]^2 - 5	
  + 		grad <- c(1, 0, 1, 0, 4*x[5]*s, 4*x[6]*s, 4*x[7]*s)
  + 			
  + 	}
  + 	grad[j]	
  + }
  > 
  > 
  > #Gr_x_k Gr_x_j O_i(x)
  > hefullob <- function(x, i, j, k)
  + {
  + 	x <- x[1:7]
  + 	if(i == 1)
  + 	{
  + 		he <- diag( 6*(x - 1:7) )
  + 	}
  + 	if(i == 2)
  + 	{
  + 		he <- diag( c(0, 2, 6, 12, 20, 30, 42)*(x - 1:7)^c(0, 0:5) )
  + 	}
  + 	if(i == 3)
  + 	{
  + 		s <- x[5]^2 + x[6]^2 + x[7]^2	
  + 		
  + 		he <- rbind(rep(0, 7), rep(0, 7), rep(0, 7), rep(0, 7),
  + 			c(0, 0, 0, 0, 4*s+8*x[5]^2, 8*x[5]*x[6], 8*x[5]*x[7]),
  + 			c(0, 0, 0, 0, 8*x[5]*x[6], 4*s+8*x[6]^2, 8*x[6]*x[7]),
  + 			c(0, 0, 0, 0,  8*x[5]*x[7], 8*x[6]*x[7], 4*s+8*x[7]^2) )
  + 	}
  + 	he[j,k]	
  + }
  > 
  > 
  > 
  > # (2) constraint linked functions
  > #
  > 
  > dimlam <- dimw <- c(1, 2, 2)
  > 
  > #constraint function g_i(x)
  > g <- function(x, i)
  + {
  + 	x <- x[1:7]
  + 	#cat(x[1:5], "|", i, "\n")
  + 	if(i == 1)
  + 		res <- sum( x^(1:7) ) -7
  + 	if(i == 2)
  + 		res <- c(sum(x) + prod(x) - 14, 20 - sum(x))
  + 	if(i == 3)
  + 		res <- c(sum(x^2) + 1, 100 - sum(x))
  + 	#cat("res", res + par$a, "\n")	
  + 	res
  + }
  > 
  > 
  > #Gr_x_j g_i(x)
  > grfullg <- function(x, i, j)
  + {
  + 	x <- x[1:7]	
  + 	if(i == 1)
  + 	{
  + 		grad <- (1:7) * x ^ (0:6)
  + 	}
  + 	if(i == 2)
  + 	{
  + 		grad <- 1 + sapply(1:7, function(i) prod(x[-i]))
  + 		grad <- cbind(grad, -1)
  + 	}
  + 	if(i == 3)
  + 	{
  + 		grad <- cbind(2*x, -1)
  + 	}
  + 
  + 
  + 	if(i == 1)
  + 		res <- grad[j]	
  + 	if(i != 1)
  + 		res <- grad[j,]	
  + 	as.numeric(res)
  + }
  > 
  > 
  > 
  > #Gr_x_k Gr_x_j g_i(x)
  > hefullg <- function(x, i, j, k)
  + {
  + 	x <- x[1:7]
  + 	if(i == 1)
  + 	{
  + 		he1 <- diag( c(0, 2, 6, 12, 20, 30, 42) * x ^ c(0, 0, 1:5) )
  + 	}
  + 	if(i == 2)
  + 	{
  + 		he1 <- matrix(0, 7, 7)
  + 		he1[1, -1] <- sapply(2:7, function(i) prod(x[-c(1, i)]))
  + 		he1[2, -2] <- sapply(c(1, 3:7), function(i) prod(x[-c(2, i)]))
  + 		he1[3, -3] <- sapply(c(1:2, 4:7), function(i) prod(x[-c(3, i)]))
  + 		he1[4, -4] <- sapply(c(1:3, 5:7), function(i) prod(x[-c(4, i)]))
  + 		he1[5, -5] <- sapply(c(1:4, 6:7), function(i) prod(x[-c(5, i)]))
  + 		he1[6, -6] <- sapply(c(1:5, 7:7), function(i) prod(x[-c(6, i)]))
  + 		he1[7, -7] <- sapply(1:6, function(i) prod(x[-c(7, i)]))
  + 						
  + 						
  + 		he2 <- matrix(0, 7, 7)
  + 		
  + 	}
  + 	if(i == 3)
  + 	{
  + 		he1 <- diag(rep(2, 7))
  + 		he2 <- matrix(0, 7, 7)
  + 	}
  + 	if(i != 1)
  + 		return( c(he1[j, k], he2[j, k])	)
  + 	else				
  + 		return( he1[j, k] )
  + }
  > 
  > 
  > 
  > 
  > # (3) compute H
  > #
  > 
  > z <- rexp(sum(dimx) + sum(dimlam) + sum(dimw))
  > 
  > n <- sum(dimx)
  > m <- sum(dimlam)
  > x <- z[1:n]
  > lam <- z[(n+1):(n+m)]
  > w <- z[(n+m+1):(n+m+m)]
  > 
  > resphi <- funCER(z, dimx, dimlam, grobj=grfullob, constr=g, grconstr=grfullg, echo=TRUE)
  [1] 2 2 3
  [1] 1 2 2
  [1] 17
  Error in funSSR(z[1:(n + m + dimmu)], dimx, dimlam, grobj, arggrobj, constr,  : 
    DLL requires the use of native symbols
  Calls: funCER -> funSSR
  Execution halted
Running the tests in ‘tests/CER-funCER-Rcode-constrjoint.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) associated objective functions
  > #
  > 
  > dimx <- c(2, 2, 3)
  > 
  > #Gr_x_j O_i(x)
  > grfullob <- function(x, i, j)
  + {
  + 	x <- x[1:7]	
  + 	if(i == 1)
  + 	{
  + 		grad <- 3*(x - 1:7)^2
  + 	}
  + 	if(i == 2)
  + 	{
  + 		grad <- 1:7*(x - 1:7)^(0:6)
  + 	}
  + 	if(i == 3)
  + 	{
  + 		s <- x[5]^2 + x[6]^2 + x[7]^2 - 5	
  + 		grad <- c(1, 0, 1, 0, 4*x[5]*s, 4*x[6]*s, 4*x[7]*s)
  + 			
  + 	}
  + 	grad[j]	
  + }
  > 
  > 
  > #Gr_x_k Gr_x_j O_i(x)
  > hefullob <- function(x, i, j, k)
  + {
  + 	x <- x[1:7]
  + 	if(i == 1)
  + 	{
  + 		he <- diag( 6*(x - 1:7) )
  + 	}
  + 	if(i == 2)
  + 	{
  + 		he <- diag( c(0, 2, 6, 12, 20, 30, 42)*(x - 1:7)^c(0, 0:5) )
  + 	}
  + 	if(i == 3)
  + 	{
  + 		s <- x[5]^2 + x[6]^2 + x[7]^2	
  + 		
  + 		he <- rbind(rep(0, 7), rep(0, 7), rep(0, 7), rep(0, 7),
  + 			c(0, 0, 0, 0, 4*s+8*x[5]^2, 8*x[5]*x[6], 8*x[5]*x[7]),
  + 			c(0, 0, 0, 0, 8*x[5]*x[6], 4*s+8*x[6]^2, 8*x[6]*x[7]),
  + 			c(0, 0, 0, 0,  8*x[5]*x[7], 8*x[6]*x[7], 4*s+8*x[7]^2) )
  + 	}
  + 	he[j,k]	
  + }
  > 
  > 
  > 
  > # (2) constraint linked functions
  > #
  > 
  > dimlam <- dimw <- c(1, 2, 2)
  > 
  > #constraint function g_i(x)
  > g <- function(x, i)
  + {
  + 	x <- x[1:7]
  + 	#cat(x[1:5], "|", i, "\n")
  + 	if(i == 1)
  + 		res <- sum( x^(1:7) ) -7
  + 	if(i == 2)
  + 		res <- c(sum(x) + prod(x) - 14, 20 - sum(x))
  + 	if(i == 3)
  + 		res <- c(sum(x^2) + 1, 100 - sum(x))
  + 	#cat("res", res + par$a, "\n")	
  + 	res
  + }
  > 
  > 
  > #Gr_x_j g_i(x)
  > grfullg <- function(x, i, j)
  + {
  + 	x <- x[1:7]	
  + 	if(i == 1)
  + 	{
  + 		grad <- (1:7) * x ^ (0:6)
  + 	}
  + 	if(i == 2)
  + 	{
  + 		grad <- 1 + sapply(1:7, function(i) prod(x[-i]))
  + 		grad <- cbind(grad, -1)
  + 	}
  + 	if(i == 3)
  + 	{
  + 		grad <- cbind(2*x, -1)
  + 	}
  + 
  + 
  + 	if(i == 1)
  + 		res <- grad[j]	
  + 	if(i != 1)
  + 		res <- grad[j,]	
  + 	as.numeric(res)
  + }
  > 
  > 
  > 
  > #Gr_x_k Gr_x_j g_i(x)
  > hefullg <- function(x, i, j, k)
  + {
  + 	x <- x[1:7]
  + 	if(i == 1)
  + 	{
  + 		he1 <- diag( c(0, 2, 6, 12, 20, 30, 42) * x ^ c(0, 0, 1:5) )
  + 	}
  + 	if(i == 2)
  + 	{
  + 		he1 <- matrix(0, 7, 7)
  + 		he1[1, -1] <- sapply(2:7, function(i) prod(x[-c(1, i)]))
  + 		he1[2, -2] <- sapply(c(1, 3:7), function(i) prod(x[-c(2, i)]))
  + 		he1[3, -3] <- sapply(c(1:2, 4:7), function(i) prod(x[-c(3, i)]))
  + 		he1[4, -4] <- sapply(c(1:3, 5:7), function(i) prod(x[-c(4, i)]))
  + 		he1[5, -5] <- sapply(c(1:4, 6:7), function(i) prod(x[-c(5, i)]))
  + 		he1[6, -6] <- sapply(c(1:5, 7:7), function(i) prod(x[-c(6, i)]))
  + 		he1[7, -7] <- sapply(1:6, function(i) prod(x[-c(7, i)]))
  + 		he2 <- matrix(0, 7, 7)
  + 	}
  + 	if(i == 3)
  + 	{
  + 		he1 <- diag(rep(2, 7))
  + 		he2 <- matrix(0, 7, 7)
  + 	}
  + 	if(i != 1)
  + 		return( c(he1[j, k], he2[j, k])	)
  + 	else				
  + 		return( he1[j, k] )
  + }
  > 
  > 
  > dimmu <- 3
  > 
  > #constraint function h(x)
  > h <- function(x)
  + {
  + 	x <- x[1:7]
  + 	c(prod(x) - 1, sum(x^2) -2, sum(x^3) -3)
  + }
  > grh <- function(x, j)
  + {
  + 	x <- x[1:7]
  + 	c(prod(x[-j]), 2*x[j], 3*x[j]^2)
  + }
  > heh <- function(x, j, k)
  + {
  + 	x <- x[1:7] 
  + 	c(prod(x[-c(j,k)]), 2*(j==k), 6*x[j]*(j==k))
  + }
  > 
  > 
  > 
  > # (3) compute H
  > #
  > 
  > z <- rexp(sum(dimx) + 2*sum(dimlam) + 2*sum(dimmu))
  > 
  > n <- sum(dimx)
  > m <- sum(dimlam)
  > x <- z[1:n]
  > lam <- z[(n+1):(n+m)]
  > mu <- z[(n+m+1):(n+m+dimmu)]
  > w <- z[(n+m+dimmu+1):(n+2*m+2*dimmu)]
  > 
  > resphi <- funCER(z, dimx, dimlam, grobj=grfullob, constr=g, grconstr=grfullg, joint=h, grjoint=grh, dimmu=dimmu, echo=TRUE)
  [1] 2 2 3
  [1] 1 2 2
  [1] 23
  Error in funSSR(z[1:(n + m + dimmu)], dimx, dimlam, grobj, arggrobj, constr,  : 
    DLL requires the use of native symbols
  Calls: funCER -> funSSR
  Execution halted
Running the tests in ‘tests/CER-funCER-Rcode-joint.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) associated objective functions
  > #
  > 
  > dimx <- c(2, 2, 3)
  > 
  > #Gr_x_j O_i(x)
  > grfullob <- function(x, i, j)
  + {
  + 	x <- x[1:7]	
  + 	if(i == 1)
  + 	{
  + 		grad <- 3*(x - 1:7)^2
  + 	}
  + 	if(i == 2)
  + 	{
  + 		grad <- 1:7*(x - 1:7)^(0:6)
  + 	}
  + 	if(i == 3)
  + 	{
  + 		s <- x[5]^2 + x[6]^2 + x[7]^2 - 5	
  + 		grad <- c(1, 0, 1, 0, 4*x[5]*s, 4*x[6]*s, 4*x[7]*s)
  + 			
  + 	}
  + 	grad[j]	
  + }
  > 
  > 
  > #Gr_x_k Gr_x_j O_i(x)
  > hefullob <- function(x, i, j, k)
  + {
  + 	x <- x[1:7]
  + 	if(i == 1)
  + 	{
  + 		he <- diag( 6*(x - 1:7) )
  + 	}
  + 	if(i == 2)
  + 	{
  + 		he <- diag( c(0, 2, 6, 12, 20, 30, 42)*(x - 1:7)^c(0, 0:5) )
  + 	}
  + 	if(i == 3)
  + 	{
  + 		s <- x[5]^2 + x[6]^2 + x[7]^2	
  + 		
  + 		he <- rbind(rep(0, 7), rep(0, 7), rep(0, 7), rep(0, 7),
  + 			c(0, 0, 0, 0, 4*s+8*x[5]^2, 8*x[5]*x[6], 8*x[5]*x[7]),
  + 			c(0, 0, 0, 0, 8*x[5]*x[6], 4*s+8*x[6]^2, 8*x[6]*x[7]),
  + 			c(0, 0, 0, 0,  8*x[5]*x[7], 8*x[6]*x[7], 4*s+8*x[7]^2) )
  + 	}
  + 	he[j,k]	
  + }
  > 
  > 
  > dimmu <- 3
  > 
  > #constraint function h(x)
  > h <- function(x)
  + {
  + 	x <- x[1:7]
  + 	c(prod(x) - 1, sum(x^2) -2, sum(x^3) -3)
  + }
  > grh <- function(x, j)
  + {
  + 	x <- x[1:7]
  + 	c(prod(x[-j]), 2*x[j], 3*x[j]^2)
  + }
  > heh <- function(x, j, k)
  + {
  + 	x <- x[1:7] 
  + 	c(prod(x[-c(j,k)]), 2*(j==k), 6*x[j]*(j==k))
  + }
  > 
  > 
  > 
  > # (3) compute H
  > #
  > 
  > z <- rexp(sum(dimx) + 2*sum(dimmu))
  > 
  > n <- sum(dimx)
  > m <- 0
  > x <- z[1:n]
  > lam <- NULL
  > mu <- z[(n+m+1):(n+m+dimmu)]
  > w <- z[(n+m+dimmu+1):(n+2*m+2*dimmu)]
  > 
  > resphi <- funCER(z, dimx, dimlam, grobj=grfullob, joint=h, grjoint=grh, dimmu=dimmu, echo=TRUE)
  [1] 2 2 3
  [1] 0 0 0
  [1] 13
  Error in funSSR(z[1:(n + m + dimmu)], dimx, dimlam, grobj, arggrobj, constr,  : 
    DLL requires the use of native symbols
  Calls: funCER -> funSSR
  Execution halted
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)
  Error in funSSR(z0, dimx, dimlam, grobj = grobj, constr = g, grconstr = grg,  : 
    DLL requires the use of native symbols
  Execution halted
Running the tests in ‘tests/SSR-Rcode-funSSRcheck-constrjoint.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) associated objective functions
  > #
  > 
  > dimx <- c(2, 2, 3)
  > 
  > #Gr_x_j O_i(x)
  > grfullob <- function(x, i, j)
  + {
  + 	x <- x[1:7]	
  + 	if(i == 1)
  + 	{
  + 		grad <- 3*(x - 1:7)^2
  + 	}
  + 	if(i == 2)
  + 	{
  + 		grad <- 1:7*(x - 1:7)^(0:6)
  + 	}
  + 	if(i == 3)
  + 	{
  + 		s <- x[5]^2 + x[6]^2 + x[7]^2 - 5	
  + 		grad <- c(1, 0, 1, 0, 4*x[5]*s, 4*x[6]*s, 4*x[7]*s)
  + 			
  + 	}
  + 	grad[j]	
  + }
  > 
  > 
  > #Gr_x_k Gr_x_j O_i(x)
  > hefullob <- function(x, i, j, k)
  + {
  + 	x <- x[1:7]
  + 	if(i == 1)
  + 	{
  + 		he <- diag( 6*(x - 1:7) )
  + 	}
  + 	if(i == 2)
  + 	{
  + 		he <- diag( c(0, 2, 6, 12, 20, 30, 42)*(x - 1:7)^c(0, 0:5) )
  + 	}
  + 	if(i == 3)
  + 	{
  + 		s <- x[5]^2 + x[6]^2 + x[7]^2	
  + 		
  + 		he <- rbind(rep(0, 7), rep(0, 7), rep(0, 7), rep(0, 7),
  + 			c(0, 0, 0, 0, 4*s+8*x[5]^2, 8*x[5]*x[6], 8*x[5]*x[7]),
  + 			c(0, 0, 0, 0, 8*x[5]*x[6], 4*s+8*x[6]^2, 8*x[6]*x[7]),
  + 			c(0, 0, 0, 0,  8*x[5]*x[7], 8*x[6]*x[7], 4*s+8*x[7]^2) )
  + 	}
  + 	he[j,k]	
  + }
  > 
  > 
  > 
  > # (2) constraint linked functions
  > #
  > 
  > dimlam <- c(1, 2, 2)
  > 
  > #constraint function g_i(x)
  > g <- function(x, i)
  + {
  + 	x <- x[1:7]
  + 	#cat(x[1:5], "|", i, "\n")
  + 	if(i == 1)
  + 		res <- sum( x^(1:7) ) -7
  + 	if(i == 2)
  + 		res <- c(sum(x) + prod(x) - 14, 20 - sum(x))
  + 	if(i == 3)
  + 		res <- c(sum(x^2) + 1, 100 - sum(x))
  + 	#cat("res", res + par$a, "\n")	
  + 	res
  + }
  > 
  > 
  > #Gr_x_j g_i(x)
  > grfullg <- function(x, i, j)
  + {
  + 	x <- x[1:7]	
  + 	if(i == 1)
  + 	{
  + 		grad <- (1:7) * x ^ (0:6)
  + 	}
  + 	if(i == 2)
  + 	{
  + 		grad <- 1 + sapply(1:7, function(i) prod(x[-i]))
  + 		grad <- cbind(grad, -1)
  + 	}
  + 	if(i == 3)
  + 	{
  + 		grad <- cbind(2*x, -1)
  + 	}
  + 	if(i == 1) res <- grad[j]	
  + 	if(i != 1) res <- grad[j,]	
  + 	as.numeric(res)
  + }
  > 
  > 
  > 
  > #Gr_x_k Gr_x_j g_i(x)
  > hefullg <- function(x, i, j, k)
  + {
  + 	x <- x[1:7]
  + 	if(i == 1)
  + 	{
  + 		he1 <- diag( c(0, 2, 6, 12, 20, 30, 42) * x ^ c(0, 0, 1:5) )
  + 	}
  + 	if(i == 2)
  + 	{
  + 		he1 <- matrix(0, 7, 7)
  + 		he1[1, -1] <- sapply(2:7, function(i) prod(x[-c(1, i)]))
  + 		he1[2, -2] <- sapply(c(1, 3:7), function(i) prod(x[-c(2, i)]))
  + 		he1[3, -3] <- sapply(c(1:2, 4:7), function(i) prod(x[-c(3, i)]))
  + 		he1[4, -4] <- sapply(c(1:3, 5:7), function(i) prod(x[-c(4, i)]))
  + 		he1[5, -5] <- sapply(c(1:4, 6:7), function(i) prod(x[-c(5, i)]))
  + 		he1[6, -6] <- sapply(c(1:5, 7:7), function(i) prod(x[-c(6, i)]))
  + 		he1[7, -7] <- sapply(1:6, function(i) prod(x[-c(7, i)]))
  + 		he2 <- matrix(0, 7, 7)		
  + 	}
  + 	if(i == 3)
  + 	{
  + 		he1 <- diag(rep(2, 7))
  + 		he2 <- matrix(0, 7, 7)
  + 	}
  + 	if(i != 1)
  + 		return( c(he1[j, k], he2[j, k])	)
  + 	else				
  + 		return( he1[j, k] )
  + }
  > 
  > 
  > 
  > 
  > dimmu <- 3
  > 
  > #constraint function h(x)
  > h <- function(x)
  + {
  + 	x <- x[1:7]
  + 	c(prod(x) - 1, sum(x^2) -2, sum(x^3) -3)
  + }
  > grh <- function(x, j)
  + {
  + 	x <- x[1:7]
  + 	c(prod(x[-j]), 2*x[j], 3*x[j]^2)
  + }
  > heh <- function(x, j, k)
  + {
  + 	x <- x[1:7] 
  + 	c(prod(x[-c(j,k)]), 2*(j==k), 6*x[j]*(j==k))
  + }
  > 
  > 
  > 
  > # (3) compute Phi
  > #
  > 
  > z <- rexp(sum(dimx) + sum(dimlam) + dimmu)
  > 
  > n <- sum(dimx)
  > m <- sum(dimlam)
  > x <- z[1:n]
  > lam <- z[(n+1):(n+m)]
  > mu <- z[-(1:(n+m))]
  > 
  > g(z, 1)
  [1] 331.9189
  > g(z, 2)
  [1] -2.872810  8.909902
  > g(z, 3)
  [1] 27.74071 88.90990
  > 
  > resphi <- funSSR(z, dimx, dimlam, grobj=grfullob, constr=g, grconstr=grfullg, compl=phiFB, joint=h, grjoint=grh, dimmu=dimmu)
  Error in funSSR(z, dimx, dimlam, grobj = grfullob, constr = g, grconstr = grfullg,  : 
    DLL requires the use of native symbols
  Execution halted
Running the tests in ‘tests/SSR-funSSR-Rcode-constr.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) associated objective functions
  > #
  > 
  > dimx <- c(2, 2, 3)
  > 
  > #Gr_x_j O_i(x)
  > grfullob <- function(x, i, j)
  + {
  + 	x <- x[1:7]	
  + 	if(i == 1)
  + 	{
  + 		grad <- 3*(x - 1:7)^2
  + 	}
  + 	if(i == 2)
  + 	{
  + 		grad <- 1:7*(x - 1:7)^(0:6)
  + 	}
  + 	if(i == 3)
  + 	{
  + 		s <- x[5]^2 + x[6]^2 + x[7]^2 - 5	
  + 		grad <- c(1, 0, 1, 0, 4*x[5]*s, 4*x[6]*s, 4*x[7]*s)
  + 			
  + 	}
  + 	grad[j]	
  + }
  > 
  > 
  > #Gr_x_k Gr_x_j O_i(x)
  > hefullob <- function(x, i, j, k)
  + {
  + 	x <- x[1:7]
  + 	if(i == 1)
  + 	{
  + 		he <- diag( 6*(x - 1:7) )
  + 	}
  + 	if(i == 2)
  + 	{
  + 		he <- diag( c(0, 2, 6, 12, 20, 30, 42)*(x - 1:7)^c(0, 0:5) )
  + 	}
  + 	if(i == 3)
  + 	{
  + 		s <- x[5]^2 + x[6]^2 + x[7]^2	
  + 		
  + 		he <- rbind(rep(0, 7), rep(0, 7), rep(0, 7), rep(0, 7),
  + 			c(0, 0, 0, 0, 4*s+8*x[5]^2, 8*x[5]*x[6], 8*x[5]*x[7]),
  + 			c(0, 0, 0, 0, 8*x[5]*x[6], 4*s+8*x[6]^2, 8*x[6]*x[7]),
  + 			c(0, 0, 0, 0,  8*x[5]*x[7], 8*x[6]*x[7], 4*s+8*x[7]^2) )
  + 	}
  + 	he[j,k]	
  + }
  > 
  > 
  > 
  > # (2) constraint linked functions
  > #
  > 
  > dimlam <- c(1, 2, 2)
  > 
  > #constraint function g_i(x)
  > g <- function(x, i)
  + {
  + 	x <- x[1:7]
  + 	#cat(x[1:5], "|", i, "\n")
  + 	if(i == 1)
  + 		res <- sum( x^(1:7) ) -7
  + 	if(i == 2)
  + 		res <- c(sum(x) + prod(x) - 14, 20 - sum(x))
  + 	if(i == 3)
  + 		res <- c(sum(x^2) + 1, 100 - sum(x))
  + 	#cat("res", res + par$a, "\n")	
  + 	res
  + }
  > 
  > 
  > #Gr_x_j g_i(x)
  > grfullg <- function(x, i, j)
  + {
  + 	x <- x[1:7]	
  + 	if(i == 1)
  + 	{
  + 		grad <- (1:7) * x ^ (0:6)
  + 	}
  + 	if(i == 2)
  + 	{
  + 		grad <- 1 + sapply(1:7, function(i) prod(x[-i]))
  + 		grad <- cbind(grad, -1)
  + 	}
  + 	if(i == 3)
  + 	{
  + 		grad <- cbind(2*x, -1)
  + 	}
  + 
  + 
  + 	if(i == 1)
  + 		res <- grad[j]	
  + 	if(i != 1)
  + 		res <- grad[j,]	
  + 	as.numeric(res)
  + }
  > 
  > 
  > 
  > #Gr_x_k Gr_x_j g_i(x)
  > hefullg <- function(x, i, j, k)
  + {
  + 	x <- x[1:7]
  + 	if(i == 1)
  + 	{
  + 		he1 <- diag( c(0, 2, 6, 12, 20, 30, 42) * x ^ c(0, 0, 1:5) )
  + 	}
  + 	if(i == 2)
  + 	{
  + 		he1 <- matrix(0, 7, 7)
  + 		he1[1, -1] <- sapply(2:7, function(i) prod(x[-c(1, i)]))
  + 		he1[2, -2] <- sapply(c(1, 3:7), function(i) prod(x[-c(2, i)]))
  + 		he1[3, -3] <- sapply(c(1:2, 4:7), function(i) prod(x[-c(3, i)]))
  + 		he1[4, -4] <- sapply(c(1:3, 5:7), function(i) prod(x[-c(4, i)]))
  + 		he1[5, -5] <- sapply(c(1:4, 6:7), function(i) prod(x[-c(5, i)]))
  + 		he1[6, -6] <- sapply(c(1:5, 7:7), function(i) prod(x[-c(6, i)]))
  + 		he1[7, -7] <- sapply(1:6, function(i) prod(x[-c(7, i)]))
  + 						
  + 						
  + 		he2 <- matrix(0, 7, 7)
  + 		
  + 	}
  + 	if(i == 3)
  + 	{
  + 		he1 <- diag(rep(2, 7))
  + 		he2 <- matrix(0, 7, 7)
  + 	}
  + 	if(i != 1)
  + 		return( c(he1[j, k], he2[j, k])	)
  + 	else				
  + 		return( he1[j, k] )
  + }
  > 
  > 
  > 
  > 
  > # (3) compute Phi
  > #
  > 
  > z <- rexp(sum(dimx) + sum(dimlam))
  > 
  > n <- sum(dimx)
  > m <- sum(dimlam)
  > x <- z[1:n]
  > lam <- z[(n+1):(n+m)]
  > 
  > resphi <- funSSR(z, dimx, dimlam, grobj=grfullob, constr=g, grconstr=grfullg, compl=phiFB)
  Error in funSSR(z, dimx, dimlam, grobj = grfullob, constr = g, grconstr = grfullg,  : 
    DLL requires the use of native symbols
  Execution halted
Running the tests in ‘tests/SSR-funSSR-funSSRcheck-constr.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) associated objective functions
  > #
  > 
  > dimx <- c(2, 2, 3)
  > 
  > #Gr_x_j O_i(x)
  > grfullob <- function(x, i, j)
  + {
  + 	x <- x[1:7]	
  + 	if(i == 1)
  + 	{
  + 		grad <- 3*(x - 1:7)^2
  + 	}
  + 	if(i == 2)
  + 	{
  + 		grad <- 1:7*(x - 1:7)^(0:6)
  + 	}
  + 	if(i == 3)
  + 	{
  + 		s <- x[5]^2 + x[6]^2 + x[7]^2 - 5	
  + 		grad <- c(1, 0, 1, 0, 4*x[5]*s, 4*x[6]*s, 4*x[7]*s)
  + 			
  + 	}
  + 	grad[j]	
  + }
  > 
  > 
  > #Gr_x_k Gr_x_j O_i(x)
  > hefullob <- function(x, i, j, k)
  + {
  + 	x <- x[1:7]
  + 	if(i == 1)
  + 	{
  + 		he <- diag( 6*(x - 1:7) )
  + 	}
  + 	if(i == 2)
  + 	{
  + 		he <- diag( c(0, 2, 6, 12, 20, 30, 42)*(x - 1:7)^c(0, 0:5) )
  + 	}
  + 	if(i == 3)
  + 	{
  + 		s <- x[5]^2 + x[6]^2 + x[7]^2	
  + 		
  + 		he <- rbind(rep(0, 7), rep(0, 7), rep(0, 7), rep(0, 7),
  + 			c(0, 0, 0, 0, 4*s+8*x[5]^2, 8*x[5]*x[6], 8*x[5]*x[7]),
  + 			c(0, 0, 0, 0, 8*x[5]*x[6], 4*s+8*x[6]^2, 8*x[6]*x[7]),
  + 			c(0, 0, 0, 0,  8*x[5]*x[7], 8*x[6]*x[7], 4*s+8*x[7]^2) )
  + 	}
  + 	he[j,k]	
  + }
  > 
  > 
  > 
  > # (2) constraint linked functions
  > #
  > 
  > dimlam <- c(1, 2, 2)
  > 
  > #constraint function g_i(x)
  > g <- function(x, i)
  + {
  + 	x <- x[1:7]
  + 	#cat(x[1:5], "|", i, "\n")
  + 	if(i == 1)
  + 		res <- sum( x^(1:7) ) -7
  + 	if(i == 2)
  + 		res <- c(sum(x) + prod(x) - 14, 20 - sum(x))
  + 	if(i == 3)
  + 		res <- c(sum(x^2) + 1, 100 - sum(x))
  + 	#cat("res", res + par$a, "\n")	
  + 	res
  + }
  > 
  > 
  > #Gr_x_j g_i(x)
  > grfullg <- function(x, i, j)
  + {
  + 	x <- x[1:7]	
  + 	if(i == 1)
  + 	{
  + 		grad <- (1:7) * x ^ (0:6)
  + 	}
  + 	if(i == 2)
  + 	{
  + 		grad <- 1 + sapply(1:7, function(i) prod(x[-i]))
  + 		grad <- cbind(grad, -1)
  + 	}
  + 	if(i == 3)
  + 	{
  + 		grad <- cbind(2*x, -1)
  + 	}
  + 
  + 
  + 	if(i == 1)
  + 		res <- grad[j]	
  + 	if(i != 1)
  + 		res <- grad[j,]	
  + 	as.numeric(res)
  + }
  > 
  > 
  > 
  > #Gr_x_k Gr_x_j g_i(x)
  > hefullg <- function(x, i, j, k)
  + {
  + 	x <- x[1:7]
  + 	if(i == 1)
  + 	{
  + 		he1 <- diag( c(0, 2, 6, 12, 20, 30, 42) * x ^ c(0, 0, 1:5) )
  + 	}
  + 	if(i == 2)
  + 	{
  + 		he1 <- matrix(0, 7, 7)
  + 		he1[1, -1] <- sapply(2:7, function(i) prod(x[-c(1, i)]))
  + 		he1[2, -2] <- sapply(c(1, 3:7), function(i) prod(x[-c(2, i)]))
  + 		he1[3, -3] <- sapply(c(1:2, 4:7), function(i) prod(x[-c(3, i)]))
  + 		he1[4, -4] <- sapply(c(1:3, 5:7), function(i) prod(x[-c(4, i)]))
  + 		he1[5, -5] <- sapply(c(1:4, 6:7), function(i) prod(x[-c(5, i)]))
  + 		he1[6, -6] <- sapply(c(1:5, 7:7), function(i) prod(x[-c(6, i)]))
  + 		he1[7, -7] <- sapply(1:6, function(i) prod(x[-c(7, i)]))
  + 						
  + 						
  + 		he2 <- matrix(0, 7, 7)
  + 		
  + 	}
  + 	if(i == 3)
  + 	{
  + 		he1 <- diag(rep(2, 7))
  + 		he2 <- matrix(0, 7, 7)
  + 	}
  + 	if(i != 1)
  + 		return( c(he1[j, k], he2[j, k])	)
  + 	else				
  + 		return( he1[j, k] )
  + }
  > 
  > 
  > 
  > 
  > # (3) compute Phi
  > #
  > 
  > z <- rexp(sum(dimx) + sum(dimlam))
  > 
  > n <- sum(dimx)
  > m <- sum(dimlam)
  > x <- z[1:n]
  > lam <- z[(n+1):(n+m)]
  > 
  > resphi <- funSSR(z, dimx, dimlam, grobj=grfullob, constr=g, grconstr=grfullg, compl=phiFB)
  Error in funSSR(z, dimx, dimlam, grobj = grfullob, constr = g, grconstr = grfullg,  : 
    DLL requires the use of native symbols
  Execution halted
Running the tests in ‘tests/SSR-funSSR-funSSRcheck-constrjoint.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) associated objective functions
  > #
  > 
  > dimx <- c(2, 2, 3)
  > 
  > #Gr_x_j O_i(x)
  > grfullob <- function(x, i, j)
  + {
  + 	x <- x[1:7]	
  + 	if(i == 1)
  + 	{
  + 		grad <- 3*(x - 1:7)^2
  + 	}
  + 	if(i == 2)
  + 	{
  + 		grad <- 1:7*(x - 1:7)^(0:6)
  + 	}
  + 	if(i == 3)
  + 	{
  + 		s <- x[5]^2 + x[6]^2 + x[7]^2 - 5	
  + 		grad <- c(1, 0, 1, 0, 4*x[5]*s, 4*x[6]*s, 4*x[7]*s)
  + 			
  + 	}
  + 	grad[j]	
  + }
  > 
  > 
  > #Gr_x_k Gr_x_j O_i(x)
  > hefullob <- function(x, i, j, k)
  + {
  + 	x <- x[1:7]
  + 	if(i == 1)
  + 	{
  + 		he <- diag( 6*(x - 1:7) )
  + 	}
  + 	if(i == 2)
  + 	{
  + 		he <- diag( c(0, 2, 6, 12, 20, 30, 42)*(x - 1:7)^c(0, 0:5) )
  + 	}
  + 	if(i == 3)
  + 	{
  + 		s <- x[5]^2 + x[6]^2 + x[7]^2	
  + 		
  + 		he <- rbind(rep(0, 7), rep(0, 7), rep(0, 7), rep(0, 7),
  + 			c(0, 0, 0, 0, 4*s+8*x[5]^2, 8*x[5]*x[6], 8*x[5]*x[7]),
  + 			c(0, 0, 0, 0, 8*x[5]*x[6], 4*s+8*x[6]^2, 8*x[6]*x[7]),
  + 			c(0, 0, 0, 0,  8*x[5]*x[7], 8*x[6]*x[7], 4*s+8*x[7]^2) )
  + 	}
  + 	he[j,k]	
  + }
  > 
  > 
  > 
  > # (2) constraint linked functions
  > #
  > 
  > dimlam <- c(1, 2, 2)
  > 
  > #constraint function g_i(x)
  > g <- function(x, i)
  + {
  + 	x <- x[1:7]
  + 	#cat(x[1:5], "|", i, "\n")
  + 	if(i == 1)
  + 		res <- sum( x^(1:7) ) -7
  + 	if(i == 2)
  + 		res <- c(sum(x) + prod(x) - 14, 20 - sum(x))
  + 	if(i == 3)
  + 		res <- c(sum(x^2) + 1, 100 - sum(x))
  + 	#cat("res", res + par$a, "\n")	
  + 	res
  + }
  > 
  > 
  > #Gr_x_j g_i(x)
  > grfullg <- function(x, i, j)
  + {
  + 	x <- x[1:7]	
  + 	if(i == 1)
  + 	{
  + 		grad <- (1:7) * x ^ (0:6)
  + 	}
  + 	if(i == 2)
  + 	{
  + 		grad <- 1 + sapply(1:7, function(i) prod(x[-i]))
  + 		grad <- cbind(grad, -1)
  + 	}
  + 	if(i == 3)
  + 	{
  + 		grad <- cbind(2*x, -1)
  + 	}
  + 	if(i == 1) res <- grad[j]	
  + 	if(i != 1) res <- grad[j,]	
  + 	as.numeric(res)
  + }
  > 
  > 
  > 
  > #Gr_x_k Gr_x_j g_i(x)
  > hefullg <- function(x, i, j, k)
  + {
  + 	x <- x[1:7]
  + 	if(i == 1)
  + 	{
  + 		he1 <- diag( c(0, 2, 6, 12, 20, 30, 42) * x ^ c(0, 0, 1:5) )
  + 	}
  + 	if(i == 2)
  + 	{
  + 		he1 <- matrix(0, 7, 7)
  + 		he1[1, -1] <- sapply(2:7, function(i) prod(x[-c(1, i)]))
  + 		he1[2, -2] <- sapply(c(1, 3:7), function(i) prod(x[-c(2, i)]))
  + 		he1[3, -3] <- sapply(c(1:2, 4:7), function(i) prod(x[-c(3, i)]))
  + 		he1[4, -4] <- sapply(c(1:3, 5:7), function(i) prod(x[-c(4, i)]))
  + 		he1[5, -5] <- sapply(c(1:4, 6:7), function(i) prod(x[-c(5, i)]))
  + 		he1[6, -6] <- sapply(c(1:5, 7:7), function(i) prod(x[-c(6, i)]))
  + 		he1[7, -7] <- sapply(1:6, function(i) prod(x[-c(7, i)]))
  + 		he2 <- matrix(0, 7, 7)		
  + 	}
  + 	if(i == 3)
  + 	{
  + 		he1 <- diag(rep(2, 7))
  + 		he2 <- matrix(0, 7, 7)
  + 	}
  + 	if(i != 1)
  + 		return( c(he1[j, k], he2[j, k])	)
  + 	else				
  + 		return( he1[j, k] )
  + }
  > 
  > 
  > 
  > 
  > dimmu <- 3
  > 
  > #constraint function h(x)
  > h <- function(x)
  + {
  + 	x <- x[1:7]
  + 	c(prod(x) - 1, sum(x^2) -2, sum(x^3) -3)
  + }
  > grh <- function(x, j)
  + {
  + 	x <- x[1:7]
  + 	c(prod(x[-j]), 2*x[j], 3*x[j]^2)
  + }
  > heh <- function(x, j, k)
  + {
  + 	x <- x[1:7] 
  + 	c(prod(x[-c(j,k)]), 2*(j==k), 6*x[j]*(j==k))
  + }
  > 
  > 
  > 
  > # (3) compute Phi
  > #
  > 
  > z <- rexp(sum(dimx) + sum(dimlam) + dimmu)
  > 
  > n <- sum(dimx)
  > m <- sum(dimlam)
  > x <- z[1:n]
  > lam <- z[(n+1):(n+m)]
  > mu <- z[-(1:(n+m))]
  > 
  > resphi <- GNE:::funSSRcheck(z, dimx, dimlam, grobj=grfullob, constr=g, grconstr=grfullg, compl=phiFB, joint=h, grjoint=grh, dimmu=dimmu)
  > 
  > 
  > check <- c(grfullob(x, 1, 1) + lam[1] * grfullg(x, 1, 1) + mu %*% grh(x, 1),
  + 	grfullob(x, 1, 2) + lam[1] * grfullg(x, 1, 2) + mu %*% grh(x, 2),
  + 	grfullob(x, 2, 3) + lam[2:3] %*% grfullg(x, 2, 3) + mu %*% grh(x, 3),
  + 	grfullob(x, 2, 4) + lam[2:3] %*% grfullg(x, 2, 4) + mu %*% grh(x, 4),
  + 	grfullob(x, 3, 5) + lam[4:5] %*% grfullg(x, 3, 5) + mu %*% grh(x, 5),
  + 	grfullob(x, 3, 6) + lam[4:5] %*% grfullg(x, 3, 6) + mu %*% grh(x, 6),
  + 	grfullob(x, 3, 7) + lam[4:5] %*% grfullg(x, 3, 7) + mu %*% grh(x, 7),
  + 	phiFB(-g(x, 1), lam[1]), 
  + 	phiFB( -g(x, 2)[1], lam[2]), 
  + 	phiFB( -g(x, 2)[2], lam[3]), 
  + 	phiFB( -g(x, 3)[1], lam[4]), 
  + 	phiFB( -g(x, 3)[2], lam[5]),
  + 	phiFB( -h(x)[1], mu[1]), 
  + 	phiFB( -h(x)[2], mu[2]),
  + 	phiFB( -h(x)[3], mu[3]))
  > 	
  > 
  > #check
  > cat("\n\n________________________________________\n\n")
  
  
  ________________________________________
  
  > 
  > #part A
  > print(cbind(check, res=as.numeric(resphi))[1:n, ])
            check        res
  [1,]   1.942064   1.942064
  [2,]  11.421957  11.421957
  [3,]  24.024983  24.024983
  [4,] -26.491556 -26.491556
  [5,]  -4.236295  -4.236295
  [6,]  -9.983095  -9.983095
  [7,] -13.216366 -13.216366
  > #part B
  > print(cbind(check, res=as.numeric(resphi))[(n+1):length(z), ])
             check         res
  [1,]  31.1732355  31.1732355
  [2,]  -0.4091932  -0.4091932
  [3,]  27.4243560  27.4243560
  [4,]  17.7058552  17.7058552
  [5,] 188.1476744 188.1476744
  [6,]  -0.3344660  -0.3344660
  [7,]  11.7477181  11.7477181
  [8,]  20.3157204  20.3157204
  > 
  > 
  > if(sum(abs(check - resphi)) > .Machine$double.eps^(2/3))
  + 	stop("wrong result")
  > 
  > 
  > 
  > z <- rexp(sum(dimx) + dimmu)
  > n <- sum(dimx)
  > m <- 0
  > x <- z[1:n]
  > mu <- z[-(1:(n+m))]
  > 
  > resphi <- GNE:::funSSRcheck(z, dimx, grobj=grfullob, compl=phiFB, joint=h, grjoint=grh, dimmu=dimmu)
  > 
  > 
  > check <- c(grfullob(x, 1, 1) + mu %*% grh(x, 1),
  + 	grfullob(x, 1, 2) + mu %*% grh(x, 2),
  + 	grfullob(x, 2, 3) + mu %*% grh(x, 3),
  + 	grfullob(x, 2, 4) + mu %*% grh(x, 4),
  + 	grfullob(x, 3, 5) + mu %*% grh(x, 5),
  + 	grfullob(x, 3, 6) + mu %*% grh(x, 6),
  + 	grfullob(x, 3, 7) + mu %*% grh(x, 7),
  + 	phiFB( -h(x)[1], mu[1]), 
  + 	phiFB( -h(x)[2], mu[2]),
  + 	phiFB( -h(x)[3], mu[3]))
  > 	
  > 
  > #check
  > cat("\n\n________________________________________\n\n")
  
  
  ________________________________________
  
  > 
  > #part A
  > print(cbind(check, res=as.numeric(resphi))[1:n, ])
             check         res
  [1,]   4.8303807   4.8303807
  [2,]   9.3198069   9.3198069
  [3,]  17.0884530  17.0884530
  [4,] -39.4561307 -39.4561307
  [5,]  -2.3273600  -2.3273600
  [6,]  -0.3058595  -0.3058595
  [7,]  -1.4943526  -1.4943526
  > #part B
  > print(cbind(check, res=as.numeric(resphi))[(n+1):length(z), ])
            check        res
  [1,] -0.7151937 -0.7151937
  [2,]  9.8637922  9.8637922
  [3,] 14.2055921 14.2055921
  > 
  > 
  > if(sum(abs(check - resphi)) > .Machine$double.eps^(2/3))
  + 	stop("wrong result")
  > 
  > 
  > 
  > 
  > 
  > 
  > 
  > # (4) compute Jac Phi
  > #
  > 
  > z <- rexp(sum(dimx) + sum(dimlam) + dimmu)
  > 
  > n <- sum(dimx)
  > m <- sum(dimlam)
  > x <- z[1:n]
  > lam <- z[(n+1):(n+m)]
  > mu <- z[-(1:(n+m))]
  > 
  > 
  > resjacphi <- jacSSR(z, dimx, dimlam, heobj=hefullob, constr=g, 	
  + 	grconstr=grfullg, heconstr=hefullg, gcompla=GrAphiFB, gcomplb=GrBphiFB,
  + 	joint=h, grjoint=grh, hejoint=heh, dimmu=dimmu)
  Error in jacSSR(z, dimx, dimlam, heobj = hefullob, constr = g, grconstr = grfullg,  : 
    DLL requires the use of native symbols
  Execution halted
Running the tests in ‘tests/SSR-testarg.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
  > 
  > 
  > try(funSSR("x"))
  Error in funSSR("x") : argument "dimx" is missing, with no default
  > 
  > try(funSSR(rep(1, 2) , 1, grobj=function(x) x))
  Error in testargfunSSR(z, dimx, dimlam, grobj, arggrobj, constr, argconstr,  : 
    SSR: incompatible dimension for dimlam, dimx, dimmu.
  > 
  > try(funSSR(rep(1, 2), rep(1, 2), grobj=function(x) x))
  Error in testargfunSSR(z, dimx, dimlam, grobj, arggrobj, constr, argconstr,  : 
    missing compl argument.
  > 
  > try(funSSR(rep(1, 2), rep(1, 2), grobj=function(x) x, compl=phiFB))
  Error in grobj(z, i, j) : unused arguments (i, j)
  Error when calling function, below the try output.
  [1] "Error in grobj(z, i, j) : unused arguments (i, j)\n"
  attr(,"class")
  [1] "try-error"
  attr(,"condition")
  <simpleError in grobj(z, i, j): unused arguments (i, j)>
  Arguments are:
  [[1]]
  [1] 1 1
  
  [[2]]
  [1] 1
  
  [[3]]
  [1] 1
  
  [[4]]
  list()
  
  Error in testfunc(grobjfinal, z, arg = arggrobj, echo = echo, errmess = str) : 
    the call to grobj(z, 1, 1, arggrobj) does not work. arguments are x .
  > 
  > funSSR(rep(1, 2), rep(1, 2), grobj=function(x, i, j) x, compl=phiFB)
  Error in funSSR(rep(1, 2), rep(1, 2), grobj = function(x, i, j) x, compl = phiFB) : 
    DLL requires the use of native symbols
  Execution halted
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))
  Error in if (any(res$par[1:3] < 0) && check) return(rep(NA, 3)) else return(res$par[1:3]) : 
    missing value where TRUE/FALSE needed
  Calls: t -> getNE -> sapply -> lapply -> FUN
  Execution halted