I would like to plot an implicit function of x and y: 1 - 0.125 * y ^ 2 - x ^ 2 = 0.005
I know it can be plotted as a contour plot but have trouble with the "outer" command
in the following:
x<-seq(0.4,1.01,length=1000)
y<-seq(0,3,length=1000)
z<-outer(x,y,FUN="1-0.125*y^2-x^2=0.005")
contour(x,y,z,levels=0,drawpoints=FALSE)
I read the FAQ (7.17) regarding the "outer" command and the need to vectorize the function but am still in a quandry.
I think you're a little confused about the meaning of 'function'.
All the operations (+,-,^) in your function are vectorized so that all works just fine.
x <- seq(0.4,1.01,length=1000)
y <- seq(0,3,length=1000)
z <- outer(x,y,function(x,y) 1-0.125*y^2-x^2-0.005)
contour(x,y,z,levels=0,drawlabels=FALSE)
Or if you want a minor shortcut:
library(emdbook)
curve3d(1-0.125*y^2-x^2-0.005,
xlim=c(0.4,1.01),
ylim=c(0,3),
n=c(100,100),
sys3d="contour",drawlabels=FALSE,levels=0)
This actually is slower because it uses a for loop internally rather than outer(), so I set it to 100x100 rather than 1000x1000 (which is overkill for this example anyway), but it will work on more complex examples that can't be vectorized easily ...
plotting an implicit equation as a contour plot is overkill. You are essentially throwing away 99.99% of the computations you did.
Better way is to find the value of y for a given x that will make the equation 0. Here is the code using uniroot in base R.
R code using uniroot from base R
x = seq(0, 0.995, length = 100) # no real root above x = 0.995
root <- function(a) {
uniroot(function(x,y) 1 - 0.125 * y^2 - x^2 - 0.005, c(0, 3), x = a )$root #only care about the root
}
y <- sapply(x, root)
plot(x,y, type = "l")
Ok the c(0, 3) in the uniroot argument is the range of y values where the root lies. so for every given x value uniroot will look for a y value between 0 and 3 for a root.
R code using fsolve from pracma package
library("pracma")
x <- seq(0,0.995, length=100)
fun <- function(y) c(1 - 0.125 * y^2 - x^2 - 0.005)
y_sol <- fsolve(fun, rep(1, length(x)))$x
plot(x,y_sol, type="l")
fsolve takes in the function whose root is sought and guess values of y for every given value of x. Here we are saying that the y values lie near 1. we are giving it a guess value of 1's
uniroot wants a bound range to look for root, fsolve requires a guess where the root might be.
These are faster ways to plot implicit equations. You can then use any graph package like ggplot2/rbokeh to do the plotting.
I haven't done any benchmarks so cannot tell which one method is faster. Though for such a simple implicit function it won't matter
Related
I'm trying to find a root of the following function (based on the Gamma (gamma()) function) using the uniroot() function:
cv = 0.056924/1.024987^2
fx2 = function(theta, eta){
p1 = 1 - 2/(theta*(1-eta))
p2 = 1 - 1/(theta*(1-eta))
return(( gamma(p1)/(gamma(p2))^2 ) - (cv+1) )
}
This function gives me the following plot:
v = seq(0, 1, 0.01)
plot(v, fx2(3.0, v), type='l' )
It seems to me that the root of this function is close to 0.33, but the uniroot() function doesn't find the root, returning the following result:
uniroot(fx2, interval = c(0,0.3), theta=3 )
Error in uniroot(fx2, interval = c(0, 0.3), theta = 3) :
f() values at end points not of opposite sign
How do I find the root of this function? Are there any other packages with a more accurate algorithm?
I first rewrote your function to (optionally) express gamma(p1)/gamma(p2)^2 in terms of a computation that's first done on the log scale (via lgamma()) and then exponentiated. This is more numerically stable, and the consequences will become clear below ... (It's possible that I screwed up the log-scale computation — you should double-check it. Update/warning: reading the documentation more carefully (!!), lgamma() evaluates to the log of the absolute value of the gamma function. So there may be some weird sign stuff going on in the answer below. The fact remains that if you are evaluating ratios of gamma functions for x<0 (i.e. in the regime where the value can go negative), Bad Stuff is very likely going to happen.
cv = 0.056924/1.024987^2
fx3 <- function(theta, eta, lgamma = FALSE) {
p1 <- 1 - 2/(theta*(1-eta))
p2 <- 1 - 1/(theta*(1-eta))
if (lgamma) {
val <- exp(lgamma(p1) - 2*lgamma(p2)) - (cv+1)
} else {
val <- ( gamma(p1)/(gamma(p2))^2 ) - (cv+1)
}
}
Compute the function with and without log-scaling:
x <- seq(0, 1, length.out = 20001)
v <- sapply(x, fx3, theta = 3.0, lgamma = TRUE)
v2 <- sapply(x, fx3, theta = 3.0, lgamma = FALSE)
Find root (more explanation below):
uu <- uniroot(function(eta) fx3(3.0, eta, lgamma = TRUE),
c(0.4, 0.5))
Plot it:
par(las=1, bty="l")
plot(x, abs(v), col = as.numeric(v<0) + 1, type="p", log="y",
pch=".", cex=3)
abline(v = uu$root, lty=2)
cvec <- sapply(c("blue","magenta"), adjustcolor, alpha.f = 0.2)
points(x, abs(v2), col=cvec[as.numeric(v2<0) + 1], pch=".", cex=3)
Here I'm plotting the absolute value on a log scale, with sign indicated by colour (black/blue >0, red>magenta <0). Black/red is the log-scale calculation, blue/magenta is the original calculation. I also plotted the function at very high resolution to try to avoid missing or mischaracterizing features.
There's a lot of weird stuff going on here.
both versions of the function do something interesting near x=1/3; the original version looks like a pole (value diverges to +∞, "returns" from -∞), while the log-scale computation goes up to +∞ and returns without changing sign.
the log-scale computation has a root near x=0.45 (absolute value becomes small while the sign flips), but the original computation doesn't — presumably because of some kind of catastrophic loss of precision? If we give uniroot bounds that don't include the pole, it can find this root.
there are further poles and/or roots at larger values of x that I didn't explore.
All of this basically says that it's pretty dangerous to mess around with this function without knowing what its mathematical properties are. I discovered some stuff by numerical exploration, but it would be best to analyze the function so that you really know what's happening; any numerical exploration can be fooled if the function is sufficiently strangely behaved.
Let me make my question clear because I don't know how to ask it properly (therefore I don't know if it was answered already or not), I will go through my whole problem:
There is a given function (which is the right side of an explicit first order differential equation if it matters):
f = function(t,y){
-2*y+3*t
}
Then there's a given interval from 'a' to 'b', this is the range the function is calculated in with 'n' steps, so the step size in the interval (dt) is:
dt=abs(a-b)/n
In this case 'a' is always 0 and 'b' is always positive, so 'b' is always greater than 'a' but I tried to be generic.
The initial condition:
yt0=y0
The calculation that determines the vector:
yt=vector("numeric",n)
for (i in 1:(n-1))
{
yt[1]=f(0,yt0)*dt+yt0
yt[i+1]=(f(dt*i,yt[i]))*dt+yt[i]
}
The created vector is 'n' long, but this is an approximate solution to the differential equation between the interval ranging from 'a' to 'b'. And here comes my problem:
When I try plotting it alongside the exact solution (using deSolve), it is not accurate. The values of the vector are accurate, but it does not know that these values belong to an approximate function that's between the interval range 'a' to 'b' .
That's why the graphs of the exact and approximate solution are not matching at all. I feel pretty burnt out, so I might not describe my issue properly, but is there a solution to this? To make it realise that its values are between 'a' and 'b' on the 'x' axis and not between '1' and 'n'?
I thank you all for the answers in advance!
The deSolve lines I used (regarding 'b' is greater than 'a'):
df = function(t, y, params) list(-2*y+3*t)
t = seq(a, b, length.out = n)
ddf = as.data.frame(ode(yt0, t, df, parms=NULL))
I tried to reconstruct the comparison between an "approximate" solution using a loop (that is in fact the Euler method), and a solution with package deSolve. It uses the lsoda solver by default that is more precise than Euler'S method, but it is of course also an approximation (default relative and absolute tolerance set to 1e-6).
As the question missed some concrete values and the plot functions, it was not clear where the original problem was, but the following example may help to re-formulate the question. I assume that the problem may be confusion between t (absolute time) and dt between the two approaches. Compare the lines marked as "original code" with the "suggestion":
library(deSolve)
f = function(t, y){
-2 * y + 3 * t
}
## some values
y0 <- 0.1
a <- 3
b <- 5
n <- 100
## Euler method using a loop
dt <- abs(a-b)/n
yt <- vector("numeric", n)
yt[1] <- f(0, y0) * dt + y0 # written before the loop
for (i in 1:(n-1)) {
#yt[i+1] = (f( dt * i, yt[i])) * dt + yt[i] # original code
yt[i+1] <- (f(a + dt * i, yt[i])) * dt + yt[i] # suggestion
}
## Lsoda integration wit package deSolve
df <- function(t, y, params) list(-2*y + 3*t)
t <- seq(a, b, length.out = n)
ddf = as.data.frame(ode(y0, t, df, parms=NULL))
## Plot of both solutions
plot(ddf, type="l", lwd=5, col="orange", ylab="y", las=1)
lines(t, yt, lwd=2, lty="dashed", col="blue")
legend("topleft", c("deSolve", "for loop"),
lty=c("solid", "dashed"), lwd=c(5, 2), col=c("orange", "blue"))
My problem is as it says in the title, I am trying to use the derivative (with respect to v) of the modified Bessel function of the second kind K_v(x) but with no success.
I read in one of the documentation that besselDK(v,x) would work as a derivative, apparently this is not a recognized function in R. I tried to use the expansion for the derivative, namely
besselK(v,x)*(1- (1/2v) -log(e*x/2v))
but this doesn't work to give me the correct plot as well. I am trying to plot a function which includes this.
P <- function(x) (1/2)*log(exp(1)/(2*pi*x^(2)))+(3*exp(1/x^(2))/(sqrt(2*pi*x^(2))))*besselK((1/x^(2)),1/2)*(log(exp(1)/x^(2)))
x <- seq(0.1,2,0.01)
plot(x, P(x), xlim=c(0,2), ylim=c(0,1.2), type="l")
From the code above, I get a straight line as a plot. In the correct plot, it should be a curve bending between 1 and 1.5, could someone please tell me the right way to go about it?
The derivative at nu = 1/2 is given here.
f <- function(nu,x){
besselK(x, nu)
}
library(gsl) # for expint_E1
fprime <- function(x){
sqrt(pi/2/x) * expint_E1(2*x) * exp(x)
}
nu <- 1/2
h <- 1e-6
x <- 2
(f(nu+h, x) - f(nu,x)) / h
## [1] 0.02474864
fprime(x)
## [1] 0.02474864
Background
I read here that newton method fails on function x^(1/3) when it's inital step is 1. I am tring to test it in julia jupyter notebook.
I want to print a plot of function x^(1/3)
then I want to run code
f = x->x^(1/3)
D(f) = x->ForwardDiff.derivative(f, float(x))
x = find_zero((f, D(f)),1, Roots.Newton(),verbose=true)
Problem:
How to print chart of function x^(1/3) in range eg.(-1,1)
I tried
f = x->x^(1/3)
plot(f,-1,1)
I got
I changed code to
f = x->(x+0im)^(1/3)
plot(f,-1,1)
I got
I want my plot to look like a plot of x^(1/3) in google
However I can not print more than a half of it
That's because x^(1/3) does not always return a real (as in numbers) result or the real cube root of x. For negative numbers, the exponentiation function with some powers like (1/3 or 1.254 and I suppose all non-integers) will return a Complex. For type-stability requirements in Julia, this operation applied to a negative Real gives a DomainError. This behavior is also noted in Frequently Asked Questions section of Julia manual.
julia> (-1)^(1/3)
ERROR: DomainError with -1.0:
Exponentiation yielding a complex result requires a complex argument.
Replace x^y with (x+0im)^y, Complex(x)^y, or similar.
julia> Complex(-1)^(1/3)
0.5 + 0.8660254037844386im
Note that The behavior of returning a complex number for exponentiation of negative values is not really different than, say, MATLAB's behavior
>>> (-1)^(1/3)
ans =
0.5000 + 0.8660i
What you want, however, is to plot the real cube root.
You can go with
plot(x -> x < 0 ? -(-x)^(1//3) : x^(1//3), -1, 1)
to enforce real cube root or use the built-in cbrt function for that instead.
plot(cbrt, -1, 1)
It also has an alias ∛.
plot(∛, -1, 1)
F(x) is an odd function, you just use [0 1] as input variable.
The plot on [-1 0] is deducted as follow
The code is below
import numpy as np
import matplotlib.pyplot as plt
# Function f
f = lambda x: x**(1/3)
fig, ax = plt.subplots()
x1 = np.linspace(0, 1, num = 100)
x2 = np.linspace(-1, 0, num = 100)
ax.plot(x1, f(x1))
ax.plot(x2, -f(x1[::-1]))
ax.axhline(y=0, color='k')
ax.axvline(x=0, color='k')
plt.show()
Plot
That Google plot makes no sense to me. For x > 0 it's ok, but for negative values of x the correct result is complex, and the Google plot appears to be showing the negative of the absolute value, which is strange.
Below you can see the output from Matlab, which is less fussy about types than Julia. As you can see it does not agree with your plot.
From the plot you can see that positive x values give a real-valued answer, while negative x give a complex-valued answer. The reason Julia errors for negative inputs, is that they are very concerned with type stability. Having the output type of a function depend on the input value would cause a type instability, which harms performance. This is less of a concern for Matlab or Python, etc.
If you want a plot similar the above in Julia, you can define your function like this:
f = x -> sign(x) * abs(complex(x)^(1/3))
Edit: Actually, a better and faster version is
f = x -> sign(x) * abs(x)^(1/3)
Yeah, it looks awkward, but that's because you want a really strange plot, which imho makes no sense for the function x^(1/3).
I've got the first line down which is defining the function:
f <- function(x) 3034*log(x)+2305.84*log(1-x)-1517*log(1-x)
Now the problem I'm having is I need to find all the x values where
f(x)=-1947.92 but I've got no idea what the command is to do this?
Normally I would say you should use uniroot(), after modifying the function to return zero at the target, but that will be problematic here:
target <- -1947.92
f <- function(x) 3034*log(x)+2305.84*log(1-x)-1517*log(1-x)
g <- function(x) f(x)-target
uniroot(g,interval=c(1e-4,1-1e-4))
## Error in uniroot(g, interval = c(1e-04, 1 - 1e-04)) :
## f() values at end points not of opposite sign
What's going on is that your curve crosses zero in two places. uniroot() requires that you bracket the root:
Let's take a look:
curve(g(x))
abline(h=0,col=2)
Zoom in:
curve(g(x),from=0.75,to=0.85)
abline(h=0,col=2)
Now we can either just eyeball this (i.e. use interval=c(1e-4,0.8) or interval=c(0.8,1-1e-4) depending on which root we're interested in) or find
opt1 <- optim(g,par=0.5,method="L-BFGS-B",lower=1e-4,upper=1-1e-4,
control=list(fnscale=-1)) ## maximize rather than min
then use opt1$par as your cut-point. (Or you could do some simple calculus: the maximum [point where the derivative wrt x is zero] is much easier to compute than the roots ...)
Alternatively, you could ask Wolfram Alpha ...