Plot multiple 3D images in a single plot window with plot3d - r

When I plot several 3D images using plot3d from the rgl package, the images are displayed separately. I want to show them in one plot, as when using, e.g., par(mfrow=c(2, 2)) to display four 2D images in a single plot window.
Is this possible?

The command layout3d might be useful. Maybe this code can help:
shapes <- list(Tetrahedron = tetrahedron3d(), Cube = cube3d(), Octahedron = octahedron3d(),
Icosahedron = icosahedron3d(), Dodecahedron = dodecahedron3d(),
Cuboctahedron = cuboctahedron3d())
col <- rainbow(6)
open3d()
mat <- matrix(1:4, 2, 2)
mat <- rbind(mat, mat + 4, mat + 8)
layout3d(mat, height = rep(c(3, 1), 3), sharedMouse = TRUE)
for (i in 1:6) {
next3d()
plot3d(shapes[[i]], col = col[i])
next3d()
text3d(0, 0, 0, names(shapes)[i])
}
To deactivate the rotation of all the solids together, it is enough to put sharedMouse = FALSE.

Related

Drawing a series of circles in R

I made this image in powerpoint to illustrate what I am trying to do:
I am trying to make a series of circles (each of which are the same size) that "move" along the x-axis in consistent intervals; for instance, the center of each consecutive circle would be 2 points away from the previous circle.
I have tried several things, including the DrawCircle function from the DescTools package, but cant produce this. For example, here I am trying to draw 20 circles, where the center of each circle is 2 points away from the previous, and each circle has a radius of 2 (which doesnt work)
library(DescTools)
plotdat <- data.frame(xcords = seq(1,50, by = 2.5), ycords = rep(4,20))
Canvas()
DrawCircle(x=plotdat$xcords, y=plotdat$ycords, radius = 2)
How can this be done in R?
This is basically #Peter's answer but with modifications. Your approach was fine but there is no radius= argument in DrawCircle. See the manual page ?DrawCircle for the arguments:
dev.new(width=12, height=4)
Canvas(xlim = c(0,50), ylim=c(2, 6), asp=1, xpd=TRUE)
DrawCircle(x=plotdat$xcords, y=plotdat$ycords, r.out = 2)
But your example has axes:
plot(NA, xlim = c(0,50), ylim=c(2, 6), xlab="", ylab="", yaxt="n", asp=1, xpd=TRUE)
DrawCircle(x=plotdat$xcords, y=plotdat$ycords, r.out = 2)
My solution requires the creation of some auxiliary functions
library(tidyverse)
##First function: create circle with a predefined radius, and a x-shift and y-shift
create_circle <- function(radius,x_shift, y_shift){
p <- tibble(
x = radius*cos(seq(0,2*pi, length.out = 1000)) + x_shift ,
y = radius*sin(seq(0,2*pi, length.out = 1000))+ y_shift
)
return(p)
}
##Use lapply to create circles with multiple x shifts:
##Group is only necessary for plotting
l <- lapply(seq(0,40, by = 2), function(i){
create_circle(2,i,0) %>%
mutate(group = i)
})
##Bind rows and plot
bind_rows(l) %>%
ggplot(aes(x = x, y = y, group =group)) +
geom_path()
Does this do the trick?
library(DescTools)
plotdat <- data.frame(xcords = seq(1, 5, length.out = 20), ycords = rep(4,20))
Canvas(xlim = c(0, 5), xpd=TRUE)
DrawCircle(x=plotdat$xcords, y=plotdat$ycords, r.out = 2)
I've assumed when you say circle centres are 2 points apart you mean 0.2 units apart.
You may have to experiment with the values to get what you need.

R: drawing multiple things over one another

