Related
i need to overlay multiple subplots onto a single plot which is already contained inside a multirow figure (see image)
the reason why i need subplots instead of screen layout is because the figure will be possibly multicolumn, also (a 5 by 3 plot, in total)
there are packages which assist in doing subplots, but they break when you use multirow figures, and sequential subplots, except the first one, are rendered next to the overall figure border, not relative to the current row/column plot borders
i understand large packages such as ggplot2 allow this relatively easily, but base R plots are highly preferable
UPD:
the minimum reproducible example depicting the problem is here:
require(Hmisc)
COL.1 <- c('red','orange','yellow'); COL.2 <- c('blue','green','turquoise')
SUBPLOT.FUN <- function(COL) {plot(rnorm(100), type='l', col=COL)}
PLOT.FUN <- function(i) {
plot(rnorm(100),ylim=c(-1,1))
subplot(SUBPLOT.FUN(COL.1[i]), 100,1, vadj=1,hadj=1,pars=list(mfg=c(1,i)))
subplot(SUBPLOT.FUN(COL.2[i]), 100,-1,vadj=0,hadj=1,pars=list(mfg=c(1,i)))
}
plot.new(); par(mfrow=c(1,3))
for (i in 1:3) {
PLOT.FUN(i)
}
which looks like that:
while what is required is shown on the first image (meaning, EACH of the three plots must contain 3 subplots in their respective locations (along the right border, arranged vertically))
N.B. either the figure is multirow or multicolumn (as depicted) does not matter
Something like this? Inspired in this R-bloggers post.
# reproducible test data
set.seed(2022)
x <- rnorm(1000)
y <- rbinom(1000, 1, 0.5)
z <- rbinom(1000, 4, 0.5)
# save default values and prepare
# to create custom plot areas
old_par <- par(fig = c(0,1,0,1))
# set x axis limits based on data
h <- hist(x, plot = FALSE)
xlim <- c(h$breaks[1] - 0.5, h$breaks[length(h$breaks)] + 2)
hist(x, xlim = xlim)
# x = c(0.6, 1) right part of plot
# y = c(0.5, 1) top part of plot
par(fig = c(0.6, 1, 0.5, 1), new = TRUE)
boxplot(x ~ y)
# x = c(0.6, 1) right part of plot
# y = c(0.1, 0.6) bottom part of plot
par(fig = c(0.6, 1, 0.1, 0.6), new = TRUE)
boxplot(x ~ z)
# put default values back
par(old_par)
Created on 2022-08-18 by the reprex package (v2.0.1)
I've plotted up a series of points using the rgl package in R. I've plotted them in two dimensions for simplicity, but the issue still exists in three dimensions. The code snippet and plot below show a basic line of points plotted in the xy-plane:
library(rgl)
seq <- seq(1, 10, by = 0.1)
df <- data.frame(x = seq, y = seq / 10)
clear3d("all")
bg3d(color = "white")
points3d(x = df$x, y = df$y, z = 0)
axes3d()
rgl.viewpoint(theta = 0, phi = 0)
The points plot as expected. However, if I take these same points and translate them by a significant amount, the graphics device does not seem to be able to handle the points:
library(rgl)
seq <- seq(1, 10, by = 0.1)
df <- data.frame(x = seq, y = seq / 10)
# Translate points
df <- df + 1000000
clear3d("all")
bg3d(color = "white")
points3d(x = df$x, y = df$y, z = 0)
axes3d()
rgl.viewpoint(theta = 0, phi = 0)
Is this a known limitation? Is the problem with OpenGL, or with the package? I'm working with some points and surfaces that have an associated coordinate system, so I'd prefer not to translate my data back to the origin.
#derhass had the right idea. From the rgl manual:
Note that many of these calculations are done on the graphics card using single precision; you will likely see signs of rounding error if your scene requires more than 4 or 5 digit precision to distinguish values in any coordinate.
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"))
I have a problem when trying to make MCP from many points in R.
library(shapefiles)
# no problem when only three points...
dd <- data.frame(Id=c(1,1,1,1),X=c(3,5,8,3),Y=c(9,8,3,9))
ddTable <- data.frame(Id=c(1),Name=c("Item1"))
ddShapefile <- convert.to.shapefile(dd, ddTable, "Id", 5)
write.shapefile(ddShapefile, "/directory.../pgn_test", arcgis=T)
my.pgn <- readOGR("/directory...","pgn_test")
plot(my.pgn)
points(dd$X, dd$Y, cex = 0.7, pch = 1)
Code above works perfectly when only three points are given, however in my case there are many points...
# when some points are inside the polygon
dd <- data.frame(Id=c(rep(1, times = 6)),X=c(1,2,3,5,5,1),Y=c(1,5,3,5,1,1))
ddTable <- data.frame(Id=c(1),Name=c("Item1"))
ddShapefile <- convert.to.shapefile(dd, ddTable, "Id", 5)
write.shapefile(ddShapefile, "/directory.../pgn_test", arcgis=T)
my.pgn <- readOGR("/directory...","pgn_test")
plot(my.pgn)
points(dd$X, dd$Y, cex = 0.7, pch = 1)
Can anybody know how to solve this situation?
You could just use the base R function chull(), which "computes the subset of points which lie on the convex hull of the set of points specified":
dd <- data.frame(X = c(1,2,3,5,5,1), Y = c(1,5,3,5,1,1))
ii <- with(dd, chull(X,Y))
ii <- c(ii, ii[1])
plot(Y~X, data=dd)
lines(Y~X, data=dd[ii,])
I am attempting to reproduce a Stephen Few graphic with gradient circles that demonstrates the hard wired assumption that light appears from above. Here are the circles:
How can I recreate this? Drawing the circles isn't too bad but adding gradient is where I get thrown. I am thinking grid may create something more crisp but this may be a misconception I have.
Here is the start with drawing circles:
## John Fox circle function
source("http://dl.dropboxusercontent.com/u/61803503/wordpress/circle_fun.txt")
par(mar=rep(1, 4), bg = "grey80")
plot.new()
for (i in seq(0, 1, by = .2)) {
for (j in seq(.6, 1, by = .1)) {
circle(i, j, .5, "cm", , 1)
}
}
Related question: How to use R to build bubble charts with gradient fills
EDIT:
Thought I'd share the results:
And here's the code.
With some repeated use of clip, you can get there.
# set up a blank plot
par(mar=rep(0, 4))
par(bg="#cccccc")
plot(NA,xlim=0:1,ylim=0:1)
# define a function
grad.circ <- function(centrex,centrey,radius,col,resolution) {
colfunc <- colorRampPalette(col)
shades <- colfunc(resolution)
for (i in seq_along(shades) ) {
clip(
centrex - radius,
centrex + radius,
(centrey + radius) - ((i-1) * (radius*2)/length(shades)),
(centrey + radius) - (i * (radius*2)/length(shades))
)
symbols(
centrex,
centrey,
circles=radius,
bg=shades[i],
fg=NA,
add=TRUE,
inches=FALSE
)
}
}
# call the function
grad.circ(0.5,0.5,0.5,c("black", "white"),300)
Result:
EDIT (by Tyler Rinker):
I wanted to add the rest of the code I used to replicate the image:
FUN <- function(plot = TRUE, cols = c("black", "white")) {
plot(NA, xlim=0:1, ylim=0:1, axes=FALSE)
if (plot) {
grad.circ(0.5, 0.5, 0.5, cols, 300)
}
}
FUN2 <- function(){
lapply(1:3, function(i) FUN(,c("white", "black")))
FUN(F)
lapply(1:3, function(i) FUN())
}
X11(10, 4.5)
par(mfrow=c(3, 7))
par(mar=rep(0, 4))
par(bg="gray70")
invisible(lapply(1:3, function(i) FUN2()))
Here is a version using rasters and rasterImage:
image <- as.raster( matrix( seq(0,1,length.out=1001), nrow=1001, ncol=1001) )
tmp <- ( row(image) - 501 ) ^2 + ( col(image) - 501 )^2
image[tmp > 500^2] <- NA
image2 <- as.raster( matrix( seq(1,0, length.out=1001), nrow=1001, ncol=1001) )
image2[ tmp > 500^2 ] <- NA
image3 <- row(image) + col(image)
image3 <- image3/max(image3)
image3[tmp>500^2] <- NA
image4 <- 1-image3
image3 <- as.raster(image3)
image4 <- as.raster(image4)
plot( 0:1, 0:1, type='n', asp=1,ann=FALSE,axes=FALSE)
rect(0,0,1,1, col='grey')
rasterImage(image, 0.2, 0.2, 0.3, 0.3)
rasterImage(image2, 0.6, 0.6, 0.7, 0.7)
rasterImage(image3, 0.6, 0.3, 0.7, 0.4)
rasterImage(image4, 0.3, 0.7, 0.4, 0.8)
Other directions of shading can be made by changing the math a little.
You can do this using the (not on CRAN) package zernike . It's designed to produce various images related to Zernike polynomials, heavily used in optics & astronomy systems. Your desired images are pretty much the second Zernike term.
The author is Author: M.L. Peck (mpeck1#ix.netcom.com) ; I forget exactly where the R-package resides on hte web.
And here's an approach using sp and rgeos (similar application here and here).
library(sp)
library(rgeos)
library(raster)
Create two sets of 9 circles by buffering points, then plot their union to set up the plotting area.
b <- gBuffer(SpatialPoints(cbind(rep(1:3, 3), rep(1:3, each=3))), TRUE,
width=0.45, quadsegs=100)
b2 <- gBuffer(SpatialPoints(cbind(rep(5:7, 3), rep(1:3, each=3))), TRUE,
width=0.45, quadsegs=100)
plot(gUnion(b, b2), border=NA)
Step through the polygons and extract their bounding boxes.
bb <- sapply(b#polygons, bbox)
bb2 <- sapply(b2#polygons, bbox)
Plot stacked segments to simulate a gradient.
segments(rep(bb[1,], each=1000),
mapply(seq, bb[2,], bb[4,], len=1000),
rep(bb[3,], each=1000), col=gray.colors(1000, 0))
segments(rep(bb2[1,], each=1000),
mapply(seq, bb2[2,], bb2[4,], len=1000),
rep(bb2[3,], each=1000), col=rev(gray.colors(1000, 0)))
Difference the union of the SpatialPolygon objects and plot the differenced polygon to mask out the non-circles areas.
plot(gDifference(as(extent(par('usr')), 'SpatialPolygons'), gUnion(b, b2)),
col='gray80', border='gray80', add=TRUE)
For bonus circle smoothness, plot the circles once more, with colour equal to the background colour.
plot(gUnion(b, b2), border='gray80', lwd=2, add=TRUE)