Related
I am hoping someone can help me with the formating from phylo.to.plot() or suggest another method that can produce a similar output.
I have followed tutorial(s) here to produce an output but it seems difficult to alter the resulting figures.
Briefly these are my questions. I will expand further below.
How to plot a subregion of a "WorldHires" map, not entire region?
Change the shape of the points on the map, but maintain the colour?
Add gradient of continuous variable to map
Reproducible example:
Here is a very basic tree with some randomly assigned geographic locations
myTree <- ape::read.tree(text='((A, B), ((C, D), (E, F)));')
plot(myTree)
# It needs to be rooted for `phylo.to.map()` to work
myTree$branch.length = NULL
rooted_cladogram = ape::compute.brlen(myTree)
# Sample information
Sample <- c("A","B","C","D","E","F")
coords <- matrix(c(56.001966,57.069417,50.70228, 51.836213, 54.678997, 54.67831,-5.636926,-2.47805,-3.8975018, -2.235444,-3.4392211, -1.751833), nrow=6, ncol=2)
rownames(coords) <- Sample
head(coords)
## Plot phylo.to.map
obj<-phylo.to.map(rooted_cladogram,coords,database="worldHires", regions="UK",plot=FALSE,xlim=c(-11,3), ylim=c(49,59),direction="rightwards")
plot(obj,direction="rightwards",fsize=0.5,cex.points=c(0,1), lwd=c(3,1),ftype="i")
Plot output here:
Question 1: How do I plot a subregion of a "WorldHires" map, not the entire region?
I would like to only have mainland Britain which is a subregion of the "UK" in the WorldHires database. To access it normally I would do:
map1 <- ggplot2::map_data(map = "worldHires", region = c("UK"),xlim=c(-11,3), ylim=c(49,59))
GB <- subset(map1, subregion=="Great Britain")
# Plot
GB_plot<- ggplot(GB )+
geom_polygon(aes(x = long, y = lat, group = group), fill = "white", colour = "black")+
theme_classic()+
theme(axis.line=element_blank(),
axis.text=element_blank(),
axis.ticks=element_blank(),
axis.title=element_blank(),
panel.border = element_blank())
Which looks like this:
I have tried but it ignore the subregion argument.
obj<-phylo.to.map(ttree,coords,database="worldHires", regions="UK", subregion="Great Britain",plot=FALSE,xlim=c(-11,3), ylim=c(49,59),direction="rightwards")
Is there a way to provide it directly with a map instead of using WorldHires?
Question 2: How do I change the shape of the points on the map but keep maintain the colour?
I want to use shapes on the map to indicate the 3 major clade on my tree geographically. However, when I add a pch argument in, it correctly changes the shapes but the points then become black instead of following the colour that they were before. The lines from the tree to the map maintain the colour, it is just the points themselves that seem to turn black.
This is how I have tried to change the shape of the points:
# Original code - points
cols <-setNames(colorRampPalette(RColorBrewer::brewer.pal(n=6, name="Dark2"))(Ntip(myTree)),myTree$tip.label)
obj<-phylo.to.map(rooted_cladogram,coords,database="worldHires", regions="UK",plot=FALSE,xlim=c(-11,3), ylim=c(49,59),direction="rightwards")
plot(obj,direction="rightwards",fsize=0.5,cex.points=c(0,1), colors=cols,lwd=c(3,1),ftype="i")
Point and lines are coloured. I would like to change the shape of points
# Code to change points = but points are no longer coloured
shapes <- c(rep(2,2),rep(1,2),rep(0,2))
obj<-phylo.to.map(rooted_cladogram,coords,database="worldHires", regions="UK",plot=FALSE,xlim=c(-11,3), ylim=c(49,59),direction="rightwards")
plot(obj,direction="rightwards",fsize=0.5,cex.points=c(0,1), colors=cols,pch=shapes,lwd=c(3,1),ftype="i")
Output: The shapes are changed but they are no longer coloured in:
Question 3: How do I add a gradient to the map?
Given this fake dataset, how to I create a smoothed gradient of the value variable?
Any help and advice on this would be very much appreciated.
It would also be useful to know how to change the size of points
Thank you very much in advance,
Eve
I improved (somewhat) on my comments by using the map you made in your question. Here's the code:
library(mapdata)
library(phytools)
library(ggplot2)
myTree <- ape::read.tree(text='((A, B), ((C, D), (E, F)));')
plot(myTree)
# It needs to be rooted for `phylo.to.map()` to work
myTree$branch.length = NULL
rooted_cladogram = ape::compute.brlen(myTree)
# Sample information
Sample <- c("A","B","C","D","E","F")
coords <- matrix(
c(56.001966,
57.069417,
50.70228,
51.836213,
54.678997,
54.67831,
-5.636926,
-2.47805,
-3.8975018,
-2.235444,
-3.4392211,
-1.751833),
nrow=6,
ncol=2)
rownames(coords) <- Sample
head(coords)
obj <- phylo.to.map(
rooted_cladogram,
coords,
database="worldHires",
regions="UK",
plot=FALSE,
xlim=c(-11,3),
ylim=c(49,59),
direction="rightwards")
# Disable default map
obj2 <- obj
obj2$map$x <- obj$map$x[1]
obj2$map$y <- obj$map$y[1]
# Set plot parameters
cols <- setNames(
colorRampPalette(
RColorBrewer::brewer.pal(n=6, name="Dark2"))(Ntip(myTree)),myTree$tip.label)
shapes <- c(rep(2,2),rep(1,2),rep(0,2))
sizes <- c(1, 2, 3, 4, 5, 6)
# Plot phylomap
plot(
obj2,
direction="rightwards",
fsize=0.5,
cex.points=0,
colors=cols,
pch=shapes,
lwd=c(3,1),
ftype="i")
# Plot new map area that only includes GB
uk <- map_data(
map = "worldHires",
region = "UK")
gb <- uk[uk$subregion == "Great Britain",]
points(x = gb$long,
y = gb$lat,
cex = 0.001)
# Plot points on map
points(
x = coords[,2],
y = coords[,1],
pch = shapes,
col = cols,
cex = sizes)
e: Use sf object instead of points to illustrate GB. It is tough to provide more advice beyond this on how to add symbology for your spatially varying variable, but sf is popular and very well documented, e.g. https://r-spatial.github.io/sf/articles/sf5.html. Let me know if you have any other questions!
ee: Added lines to plot name and symbol on tips.
eee: Added gradient dataset to map.
library(phytools)
library(mapdata)
library(ggplot2)
library(sf)
myTree <- ape::read.tree(text='((A, B), ((C, D), (E, F)));')
plot(myTree)
# It needs to be rooted for `phylo.to.map()` to work
myTree$branch.length = NULL
rooted_cladogram = ape::compute.brlen(myTree)
# Sample information
Sample <- c("A","B","C","D","E","F")
coords <- matrix(c(56.001966,57.069417,50.70228, 51.836213, 54.678997, 54.67831,-5.636926,-2.47805,-3.8975018, -2.235444,-3.4392211, -1.751833), nrow=6, ncol=2)
rownames(coords) <- Sample
head(coords)
obj <- phylo.to.map(
rooted_cladogram,
coords,
database="worldHires",
regions="UK",
plot=FALSE,
xlim=c(-11,3),
ylim=c(49,59),
direction="rightwards")
# Disable default map
obj2 <- obj
obj2$map$x <- obj$map$x[1]
obj2$map$y <- obj$map$y[1]
## Plot tree portion of map
# Set plot parameters
cols <- setNames(
colorRampPalette(
RColorBrewer::brewer.pal(n=6, name="Dark2"))(Ntip(myTree)),myTree$tip.label)
shapes <- c(rep(2,2),rep(1,2),rep(0,2))
sizes <- c(1, 2, 3, 4, 5, 6)
# Plot phylomap
plot(
obj2,
direction="rightwards",
fsize=0.5,
cex.points=0,
colors=cols,
pch=shapes,
lwd=c(3,1),
ftype="i")
tiplabels(pch=shapes, col=cols, cex=0.7, offset = 0.2)
tiplabels(text=myTree$tip.label, col=cols, cex=0.7, bg = NA, frame = NA, offset = 0.2)
## Plot GB portion of map
# Plot new map area that only includes GB
uk <- map_data(map = "worldHires", region = "UK")
gb <- uk[uk$subregion == "Great Britain",]
# Convert GB to sf object
gb_sf <- st_as_sf(gb, coords = c("long", "lat"))
# Covert to polygon
gb_poly <- st_sf(
aggregate(
x = gb_sf$geometry,
by = list(gb_sf$region),
FUN = function(x){st_cast(st_combine(x), "POLYGON")}))
# Add polygon to map
plot(gb_poly, col = NA, add = TRUE)
## Load and format gradient data as sf object
# Load data
g <- read.csv("gradient_data.txt", sep = " ", na.strings = c("NA", " "))
# Check for, then remove NAs
table(is.na(g))
g2 <- g[!is.na(g$Lng),]
# For demonstration purposes, make dataset easier to manage
# Delete this sampling line to use the full dataset
g2 <- g2[sample(1:nrow(g2), size = 1000),]
# Create sf point object
gpt <- st_as_sf(g2, coords = c("Lng", "Lat"))
## Set symbology and plot
# Cut data into 5 groups based on "value"
groups <- cut(gpt$value,
breaks = seq(min(gpt$value), max(gpt$value), len = 5),
include.lowest = TRUE)
# Set colors
gpt$colors <- colorRampPalette(c("yellow", "red"))(5)[groups]
# Plot
plot(gpt$geometry, pch = 16, col = gpt$colors, add = TRUE)
## Optional legend for gradient data
# Order labels and colors for the legend
lev <- levels(groups)
# Used rev() here to make colors in correct order
fil <- rev(levels(as.factor(gpt$colors)))
legend("topright", legend = lev, fill = fil, add = TRUE)
## Plot sample points on GB
# Plot points on map
points(
x = coords[,2],
y = coords[,1],
pch = shapes,
col = cols,
cex = sizes)
see here for more info on gradient symbology and legends: R: Gradient plot on a shapefile
I am trying to plot a bathymetry map of the the northeast US using the marmap library. The following code loads the correct extent but when I plot the map I have blank space between the border and the map either at the top/bottom or left/right of the map. This also occurs when exporting the plots. If I drag the plot viewer screen size the plot adjusts and I can remove almost all of the empty space but I will be running this script in a loop so its not practical to solve this problem this way. Because of the loop I also can't hard code any dimensions into the plot because it will change for each new extent. How can I set the border of the plot to match the extent of the bathymetry?
library(marmap)
library(maps)
atl<- getNOAA.bathy(-80.93645,-41.61417,30.2 ,60.905 ,resolution=4)
blues <- colorRampPalette(c("darkblue", "cyan"))
greys <- colorRampPalette(c(grey(0.4),grey(0.99)))
plot(atl, image = TRUE, land = TRUE, n=0,
bpal = list(c(0, max(atl), greys(100)),
c(min(atl), 0, blues(100))))
map(database= "state", col="black", fill=FALSE, add=TRUE)
text(x=state.center$x, y=state.center$y, state.abb, cex=0.5)
This behavior is caused by the asp argument of plot.bathy(). By default, it is fixed as asp = 1 to ensure that the scales on both axes are the same (one degree of longitude equals one degree of latitude). An unwelcome consequence of this default, is the white bands appearing either on the left/right sides of the graph, or on the top/bottom sides depending on the dimensions of your bathymetric map and the plotting device.
So I suppose you have 2 options:
If you don't mind having a slightly distorted perspective, you can set asp = NA in your call to plot.bathy()
If you want to have the correct aspect ratio but need to use the default size for your plotting region, then you have to download a bathymetric region that covers the whole plotting region of your active device. For instance, you could call plot.bathy() once to create a "default" plot, then, use par("usr") to determine the limits of the bathymetry needed to fill the entire plotting area. You would then download a second bathymetry with the appropriate ranges in longitude and latitude. Which is maybe not desirable.
Here is what the code would look like for the second option:
atl <- getNOAA.bathy(-80.93645, -41.61417, 30.2, 60.905, resolution = 4)
blues <- colorRampPalette(c("darkblue", "cyan"))
greys <- colorRampPalette(c(grey(0.4), grey(0.99)))
plot(atl, image = TRUE, land = TRUE, n = 0,
bpal = list(c(0, max(atl), greys(100)),
c(min(atl), 0, blues(100))))
coord <- par("usr")
atl2 <- getNOAA.bathy(coord[1], coord[2], coord[3], coord[4], res = 4)
plot(atl2, image = TRUE, land = TRUE, lwd = 0.2,
bpal = list(c(0, max(atl2), greys(100)),
c(min(atl2), 0, blues(100))))
map(database = "state", col = "black", fill = FALSE, add = TRUE)
text(x = state.center$x, y = state.center$y, state.abb, cex = 0.5)
I suppose the solution proposed by Roman Luštrik works too, but it has the inconvenience of leaving the white bands visible on both sides of the plot.
As an aside, if you have a lot of bathymetric regions to plot, you should maybe consider using the keep = TRUE argument of getNOAA.bathy() to avoid querying the NOAA servers each time you need to re-execute your code (and it is much faster to load local data than remote ones). And you could also download once and for all the global 4Go ETOPO1 and use subset.bathy() to, well, subset the bathymetry you need for each plot.
Here is a proposal using a workaround. The idea is to convert the bathy object into raster object and then make the plot using levelplot from rasterVisthat correctly fits the plotting area to the raster extent. Note that using raster allows having a defined pixel size and, therefore, a correct width/height ratio that you don't seem to have with marmap::plot method.
library(raster)
library(rasterVis)
r <- marmap::as.raster(atl)
state <- map('state', plot = FALSE)
state <- data.frame(lon = state$x, lat = state$y)
state.lab <- data.frame(lon = state.center$x, lat = state.center$y,
label = state.abb)
# you can remove the color legend by adding colorkey = FALSE in levelplot()
levelplot(r,
at = c(seq(min(atl), 0, length.out = 100),
seq(0, max(atl), length.out = 100)[-1]),
col.regions = c(blues(100), greys(100)),
margin = FALSE) +
xyplot(lat ~ lon, state, type = 'l',
col = 'black') +
xyplot(lat ~ lon, data = state.lab,
panel = function(y, x, ...) {
ltext(x = x, y = y, labels = state.lab$label, cex = 0.75)
})
I'm trying to plot two maps side by side using sf::plot and I can't manage to get it to work. There is two problems, the first one is that the plots are made on top of each other instead of side by side and the second is that I lose the legend.
Here is a example and more explanations.
library(sf)
library(dplyr)
# preparing the shapefile
nc <- st_read(system.file("gpkg/nc.gpkg", package="sf"), quiet = TRUE) %>%
select(AREA, PERIMETER) %>%
mutate(AREA = as.factor(AREA<median(AREA)))
If I plot every field independently:
plot(nc[,1])
plot(nc[,2])
Both images are nice, with a legend and all, but I want both on the same panel. sf::plot offers this feature built in as explained in https://r-spatial.github.io/sf/articles/sf5.html#geometry-with-attributes-sf:
plot(nc)
I lose the legend and they are on top of each other instead of side by side. In ?plot you can read:
For more control over individual maps, set parameter mfrow with par
prior to plotting, and plot single maps one by one.
But when I do, it doesn't work:
par(mfrow=c(1,2))
plot(nc[,1])
plot(nc[,2])
par(mfrow=c(1,1))
Any idea how to plot 2 maps side by side with sf?
Finally, it was a problem in the documentation. To be able to use par with sf::plot you need to do either:
par(mfrow=c(1,2))
plot(st_geometry(nc[,1]))
plot(st_geometry(nc[,2]))
par(mfrow=c(1,1))
or
par(mfrow=c(1,2))
plot(nc[,1], key.pos = NULL, reset = FALSE)
plot(nc[,2], key.pos = NULL, reset = FALSE)
par(mfrow=c(1,1))
However, you lose the colors in the first case and lose the legend in both cases. You have to manage it yourself manually.
see: https://github.com/r-spatial/sf/issues/877
I didn`t found the solution in sf package. I found this that probably works fine for you
library(ggplot2)
area<-ggplot() + geom_sf(data = nc[,1], aes(fill = AREA))
perim<-ggplot() + geom_sf(data = nc[,2], aes(fill = PERIMETER))
gridExtra::grid.arrange(area,perim,nrow=1)
To add to #Bastien's answer, you can add a legend manually. Here's a simple function that will add a continuous legend using the leaflet and plotrix libraries:
addLegendToSFPlot <- function(values = c(0, 1), labels = c("Low", "High"),
palette = c("blue", "red"), ...){
# Get the axis limits and calculate size
axisLimits <- par()$usr
xLength <- axisLimits[2] - axisLimits[1]
yLength <- axisLimits[4] - axisLimits[3]
# Define the colour palette
colourPalette <- leaflet::colorNumeric(palette, range(values))
# Add the legend
plotrix::color.legend(xl=axisLimits[2] - 0.1*xLength, xr=axisLimits[2],
yb=axisLimits[3], yt=axisLimits[3] + 0.1 * yLength,
legend = labels, rect.col = colourPalette(values),
gradient="y", ...)
}
To use the above function with #Bastien's code:
# Load required libraries
library(sf) # Working spatial data
library(dplyr) # Processing data
library(leaflet) # Has neat colour palette function
library(plotrix) # Adding sf like legend to plot
# Get and set plotting window dimensions
mfrowCurrent <- par()$mfrow
par(mfrow=c(1,2))
# Add sf plot with legend
plot(nc[,1], key.pos = NULL, reset = FALSE)
addLegendToSFPlot(values = c(0, 1),
labels = c("False", "True"),
palette = c("lightseagreen", "orange"))
# Add sf plot with legend
plot(nc[,2], key.pos = NULL, reset = FALSE)
valueRange <- range(nc[, 2, drop = TRUE])
addLegendToSFPlot(values = seq(from = valueRange[1], to = valueRange[2], length.out = 5),
labels = c("Low", "", "Medium", "", "High"),
palette = c("blue", "purple", "red", "yellow"))
# Reset plotting window dimensions
par(mfrow=mfrowCurrent)
Is it possible in R to create a color key like the one below? (this one comes from the software Grid Analysis and Display System - Grads).
There are two features that I can't reproduce in R:
The sequence is non linear however it is displayed as if
Values bigger than 200 are grey / Values smaller than 0 are white
I'm using levelplot from rastervis that plots rasters using the lattice levelplot:
require(raster)
require(rasterVis)
set.seed(200)
X = seq(-40,0,by=1)
Y = seq(-60,-40,by=1)
grid = expand.grid(list(X=X,Y=Y))
Z = rnorm(nrow(grid),mean=10,sd=100)
data = data.frame(grid,Z)
r = rasterFromXYZ(data)
mapTheme <- rasterTheme(region=c('#EEF7FA','#D6F8F7',"#BEDAFF",'#5DA4FF',"#0000FF","#D4F9E2","#00FF7F","#008000","#FFFF00","#FFD27F", "#FFB732" ,"#EE7600",
"#D53E4F","#FF6A6A"))
my.at = c(0,1,5,10,15,20,25,30,40,50,75,100,150,200)
myColorkey <- list(at=my.at,
space="bottom",
labels=list(at=my.at))
p=levelplot(r, par.settings=mapTheme,at = my.at, colorkey=myColorkey,margin=F)
print(p)
The result:
As you can see, both values smaller than 0 and bigger than 200 are white, I've no idea how to set values bigger than or smaller than a certain value to appear as a specific color. Morover, how can I make the space between consecutive thick marks in the color key to have the same size although the intervals are not the same?
This is a workaround for equally sized intervals for non linear sequences:
library(raster)
library(rasterVis)
set.seed(200)
X = seq(-40,0,by=1)
Y = seq(-60,-40,by=1)
grid = expand.grid(list(X=X,Y=Y))
Z = rnorm(nrow(grid),mean=10,sd=100)
data = data.frame(grid,Z)
r = rasterFromXYZ(data)
mapTheme <- rasterTheme(region=c('#EEF7FA','#D6F8F7',"#BEDAFF",'#5DA4FF',"#0000FF","#D4F9E2","#00FF7F",
"#008000","#FFFF00","#FFD27F", "#FFB732" ,"#EE7600", "#D53E4F","#FF6A6A"))
my.at=c(0,1,5,10,15,20,25,30,40,50,75,100,150,200)
my.brks=seq(0, 200, by=15)
myColorkey <- list(at=my.brks, labels=list(at=my.brks, labels=my.at), space="bottom")
p=levelplot(r, par.settings=mapTheme, at=my.at, colorkey=myColorkey, margin=F)
print(p)
This could be a solution for values smaller 0 and greater than 200:
library(raster)
library(rasterVis)
set.seed(200)
X = seq(-40,0,by=1)
Y = seq(-60,-40,by=1)
grid = expand.grid(list(X=X,Y=Y))
Z = rnorm(nrow(grid),mean=10,sd=100)
data = data.frame(grid,Z)
r = rasterFromXYZ(data)
mapTheme <- rasterTheme(region=c('white','#EEF7FA','#D6F8F7',"#BEDAFF",'#5DA4FF',"#0000FF","#D4F9E2","#00FF7F",
"#008000","#FFFF00","#FFD27F", "#FFB732" ,"#EE7600", "#D53E4F","#FF6A6A", "gray"))
max(values(r))
min(values(r))
my.at=c(min(values(r)), 0,1,5,10,15,20,25,30,40,50,75,100,150,200, max(values(r)))
my.brks=seq(0, 200, by=13)
myColorkey <- list(at=my.brks, labels=list(at=my.brks, labels=c(-276,0,1,5,10,15,20,25,30,40,50,75,100,150,200, 388)), space="bottom")
p=levelplot(r, par.settings=mapTheme, at=my.at, colorkey=myColorkey, margin=F)
print(p)
Your colors are not progressing from light to dark. You can use the RColorBrewer package to fix this.
library(RColorBrewer)
reds = brewer.pal(5, "YlOrRd")
greens = brewer.pal(3, "Greens")
blues = brewer.pal(5, "Blues")
mapTheme <- rasterTheme(region=c('white', blues, greens, reds, "gray"))
This is a very helpful workaround. While not addressing question 1, something I found useful for question 2 (adding triangles for values below/above the limits of the colorbar range) can be achieved by adding this:
library(s2dverification)
data_array <- array(Z, dim = c(length(X), length(Y)))
PlotEquiMap(data_array, X, Y,bar_limits=c(0,200),col_inf='white',col_sup='gray')
raster with colorbar
Another solution with updates to lattice:
library(raster)
library(rasterVis)
set.seed(200)
X = seq(-40,0,by=1)
Y = seq(-60,-40,by=1)
grid = expand.grid(list(X=X,Y=Y))
Z = rnorm(nrow(grid),mean=10,sd=100)
data = data.frame(grid,Z)
r = rasterFromXYZ(data)
levelplot(r, margin=F, at=c(-Inf, seq(0, 200, 20), Inf),
colorkey = list(tri.lower = TRUE, tri.upper = TRUE))
As long as you add "-Inf" and "Inf" to your at definition, the option to add triangles to the colorbar is activated.
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