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 want to plot the clustering coefficient and the average shortest-
path as a function of the parameter p of the Watts-Strogatz model as following:
And this is my code:
library(igraph)
library(ggplot2)
library(reshape2)
library(pracma)
p <- #don't know how to generate this?
trans <- -1
path <- -1
for (i in p) {
ws_graph <- watts.strogatz.game(1, 1000, 4, i)
trans <-c(trans, transitivity(ws_graph, type = "undirected", vids = NULL,
weights = NULL))
path <- c(path,average.path.length(ws_graph))
}
#Remove auxiliar values
trans <- trans[-1]
path <- path[-1]
#Normalize them
trans <- trans/trans[1]
path <- path/path[1]
x = data.frame(v1 = p, v2 = path, v3 = trans)
plot(p,trans, ylim = c(0,1), ylab='coeff')
par(new=T)
plot(p,path, ylim = c(0,1), ylab='coeff',pch=15)
How should I proceed to make this x-axis?
You can generate the values of p using code like the following:
p <- 10^(seq(-4,0,0.2))
You want your x values to be evenly spaced on a log10 scale. This means you need to take evenly spaced values as the exponent for the base 10, because the log10 scale takes the log10 of your x values, which is the exact opposite operation.
With this, you are already pretty far. You don't need par(new=TRUE), you can simply use the function plot followed by the function points. The latter does not redraw the whole plot. Use the argument log = 'x' to tell R you need a logarithmic x axis. This only needs to be set in the plot function, the points function and all other low-level plot functions (those who do not replace but add to the plot) respect this setting:
plot(p,trans, ylim = c(0,1), ylab='coeff', log='x')
points(p,path, ylim = c(0,1), ylab='coeff',pch=15)
EDIT: If you want to replicate the log-axis look of the above plot, you have to calculate them yourselves. Search the internet for 'R log10 minor ticks' or similar. Below is a simple function which can calcluate the appropriate position for log axis major and minor ticks
log10Tck <- function(side, type){
lim <- switch(side,
x = par('usr')[1:2],
y = par('usr')[3:4],
stop("side argument must be 'x' or 'y'"))
at <- floor(lim[1]) : ceil(lim[2])
return(switch(type,
minor = outer(1:9, 10^(min(at):max(at))),
major = 10^at,
stop("type argument must be 'major' or 'minor'")
))
}
After you have defined this function, by using the above code, you can call the function inside the axis(...) function, which draws axes. As a suggestion: save the function away in its own R script and import that script at the top of your calculation using the function source. By this means, you can reuse the function in future projects. Prior to drawing the axes, you have to prevent plot from drawing default axes, so add the parameter axes = FALSE to your plot call:
plot(p,trans, ylim = c(0,1), ylab='coeff', log='x', axes=F)
Then you may generate the axes, using the tick positions generated by the
new function:
axis(1, at=log10Tck('x','major'), tcl= 0.2) # bottom
axis(3, at=log10Tck('x','major'), tcl= 0.2, labels=NA) # top
axis(1, at=log10Tck('x','minor'), tcl= 0.1, labels=NA) # bottom
axis(3, at=log10Tck('x','minor'), tcl= 0.1, labels=NA) # top
axis(2) # normal y axis
axis(4) # normal y axis on right side of plot
box()
As a third option, as you are importing ggplot2 in your original post: The same, without all of the above, with ggplot:
# Your data needs to be in the so-called 'long format' or 'tidy format'
# that ggplot can make sense of it. Google 'Wickham tidy data' or similar
# You may also use the function 'gather' of the package 'tidyr' for this
# task, which I find more simple to use.
d2 <- reshape2::melt(x, id.vars = c('v1'), measure.vars = c('v2','v3'))
ggplot(d2) +
aes(x = v1, y = value, color = variable) +
geom_point() +
scale_x_log10()
I found many resources on how to draw Venn diagrams in R. Stack Overflow has a lot of them. However, I still can't draw my diagrams the way I want. Take the following code as an example:
library("VennDiagram")
A <- 1:4
B <- 3:6
d <- list(A, B)
vp <- venn.diagram(d, fill = c("white", "white"), alpha = 1, filename = NULL,
category.names=c("A", "B"))
grid.draw(vp)
I want the intersection between the sets to be red. However, if I change any of the white colors to red, I get the following:
vp_red <- venn.diagram(d, fill = c("red", "white"), alpha = 1, filename = NULL,
category.names=c("A", "B"))
grid.draw(vp_red)
That's not quite what I want. I want only the intersection to be red. If I change the alpha, this is what I get:
vp_alpha <- venn.diagram(d, fill = c("red", "white"), alpha = 0.5, filename = NULL,
category.names=c("A", "B"))
grid.draw(vp_alpha)
Now I have pink in my intersection. This is not what I want as well. What I want is something like this image from Wikipedia:
How can I do this? Maybe VennDiagram package can't do it and I need some other package, but I've been testing different ways to do it, and I'm not being able to find a solution.
I will show two different possibilities. In the first example, polyclip::polyclip is used to get the intersection. In the second example, circles are converted to sp::SpatialPolygons and we get the intersection using rgeos::gIntersection. Then we re-plot the circles and fill the intersecting area.
The resulting object when using venn.diagram is
"of class gList containing the grid objects that make up the diagram"
Thus, in both cases we can grab relevant data from "vp". First, check the structure and list the grobs of the object:
str(vp)
grid.ls()
# GRID.polygon.234
# GRID.polygon.235
# GRID.polygon.236 <~~ these are the empty circles
# GRID.polygon.237 <~~ $ col : chr "black"; $ fill: chr "transparent"
# GRID.text.238 <~~ labels
# GRID.text.239
# GRID.text.240
# GRID.text.241
# GRID.text.242
1. polyclip
Grab x- and y-values, and put them in the format required for polyclip:
A <- list(list(x = as.vector(vp[[3]][[1]]), y = as.vector(vp[[3]][[2]])))
B <- list(list(x = as.vector(vp[[4]][[1]]), y = as.vector(vp[[4]][[2]])))
Find intersection:
library(polyclip)
AintB <- polyclip(A, B)
Grab labels:
ix <- sapply(vp, function(x) grepl("text", x$name, fixed = TRUE))
labs <- do.call(rbind.data.frame, lapply(vp[ix], `[`, c("x", "y", "label")))
Plot it!
plot(c(0, 1), c(0, 1), type = "n", axes = FALSE, xlab = "", ylab = "")
polygon(A[[1]])
polygon(B[[1]])
polygon(AintB[[1]], col = "red")
text(x = labs$x, y = labs$y, labels = labs$label)
2. SpatialPolygons and gIntersection
Grab the coordinates of the circles:
# grab x- and y-values from first circle
x1 <- vp[[3]][["x"]]
y1 <- vp[[3]][["y"]]
# grab x- and y-values from second circle
x2 <- vp[[4]][["x"]]
y2 <- vp[[4]][["y"]]
Convert points to SpatialPolygons and find their intersection:
library(sp)
library(rgeos)
p1 <- SpatialPolygons(list(Polygons(list(Polygon(cbind(x1, y1))), ID = 1)))
p2 <- SpatialPolygons(list(Polygons(list(Polygon(cbind(x2, y2))), ID = 2)))
ip <- gIntersection(p1, p2)
Plot it!
# plot circles
plot(p1, xlim = range(c(x1, x2)), ylim = range(c(y1, y2)))
plot(p2, add = TRUE)
# plot intersection
plot(ip, add = TRUE, col = "red")
# add labels (see above)
text(x = labs$x, y = labs$y, labels = labs$label)
I'm quite sure you could work directly on the grobs using clipping functions in grid or gridSVG package.
It's very easy in eulerr R package
library(eulerr)
plot(euler(c("A"=5,"B"=4,"A&B"=2)),quantities = TRUE,fills=c("white","white","red"))
euler set colours
I want to plot a matrix of z values with x rows and y columns as a surface similar to this graph from MATLAB.
Surface plot:
Code to generate matrix:
# Parameters
shape<-1.849241
scale<-38.87986
x<-seq(from = -241.440, to = 241.440, by = 0.240)# 2013 length
y<-seq(from = -241.440, to = 241.440, by = 0.240)
matrix_fun<-matrix(data = 0, nrow = length(x), ncol = length(y))
# Generate two dimensional travel distance probability density function
for (i in 1:length(x)) {
for (j in 1:length(y)){
dxy<-sqrt(x[i]^2+y[j]^2)
prob<-1/(scale^(shape)*gamma(shape))*dxy^(shape-1)*exp(-(dxy/scale))
matrix_fun[i,j]<-prob
}}
# Rescale 2-d pdf to sum to 1
a<-sum(matrix_fun)
matrix_scale<-matrix_fun/a
I am able to generate surface plots using a couple methods (persp(), persp3d(), surface3d()) but the colors aren't displaying the z values (the probabilities held within the matrix). The z values only seem to display as heights not as differentiated colors as in the MATLAB figure.
Example of graph code and graphs:
library(rgl)
persp3d(x=x, y=y, z=matrix_scale, color=rainbow(25, start=min(matrix_scale), end=max(matrix_scale)))
surface3d(x=x, y=y, z=matrix_scale, color=rainbow(25, start=min(matrix_scale), end=max(matrix_scale)))
persp(x=x, y=y, z=matrix_scale, theta=30, phi=30, col=rainbow(25, start=min(matrix_scale), end=max(matrix_scale)), border=NA)
Image of the last graph
Any other tips to recreate the image in R would be most appreciated (i.e. legend bar, axis tick marks, etc.)
So here's a ggplot solution which seems to come a little bit closer to the MATLAB plot
# Parameters
shape<-1.849241
scale<-38.87986
x<-seq(from = -241.440, to = 241.440, by = 2.40)
y<-seq(from = -241.440, to = 241.440, by = 2.40)
df <- expand.grid(x=x,y=y)
df$dxy <- with(df,sqrt(x^2+y^2))
df$prob <- dgamma(df$dxy,shape=shape,scale=scale)
df$prob <- df$prob/sum(df$prob)
library(ggplot2)
library(colorRamps) # for matlab.like(...)
library(scales) # for labels=scientific
ggplot(df, aes(x,y))+
geom_tile(aes(fill=prob))+
scale_fill_gradientn(colours=matlab.like(10), labels=scientific)
BTW: You can generate your data frame of probabilities much more efficiently using the built-in dgamma(...) function, rather than calculating it yourself.
In line with alexis_laz's comment, here is an example using filled.contour. You might want to increase your by to 2.40 since the finer granularity increases the time it takes to generate the plot by a lot but doesn't improve quality.
filled.contour(x = x, y = y, z = matrix_scale, color = terrain.colors)
# terrain.colors is in the base grDevices package
If you want something closer to your color scheme above, you can fiddle with the rainbow function:
filled.contour(x = x, y = y, z = matrix_scale,
color = (function(n, ...) rep(rev(rainbow(n/2, ...)[1:9]), each = 3)))
Finer granularity:
filled.contour(x = x, y = y, z = matrix_scale, nlevels = 150,
color = (function(n, ...)
rev(rep(rainbow(50, start = 0, end = 0.75, ...), each = 3))[5:150]))
Is there a way to ensure that the box around a plot matches the raster extents exactly? In the following there is a gap above and below or to the left and right of the raster depending on the device proportions:
require(raster)
r = raster()
r[]= 1
plot(r, xlim=c(xmin(r), xmax(r)), ylim=c(ymin(r), ymax(r)))
One element of the problem with raster objects is that asp=1 to ensure proper display. The following basic scatterplot has the same issue when asp=1:
plot(c(1:10), c(1:10), asp=1)
Try vectorplot(r) from the rasterVis package to see what I want the axes to look like.
EDIT:
Solutions need to play nice with SpatialPoints overlays, not showing points outside the specified raster limits:
require(raster)
require(maptools)
# Raster
r = raster()
r[]= 1
# Spatial points
x = c(-100, 0, 100)
y = c(100, 0, 100)
points = SpatialPoints(data.frame(x,y))
plot(r, xlim=c(xmin(r), xmax(r)), ylim=c(ymin(r), ymax(r)))
plot(points, add=T)
You'd probably do best to go with one of the lattice-based functions for plotting spatial raster objects provided by the raster and rasterVis packages. You discovered one of them in vectorplot(), but spplot() or levelplot() better match your needs in this case.
(The base graphics-based plot() method for "RasterLayer" objects just doesn't allow any easy way for you to set axes with the appropriate aspect ratio. For anyone interested, I go into more detail about why that's so in a section at the bottom of the post.)
As an example of the kind of plot that levelplot() produces:
require(raster)
require(rasterVis)
## Create a raster and a SpatialPoints object.
r <- raster()
r[] <- 1:ncell(r)
SP <- spsample(Spatial(bbox=bbox(r)), 10, type="random")
## Then plot them
levelplot(r, col.regions = rev(terrain.colors(255)), cuts=254, margin=FALSE) +
layer(sp.points(SP, col = "red"))
## Or use this, which produces the same plot.
# spplot(r, scales = list(draw=TRUE),
# col.regions = rev(terrain.colors(255)), cuts=254) +
# layer(sp.points(SP, col = "red"))
Either of these methods may still plot some portion of the symbol representing points that fall just outside of the plotted raster. If you want to avoid that possibility, you can just subset your SpatialPoints object to remove any points falling outside of the raster. Here's a simple function that'll do that for you:
## A function to test whether points fall within a raster's extent
inExtent <- function(SP_obj, r_obj) {
crds <- SP_obj#coord
ext <- extent(r_obj)
crds[,1] >= ext#xmin & crds[,1] <= ext#xmax &
crds[,2] >= ext#ymin & crds[,2] <= ext#ymax
}
## Remove any points in SP that don't fall within the extent of the raster 'r'
SP <- SP[inExtent(SP, r), ]
Additional weedy detail about why it's hard to make plot(r) produce snugly fitting axes
When plot is called on an object of type raster, the raster data is (ultimately) plotted using either rasterImage() or image(). Which path is followed depends on: (a) the type of device being plotted to; and (b) the value of the useRaster argument in the original plot() call.
In either case, the plotting region is set up in a way which produces axes that fill the plotting region, rather than in a way that gives them the appropriate aspect ratio.
Below, I show the chain of functions that's called on the way to this step, as well as the call that ultimately sets up the plotting region. In both cases, there appears to be no simple way to alter both the extent and the aspect ratio of the axes that are plotted.
useRaster=TRUE
## Chain of functions dispatched by `plot(r, useRaster=TRUE)`
getMethod("plot", c("RasterLayer", "missing"))
raster:::.plotraster2
raster:::.rasterImagePlot
## Call within .rasterImagePlot() that sets up the plotting region
plot(NA, NA, xlim = e[1:2], ylim = e[3:4], type = "n",
, xaxs = "i", yaxs = "i", asp = asp, ...)
## Example showing why the above call produces the 'wrong' y-axis limits
plot(c(-180,180), c(-90,90),
xlim = c(-180,180), ylim = c(-90,90), pch = 16,
asp = 1,
main = "plot(r, useRaster=TRUE) -> \nincorrect y-axis limits")
useRaster=FALSE
## Chain of functions dispatched by `plot(r, useRaster=FALSE)`
getMethod("plot", c("RasterLayer", "missing"))
raster:::.plotraster2
raster:::.imageplot
image.default
## Call within image.default() that sets up the plotting region
plot(NA, NA, xlim = xlim, ylim = ylim, type = "n", xaxs = xaxs,
yaxs = yaxs, xlab = xlab, ylab = ylab, ...)
## Example showing that the above call produces the wrong aspect ratio
plot(c(-180,180), c(-90,90),
xlim = c(-180,180), ylim = c(-90,90), pch = 16,
main = "plot(r,useRaster=FALSE) -> \nincorrect aspect ratio")
Man, I got stumped and ended up just turning the foreground color off to plot. Then you can take advantage of the fact that the raster plot method calls fields:::image.plot, which lets you just plot the legend (a second time, this time showing the ink!). This is inelegant, but worked in this case:
par("fg" = NA)
plot(r, xlim = c(xmin(r), xmax(r)), ylim = c(ymin(r), ymax(r)), axes = FALSE)
par(new = TRUE,"fg" = "black")
plot(r, xlim = c(xmin(r), xmax(r)), ylim = c(ymin(r), ymax(r)), axes = FALSE, legend.only = TRUE)
axis(1, pos = -90, xpd = TRUE)
rect(-180,-90,180,90,xpd = TRUE)
ticks <- (ymin(r):ymax(r))[(ymin(r):ymax(r)) %% 20 == 0]
segments(xmin(r),ticks,xmin(r)-5,ticks, xpd = TRUE)
text(xmin(r),ticks,ticks,xpd=TRUE,pos=2)
title("sorry, this could probably be done in some more elegant way")
This is way I solved this problem
require(raster)
r = raster()
# default for raster is 180 row by 360 cols = 64800 cells
# fill with some values to make more interesting
r[]= runif(64800, 1, 1000)
# Set margin for text
par(mar=c(2, 6, 6, 2))
# Set some controls for the raster cell colours and legend
MyBrks<-c(0,1,4,16,64,256,1E20)
MyLbls<-c("<1","<4","<16","<64","<256","<Max")
MyClrs<-c("blue","cyan","yellow","pink","purple","red")
# Plot raster without axes or box or legend
# Note xlim and ylim don't seem do much unless you want to trim x and y
plot(r,
col=MyClrs,
axes=FALSE,
box=FALSE,
legend=FALSE
)
# Set up the ranges and intervals for axes - you can get the min max
# using xmin(r) and ymax(r) and so on if you like
MyXFrm <- -180
MyXTo <- 180
MyXStp <- 60
MyYFrm <- -90
MyYTo <- 90
MyYStp <- 30
# Plot the axes
axis(1,tick=TRUE,pos=ymin(r),las=1,at=seq(MyXFrm,MyXTo ,MyXStp ))
axis(2,tick=TRUE,pos=xmin(r),las=1,at=seq(MyYFrm ,MyYTo ,MyYStp ))
# Plot the legend use xpd to plot the legend outside the plot region
par(xpd=TRUE)
legend(MyXTo ,MyYTo ,
legend=MyLbls[1:6],
col= MyClrs,
fill=Clrs[1:6],
bg=rgb(0,0,0,0.85),
cex=0.9,
text.col="white",
text.font=2,
border=NA
)
# Add some axis labels and a title
text(-220,0,"Y",font=2)
text(0,-130,"X",font=2)
text(0,120,"My Raster",font=4,cex=1.5)
I think the best (or simplest) solution is to use image():
library(raster)
# Raster
r = raster()
r[]= rnorm(ncell(r))
# Spatial points
x = c(-100, 0, 100)
y = c(100, 0, 100)
points = SpatialPoints(data.frame(x,y))
# plot
image(r)
plot(points, add=T, pch=16, cex=2)