I have two different matrices (same x and y axis) which a plot as contour plots contour (x,y,z). I would like to figure out how to stack both matrix into a single plot in R.
I've been trying to use the as.layer function but it doesn't work
heteroplot <- contour(a[,1],t(a[,1]),nlevels=7,heterocov^2,col="green",xlab="ppm",ylab="ppm",bty="n")
homocov <- contour(a[,1],t(a[,1]),nlevels=7,cova^2,col="red",xlab="ppm",ylab="ppm",bty="n")
as.layer(homocov,x.same = TRUE, y.same = TRUE)
thanks!
You can do this, if I've understood correctly, using the add argument to contour(). For example:
x <- -6:16
y <- x
z1 <- outer(x, sqrt(abs(x)), FUN = "/")
z2 <- outer(x, abs(x), FUN = "/")
contour(x, x, z1)
contour(x, x, z2, add = TRUE, col = "red") ## overlay second contour
which gives:
Not sure where the as.layer function comes from...?
Related
I want to plot a discontinuous surface using the persp function.
Here is the function:
f <- function(x, y)
{
r <- sqrt(x^2 + y^2)
out <- numeric(length(r))
ok <- r >= 1
out[ok] <- exp(-(r[ok] - 1))
return(out)
}
To get a perspective plot of the function on a regular grid, I use
x <- y <- seq(-4, 4, length.out = 50)
z <- outer(x, y, f)
persp(x, y, z, , theta = 30, phi = 30, expand = 0.5, col = "lightblue")
The resulting plot does not properly show the circular nature of discontinuity points of the surface. Any suggestion about how to obtain a better perspective plot, instead of contour plot or image?
If something interactive works for you, I would go for something like this:
library(plotly)
plot_ly(z = ~ z) %>% add_surface()
Because the circular nature is best seen from above, a phi of 90 would be best to highlight this feature, but then you lose the rest of the shape and it is pretty useless. Hence, I would go for something interactive.
persp(x, y, z, , theta = 30, phi = 30, expand = 0.5, col = "lightblue")
I'm using lattice to create a scatterplot matrix with an overlaid contour plot of a bivariate kernel density function. The following code is giving a strange behavior, where the contour plots are only drawn partially, starting from the bottom and getting cut off at the top. How much gets drawn depends on the value of n in MASS::kde2d.
library(lattice)
library(MASS)
splom(iris, upper.panel = function(x, y, ...) {
if(is.numeric(x) & is.numeric(y)){
# calculate bivariate kernel density
f1 <- kde2d(x = x, y = y, n = 20) #, lims = c(0, 10 ,0, 10))
f <- data.frame(x = f1$x, y = rep(f1$y, each = length(f1$x)),
z = as.vector(f1$z))
panel.contourplot(x = f$x, y = f$y, z = f$z,
contour = TRUE, ...)
}
panel.xyplot(x, y, ...)
})
Poking around and printing summaries of the intermediate values seems to indicate that the functions are behaving as expected and giving values in the expected range. Any idea what's going on?
Okay, so it turns out the ... was passing the old subscripts argument to the new panel function. Since the iris data had 25*25 = 125 subscripts, the panel.contourplot was only considering the first 125 elements of its x, y, and z arguments. The following takes care of that.
splom(iris, upper.panel = function(x, y, subscripts, ...) {
if(is.numeric(x) & is.numeric(y)){
# calculate bivariate kernel density
v <- current.panel.limits() # allows full bleed by setting limits explicitly
f1 <- kde2d(x = x, y = y, n = 50, lims = c(v$xlim, v$ylim))
f <- data.frame(x = f1$x, y = rep(f1$y, each = length(f1$x)),
z = as.vector(f1$z))
panel.contourplot(f$x, f$y, f$z, contour = TRUE,
subscripts = 1:dim(f)[1], ...)
}
panel.xyplot(x, y, subscripts = subscripts, ...)
})
While we're at it, I threw in some code to make the levelplot take up the entire panel instead of having nasty white borders around the edges. Much better!
I'm sure this is a very simple problem, but somehow I can not find the answer. So in 2D if I want to display predictions on top actual values I do something like this:
plot(x, y, type = “l”, col = “green")
lines(x`, y`, type = “l”, col = "blue")
but I can not figure out how to do this in 3d (I’m using scatterplot3d)
I manage to display actual values
s3d<-scatterplot3d(x, y, z, color = “blue”, type = “l”, …)
s3d.coords <- s3d$xyz.convert(x,y,z)
D3_coord=cbind(s3d.coords$x,s3d.coords$y)
but how do I draw a graph for predicted values on top of that?
Thank you in advance.
I'm not sure if this is what you are going for, but here is one option (notice the differing data structure as input to scatterplot3d - a vector rather than a matrix for z):
library(scatterplot3d)
n <- 10
x <- seq(-10,10,,n)
y <- seq(-10,10,,n)
grd <- expand.grid(x=x,y=y)
z <- matrix(2*grd$x^3 + 3*grd$y^2, length(x), length(y))
image(x, y, z, col=rainbow(100))
plot(x, y, type = "l", col = "green")
X <- grd$x
Y <- grd$y
Z <- 2*X^3 + 3*Y^2
s3d <- scatterplot3d(X, Y, Z, color = "blue", pch=20)
s3d.coords <- s3d$xyz.convert(X, Y, Z)
D3_coord=cbind(s3d.coords$x,s3d.coords$y)
lines(D3_coord, t="l", col=rgb(0,0,0,0.2))
I am trying to visualize a curve for pollination distribution. I am very new to R so please don't be upset by my stupidity.
llim <- 0
ulim <- 6.29
f <- function(x,y) {(.156812/((2*pi)*(.000005^2)*(gamma(2/.156812)))*exp(-((sqrt(x^2+y^2))/.000005)^.156812))}
integrate(function(y) {
sapply(y, function(y) {
integrate(function(x) f(x,y), llim, ulim)$value
})
}, llim, ulim)
fv <- Vectorize(f)
curve(fv, from=0, to=1000)
And I get:
Error in y^2 : 'y' is missing
I'm not quite sure what you're asking to plot. But I know you want to visualise your scalar function of two arguments.
Here are some approaches. First we define your function.
llim <- 0
ulim <- 6.29
f <- function(x,y) {
(.156812/((2*pi)*(.000005^2)*(gamma(2/.156812)))*exp(-((sqrt(x^2+y^2))/.000005)^.156812))
}
From your title I thought of the following. The function defined below intf integrates your function over the square [0,ul] x [0,ul] and return the value. We then vectorise and plot the integral over the square as a function the length of the side of the square.
intf <- function(ul) {
integrate(function(y) {
sapply(y, function(y) {
integrate(function(x) f(x,y), 0, ul)$value
})
}, 0, ul)$value
}
fv <- Vectorize(intf)
curve(fv, from=0, to=1000)
If f is a distribution, I guess you can make your (somewhat) nice probability interpretation of this curve. (I.e. ~20 % probability of pollination(?) in the 200 by 200 meter square.)
However, you can also do a contour plot (of the log-transformed values) which illustrate the function we are integrating above:
logf <- function(x, y) log(f(x, y))
x <- y <- seq(llim, ulim, length.out = 100)
contour(x, y, outer(x, y, logf), lwd = 2, drawlabels = FALSE)
You can also plot some profiles of the surface:
plot(1, xlim = c(llim, ulim), ylim = c(0, 0.005), xlab = "x", ylab = "f")
y <- seq(llim, ulim, length.out = 6)
for (i in seq_along(y)) {
tmp <- function(x) f(x, y = y[i])
curve(tmp, llim, ulim, add = TRUE, col = i)
}
legend("topright", lty = 1, col = seq_along(y),
legend = as.expression(paste("y = ",y)))
They need to be modified a bit to make them publication worthy, but you get the idea. Lastly, you can do some 3d plots as others have suggested.
EDIT
As per your comments, you can also do something like this:
# Define the function times radius (this time with general a and b)
# The default of a and b is as before
g <- function(z, a = 5e-6, b = .156812) {
z * (b/(2*pi*a^2*gamma(2/b)))*exp(-(z/a)^b)
}
# A function that integrates g from 0 to Z and rotates
# As g is not dependent on the angle we just multiply by 2pi
intg <- function(Z, ...) {
2*pi*integrate(g, 0, Z, ...)$value
}
# Vectorize the Z argument of intg
gv <- Vectorize(intg, "Z")
# Plot
Z <- seq(0, 1000, length.out = 100)
plot(Z, gv(Z), type = "l", lwd = 2)
lines(Z, gv(Z, a = 5e-5), col = "blue", lwd = 2)
lines(Z, gv(Z, b = .150), col = "red", lwd = 2)
lines(Z, gv(Z, a = 1e-4, b = .2), col = "orange", lwd = 2)
You can then plot the curves for the a and b you want. If either is not specified, the default is used.
Disclaimer: my calculus is rusty and I just did off this top of my head. You should verify that I've done the rotation of the function around the axis properly.
The lattice package has several functions that can help you draw 3 dimensional plots, including wireframe() and persp(). If you prefer not to use a 3d-plot, you can create a contour plot using contour().
Note: I don't know if this is intentional, but your data produces a very large spike in one corner of the plot. This produces a plot that is for all intents flat, with a barely noticable spike in one corner. This is particularly problematic with the contour plot below.
library(lattice)
x <- seq(0, 1000, length.out = 50)
y <- seq(0, 1000, length.out = 50)
First the wire frame plot:
df <- expand.grid(x=x, y=y)
df$z <- with(df, f(x, y))
wireframe(z ~ x * y, data = df)
Next the perspective plot:
dm <- outer(x, y, FUN=f)
persp(x, y, dm)
The contour plot:
contour(x, y, dm)
I would like to create a waterfall plot in R (XYYY) from my data.
So far, I use this code:
load("myData.RData")
ls()
dim(data)
##matrix to xyz coords
library(reshape2)
newData <- melt(data, id="Group.1")
dim(newData)
head(newData)
tail(newData)
newDataO <- newData[c(2,1,3)]
head(newDataO)
##color scale for z axis
myColorRamp <- function(colors, values) {
v <- (values - min(values))/diff(range(values))
x <- colorRamp(colors)(v)
rgb(x[,1], x[,2], x[,3], maxColorValue = 255)
}
cols <- myColorRamp(c("darkblue","yellow","darkorange","red","darkred"),newDataO$value)
##3D scatter
library(rgl)
plot3d(newDataO$variable, newDataO$Group.1, newDataO$value, xlab="", ylab="", zlab="", type="p", col=cols, box=FALSE, axes=FALSE)
rgl.postscript("persptrial_060514.eps","eps")
to get this plot:
https://dl.dropboxusercontent.com/u/14906265/persptrial_060514.jpg
I have also use this option in 2d with polygon but the result does not properly show the differential effect between both plots (left vs right).
I do not know whether something like persp3d could do the job but I am not familiar enough with writing code to achieve it. Any help will be very much appreciated.
It seems to me that the simplest way of doing a waterfall plot in R is to add all the lines manually in a loop.
library(rgl)
# Function to plot
f <- function(x, y) sin(10 * x * y) * cos(4 * y^3) + x
nx <- 30
ny <- 100
x <- seq(0, 1, length = nx)
y <- seq(0, 1, length = ny)
z <- outer(x, y, FUN = f)
# Plot function and add lines manually
surface3d(x, y, z, alpha = 0.4)
axes3d()
for (i in 1:nx) lines3d(x[i], y, z[i, ], col = 'white', lwd = 2)