I have a data table and I want to do the following:
1) use xyplot to plot the data
2) use rasterimage to 'mark' certain regions in this plot as 'good' (green) or 'bad' (red)
This is what I got so far:
library(lattice)
dataFrame = data.frame(
Z1 = c(0, 1, 2, 3, 4),
Z2 = c(0, 1, 2, 3, 4))
dataFrameResult = data.frame(
install=c(TRUE, TRUE, FALSE))
imageMatrix = matrix(
c(rgb(255, 0, 0, alpha=100, maxColorValue = 255 ),rgb(0, 255, 0, alpha=100, maxColorValue = 255 ),
rgb(255, 0, 0, alpha=100, maxColorValue = 255 ),rgb(0, 0, 255, alpha=100, maxColorValue = 255 )),
nrow = 2, ncol = 2, byrow = TRUE,)
image <- as.raster(imageMatrix)
fig = xyplot(Z1 ~ Z2, group = dataFrameResult$install, data=dataFrame)
plot.new()
print(fig, pos=c(0,0,1,1), more = TRUE)
par(new=TRUE)
plot(c(0, 3), c(0, 3), type = "n", xlab = "", ylab = "")
rasterImage(image, 0, 0, 1, 1, interpolate = FALSE)
This produces the following:
In principal it looks fine but the positioning of the rasterImage function and the positioning of the xyplot do not match up... So, instead of guessing and pushing them around (does this procedure depend on the scales, etc.?) I thought that it can't be that hard to draw an image into a plot... right?
So anybody knows how to achieve the image below with (0,0) being (0,0) in and (1,1) being (1,1) in both scales? Or, even better, is there a way to draw an xyplot and tell R to paint the background in a user specified function like so...
getColor = function(x,y) {
return(rgb(x, y, 0, 0, ...))
}
plot (backgroundColorFunction=getColor)
Cheers,
FW
an easier way is to use the normal plot function, and use the functions like rect() after your plot to mark the regions and points() to plot the data,
for example :
> plot(c(1, 5), c(0, 4), type= "n", xlab = "", ylab ="")
> rect( 2 ,3 , 3 , 4 , col ="green" , border="red" )
> points(c(1:5),c(0:4),col="blue")
> rect(1.8,2.8,2.3,3.4,col="white",border = "white")
that results :
you can customize your plot by changing the parameters and using your data inside this function. other functions to use after plot are :
plot.default, plot.window, points, lines, abline, axis, title, text, mtext, segments, symbols, arrows, polygon, rect, box, contour, filled.contour and image.
try search them in R help, easy to use :)
I've to mention that you can use this function for many times for one plot for example if you want to plot 2 rects just write two rect() function

create gradient filled arrow in base R

I am looking for a way to add an arrow to a plot in base R, such that the arrow will be filled with a grey-gradient color, like this:
I have seen this solution, but that seems quite complex and not that flexible: I need to draw a great mahy arrows, in a great many plots, all potentially with different length and width.
I am aware of the shape package, but that seems to only be able to fill arrowheads, and does not provide a fillable "base" of the arrow.
Any suggestions?
Here is one way to get you started, along the lines of #MrFlick's suggestion. You probably want to encapsulate this inside a function that will allow you to exert more influence over the size of the arrowhead, the width of the base and arrow head, the smoothness of the gradient, etc.
#empty box
plot(c(-1, 2), c(-1, 10), ,type="n",axes=FALSE, xlab = "", ylab = "")
# plot the arrow, without a fill
polygon(c(0,0,-.25,.5,1.25,1,1,0), y = c(0,6,6, 8,6,6,0,0), border = NA)
# create gradient colors
nslices = 100
cols <- colorRampPalette(colors = c("white", "black"))(nslices)
# split the base of the arrow in nslices and fill each progressively
ys <- seq(0,6, len = nslices + 1)
for (i in 1:nslices) {
polygon(c(0,0,1,1), c(ys[i], ys[i+1], ys[i+1], ys[i]), col = cols[i], border = NA)
}
# add a filled arrowhead
polygon(c(-.25, .5, 1.25, -.25), c(6, 8, 6, 6), col = "black")
This would get you an arrow like this:
HTH, Peter
using the arrow defined in the linked question, now in base graphics
# create a black arrow, saved as external file
library(grid)
png("mask.png")
grid.polygon(c(-0.06, 0.06, 0.06, 0.15, 0, -0.15, -0.06),
c(-5, -5, 2.5, 2, 5, 2, 2.5), gp=gpar(fill="black"),
def="native",
vp=viewport(xs=c(-0.15, 0.15), ys=c(-5, 5)))
dev.off()
## read back in as colour matrix
library(png)
m <- readPNG("mask.png", native=FALSE)
mask <- matrix(rgb(m[,,1],m[,,2],m[,,3]),
nrow=nrow(m))
rmat <- matrix(grey(seq(0,1,length=nrow(m))),
nrow=nrow(m), ncol=ncol(m))
rmat[mask == "#FFFFFF"] <- NA
## use in base plot
set.seed(12321)
plot(1:10, rnorm(10))
rasterImage(rmat, 2, -1, 2.5, 0)
Edit:
you don't have to use a temporary file to create the mask, it's just (much more) convenient than fiddling with logical matrices. Here's a starting point to create the arrow directly as a matrix,
marrow <- function(nr=500, nc=300, col = grey(seq(0, 1, length=nr))){
skin <- matrix(col, nrow=nr, ncol=nc)
head <- lower.tri(matrix(TRUE, nrow=nc/2, ncol=nc/2))
skull <- cbind(head[seq(nc/2,1),], head[seq(nc/2,1),seq(nc/2,1)])
rib <- matrix(TRUE, nrow=nr-nrow(skull), ncol=nc/4)
trunk <- cbind(rib, !rib, !rib, rib)
skeleton <- rbind(skull, trunk)
skin[skeleton] <- NA_character_
skin
}
grid.newpage()
grid.raster(marrow(),
width = unit(1,"npc"),
height=unit(1,"npc"))

