Solving transcendental equations in R - r

Is there a function for solving transcendental equations in R?
For example, I want to solve the following equation
x = 1/tan(x)
Any suggestions? I know the solution has multiple roots so I also want to be able to recover all the answers for a given interval

I would plot the function curve and look at it to see what it looks like:
R > y = function(x) { x - 1/tan(x) }
R > curve(y, xlim = c(-10, 10))
R > abline(h = 0, color = 'red')
Then I saw there is a root between 0 and 3, I would use uniroot to get the root I want:
R > uniroot(y, interval = c(0, 3))
$root
[1] 0.8603
$f.root
[1] 6.612e-06
$iter
[1] 7
$estim.prec
[1] 6.104e-05

You can use uniroot to find roots of any 1D equations within a given range. However, getting multiple roots seems like a very hard problem in general (e.g. see the relevant chapter of Numerical Recipes for some background: chapter 9 at http://apps.nrbook.com/c/index.html ). Which root is found when there are multiple roots is hard to predict. If you know enough about the problem to subdivide the space into subregions with zero or one roots, or if you're willing to divide it into lots of regions and hope that you found all the roots, you can do it. Otherwise I look forward to other peoples' solutions ...
In this particular case, as shown by #liuminzhao's solution, there's (at most? exactly?) one solution between n*pi and (n+1)*pi
y = function(x) x-1/tan(x)
curve(y,xlim=c(-10,10),n=501,ylim=c(-5,5))
abline(v=(-3:3)*pi,col="gray")
abline(h=0,col=2)
This is a bit of a hack, but it will find roots of your equation (provided they are not too close to a multiple of pi: you can reduce eps if you like ...). However, if you want to solve a different multi-root transcendental equation you might need another (specialized) strategy ...
f <- function(n,eps=1e-6) uniroot(y,c(n*pi+eps,(n+1)*pi-eps))$root
sapply(0:3,f)
## [1] 0.8603337 3.4256204 6.4372755 9.5293334

Related

How to generate a negative exponential distribution in R

I was manually creating a negative exponent distribution today and was trying to figure out a faster/easier solution. First, I just manually crafted a geometric sequence such as this one, multiplying constantly by .60 til I neared zero:
x <- 400
x*.60
Doing this about 20 times, I got this vector of solutions and plotted the distribution, as seen below:
y <- c(400,240,144,86.4, 51.84, 31.104, 18.6624, 11.19744, 6.718464, 4.031078,
2.418647, 1.451188, .8707129, .5224278, .3134567, .188074, .1128444,
.06770664, .04062398, .02437439)
plot(y)
However, I was trying to figure out what must be an easier way of doing this with seq, but I only know how to do this with arithmetic sequences. I tried reproducing what I did below:
plot(seq(from=400,
to=1,
by=-.60))
Which obviously doesn't produce the same effect, causing a very linear decline when plotted:
Is there an easier solution? I have to imagine that this is a rather basic function within R.
You may use dexp.
(x <- dexp(1:20, rate=.5)*1000)
# [1] 303.26532986 183.93972059 111.56508007 67.66764162 41.04249931 24.89353418 15.09869171 9.15781944 5.55449827
# [10] 3.36897350 2.04338572 1.23937609 0.75171960 0.45594098 0.27654219 0.16773131 0.10173418 0.06170490
# [19] 0.03742591 0.02269996
plot(x)
To make it start exactly at 400, we can minimize (400 - dexp(1, rate=.5)*x)^2 using optimize.
f <- function(x, a) (a - dexp(1, rate=.5)*x)^2
xmin <- optimize(f, c(0, 4000), a=400)
(x <- dexp(seq_len(20), rate=.5)*xmin$minimum)
# [1] 400.00000000 242.61226389 147.15177647 89.25206406 54.13411329 32.83399945 19.91482735 12.07895337 7.32625556
# [10] 4.44359862 2.69517880 1.63470858 0.99150087 0.60137568 0.36475279 0.22123375 0.13418505 0.08138735
# [19] 0.04936392 0.02994073
Note that if you want any different rate= you should to use it both in optimize and when creating the values.

In R, find non-linear lines from two sets of points and then find the intersection of those points

Using R, I want to estimate two curves using points from two vectors, and then find the x and y coordinates where those estimated curves intersect.
In a strategic setting with players "t" and "p", I am simulating best responses for both players in response to what the other would pick in a strategic setting (game theory). The problem is that I don't have functions or lines, I have two sets of points originating from simulation, with one set of points corresponding to the player's best response to given actions by the other player. The actual math was too difficult for me (or matlab) to solve, which is why I'm using this simulated visual approach. I want to estimate best response functions (i.e. create non-linear curves) using the points, and then take the two estimated curves and find where they intersect in order to identify nash equilibrium (where the best response curves intersect).
As an example, here are two such vectors I am working with:
t=c(10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.1,10.1,10.1,10.1,10.1,10.1,10.1,10.1,10.1,10.1,10.1,10.1,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0,10.0)
p=c(12.3,12.3,12.3,12.3,12.3,12.3,12.4,12.4,12.4,12.5,12.5,12.5,12.6,12.6,12.7,12.7,12.8,12.8,12.9,12.9,13.0,13.1,13.1,13.2,13.3,13.4,13.5,13.4,13.5,13.6,13.6,13.7,13.8,13.8,13.9,13.9,13.9,14.0,14.0,14.0,14.0)
For the first line, the sample is made up of (t,a), and for the second line, the sample is made up of (a,p) where a is a third vector given by
a = seq(10, 14, by = 0.1)
For example, the first point for the sample corresponding to the first vector would be (10.0,10.0) and the second point would be (10.0,10.1). The first point for the sample corresponding to the second vector would be (10.0,12.3) and the second point would be (10.1,12.3).
What I originally tried to do is estimate the lines using polynomials produced by lm models, but those don't seem to always work:
plot(a,t, xlim=c(10,14), ylim=c(10,14), col="purple")
points(p,a, col="red")
fit4p <- lm(a~poly(p,3,raw=TRUE))
fit4t <- lm(t~poly(a,3,raw=TRUE))
lines(a, predict(fit4t, data.frame(x=a)), col="purple", xlim=c(10,14), ylim=c(10,14),type="l",xlab="p",ylab="t")
lines(p, predict(fit4p, data.frame(x=a)), col="green")
fit4pCurve <- function(x) coef(fit4p)[1] +x*coef(fit4p)[2]+x^2*coef(fit4p)[3]+x^3*coef(fit4p)[4]
fit4tCurve <- function(x) coef(fit4t)[1] +x*coef(fit4t)[2]+x^2*coef(fit4t)[3]+x^3*coef(fit4t)[4]
a_opt1 = optimise(f=function(x) abs(fit4pCurve(x)-fit4tCurve(x)), c(10,14))$minimum
b_opt1 = as.numeric(fit4pCurve(a_opt1))
EDIT:
After fixing the type, I get the correct answer, but it doesn't always work if the samples don't come back as cleanly.
So my question can be broken down a few ways. First, is there a better way to accomplish what I'm trying to do. I know what I'm doing isn't perfectly accurate by any means, but it seems like a decent approximation for my purposes. Second, if there isn't a better way, is there a way I could improve on the methodology I have listed above.
Restart your R session, make sure all variables are cleared and copy/paste this code. I found a few mistakes in referenced variables. Also note that R is case sensitive. My suspicion is that you've been overwriting variables.
plot(a,t, xlim=c(10,14), ylim=c(10,14), col="purple")
points(p,a, col="red")
fit4p <- lm(a~poly(p,3,raw=TRUE))
fit4t <- lm(t~poly(a,3,raw=TRUE))
lines(a, predict(fit4t, data.frame(x=a)), col="purple", xlim=c(T,P), ylim=c(10,14),type="l",xlab="p",ylab="t")
lines(p, predict(fit4p, data.frame(x=a)), col="green")
fit4pCurve <- function(x) coef(fit4p)[1] +x*coef(fit4p)[2]+x^2*coef(fit4p)[3]+x^3*coef(fit4p)[4]
fit4tCurve <- function(x) coef(fit4t)[1] +x*coef(fit4t)[2]+x^2*coef(fit4t)[3]+x^3*coef(fit4t)[4]
a_opt = optimise(f=function(x) abs(fit4pCurve(x)-fit4tCurve(x)), c(T,P))$minimum
b_opt = as.numeric(fit4pCurve(a_opt))
As you will see:
> a_opt
[1] 12.24213
> b_opt
[1] 10.03581

Local maxima for matrix in R

I would like to know if there is any function that will give a local maxima for matrix on a plane?
I found one solution from
Given a 2D numeric "height map" matrix in R, how can I find all local maxima?
but it seems that there are some mistakes where for this line
localmax <- focal(r, fun = f, pad=TRUE, padValue=NA)
Error in focal(r, fun = f, pad = TRUE, padValue = NA) :
argument "w" is missing
Not sure on how to contact the person who gave the solution, so I just post it here
Regards
Aftar
Personally I'd dump your matrix into imageJ to do this.
As another option, you might port this Matlab code http://www.mathworks.com/matlabcentral/fileexchange/37388-fast-2d-peak-finder . That module does some smoothing to improve the chance of finding "real" peaks in an image. IMHO local maxima only have meaning if the surface is smooth in the mathematical sense, i.e. everywhere differentiable.

How to calculate arcsin(sgn(x)√|x|)?

I'm trying to arcsine squareroot data lying on [-1,1]. Using transf.arcsine from the metafor package produces NaNs when trying to squareroot the negative datapoints. Conceptually, I want to use arcsin(sgn(x)√|x|) i.e. square the absolute value, apply its previous sign, then arcsine transform it. The trouble is I have no idea how to begin doing this in R. Help would be appreciated.
x <- seq(-1, 1, length = 20)
asin(sign(x) * sqrt(abs(x)))
or as a function
trans.arcsine <- function(x){
asin(sign(x) * sqrt(abs(x)))
}
trans.arcsine(x)
Help in R is just help() or help.search(). So, let's try the obvious,
> help(arcsin)
No documentation for ‘arcsin’ in specified packages and libraries:
OK, that's not good. But it must be able to trig... let's try something even simpler.
help(sin)
There's all the trig functions. And I note, there's a link to Math on the page. Clicking that seems to provide all of the functions you need. It turns out that I could have just typed..
help(Math)
also,
help.search('trigonometry')
I had a similar prob. I wanted to arcsine transform most of the dataset "logmeantd.ascvr" & approached it in this manner:
First make are data range has been transformed b/t -1 and 1 (in this case they were expressed as percentages):
logmeantd.ascvr[1:12] <- logmeantd.ascvr[1:12] * 0.01
Next apply the square root function, sqrt():
logmeantd.ascvr[1:12] <- sqrt(logmeantd.ascvr[1:12])
lastly apply the arc sine function, asin():
logmeantd.ascvr[1:12] <- asin(logmeantd.ascvr[1:12])
*note in this instance I had excluded the MEAN variable of my dataset because I wanted to apply a log function to it, log():
logmeantd.ascvr$MEAN <- log(logmeantd.ascvr$MEAN)

How can I calculate the area within a contour in R?

I'm wondering if it is possible to caclulate the area within a contour in R.
For example, the area of the contour that results from:
sw<-loess(m~l+d)
mypredict<-predict(sw, fitdata) # Where fitdata is a data.frame of an x and y matrix
contour(x=seq(from=-2, to=2, length=30), y=seq(from=0, to=5, length=30), z=mypredict)
Sorry, I know this code might be convoluted. If it's too tough to read. Any example where you can show me how to calculate the area of a simply generated contour would be helpful.
Thanks for any help.
I'm going to assume you are working with an object returned by contourLines. (An unnamed list with x and y components at each level.) I was expecting to find this in an easy to access location but instead found a pdf file that provided an algorithm which I vaguely remember seeing http://finzi.psych.upenn.edu/R/library/PBSmapping/doc/PBSmapping-UG.pdf (See pdf page 19, labeled "-11-") (Added note: The Wikipedia article on "polygon" cites this discussion of the Surveyors' Formula: http://www.maa.org/pubs/Calc_articles/ma063.pdf , which justifies my use of abs().)
Building an example:
x <- 10*1:nrow(volcano)
y <- 10*1:ncol(volcano)
contour(x, y, volcano);
clines <- contourLines(x, y, volcano)
x <- clines[[9]][["x"]]
y <- clines[[9]][["y"]]
level <- clines[[9]][["level"]]
level
#[1] 130
The area at level == 130 (chosen because there are not two 130 levels and it doesn't meet any of the plot boundaries) is then:
A = 0.5* abs( sum( x[1:(length(x)-1)]*y[2:length(x)] - y[1:(length(x)-1)]*x[2:length(x)] ) )
A
#[1] 233542.1
Thanks to #DWin for reproducible example, and to the authors of sos (my favourite R package!) and splancs ...
library(sos)
findFn("area polygon compute")
library(splancs)
with(clines[[9]],areapl(cbind(x,y)))
Gets the same answer as #DWin, which is comforting. (Presumably it's the same algorithm, but implemented within a Fortran routine in the splancs package ...)

Resources