Related
I have an external function to make a series of plots:
This functions reads an object which is a raster sum made in advance, and then it plots this raster and finally on top of it, it draws a vector of a shapefile.
Since I have to do hundreds of these plots I wanted to parallelize the code. For this I used mclapply.
What happens is that when I use my desktop (Ubuntu LTS with a standard i7-6400 cpu) everything works fine and I get both the raster and the shapefile plotted with the parallel apply command.
When I run the code on my server (Debian 9, Xeon Silver 4108) and on a HPC I get the following problem:
the raster objects, which are in the memory, are plotted fine, while the vector object is not plotted and I get this error of "error packet 1. object not found".
Note that on the server/HPC this does not occur if I ran the code serially (with a serial loop, instead of mclapply).
Note that the raster is an object and it's plotted, while the vector is not plotted. I tried several workarounds:
- using get to get the object within the plot function
- read each time the vector shapefile inside the plot function
- hardcode in the plot function the name of the shapefile object
- export the object on the slaves
None of them work on my server and HPC service...
My feeling is that it is a problem of Lattice / LatticeExtra, which unfortunately are not that much maintained anymore after the arrival of ggplot
Any help is appreciated. I am enclosing the code at the bottom, although it is not a full MWE...
conc.plot <- function(i, main.list.con.file, path, dupl.sources = FALSE, tm.series = tm, bldng.shp = "buildings.vector", color.scale.type = "macc"){
library(raster)
library(rasterVis)
library(grid)
library(lattice)
library(sp)
library(latticeExtra)
library(rgdal)
## i is the element to be plotted in the main.list.con.file
## main.list.con.file is the vector with ALL (including duplicates) con. files
## path is the path to the folder of the main.list.con
## tm is the vector of simulation timesteps as read in the mettimeseries
conc.field <- get(paste0("sum.rast.",i))
## Define conc. limits
conc.field#data#values[conc.field#data#values < 1] <- 0
conc.field[conc.field > 210] <- 210
## arbitrary units
if(color.scale.type == "arbitrary"){
scale.tick <- seq(1,211,2)
scale.label <- c("very low", "low", "medium", "high", "very high")
scale.label.at <- c(10,40,80,150,200)
scale.col <- colorRampPalette(rev(c('#a50026','#d73027','#f46d43','#fdae61','#fee090','#ffffbf','#e0f3f8','#abd9e9','#74add1','#4575b4','#313695','#a1d99b'))) ##colorRampPalette(c("lightyellow","yellow","orange","red","darkred"))
}
time.step <- as.integer(sub(".*\\b(\\d{5})\\b.*", "\\1", main.list.con.file[i]))
## start plotting
png(filename = paste(path, "conc_map_lev_",sprintf("%04d",time.step), ".png", sep=""), width = 300*7, height = 300*5, res=300, pointsize = 12, type="cairo")
print(rasterVis::levelplot(conc.field, margin=FALSE, maxpixel=1e12,
main = format(tm.series$date[time.step],"%B %d, %H:%M %Z", tz="Europe/Rome"), ## FOR CESGA ONLY THERE IS NO HANDLING OF TIMEZONES
col.regions = scale.col, ## color vector to be used if regions is TRUE. The general idea is that this should be a color vector of moderately large length. This vector would be gradually varying in color
at = scale.tick, ## A numeric vector giving breakpoints along the range of z
colorkey = list(at = scale.tick, ## numeric vector specifying where the colors change. must be of length 1 more than the col vector
labels = list(at = scale.label.at, labels = scale.label), ## a character vector for labelling the "at" values, or a list including components "labels", "at", "cex", "col", "rot", "font", "fontface", "fontfamily".
col = scale.col), ## A color ramp specification, as in the col.regions argument in level.colors
xlab = "UTM Westing Coordinate (m)",
ylab = "UTM Northing Coordinate (m)",
scales = list(x = x.scale, y = y.scale),
panel = function(...){
panel.levelplot(...)
panel.abline(v = unlist(x.scale)[2:5] ,h = unlist(y.scale)[2:5], col = 1, lty = 2, lwd=.9)}
) + latticeExtra::layer(sp.polygons(get(bldng.shp), fill='grey', alpha=0.6, lwd=.1))
)
trellis.focus("legend", side="right", clipp.off=FALSE, highlight=FALSE)
dev.off()
message(paste0("Saved concentration map for time step ", time.step,", i.e. ",format(tm.series$date[time.step],"%B %d, %H:%M", tz="Europe/Rome")))
}
mc <- round(parallel::detectCores() * 0.5) + 1
clusterExport(makeCluster(mc), varlist = c("buildings.vector"))
list.conc <- which(dupl.sg)
parallel::mclapply(list.conc, function(i) conc.plot(i, main.list.con.file = list.conc, path = conc.file.path, bldng.shp = "buildings.vector", color.scale.type = "arbitrary"), mc.cores = mc, mc.preschedule = FALSE)
I am drawing a phylogenetic tree, and I would like to add something like a 'dead symbol̈́̈́' (e.g a skull) in the tips of the extinct species.
I would also like to add an x-axes bar with latex symbols in the branching times (e.g $\Delta t_i$ or numbers) marked with dots.
What I have so far is this tree. I would like to add the dead symbol right after the green dotted line in this case.
library(ape)
rec1 = '((B:1,A:1):1,(F:1,C:1.5):0.5);'
rec1 = read.tree(text = rec1)
plot(rec1,show.tip.label = F,edge.color = c("black","black","black","black","darkgreen","black"),edge.width = 2,edge.lty = c(rep(1,4),4,1))
One possibility is using ggtree. As in:
https://guangchuangyu.github.io/2018/03/annotating-phylogenetic-tree-with-images-using-ggtree-and-ggimage/
#source("https://bioconductor.org/biocLite.R")
#biocLite("BiocUpgrade") # you may need this
#biocLite("ggtree")
library(ggtree)
tree<-rtree(10)
pg<-ggtree(tree)
d <- data.frame(node = as.character(10:15),
images = c("https://i.imgur.com/8VA9cYw.png",
"https://i.imgur.com/XYM1T2x.png",
"https://i.imgur.com/EQs5ZZe.png",
"https://i.imgur.com/2xin0UK.png",
"https://i.imgur.com/hbftayl.png",
"https://i.imgur.com/3wDHW8n.png"))
pg %<+% d + geom_nodelab(aes(image=images), geom="image")
With phylopic
#install.packages('rphylopic')
library(rphylopic)
string<-name_search(text = "Homo sapiens")
selectstr<-string[2,]
string2<-name_images(uuid = selectstr)$same[[1]]$uid
tree<-rtree(10)
phylopic_info <- data.frame(node = c(12,13),
phylopic = string2)
nt<-ggtree(tree)
nt %<+% phylopic_info +
geom_nodelab(aes(image=phylopic), geom="phylopic", alpha=.5, color='steelblue')
I can see two options how to display an "extinct" symbol on a tree tip.
Use a Unicode symbol with an appropriate font that can display it as per this blog.
Add a raster image onto the tree plot.
The following code will display an extinction symbol next to the green edge in your tree. It draws on information found here.
library(jpeg)
logo <- readJPEG("Downloads/Symbol1.jpg")
logo2 <- as.raster(logo)
r <- nrow(logo2)/ncol(logo2) # aspect ratio
s <- 0.4 # symbol size
# display plot to obtain its size
plot(rec1, edge.color = c("black","black","black","black","darkgreen","black"),
edge.width = 2, edge.lty = c(rep(1,4),4,1))
lims <- par("usr") # plot area size
file_r <- (lims[2]-lims[1]) / (lims[4]-lims[3]) # aspect ratio for the file
file_s <- 480 # file size
# save tree with added symbol
png("tree_logo.png", height=file_s, width=file_s*file_r)
plot(rec1, show.tip.label = F,
edge.color = c("black","black","black","black","darkgreen","black"),
edge.width = 2, edge.lty = c(rep(1,4),4,1))
rasterImage(logo2, 1.6, 2.8, 1.6+s/r, 2.8+s)
# add axis
axisPhylo()
mtext(expression(Delta*italic("t")["i"]), side = 1, line = 3)
dev.off()
I want to include math symbols in the panel titles for this stratigraphic plot:
library(analogue)
data(V12.122)
Depths <- as.numeric(rownames(V12.122))
names(V12.122)
(plt <- Stratiplot(Depths ~ O.univ + G.ruber + G.tenel + G.pacR,
data = V12.122,
type = c("h","l","g"),
zones = 400))
plt
For example, I want to have this text in place of "O.univ" etc.:
I used this code to make that text:
plot(1, type="n", axes=FALSE, ann=FALSE)
title(line = -1, main = expression(phantom()^14*C~years~BP))
title(line = -3, main = expression(delta^18*O))
title(line = -5, main = expression(paste("TP ", mu,"g l"^-1)))
title(line = -10, main = expression("very long title \n with \n line breaks"))
But if I try to update the colnames of the data frame passed to Stratiplot, the code is not parsed, and we do not get the correct text formatting:
V12.122 <- V12.122[, 1:4]
names(V12.122)[1] <- expression(phantom()^14*C~years~BP)
names(V12.122)[2] <- expression(delta^18*O)
names(V12.122)[3] <- expression(paste("TP ", mu,"g l"^-1))
(plt <- Stratiplot(Depths ~ .,
data = V12.122,
type = c("h","l","g"),
zones = 400))
plt
How can I get Stratiplot to parse the expressions in the colnames and format them correctly in the plot?
I've tried looking through str(plt) to see where the panel titles are stored, but no success:
text <- expression(phantom()^14*C~years~BP)
plt$condlevels$ind[1] <- text
names(plt$packet.sizes)[1] <- text
names(plt$par.settings$layout.widths$panel)[1] <- text
You can't actually do this in the current release of analogue; the function is doing too much messing around with data for the expressions to remain unevaluated prior to plotting. I could probably figure this out to allow expressions as the names of the data argument object, but it is easier to just allow users to pass a vector of labels that they want for the variables.
This is now implemented in the development version of the package on github, and I'll push this to CRAN early next week.
This change implements a new argument labelValues which takes a vector of labels for use in labelling the top axis. This can be a vector of expressions.
Here is an illustration of the usage:
library("analogue")
set.seed(1)
df <- setNames(data.frame(matrix(rnorm(200 * 3), ncol = 3)),
c("d13C", "d15N", "d18O"))
df <- transform(df, Age = 1:200)
exprs <- expression(delta^{13}*C, # label for 1st variable
delta^{15}*N, # label for 2nd variable
delta^{18}*O) # label for 3rd variable
Stratiplot(Age ~ ., data = df, labelValues = exprs, varTypes = "absolute", type = "h")
which produces
Note that this is just a first pass; I'm pretty sure I haven't accounted for any reordering that goes on with sort and svar etc. if they are used.
Never used lattice plots, but I thought a chance to learn something should be worth while. Took too long to figure out.
text <- "c( expression(phantom()^14*C~years~BP),expression(delta^18*O))"
strip = strip.custom(factor.levels=eval(parse(text=text)))
plt <- Stratiplot(Depths ~ .,
data = V12.122[, 1:4],
type = c("h","l","g"),
zones = 400,
strip = strip)
Hope this gets you started.
I am trying to plot a venn diagram in an optimized way (see below) and with the cases as internal labels (not the number of cases in each intersection). I know there are post for each of them but non of the solutions allowed me to do both.
I have this:
x <- list()
x$A <- as.character(c("Per_36","Cent","CeM","vDG","LAVL","RSGd"))
x$B <- as.character(c("vCA1","DLE","Per_36","vDG","DIE","Per_35"))
x$C <- as.character(c("vCA1","Cg1","LAVL", "RSGc", "RSGd","Per_35","Per_36"))
x$D <- as.character(c("Por","Cg1","RSGc","LAVL","Per_35","RSGd","Per_36"))
require(VennDiagram)
v0 <-venn.diagram(x, lwd = 3, col = c("red", "green", "orange", "blue"),
fill = c("red", "blue", "green", "orange"), apha = 0.5, filename = NULL)
grid.draw(v0)
overlaps <- calculate.overlap(x)
overlaps <- rev(overlaps)
for (i in 1:length(overlaps)){
v0[[i+8]]$label <- paste(overlaps[[i]], collapse = "\n")
}
grid.newpage()
grid.draw(v0)
I get the following output:
Regarding the organization of the venn diagramI want to do this:
c <- venn(x, simplify = TRUE, small = 0.5, intersections = TRUE)
which I got from package gplots() using the venn function with simplify = TRUE. However, in the venn function, I seem to no be able to replace the counts by the names of the labels. I used the intersections = TRUE, which by the description of the argument should work, but it doesn't (although if I look inside the variable c, the info is there).
Logical flag indicating if the returned object should have the attribute
"individuals.in.intersections" featuring for every set a list of individuals
that are assigned to it.
Question: Using VennDiagrampackage, is there a way to do exactly the same as the simplify argument does in the venn function from gplots package?
Question 2: Using the venn function from gplots package, is there a way to display the names of each element instead of the element counts? Like I did in the 'venn.diagram' function?
Thanks in advance,
Here is my approach which is by far no solution rather a hack.
# Print a venn and save it to an object
a <- venn(list(letters[1:5], letters[3:8]))
# save the intersections
b <- attr(a, "intersections")
# find the coordinates
s <- seq(0,500,100); abline(h=s); text(s, y=s, x=0)
s <- seq(0,500,50); abline(v=s); text(s, y=0, x=s)
# the hack, destroy the venn to avoid the plotting of the internal numbers
rownames(a) <- letters[1:nrow(a)]
a
plot.venn(a)
>Error in data[n, 1] : subscript out of bounds
# include the internal labels
text(200,300,paste(b$`01`,collapse = "\n"))
text(200,200,paste(b$`11`,collapse = "\n"))
text(200,100,paste(b$`10`,collapse = "\n"))
It's annoying with multiple venns. Otherwise you can save the venn as an .svg and edit it with inkscape or similar softwares or ask the developer by email.
Edit:
If your plots looking alwas the same you can check the source code for the venn function (In RStudio by hitting F2) and copy paste the positions for 4 and 5 circle venns and replace the labels function lab("1000", data) with your desired labels.
For 4 circles:
text(35, 250, lab("1000", data))
text(140, 315, lab("0100", data))
text(260, 315, lab("0010", data))
text(365, 250, lab("0001", data))
text(90, 280, lab("1100", data), cex = small)
text(95, 110, lab("1010", data))
text(200, 50, lab("1001", data), cex = small)
text(200, 290, lab("0110", data))
text(300, 110, lab("0101", data))
text(310, 280, lab("0011", data), cex = small)
text(130, 230, lab("1110", data))
text(245, 75, lab("1101", data), cex = small)
text(155, 75, lab("1011", data), cex = small)
text(270, 230, lab("0111", data))
text(200, 150, lab("1111", data))
Edit
Nowadays I would switch to a ggplot solution
ggVennDiagram::ggVennDiagram(x)
According to the comments from others, this post has been separated into several
smaller questions from the previous version of this OP.
In the graph below, will you help me to (Newbie to R)
Custom legends according to the data they represent like filled for variable 1, circle points for variable 2 and line for variable 3 and their colors.
same letter size for the legend and axis-names.
The graph below is produced with the data in pdf device with following layout.
m <- matrix(c(1,2,3,3,4,5),nrow = 3,ncol = 2,byrow = TRUE)
layout(mat = m,heights = c(0.47,0.06,0.47))
par(mar=c(4,4.2,3,4.2))
#Codes for Fig A and B
...
#Margin for legend
par(mar = c(0.2,0.2,0.1,0.1))
# Code for legend
...
#Codes for Fig C and D
...
Using doubleYScale from latticeExtra and the data in the long format (see my previous answer), you can simplify the work:
No need to create a custom layout to superpose many plots
No need to create the legend manually
The idea is to create 2 separates objects and then merge them using doubleYScale. The latter will create the second axes. I hope I get your ploygon idea since it is not very clear why do you invert it in your OP.
library(latticeExtra)
obj1 <- xyplot(Variable~TimeVariable|Type,type='l',
groups=time, scales=list(x=list(relation='free'),
y=list(relation='free')),
auto.key=list(columns = 3,lines = TRUE,points=FALSE) ,
data = subset(dat.l,time !=1))
obj2 <- xyplot(Variable~TimeVariable|Type,
data = subset(dat.l,time ==1),type='l',
scales=list(x=list(alternating=2),
auto.key=list(columns = 3,lines = TRUE,points=FALSE),
y=list(relation='free')),
panel=function(x,y,...){
panel.xyplot(x,y,...)
panel.polygon(x,y,col='violetred4',border=NA,alpha=0.3)
})
doubleYScale(obj1, obj2, add.axis = TRUE,style1 = 0, style2 = 1)
Try the following:
1) For the legend part
The data can be found on https://www.dropbox.com/s/4kgq8tyvuvq22ym/stackfig1_2.csv
The code I used is as follows:
data <- read.csv("stackfig1_2.csv")
library(Hmisc)
label1=c(0,100,200,300)
plot(data$TimeVariable2C,data$Variable2C,axes=FALSE,ylab="",xlab="",xlim=c(0,24),
ylim=c(0,2.4),xaxs="i",yaxs="i",pch=19)
lines(data$TimeVariable3C,data$Variable3C)
axis(2,tick=T,at=seq(0.0,2.4,by=0.6),label= seq(0.0,2.4,by=0.6))
axis(1,tick=T,at=seq(0,24,by=6),label=seq(0,24,by=6))
mtext("(C)",side=1,outer=F,line=-10,adj=0.8)
minor.tick(nx=5,ny=5)
par(new=TRUE)
plot(data$TimeVariable1C,data$Variable1C,axes=FALSE,xlab="",ylab="",type="l",
ylim=c(800,0),xaxs="i",yaxs="i")
axis(3,xlim=c(0,24),tick=TRUE,at= seq(0,24,by=6),label=seq(0,24,by=6),col.axis="violetred4",col="violetred4")
axis(4,tick=TRUE,at= label1,label=label1,col.axis="violetred4",col="violetred4")
polygon(data$TimeVariable1C,data$Variable1C,col='violetred4',border=NA)
legend("top", legend = c("Variable A","Variable B","Variable C"), col = c("black","violetred4","black"),
ncol = 2, lwd =c("","",2),pch=c(19,15,NA),cex=1)
The output is as follows:
2) To make the font size same use the parameter cex and make it same everywhere.