Is there a way to reproduce the following plot in R?
EDIT
This is what I could do with persp() in base R and plot_ly in plotly. Also a bit ugly.
x <- seq(0,1,0.01)
y <- seq(0,1,0.01)
f <- function(x,y){ z <- -x - y + 1 }
z <- outer(x,y,f)
z <- ifelse(z<0,NA,z)
persp(x, y, z, theta = 30, phi = 30, expand = 0.5, col = "lightblue")
plot_ly(x=x,y=y,z=z,type="surface") %>% layout(xaxis=list(range=c(0,1)), yaxis=list(range=c(0,1)), zaxis=list(range=c(0,1)))
BTW...the matplotlib plots were obtained here:
http://blog.bogatron.net/blog/2014/02/02/visualizing-dirichlet-distributions/
Using persp in base R I was able to get this far:
persp(0:1, 0:1,
matrix(c(1,0,0,NA), nrow=2),
col="green", theta=60,
xlab= "theta_1",
ylab = "theta_2",
zlab="theata_3")
But I could not figure out how to do a few things, including greek symbols on axes.
I am turning this into a wiki in case any persp experts out there want to finish the job.
This is a little ugly/still incomplete but at least shows one way to get Greek labels in.
pp <- persp(0:1, 0:1,
matrix(c(2,0,0,NA), nrow=2),
col="green", theta=60,
xlab= "",
ylab ="",
zlab="",
ticktype="detailed",
nticks=1)
text(trans3d(0.5,-0.1,-0.1,pp),labels=expression(theta[1]))
Related
So I have this code that produces the exact surface
f = function(x, y){
z = ((x^2)+(3*y^2))*exp(-(x^2)-(y^2))
}
plot3d(f, col = colorRampPalette(c("blue", "white")),
xlab = "X", ylab = "Y", zlab = "Z",
xlim = c(-3, 3), ylim = c(-3, 3),
aspect = c(1, 1, 0.5))
Giving the following plot:
Now I have some code that does a random walk metropolis algorithm to reproduce the above image. I think it works as if I do another plot of these calculated values I get the next image with 500 points. Here is the code
open3d()
plot3d(x0, y0, f(x0, y0), type = "p")
Which gives the following plot:
I know it's hard looking at this still image but being able to rotate the sampling is working.
Now here is my question: How can I use plot3d() so that I can have a surface that connects all these points and gives a more jagged representation of the exact plot? Or how can I have each point in the z axis as a bar from the xy plane? I just want something more 3 dimensional than points and I can't find how to do this.
Thanks for your help
You can do this by triangulating the surface. You don't give us your actual data, but I can create some similar data using
f = function(x, y){
z = ((x^2)+(3*y^2))*exp(-(x^2)-(y^2))
}
x <- runif(500, -3, 3)
y <- runif(500, -3, 3)
z <- f(x, y)
Then the plotting is done using the method in ?persp3d.deldir:
library(deldir)
library(rgl)
col <- colorRampPalette(c("blue", "white"))(20)[1 + round(19*(z - min(z))/diff(range(z)))]
dxyz <- deldir::deldir(x, y, z = z, suppressMsge = TRUE)
persp3d(dxyz, col = col, front = "lines", back = "lines")
This might need some cosmetic fixes, e.g.
aspect3d(2, 2, 1)
After some rotation, this gives me the following plot:
I'm not sure to understand what you want. If my understanding is correct, here is a solution. Define a parametric representation of your surface:
fx <- function(u,v) u
fy <- function(u,v) v
fz <- function(u,v){
((u^2)+(3*v^2))*exp(-(u^2)-(v^2))
}
Let's say you have these points:
x0 <- seq(-3, 3, length.out = 20)
y0 <- seq(-3, 3, length.out = 20)
Then you can use the function parametric3d of the misc3d package, with the option fill=FALSE to get a wireframe:
library(misc3d)
parametric3d(fx, fy, fz, u=x0, v=y0,
color="blue", fill = FALSE)
Is it what you want?
To get some vertical bars, use the function segments3d of rgl:
i <- 8
bar <- rbind(c(x0[i],y0[i],0),c(x0[i],y0[i],f(x0[i],y0[i])))
segments3d(bar, color="red")
Here is a plot with only 50 points using my original code.
When I then apply what was said by Stéphane Laurent I then get this plot which feels too accurate when given the actual points I have
Perhaps you need to explain to me what is actually happening in the function parametric3d
I'm trying to plot a function of two variables using the persp()function in R. This is what I have so far:
C_unab <- function(u1, u2) {
return(u1 * u2)
}
x <- seq(0, 1, by = 0.1)
y <- seq(0, 1, by = 0.1)
z_1 <- outer(x,y, C_unab)
persp(x, y, z_1, theta = -60, phi = 25 ,shade = 0.7,expand = 0.8 , ltheta = -60, ticktype = "detailed",
xlab = "u1", ylab = "u2", zlab = "Phi", col="lightblue")
This works fine. However, I would like the "1" and "2" that appear in the axis labels to be subscripted (i. e. as indices). I've looked around and found "plotmath". However that doesn't seem to work for pesp()and the documentation says:" Expressions can also be used for titles, subtitles and x- and y-axis labels (but not for axis labels on persp plots)."
I've also done a search around here but haven't found anything that works for me.
Any help would be appreciated!
You cannot use expressions with persp, ... a well documented limitation. The usual advice is to switch to lattice:
library(lattice)
png(); print( wireframe(z_1~x+y ,data=data.frame(x=x, y=rep(y, each=length(x)), z_1=z_1) ,
xlab=expression(u[1]), ylab=expression(u[2]), zlab = "Z") ); dev.off()
I am having extreme difficulty in making my axes logarithmic/have custom tick marks in plot3d using the rgl package. I've tried using the "log='xy'" command in my code just like you would in the basic plot function, and I have tried to create custom tick marks using rgl.bbox. My y axis is plotting fine but my x and z are not cooperating. I cannot get anything to work. Any ideas? Below is my data, code, and a picture of the result I'm getting. I should also add that I'm basically plotting multiple 2d scatterplots in 3d using an arbitrary z value to separate the individual 2d plots.
https://www.dropbox.com/s/wv24rmnyalm3vvc/scattertest.csv?dl=0
#!/usr/bin/env Rscript
library("rgl")
data <- read.csv("~/Desktop/scattertest.csv", header=TRUE, fill=TRUE, sep=',')
x <- names(data[2])
y <- names(data[3])
z <- names(data[4])
plot3d(data[[x]], data[[z]], data[[y]], type="s", size=0.75, lit=FALSE, axes=FALSE,
xlab="rpmn", ylab="round", zlab="rpmt", log="xz",
xmin=c(0.1, 10^6), ymin=c(1,4), zmin=c(0.1, 10^6))
rgl.bbox(color="grey50", emission="grey50",
xat = c(0.1, 1, 10, 100, 10^3, 10^4, 10^5, 10^6), yat = c(1, 2, 3, 4), zat = c(0.1, 1, 10, 100, 10^3, 10^4, 10^5, 10^6),
xlen=8, ylen=4, zlen=8)
There's no support for log="xy" in plot3d(), you'll need to do the transformation yourself.
Your code asks for logarithmic labels, but you aren't doing the logarithmic transformation, so it's not working. You need to rescale the data as well.
You didn't post a reproducible example, but it's easy to create one:
x <- rlnorm(20, 2, 6)
y <- runif(20, 1, 4)
z <- rlnorm(20, 2, 6)
xyz <- cbind(log(x), y, log(z))
plot3d(xyz, axes = FALSE)
ticks <- 10^((-1):6)
bbox3d(xat = log(ticks), xlab = ticks, yat = pretty(1:4),
zat = log(ticks), zlab = ticks,
color="grey50", emission="grey50")
I have some wind speed and direction data over a course of some time and I need to plot it into a feather plot.
After surfing the web for some time, I find a function someone wrote to plot the feather plot that works for me (Thank you if you are reading this!!). My problem now is that I don't know how to manipulate the labelling of the x-axis.
After the plotting, the figure looks like this:
Now the x-axis doesn't look too bad here, but imagine I have 200 data points (and thus ticks) instead of 10, and the axis ticks can get a bit confusing. So I was hoping someone can help me manipulate the x-axis, specifically messing with the ticks.
The code to plot the figure is:
stg <- scan(what="", sep="\n")
9/20/15_12:00 2.597058824 157.9411765
9/21/15_0:00 2.177192982 185.1754386
9/21/15_12:00 2.577391304 189.2173913
9/22/15_0:00 1.984955752 237.4336283
9/22/15_12:00 3.993859649 252.6315789
9/23/15_0:00 1.613392857 175.5357143
9/23/15_12:00 3.849166667 216.8333333
9/24/15_0:00 2.138135593 117.0338983
9/24/15_12:00 3.32605042 216.302521
9/25/15_0:00 1.490178571 239.8214286
df <- read.table(textConnection(stg), sep="")
colnames(df) <- c("Time", "wsp", "wdir")
df$PTime <- as.POSIXct(df$Time, format="%m/%d/%y_%H:%M")
feather.plot2 <- function (r, theta, xpos, yref = 0, use.arrows = TRUE, col.refline = "lightgray",
fp.type = "s", main = "", xlab = "", ylab = "", xlabels = NULL,
...)
{
if (missing(xpos))
xpos <- 1:length(theta)
if (fp.type == "m")
theta <- 5 * pi/2 - theta
x <- r * cos(theta)
y <- r * sin(theta)
xmult <- diff(range(xpos))/(diff(range(y)) * 2)
x <- x * xmult
xlim <- range(c(xpos, x + xpos))
ylim <- range(c(y, yref))
oldpin <- par("pin")
xdiff <- xlim[2] - xlim[1]
ydiff <- ylim[2] - ylim[1]
plot(0, xlim = xlim, ylim = ylim, type = "n", main = main,
xlab = xlab, ylab = ylab, axes = TRUE, xaxt = "n")
box()
if (is.null(xlabels))
axis(1)
else axis(1, at = xpos, labels = xlabels)
abline(h = yref, col = col.refline)
if (use.arrows)
arrows(xpos, yref, xpos + x, y, length = 0.1, ...)
else segments(xpos, yref, xpos + x, y, ...)
par(pin = oldpin)
}
feather.plot2(df$wsp, df$wdir, fp.type="m", xlabels=df$PTime)
And what I want is something like having big ticks for 12:00, and smaller ticks for 0:00, like in this figure:
Although I don't know why the label for this figure comes out as "Sun - Thu" instead of dates...
The code for this figure is:
daterange=c(min(df$PTime), max(df$PTime))
plot(x=df$PTime, y=df$wsp, xaxt="n", type="l")
axis.POSIXct(1, at=seq(daterange[1], daterange[2], by="day"))
axis.POSIXct(1, at=seq(daterange[1], daterange[2], by="12 hours"), tcl = -0.3, labels=FALSE )
I've tried using using these axis commands on the feather plot, but it did not work. So I'd appreciate any help/advice. Thank you so much!!
I'm seeing two requests: Major and minor ticks; and More compact axis annotation of date-times. Step 1: Suppress the default axis creation. Step 2: The usual manor is to label the major ticks, so we would determine the proper location of those ticks and give a format specification to the labels. Step 3: place the minor tick marks. Most of this you've already figured out, and I would have thought the format problem was the easiest one to solve, so let's see:
plot(x=df$PTime, y=df$wsp, xaxt="n", type="l")
axis.POSIXct(1, at=seq(daterange[1], daterange[2], by="day"), format="%m-%d %H%P",
lwd.ticks=2)
axis.POSIXct(1, at=seq(daterange[1], daterange[2], by="12 hours"),
tcl = -0.3, labels=FALSE )
Seems to succeed at what I think are your goals. The use of by = "day" may be what leads the interpreter to choose the three letter abbrev of day names. (I don't really know.)
I am trying to control how many z labels should be written in my contour plot plotted with contourplot() from the lattice library.
I have 30 contour lines but I only want the first 5 to be labelled. I tried a bunch of things like
contourplot(z ~ z+y, data=d3, cuts=30, font=3, xlab="x axis", ylab="y axis", scales=list(at=seq(2,10,by=2)))
contourplot(z ~ z+y, data=d3, cuts=30, font=3, xlab="x axis", ylab="y axis", at=seq(2,10,by=2))
but nothing works.
Also, is it possible to plot two contourplot() on the same graph? I tried
contourplot(z ~ z+y, data=d3, cuts=30)
par(new=T)
contourplot(z ~ z+y, data=d3, cuts=20)
but it's not working.
Thanks!
Here is my take:
library(lattice)
x <- rep(seq(-1.5,1.5,length=50),50)
y <- rep(seq(-1.5,1.5,length=50),rep(50,50))
z <- exp(-(x^2+y^2+x*y))
# here is default plot
lp1 <- contourplot(z~x*y)
# here is an enhanced one
my.panel <- function(at, labels, ...) {
# draw odd and even contour lines with or without labels
panel.contourplot(..., at=at[seq(1, length(at), 2)], col="blue", lty=2)
panel.contourplot(..., at=at[seq(2, length(at), 2)], col="red",
labels=as.character(at[seq(2, length(at), 2)]))
}
lp2 <- contourplot(z~x*y, panel=my.panel, at=seq(0.2, 0.8, by=0.2))
lp3 <- update(lp2, at=seq(0.2,0.8,by=0.1))
lp4 <- update(lp3, lwd=2, label.style="align")
library(gridExtra)
grid.arrange(lp1, lp2, lp3, lp4)
You can adapt the custom panel function to best suit your needs (e.g. other scale for leveling the z-axis, color, etc.).
You can specify the labels as a character vector argument and set the last values with rep("", 5), so perhaps for the example you offered on an earlier question about contour
x = seq(0, 10, by = 0.5)
y = seq(0, 10, by = 0.5)
z <- outer(x, y)
d3 <- expand.grid(x=x,y=y); d3$z <- as.vector(z)
contourplot(z~x+y, data=d3)
# labeled '5'-'90'
contourplot(z~x+y, data=d3,
at=seq(5,90, by=5),
labels=c(seq(5,25, by=5),rep("", 16) ),
main="Labels only at the first 5 contour lines")
# contourplot seems to ignore 'extra' labels
# c() will coerce the 'numeric' elements to 'character' if any others are 'character'
?contourplot # and follow the link in the info about labels to ?panel.levelplot