Side-by-side Venn diagram using Vennerable

I am trying to put two Venn diagrams in one single graph, i.e. I am using par(mfrow=c(1,2)) at the very beginning. However, when I use the Venn() function in the Vennerable package:
VennCompare = Venn(SetNames = c("A", "B", "C"), Weight = c(0, 38, 1, 0, 1, 80, 0, 14))
pdf(file="Venn.pdf", width=12, height=6)
par(mfrow=c(1,2))
plot(VennCompare, doWeights=FALSE)
plot(VennCompare, doWeights=TRUE, show = list(SetLabels = TRUE, Faces = FALSE))
dev.off()
The resultant pdf file contains 2 pages, and each page has a single Venn diagram.
How can I put the two diagrams into a single page (i.e. side-by-side)?
As already discussed in comments, Vennerable uses grid graphics and fixes the grid parameters inside of the package functions. You should probably ask kindly from package maintainers if they could add this kind of functionality in their packages, but in a meantime I offer you a Sketchof a hack which allows you to do what you want:
The first command allows you to edit the function called makevp.eqsc which seems to contain the grid definitions:
trace("makevp.eqsc",edit=TRUE)
Original code looks like this:
function (xrange, yrange)
{
pushViewport(plotViewport(name = "Vennmar", c(1, 1, 1, 1)))
pushViewport(viewport(name = "Vennlay", layout = grid.layout(1,
1, widths = diff(xrange), heights = diff(yrange), respect = TRUE)))
pushViewport(viewport(name = "Vennvp", layout.pos.row = 1,
layout.pos.col = 1, xscale = xrange, yscale = yrange))
}
The most relevant parts are grid.layout, which tells you what kind of grid you want to draw. Also layout.pos.row and layout.pos.col are important, they tell in which position to draw. Change the code for example like this:
function (xrange, yrange)
{
pushViewport(plotViewport(name = "Vennmar", c(1, 1, 1, 1)))
pushViewport(viewport(name = "Vennlay", layout = grid.layout(2,
1, widths = diff(xrange), heights = diff(yrange), respect = TRUE)))
pushViewport(viewport(name = "Vennvp", layout.pos.row = number,
layout.pos.col = 1, xscale = xrange, yscale = yrange))
}
Now you will get two stacked graphs, like this:
number<-1 #change the argument inside of makevp.eqsc
plot(VennCompare, doWeights=FALSE)
number<-2
plot(VennCompare, doWeights=TRUE,
show = list(SetLabels = TRUE, Faces = FALSE),add=TRUE) #note add=TRUE
This doesn't look really nice, but by modifying makevp.eqsc you can probably archieve more nice results.
I couldn't install that package, but a trick that might help here is to use grid.grab to capture the drawing into a grob that can be placed elsewhere,
library(grid)
myplot <- function(){
pushViewport(viewport(x=0.5,width=1, just=0.5))
grid.rect(gp=gpar(fill=grey(runif(1, 0.2, 0.8))))
grid.points()
popViewport()
}
p1 <- grid.grabExpr(myplot())
p2 <- grid.grabExpr(myplot())
library(gridExtra)
grid.arrange(p1, p2, ncol=2)
Try this:
v <- Venn(n=2)
plot(v)
grid.text("Title", vp = viewport(x=0.5, y=.9, w=unit(1, "npc"), h=unit(1, "npc")))

R legend for color density scatterplot produced using smoothScatter

I am producing a color density scatterplot in R using the smoothScatter() function.
Example:
## A largish data set
n <- 10000
x1 <- matrix(rnorm(n), ncol = 2)
x2 <- matrix(rnorm(n, mean = 3, sd = 1.5), ncol = 2)
x <- rbind(x1, x2)
oldpar <- par(mfrow = c(2, 2))
smoothScatter(x, nrpoints = 0)
Output:
The issue I am having is that I am unsure how to add a legend/color scale that describes the relative difference in numeric terms between different shades. For example, there is no way to tell whether the darkest blue in the figure above is 2 times, 10 times or 100 times as dense as the lightest blue without some sort of legend or color scale. Is there any way in R to retrieve the requisite information to make such a scale, or anything built in that can produce a color scale of this nature automatically?
Here is an answer that relies on fields::imageplot and some fiddling with par(mar) to get the margins correct
fudgeit <- function(){
xm <- get('xm', envir = parent.frame(1))
ym <- get('ym', envir = parent.frame(1))
z <- get('dens', envir = parent.frame(1))
colramp <- get('colramp', parent.frame(1))
fields::image.plot(xm,ym,z, col = colramp(256), legend.only = T, add =F)
}
par(mar = c(5,4,4,5) + .1)
smoothScatter(x, nrpoints = 0, postPlotHook = fudgeit)
You can fiddle around with image.plot to get what you want and look at ?bkde2D and the transformation argument to smoothScatter to get an idea of what the colours represent.

Resources