There's a nice answer around to plot a miniature plot within a plot. I wrapped it in a function which works fine for a single plot.
myPlot <- function(x, y) {
# main plot
plot(x)
# calculate position of inset
pp <- par("plt")
x0 <- pp[2] - (pp[2] - pp[1]) * 0.225
x1 <- pp[2] - .01
y0 <- pp[4] - (pp[4] - pp[3]) * 0.225
y1 <- pp[4] - .01
# set position for inset
op <- par(fig=c(x0, x1, y0, y1), mar=c(0, 0, 0, 0), new=TRUE)
# add inset grey background
plot.new()
u <- par("usr")
rect(u[1], u[2], u[4], u[3], col="grey80")
# add inset
par(new=TRUE)
plot(y, col=2)
par(op)
}
myPlot(x, y)
However, when I useMap to loop over several data lists, in order to make multiple plots of this type side by side, there seems to be a mess with the pars. The miniature appears as a new plot and not within the main plot. Also a new device is opened after one iteration (i.e. old plot gets overwritten).
op1 <- par(mfrow=c(1, 2))
Map(function(x, y) myPlot(x, y), list(d0, d0), list(d0_inset, d0_inset))
par(op1)
When I use Map(function(x, y) myPlot(x, y), list(d0, d0), list(d0_inset, d0_inset)) alone, though, there are two perfect plots in the plot queue (of RStudio). Thus the plot.new() and par(new=TRUE) might not be the issue here.
What I actually want is this:
myPlot() should throw a number of main plots with miniatures inside corresponding to the length of the data lists when using Map and fit it into the par(mfrow=...).
Does anyone have a clue how to solve this using base R functionalities?
Data:
x <- data.frame(x = rnorm(150, sd=5), y = rnorm(150, sd=5))
y <- data.frame(x = rnorm(1500, sd=5), y = rnorm(1500, sd=5))
There's a couple of points here Jay. The first is that if you want to continue to use mfrow then it's best to stay away from using par(fig = x) to control your plot locations, since fig changes depending on mfrow and also forces a new plot (though you can override that, as per your question). You can use plt instead, which makes all co-ordinates relative to the space within the fig co-ordinates.
The second point is that you can plot the rectangle without calling plot.new()
The third, and maybe most important, is that you only need to write to par twice: once to change plt to the new plotting co-ordinates (including a new = TRUE to plot it in the same window) and once to reset plt (since new will reset itself). This means the function is well behaved and leaves the par as they were.
Note I have added a parameter, at, that allows you to specify the position and size of the little plot within the larger plot. It uses normalized co-ordinates, so for example c(0, 0.5, 0, 0.5) would be the bottom left quarter of the plotting area. I have set it to default at somewhere near your version's location.
myPlot <- function(x, y, at = c(0.7, 0.95, 0.7, 0.95))
{
# Helper function to simplify co-ordinate conversions
space_convert <- function(vec1, vec2)
{
vec1[1:2] <- vec1[1:2] * diff(vec2)[1] + vec2[1]
vec1[3:4] <- vec1[3:4] * diff(vec2)[3] + vec2[3]
vec1
}
# Main plot
plot(x)
# Gray rectangle
u <- space_convert(at, par("usr"))
rect(u[1], u[3], u[2], u[4], col="grey80")
# Only write to par once for drawing insert plot: change back afterwards
plt <- par("plt")
plt_space <- space_convert(at, plt)
par(plt = plt_space, new = TRUE)
plot(y, col = 2)
par(plt = plt)
}
So we can test it with:
x <- data.frame(x = rnorm(150, sd = 5), y = rnorm(150, sd = 5))
y <- data.frame(x = rnorm(1500, sd = 5), y = rnorm(1500, sd = 5))
myPlot(x, y)
par(mfrow = c(1, 2))
myPlot(x, y)
myPlot(x, y)
par(mfrow = c(2, 2))
for(i in 1:4) myPlot(x, y)
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")
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
How to fill area under and above (sp)line with gradient color?
This example has been drawn in Inkscape - BUT I NEED vertical gradient - NOT horizontal.
Interval from zero to positive == from white to red.
Interval from zero to negative == from white to red.
Is there any package which could do this?
I fabricated some source data....
set.seed(1)
x<-seq(from = -10, to = 10, by = 0.25)
data <- data.frame(value = sample(x, 25, replace = TRUE), time = 1:25)
plot(data$time, data$value, type = "n")
my.spline <- smooth.spline(data$time, data$value, df = 15)
lines(my.spline$x, my.spline$y, lwd = 2.5, col = "blue")
abline(h = 0)
And here's an approach in base R, where we fill the entire plot area with rectangles of graduated colour, and subsequently fill the inverse of the area of interest with white.
shade <- function(x, y, col, n=500, xlab='x', ylab='y', ...) {
# x, y: the x and y coordinates
# col: a vector of colours (hex, numeric, character), or a colorRampPalette
# n: the vertical resolution of the gradient
# ...: further args to plot()
plot(x, y, type='n', las=1, xlab=xlab, ylab=ylab, ...)
e <- par('usr')
height <- diff(e[3:4])/(n-1)
y_up <- seq(0, e[4], height)
y_down <- seq(0, e[3], -height)
ncolor <- max(length(y_up), length(y_down))
pal <- if(!is.function(col)) colorRampPalette(col)(ncolor) else col(ncolor)
# plot rectangles to simulate colour gradient
sapply(seq_len(n),
function(i) {
rect(min(x), y_up[i], max(x), y_up[i] + height, col=pal[i], border=NA)
rect(min(x), y_down[i], max(x), y_down[i] - height, col=pal[i], border=NA)
})
# plot white polygons representing the inverse of the area of interest
polygon(c(min(x), x, max(x), rev(x)),
c(e[4], ifelse(y > 0, y, 0),
rep(e[4], length(y) + 1)), col='white', border=NA)
polygon(c(min(x), x, max(x), rev(x)),
c(e[3], ifelse(y < 0, y, 0),
rep(e[3], length(y) + 1)), col='white', border=NA)
lines(x, y)
abline(h=0)
box()
}
Here are some examples:
xy <- curve(sin, -10, 10, n = 1000)
shade(xy$x, xy$y, c('white', 'blue'), 1000)
Or with colour specified by a colour ramp palette:
shade(xy$x, xy$y, heat.colors, 1000)
And applied to your data, though we first interpolate the points to a finer resolution (if we don't do this, the gradient doesn't closely follow the line where it crosses zero).
xy <- approx(my.spline$x, my.spline$y, n=1000)
shade(xy$x, xy$y, c('white', 'red'), 1000)
Here's one approach, which relies heavily on several R spatial packages.
The basic idea is to:
Plot an empty plot, the canvas onto which subsequent elements will be laid down. (Doing this first also lets you retrieve the user coordinates of the plot, needed in subsequent steps.)
Use a vectorized call to rect() to lay down a background wash of color. Getting the fiddly details of the color gradient is actually the trickiest part of doing this.
Use topology functions in rgeos to find first the closed rectangles in your figure, and then their complement. Plotting the complement with a white fill over the background wash covers up the color everywhere except within the polygons, just what you want.
Finally, use plot(..., add=TRUE), lines(), abline(), etc. to lay down whatever other details you'd like the plot to display.
library(sp)
library(rgeos)
library(raster)
library(grid)
## Extract some coordinates
x <- my.spline$x
y <- my.spline$y
hh <- 0
xy <- cbind(x,y)
## Plot an empty plot to make its coordinates available
## for next two sections
plot(data$time, data$value, type = "n", axes=FALSE, xlab="", ylab="")
## Prepare data to be used later by rect to draw the colored background
COL <- colorRampPalette(c("red", "white", "red"))(200)
xx <- par("usr")[1:2]
yy <- c(seq(min(y), hh, length.out=100), seq(hh, max(y), length.out=101))
## Prepare a mask to cover colored background (except within polygons)
## (a) Make SpatialPolygons object from plot's boundaries
EE <- as(extent(par("usr")), "SpatialPolygons")
## (b) Make SpatialPolygons object containing all closed polygons
SL1 <- SpatialLines(list(Lines(Line(xy), "A")))
SL2 <- SpatialLines(list(Lines(Line(cbind(c(0,25),c(0,0))), "B")))
polys <- gPolygonize(gNode(rbind(SL1,SL2)))
## (c) Find their difference
mask <- EE - polys
## Put everything together in a plot
plot(data$time, data$value, type = "n")
rect(xx[1], yy[-201], xx[2], yy[-1], col=COL, border=NA)
plot(mask, col="white", add=TRUE)
abline(h = hh)
plot(polys, border="red", lwd=1.5, add=TRUE)
lines(my.spline$x, my.spline$y, col = "red", lwd = 1.5)
Another possibility which uses functions from grid and gridSVG packages.
We start by generating additional data points by linear interpolation, according to methods described by #kohske here. The basic plot will then consist of two separate polygons, one for negative values and one for positive values.
After the plot has been rendered, grid.ls is used to show a list of grobs, i.e. all building block of the plot. In the list we will (among other things) find two geom_area.polygons; one representing the polygon for values <= 0, and one for values >= 0.
The fill of the polygon grobs is then manipulated using gridSVG functions: custom color gradients are created with linearGradient, and the fill of the grobs are replaced using grid.gradientFill.
The manipulation of grob gradients is nicely described in chapter 7 in the MSc thesis of Simon Potter, one of the authors of the gridSVG package.
library(grid)
library(gridSVG)
library(ggplot2)
# create a data frame of spline values
d <- data.frame(x = my.spline$x, y = my.spline$y)
# create interpolated points
d <- d[order(d$x),]
new_d <- do.call("rbind",
sapply(1:(nrow(d) -1), function(i){
f <- lm(x ~ y, d[i:(i+1), ])
if (f$qr$rank < 2) return(NULL)
r <- predict(f, newdata = data.frame(y = 0))
if(d[i, ]$x < r & r < d[i+1, ]$x)
return(data.frame(x = r, y = 0))
else return(NULL)
})
)
# combine original and interpolated data
d2 <- rbind(d, new_d)
d2
# set up basic plot
ggplot(data = d2, aes(x = x, y = y)) +
geom_area(data = subset(d2, y <= 0)) +
geom_area(data = subset(d2, y >= 0)) +
geom_line() +
geom_abline(intercept = 0, slope = 0) +
theme_bw()
# list the name of grobs and look for relevant polygons
# note that the exact numbers of the grobs may differ
grid.ls()
# GRID.gTableParent.878
# ...
# panel.3-4-3-4
# ...
# areas.gTree.834
# geom_area.polygon.832 <~~ polygon for negative values
# areas.gTree.838
# geom_area.polygon.836 <~~ polygon for positive values
# create a linear gradient for negative values, from white to red
col_neg <- linearGradient(col = c("white", "red"),
x0 = unit(1, "npc"), x1 = unit(1, "npc"),
y0 = unit(1, "npc"), y1 = unit(0, "npc"))
# replace fill of 'negative grob' with a gradient fill
grid.gradientFill("geom_area.polygon.832", col_neg, group = FALSE)
# create a linear gradient for positive values, from white to red
col_pos <- linearGradient(col = c("white", "red"),
x0 = unit(1, "npc"), x1 = unit(1, "npc"),
y0 = unit(0, "npc"), y1 = unit(1, "npc"))
# replace fill of 'positive grob' with a gradient fill
grid.gradientFill("geom_area.polygon.836", col_pos, group = FALSE)
# generate SVG output
grid.export("myplot.svg")
You could easily create different colour gradients for positive and negative polygons. E.g. if you want negative values to run from white to blue instead, replace col_pos above with:
col_pos <- linearGradient(col = c("white", "blue"),
x0 = unit(1, "npc"), x1 = unit(1, "npc"),
y0 = unit(0, "npc"), y1 = unit(1, "npc"))
This is a terrible way to trick ggplot into doing what you want. Essentially, I make a giant grid of points that are under the curve. Since there is no way of setting a gradient within a single polygon, you have to make separate polygons, hence the grid. It will be slow if you set the pixels too low.
gen.bar <- function(x, ymax, ypixel) {
if (ymax < 0) ypixel <- -abs(ypixel)
else ypixel <- abs(ypixel)
expand.grid(x=x, y=seq(0,ymax, by = ypixel))
}
# data must be in x order.
find.height <- function (x, data.x, data.y) {
base <- findInterval(x, data.x)
run <- data.x[base+1] - data.x[base]
rise <- data.y[base+1] - data.y[base]
data.y[base] + ((rise/run) * (x - data.x[base]))
}
make.grid.under.curve <- function(data.x, data.y, xpixel, ypixel) {
desired.points <- sort(unique(c(seq(min(data.x), max(data.x), xpixel), data.x)))
desired.points <- desired.points[-length(desired.points)]
heights <- find.height(desired.points, data.x, data.y)
do.call(rbind,
mapply(gen.bar, desired.points, heights,
MoreArgs = list(ypixel), SIMPLIFY=FALSE))
}
xpixel = 0.01
ypixel = 0.01
library(scales)
grid <- make.grid.under.curve(data$time, data$value, xpixel, ypixel)
ggplot(grid, aes(xmin = x, ymin = y, xmax = x+xpixel, ymax = y+ypixel,
fill=abs(y))) + geom_rect()
The colours aren't what you wanted, but it is probably too slow for serious use anyway.
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)