I'm trying to solve
$\sum_{j=1}^{180} x^{a_j} = 1$
I created two functions :
f1 <- function(x){c(rep(x,180))}
f2 <- function(x){sum(f1(x)^vec) - 1}
where vec is my a_j vector.
uniroot doesn't work. Which function should I use ?
Is there a better syntax ?
Why doesn't uniroot work, actually? As long as you define correctly your function and the interval to look for it should work:
aj <- c(-4,-5,-3,-4,-2,-3,-1,-2,-7,-6,-5,-8,-7,-6,-6,-7,-5,-6,
-4,-5,-3,-4,-9,-8,-7,-10,-9,-8,-1,-2,rep(-1,150))
f <- function(x,vec){sum(x^vec)-1}
uniroot(f, interval=c(-100,100), vec=aj)
$root
[1] -0.518658
$f.root
[1] -0.009276057
$iter
[1] 21
$estim.prec
[1] 6.103516e-05
You can use polyroot, For example
polyroot(c(-1,rep(1,180)))
here
p(x) = -1 + 1 * x + … + 1 * x^180
EDIT To use your vector aj
It is not clear what is your vector vec , I guess you want something like this :
polyroot(c(-1,vec))
Where vec
vec = (a1,a2,..............,a180)
EDIT after OP clarification:
The OP wants to find the roots of polynome with negative exponents. The solution is to factorize by the max of the exponents to can apply polyroot.
vec <- c(-4,-5,-3,-4,-2,-3,-1,-2,-7,-6,-5,-8,-7,-6,-6,-7,-5,-6,
-4,-5,-3,-4,-9,-8,-7,-10,-9,-8,-1,-2,rep(-1,150))
ma <- max(abs(vec))
vec <- sort(ma+vec)
polyroot(as.data.frame(table(vec))$Freq)
Related
I am using a simple polynomial to fit a curve.
poly <- function(a, b, c, x) a * x^2 + b * x + c
I'd like to find the value of x that results in the maximum value of the curve. Currently I create a grid with a range of x from 20000 to 50000, run the function for each row, then use max() on the result. It works, but I have a lot of groups and it creates a big dataframe every time I do it. It is very clunky and I feel like there must be a better way.
Some typical coefficients are:
a <- -0.000000179
b <- 0.011153167
c <- 9.896420781
If you rearrange your function so the variable you want to maximize is first and you set the default values like so:
poly <- function(x, a, b, c) a * x^2 + b * x + c
formals(poly)$a <- -0.000000179
formals(poly)$b <- 0.011153167
formals(poly)$c <- 9.896420781
Then you can use the optimize function to maximize over your interval:
optimize(poly, c(20000, 50000), maximum = T)
$`maximum`
[1] 31154.1
$objective
[1] 183.6298
Where $maximum is the x value at which the maximum occurs and $objective is the height.
If a is negative, maximum of parabola a * x^2 + b * x + c is reached at -b/(2*a) :
a<0
#[1] TRUE
-b/(2*a)
#[1] 31154.1
You could use optim. I think the other solutions answered in this thread are more appealing, but I'll write this up for completeness:
a <- -0.000000179
b <- 0.011153167
c <- 9.896420781
o <- optim(
par=list(x=0),
fn=function(x){ -poly(a,b,c,x=x) },
method="Brent",
lower=-50e3, upper=50e3
)
Output:
> o
$par
[1] 31154.1
$value
[1] -183.6298
$counts
function gradient
NA NA
$convergence
[1] 0
$message
NULL
I have a function f(x) with a free constant S. Once I integrate the function f(x) from 0 to infinity I would like to approximate what value of S makes the integral equal 1.
a <-0.3 #alpha
b <- 2.5 #beta
d <-0.7 #delta
g <-1.1 #gamma
#defining the function, note S is free (which causes an error, pasted below)
integrand <- function(x) {b*g/d*exp(-g*x)*(1-exp(-d* x))*exp(-a*b*S/d*(1-exp(-d*x)))}
#defining the integral equation I would like to solve for S
intfun<- function(S) {integrate(integrand,lower=0,upper=Inf)-1}
#trying to find the root of function
uniroot(intfun, lower = 0, upper = 1)
I also tried:
uniroot(integrate(integrand,lower=0,upper=Inf)-1, lower = 0, upper = 1)
Error given:
Error in f(x, ...) : object 'S' not found
The S value I am looking for is near 0.564029.
You should change your function:
a <-0.3 #alpha
b <- 2.5 #beta
d <-0.7 #delta
g <-1.1 #gamma
#defining the function, note S is free (which causes an error, pasted below)
integrand <- function(x, S) {b*g/d*exp(-g*x)*(1-exp(-d* x))*exp(-a*b*S/d*(1-exp(-d*x)))}
#defining the integral equation I would like to solve for S
intfun<- function(S) {
integrate(function(x)integrand(x, S),lower=0,upper=Inf)[[1]]-1
}
uniroot(intfun,c(-1,1))
$root
[1] 0.564041
$f.root
[1] -6.961327e-06
$iter
[1] 6
$init.it
[1] NA
$estim.prec
[1] 6.103516e-05
I'm trying to solve this equation: ((2300+1900*1)+(x+2300+1900*1)*0.002)/(600-400) =1
Is there a way to do this with R?
ATTEMPT with incorrect solution:
library(Ryacas)
eq <- "((2300+1900*1)+(x+2300+1900*1)*0.002)/(600-400) ==1 "
# simplify the equation:
library(glue)
yac_str(glue("Simplify({eq})"))
library(evaluate)
evaluate(eq,list(x=c(0,1,10,100,-100)))
evaluate() just returns the equation:
"((2300+1900*1)+(x+2300+1900*1)*0.002)/(600-400) ==1 "
The answer for the equation is −2004200
It sounds like you want to Solve() for x rather than merely simplifying ... ? The following code solves the equation, strips off the x== from the solution, and evaluates the expression:
eq2 <- gsub("x==","",yac_str(glue("Solve({eq},x)")))
[1] "{(-0.80168e6)/0.4}"
eval(parse(text=eq2))
[1] -2004200
1) Ryacas Use the Ryacas package solve as shown below. (Thanks to #mikldk for improvement to last line.)
library(Ryacas)
eq <- "((2300+1900*1)+(x+2300+1900*1)*0.002)/(600-400) ==1 " # from question
res <- solve(ysym(eq), "x")
as_r(y_rmvars(res)) # extract and convert to R
## [1] -2004200
if eq has R variables in it, here h is referenced in eq2, then use eval to evaluate the result.
h <- 2300
eq2 <- "((h+1900*1)+(x+2300+1900*1)*0.002)/(600-400) ==1 " # from question
res2 <- solve(ysym(eq2), "x")
eval(as_r(y_rmvars(res2)))
## [1] -2004200
2) Ryacas0 or using eq from above with the Ryacas0 package:
library(Ryacas0)
res <- Solve(eq, "x")
eval(Expr(res)[[1:3]]) # convert to R
## [1] -2004200
3a) Base R In light of the fact that this is a linear equation and the solution to the following where A is the slope and B is the intercept:
A * x + B = 0
is
x = - B / A
if we replace x with the imaginary 1i and then move the rhs to the lhs we have that B and A are the real and imaginary parts of that expression. No packages are used.
r <- eval(parse(text = sub("==", "-", eq)), list(x = 1i))
-Re(r) / Im(r)
## [1] -2004200
3b) If we move the rhs to lhs then B equals it at x=0 and A equals the derivative wrt x so another base R solution would be:
e <- parse(text = sub("==", "-", eq))
- eval(e, list(x = 0)) / eval(D(e, "x"))
## [1] -200420
Here is a base R solution.
Rewrite the equation in the form of a function, use curve to get two end points where the function has different signs and put uniroot to work.
f <- function(x) ((2300+1900*1)+(x+2300+1900*1)*0.002)/(600-400) - 1
curve(f, -1e7, 1)
uniroot(f, c(-1e7, 1))
#$root
#[1] -2004200
#
#$f.root
#[1] 0
#
#$iter
#[1] 1
#
#$init.it
#[1] NA
#
#$estim.prec
#[1] 7995800
Following the discussion in the comments to the question, here is a general solution. The function whose roots are to be found now accepts an argument params in order to pass the values of rent, salary, number of workers, price, unit cost and capital cost. This argument must be a named list.
f <- function(x, K = 1, params) {
A <- with(params, rent + salary*workers)
with(params, (A + (x + A)*capitalcost)/(price - unitcost) - K)
}
params <- list(
rent = 2300,
salary = 1900,
workers = 1,
price = 600,
unitcost = 400,
capitalcost = 0.002
)
curve(f(x, params = params), -1e7, 1)
uniroot(f, c(-1e7, 1), params = params)
If you want something quick: rootSolve library is your go-to.
library(rootSolve)
func_ <- function(x) ((2300+1900*1)+(x+2300+1900*1)*0.002)/(600-400)-1
uniroot.all(func_, c(-1e9, 1e9))
[1] -2004200
Note that most of the time reducing the interval is better.
If you will maintain the same structure, then in Base R, you could do:
solveX <- function(eq){
U <- function(x)abs(eval(parse(text = sub("=+","-", eq)), list(x=x)))
optim(0, U, method = "L-BFGS-B")$par
}
eq <- "((2300+1900*1)+(x+2300+1900*1)*0.002)/(600-400) ==1 "
solveX(eq)
[1] -2004200
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 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.