I have the following function
f <- function(a,b) {
(a - 1) + 3.2/b + 3*log(gamma(a)) + 3*a*log(b);
}
I want to optimized this function with nlm() ,optim() ect....
I am trying to do that with:
value <- nlm(f,optim(f))
However, I get an error message.cannot coerce type 'closure' to vector of type 'double' I really would appreciate your answer!
It works ok for me using both optim and nlm. I did a little modification
f <- function(par) {
a <- par[1]
b <- par[2]
(a - 1) + 3.2/b + 3*log(gamma(a)) + 3*a*log(b);
}
> optim(c(1, .3), fn=f)
$par
[1] 1.399685 0.762025
$value
[1] 3.09904
$counts
function gradient
55 NA
$convergence
[1] 0
$message
NULL
> nlm(f, c(1,.3))
$minimum
[1] 3.09904
$estimate
[1] 1.3999515 0.7619307
$gradient
[1] 3.096044e-07 3.907985e-07
$code
[1] 1
$iterations
[1] 17
Related
In R , I have a vector like x= 3:100
I want to write function like:
sum ( (x/a)^2t) - 5
and get the answer if I choose any value for t .
Example:
Func= function ( t ) {
x=c(1:100)
a= min(x)
Sum ( x / a )^2t - 5
}
I don't know if this correct or not.
what about if I want to get the root of the function by secant method. I use library(NLRoot) in R. but the codes that I write it is not correct.
library(NLRoot)
curve(func, xlim=c(0,3), col='blue', lwd=1.5, lty=2,xlab="x",ylab="f(x)")
output is written Error in code.
Here is just a syntax correction
Func <- function(t) {
x <- c(1:100)
a <- min(x)
sum((x / a)^(2 * t)) - 5
}
and a more compact version might be something like below
Func <- function(t, x = 1:100) sum((x / min(x))^(2 * t)) - 5
To find the root, thanks for comments from #Rui Barradas, we can use uniroot, i.e.,
> uniroot(Func, interval = c(-5, 5))
$root
[1] -0.5091492
$f.root
[1] -0.0003913713
$iter
[1] 13
$init.it
[1] NA
$estim.prec
[1] 6.103516e-05
I have 2 equation that need to be solved by using optim
{(4x^2-20x+1/4 y^2+8=0
1/2 xy^2+2x-5y+8=0)
I have already run the code,but I'm confused if there should be 1 answer or 2 because function will only return the results for the last line
Should I do like this
> myfunc=function(x){
+ 4*x[1]^2-20*x[1]+(x[2]^2/4)+8
+ }
> optim(c(0,0),myfunc,method="BFGS")
and
> myfunc=function(x){
+ (1/2)*(x[1]*x[2]^2)+2*x[1]-5*x[2]+8
+ }
> optim(c(0,0),myfunc,method="BFGS")
or should I do like this
> myfunc=function(x){
+ 4*x[1]^2-20*x[1]+(x[2]^2/4)+8
+ (1/2)*(x[1]*x[2]^2)+2*x[1]-5*x[2]+8
+ }
> optim(c(0,0),myfunc,method="BFGS")
For the second one it still give me only the answer for the second function so which method is correct.
Minimize the sum of the squares of the two expressions that should equal zero and ensure that the value at the optimum equals 0 (up to floating point approximation).
myfunc <- function(z) {
x <- z[1]
y <- z[2]
(4*x^2-20* x + 1/4*y^2 + 8)^2 + (1/2 * x*y^2 + 2*x- 5*y + 8)^2
}
optim(c(0, 0), myfunc)
giving:
$par
[1] 0.5000553 2.0002986
$value
[1] 1.291233e-06
$counts
function gradient
67 NA
$convergence
[1] 0
$message
NULL
You can also use a package for solving systems of non linear equations such as nleqslv.
Slightly redefine your function by making it return a vector containing the result for each equation
myfunc <- function(x){
y <- numeric(length(x))
y[1] <- 4*x[1]^2-20*x[1]+(x[2]^2/4)+8
y[2] <- (1/2)*(x[1]*x[2]^2)+2*x[1]-5*x[2]+8
y
}
Define a starting value for the solver
xstart <- c(0,0)
Then do this
library(nleqslv)
nleqslv(xstart,myfunc)
giving
$x
[1] 0.5 2.0
$fvec
[1] -1.472252e-09 -7.081979e-10
$termcd
[1] 1
$message
[1] "Function criterion near zero"
$scalex
[1] 1 1
$nfcnt
[1] 7
$njcnt
[1] 1
$iter
[1] 7
There are more packages that can solve equation systems such as BB and pracma.
rm(list=ls(all=TRUE))
data <- read.csv("con.csv", header=TRUE, sep = ",")
x <- data$X0
n = length(x); T1 <- 1
f <- function(a,b) {
L <- (n*log(a))+(n*a*log(T1))+(n*a*log(b))-(n*log((T1^a)-(b^a)))- ((a+1)*sum(log(b+x)))
return(-L)
}
ML <- nlm(f, c(0.01,0.17))
Result in
Error in f(x, ...): argument "x" is missing, with no default
help me to figure out error and solution to solve it out
The argument passed to the function f must be a single vector. Here is the correct definition:
f <- function(pars) {
L <- (n*log(pars[1]))+(n*pars[1]*log(T1))+(n*pars[1]*log(pars[2]))-
(n*log((T1^pars[1])-(pars[2]^pars[1])))- ((pars[1]+1)*sum(log(pars[2]+x)))
return(-L)
}
and a working example:
set.seed(1234)
n <- 100
x <- runif(n)+5
T1 <- 1
(ML <- nlm(f, p=c(0.01,0.17)))
The result is:
$minimum
[1] 227.3527
$estimate
[1] 2.420050e-07 1.768907e-01
$gradient
[1] 259.0327 -308.4809
$code
[1] 2
$iterations
[1] 12
I'm very new to R, but I'm just looking to do a simple conditional reassignment to elements in a vector Y. However, I keep getting warning messages when the reassignments are dealing with integrals. Here is the complete code:
> rm(list=ls())
> Y <- c()
> for (k in 1:20) {
+ Y[k] <- k
+ }
> for (k in 1:20) {
+ if (Y[k] < 12) {
+ Y[k] <- cos(3 * k)
+ } else {
+ Y[k] <- integrate(function(t) sqrt(t), lower = 0, upper = k)
+ }
+ }
One of the warning messages:
Warning messages:
1: In Y[k] <- integrate(function(t) sqrt(t), lower = 0, upper = k) :
number of items to replace is not a multiple of replacement length
And the returned Y:
[[1]]
[1] -0.9899925
[[2]]
[1] 0.9601703
[[3]]
[1] -0.9111303
[[4]]
[1] 0.843854
[[5]]
[1] -0.7596879
[[6]]
[1] 0.6603167
[[7]]
[1] -0.5477293
[[8]]
[1] 0.424179
[[9]]
[1] -0.2921388
[[10]]
[1] 0.1542514
[[11]]
[1] -0.01327675
[[12]]
[1] 27.71282
[[13]]
[1] 31.24811
[[14]]
[1] 34.92214
[[15]]
[1] 38.72984
[[16]]
[1] 42.66667
[[17]]
[1] 46.72854
[[18]]
[1] 50.91169
[[19]]
[1] 55.21273
[[20]]
[1] 59.62849
Additionally, I'm a bit curious about why the output is broken up with two numbers for each element as well. Normally I'm used to vector output looking like this:
[1] 2 4 6 8 10 12 14 16 18 20 22 24 26 28 30 32 34 36 38
[20] 40
So any clarification about what I did wrong is highly appreciated.
Let me just show you how you can shorten your code:
Y <- numeric(20)
Y[1:12] <- cos(3 * (1:12))
Y[13:20] <- sapply(13:20, function (u) integrate(sqrt, lower = 0, upper = u)$value )
The result of:
integrate(function(t) sqrt(t), lower = 0, upper = k)
is a list.
you need to grab the first element of each list entry with [[1]] prior to inserting into the Y vector:
Y <- c()
#for (k in 1:20) { # This loop is unnecessary
# Y[k] <- k # as it will be overwritten
#} # with cos(3 * k) subsequently
for (k in 1:20) {
if (Y[k] < 12) {
Y[k] <- cos(3 * k)
} else {
Y[k] <- integrate(function(t) sqrt(t), lower = 0, upper = k)[[1]]
}
}
I have this equation to solve (e.g. f(x,y) = 0):
library(nleqslv)
target <- function(x)
{
z = x[1]/(x[1]+x[2])
y = numeric(2)
y[1] <- z*exp(-x[2]*(x[2]+z*(1-exp(-x[1]/z))))-0.00680
y[2] <- z/x[2]*(1-exp(-x[2]))-exp(-x[2])*z/x[1]*(1-exp(-x[1]))-3.43164
y
}
# Usage
xstart <- c(1,1)
target(xstart)
nleqslv(xstart, target, control=list(ftol=.0001, allowSingular=TRUE),jacobian=TRUE,method="Newton")
using R with nleqslv or another you have others :)
Thanks
I have been experimenting with your function. Rewrite the target function to use the a;b constants in your comment as in your second comment as follows:
target <- function(x, a=.00680,b=3.43164)
{
z <- x[1]/(x[1]+x[2])
y <- numeric(2)
y[1] <- z*exp(-x[2]*(x[2]+z*(1-exp(-x[1]/z))))-a
y[2] <- z/x[2]*(1-exp(-x[2]))-exp(-x[2])*z/x[1]*(1-exp(-x[1]))-b
y
}
The default values for a and b are what you initially specified.
Using them you'll get an ill-conditioned jacobiam.
However if we give some other values to a and b for example like so
nleqslv(xstart, target, control=list(btol=.01),jacobian=TRUE,method="Newton",a=2,b=1)
or
nleqslv(xstart, target, control=list(btol=.01),jacobian=TRUE,method="Newton",a=2,b=2)
then for the first expression the full return value of nleqslv is
$x
[1] 2.4024092 -0.7498464
$fvec
[1] 1.332268e-15 2.220446e-16
$termcd
[1] 1
$message
[1] "Function criterion near zero"
$scalex
[1] 1 1
$nfcnt
[1] 10
$njcnt
[1] 7
$iter
[1] 7
$jac
[,1] [,2]
[1,] -0.2930082 -1.2103174
[2,] 0.1801120 -0.6566861
I am inclined to conclude that either your function is incorrect or that you have specified impossible values for a and b. Method Broyden also seems to work nicely.