I have a function , foo(x,y), that creates a 3d surface from x,y coordinates. I need to find all values of (x,y) where foo=0. Currently, I am calculating foo at every point on an (x,y) search grid, but this is computationally expensive. Is there a way to give R foo, and have it return all values of (x,y) where foo=0?
With contourLines:
foo <- function(x,y) x^2 + y^2 - 1
x <- y <- seq(-2, 2, len=200)
z <- outer(x, y, foo)
cr <- contourLines(x, y, z, levels=0)
> x <- cr[[1]]$x
> y <- cr[[1]]$y
> foo(x[10], y[10])
[1] -4.438003e-05
Related
I am using in R the akima interp() function to smooth GPS coordinates regarding the measured altitude.
s = interp(x, y, z, nx=100, ny=100)
X are longitude values
Y are latitude values
Z the corresponding altitude
I want a corresponding Z value to a given X,Y pair by using the returned list s.smooth.
How it must be implemented?
Actually, I am only able to use
df1<-data.frame(s.smooth)
df1[which.min(abs(x1-df1$x))]
to get the nearest x value for one value x1.
I need a function like z_i=f(x_i,y_i) with given x_i and y_i. This position pare is not part of the initial lists x,y,z.
To get the interpolated value at specific values of x and y, you can use the xo and yo arguments of interp. To vectorize this and return the results in a data frame, you can write a little wrapper function:
library(akima)
interp_at <- function(x, y, z, xout, yout) {
do.call(rbind, lapply(seq_along(xout), function(i) {
as.data.frame(t(unlist(interp(x, y, z, xo = xout[i], yo = yout[i]))))
}))
}
So, if we had the following data:
set.seed(1)
x <- rnorm(500)
y <- rnorm(500)
z <- 10 - x^2 - y^2
and we want to know the value at [0, 0], [1, 0.5], and [2, 1] we can just do:
interp_at(x, y, z, xout = c(0, 1, 2), yout = c(0, 0.5, 1))
#> x y z
#> 1 0 0.0 9.992207
#> 2 1 0.5 8.727516
#> 3 2 1.0 4.982223
Created on 2022-06-13 by the reprex package (v2.0.1)
I would like to extend the example given here
How to plot a contour line showing where 95% of values fall within, in R and in ggplot2
to data with three dimensions (x, y and z), and instead of plotting the contour line I'd like to get the limits of the x, y and z values.
This is the example from the previous post.
library(ggplot2)
set.seed(1001)
d <- data.frame(x=rnorm(1000),y=rnorm(1000))
kd <- ks::kde(d, compute.cont=TRUE)
contour_95 <- with(kd, contourLines(x=eval.points[[1]], y=eval.points[[2]],
z=estimate, levels=cont["5%"])[[1]])
contour_95 <- data.frame(contour_95)
ggplot(data=d, aes(x, y)) +
geom_point() +
geom_path(aes(x, y), data=contour_95) +
theme_bw()
and then, it's possible to get the limits of the contour like this:
range(contour_95$x)
range(contour_95$y)
I would love to know how to get the x, y and z ranges of 3-D contours at specified percentiles.
ks:kde can deal with higher dimensions, but contourLines() cant.
This is what I've tried...
set.seed(1001)
d <- data.frame(x=rnorm(1000),y=rnorm(1000), y=rnorm(1000))
kd <- ks::kde(d, compute.cont=TRUE)
#what kd$estimates are > 95th percentile?
#make function that can extract from 3d array
multi.which <- function(A){
if ( is.vector(A) ) return(which(A))
d <- dim(A)
T <- which(A) - 1
nd <- length(d)
t( sapply(T, function(t){
I <- integer(nd)
I[1] <- t %% d[1]
sapply(2:nd, function(j){
I[j] <<- (t %/% prod(d[1:(j-1)])) %% d[j]
})
I
}) + 1 )
}
#extract those estimates that have >density than 95th percentile
ests <- multi.which(kd$estimate > kd$cont["5%"])
#make into a long dataframe with column number in the second column and row number in first column
col1=rep(1, nrow(ests))
col2=rep(2, nrow(ests))
col3=rep(3, nrow(ests))
rows=c(ests[,1], ests[,2], ests[,3])
cols=c(col1,col2,col3)
index=cbind(rows,cols)#this is the index so we can extract the coordinates in multi-D space
car::some(index)
#get coordinates with this function
fExtract <- function(dat, indexDat){
dat[as.matrix(indexDat)]
}
#pull three coordinates (x,y,z) from eval.points into 3 columns
eval.pts <- cbind(kd$eval.points[[1]], kd$eval.points[[2]], kd$eval.points[[3]])
v <- fExtract(eval.pts, index) #one long vector
#re-create the three columns of x, y and z coordinates of points at higher density than 95th percentile
x1 <- v[1:nrow(ests)]
y1 <- v[(nrow(ests)+1):(2*nrow(ests))]
z1 <- v[(2*nrow(ests)+1):(3*nrow(ests))]
#the three coordinates.
fin <- cbind(x1,y1,z1)
#get range of each dimension
range(x1)
range(y1)
range(z1)
But I'm not confident it's right.
Does anybody know if it is possible to insert a "is proportional to" symbol in an expression string in R?
Use something like this:
expression(x %~~% y)
expression(x %prop% y)
An example
# Approximately equal
x <- 1:10
y <- x + rnorm(10,0,.01)
plot(x, y, main = expression(y %~~% x))
# Proportional to...
x <- 1:10
y <- 3*x
plot(x, y, main = expression(y %prop% x))
Take a look at ?plotmath for documentation and more examples.
I'd like to know if there is a way to produce plots in R function similar to Mathematica's ContourPlot3D function? Basically, it allows you to plot a 3D surface at values of f, where f is an implicit function in three variables. The example from Mathematica: f(x,y,z) = x^3 + y^2 + z^2.
x <- y <- z <- seq(-2, 2, by=0.2)
grid <- expand.grid(x=x,y=y,z=z)
grid$f <- x^3 + y^2 + z^2
You can try the plot3D package.
The vignette has similar examples to the Mathematica link you provided.
Install the package, scan the vignette for the relevant function you want and try out that functions examples. For instance, if you want to look at the contour3D function and the surf3D function:
install.packages("plot3D")
require("plot3D")
example(contour3D)
example(surf3D)
You may want slice3D() or isosurf3D().
You can also try the misc3d package.
require(misc3d)
x <- y <- z <- seq(-2, 2, by=0.2)
x <- seq(-2,2,len=50)
g <- expand.grid(x = x, y = x, z = x)
v <- array(g$x^3 + g$y^2 + g$z^2, rep(length(x),3))
con <- computeContour3d(v, max(v), level=.2)
drawScene(makeTriangles(con))
I would like to plot:
production.ts(31, .002, 10,12,125313.93,211,95,x,"2014-02-01","2014-05-14",z,y) as function of x,y,z
As something like this plot from Mathematica, (if possible in R):
http://i.stack.imgur.com/3PRaf.png
I have a function:
library("lubridate"); library("rgl")
production.ts <- function(a, b, z, c, d, e,
f, g, h, j, r, k) {
elapsed <- (4-z)*10 + (4-c)
un.days <- 100 - elapsed
gone.days <- day(as.Date(h))
rem.days <- day(as.Date(j))
r.days <- as.numeric(as.Date(j) - as.Date(h))
m.r <- f/100*d
inputs <- d * a * (gone.days - 1)/365 + r
prin <- m.r + inputs
costs <- (r.days/365 * r + 1) * prin
added.p <- a/100*d + r
due <- d * 1-un.days
tomr.f <- 1- due + k^2
acct.paid <- (d - due)*tomr.f
net <- added.p + due + acct.paid
pv.net <- net/(1+r*(e-30-day(as.Date(j)))/365)
end <- d - due - acct.paid
more.add.p <- end*a*(rem.days-1)/365
rem <- (f-g)/100 * end
total.fv <- pv.net + rem + more.add.p
out <- costs - total.fv
out
}
x<-seq(-10,10,by=.1)
y<-seq(0,1000,by=.1)
z<-seq(0,90,by=.1)
I have tried:
func.3d<-Vectorize(production.ts(31, .002, 10,12,125313.93,211,95,x,"2014-02-01","2014-05-14",z,y))
c <- func.3d; c <- cut(c,breaks=64); cols <- rainbow(64)[as.numeric(c)]
open3d()
plot3d(x, y, z, col=cols,type="s",size=1)
But this plots lines and the colors don't line up with the values the function should output.
Does anyone know how I could do this? Thanks, I really appreciate your time!
Like this?
x<-seq(-10,10,length=100)
y<-seq(0,1000,length=100)
z<-seq(0,90,length=100)
df <- expand.grid(x=x,y=y,z=z)
f <- function(x,y,z) {production.ts(31, .002, 10,12,125313.93,211,95,x,"2014-02-01","2014-05-14",z,y)}
df$c <- f(df$x,df$y,df$z)
c <- cut(df$c,breaks=64)
cols <- rainbow(64)[as.numeric(c)]
open3d()
plot3d(df$x, df$y, df$z, col=cols,type="p",size=1)
Your code was not plotting lines. When you pass x, y, and z like that to plot3d(...) it cycles through all the elements together, so x[1],y[1],z[1] is a point, x[2],y[2],z[2] is another point, and so on. Since the vectors are different lengths, the shorter ones are recycled to fill out to the length of the longest. The visual effect of this is that the points lie on a line.
You want yo plot every combination of x, y, and z, and give each point a color based on that combination. The code above does that. The plot does not quite look like yours, but I can't tell if that is because of the way you have defined your function.
Also, the way you defined x, y, and z there would be 201 X 10001 X 901 = 1,811,191,101 points, which is too many to handle. The code above plots 1,000,000 points.
Finally, plotting spheres (type="s") is very expensive and unnecessary in this case.