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") > > # Trigonometric function > trig <- function(x) { + n <- length(x) + y <- cos(x) + s <- sum(y) + y <- n - s + c(1:n) * (1-y) - sin(x) + + y + } > > trigjac <- function(x) { + n <- length(x) + J <- matrix(numeric(n*n),n,n) + + for (p in 1:n) { + J[,p] <- sin(x[p]) + J[p,p] <- (p+1) * sin(x[p]) - cos(x[p]) + } + + J + } > > do.print.xf <- FALSE > > print.result <- function(z) { + if( do.print.xf ) { + print(z$x) + print(z$fvec) + } + print(z$message) + print(all(abs(z$fvec)<=1e-8)) + } > > n <- 10 > xstart <- rep(1,n)/n > fstart <- trig(xstart) > > znlm <- nleqslv(xstart, trig, global="dbldog", control=list(trace=0)) > print.result(znlm) [1] "Function criterion near zero" [1] TRUE > > proc.time() user system elapsed 0.14 0.03 0.17