R Under development (unstable) (2023-11-25 r85635 ucrt) -- "Unsuffered Consequences" Copyright (C) 2023 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > > library(nleqslv) > > # Brown almost linear function > > brown <- function(x) { + n <- length(x) + y <- numeric(n) + + y[1:(n-1)] <- x[1:(n-1)] + sum(x[1:n]) - (n + 1) + y[n] <- prod(x[1:n]) - 1.0 + + y + } > > brownjac <- function(x) { + n <- length(x) + J <- matrix(1,nrow=n,ncol=n) + diag(J) <- 2 + xprod <- prod(x) + J[n,] <- xprod/x # exact + J + } > > print.result <- function(z, do.print.xf=FALSE) { + if( do.print.xf ) { + print(z$x) + print(z$fvec) + } + print(z$message) + print(all(abs(z$fvec)<=1e-8)) + } > > for( m in c("Newton","Broyden") ) { + for( n in c(50,100) ) { + xstart <- rep(1,n)/2 + z <- nleqslv(xstart, brown, brownjac, method="Newton", + control=list(trace=0,ftol=1e-10,delta="cauchy",allowSingular=TRUE)) + print.result(z) + } + } [1] "Function criterion near zero" [1] TRUE [1] "Function criterion near zero" [1] TRUE [1] "Function criterion near zero" [1] TRUE [1] "Function criterion near zero" [1] TRUE > > proc.time() user system elapsed 0.14 0.06 0.20