optimized VennDiagram with internal labels r - r

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)

Related

"Error using packet 1" - object not found. Error in Lattice plotting only when using mclapply on server / HPC

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)

Adding symbols and information to Phylogenetic tree

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()

floating.pie error while using nodelables from ape package

I get an error while using the ARD model of the ace function in R. The error is
Error in floating.pie.asp(XX[i], YY[i], pie[i, ], radius = xrad[i], col = piecol) :
floating.pie: x values must be non-negative
library(ape)
library(phylobase)
tree <- read.nexus("data1.nexus")
plot(tree)
data <- read.csv("phagy_species.csv")
clade.full <- extract.clade(tree, node=91)
plot(clade.full)
clade.1 <- drop.tip(clade.full, "Bar_bre")
clade.2<- drop.tip(clade.1, "Par_pho")
clade.3<- drop.tip(clade.2, "Par_iph")
clade.4<- drop.tip(clade.3, "Eur_ser")
clade.5<- drop.tip(clade.4, "Opo_sym")
clade.6<- drop.tip(clade.5, "Mor_pel")
clade.7<- drop.tip(clade.6, "Aph_hyp")
clade.8<- drop.tip(clade.7, "Ere_oem")
clade.9<- drop.tip(clade.8, "Cal_bud")
clade.10<- drop.tip(clade.9, "Lim_red")
clade.11<- drop.tip(clade.10, "Act_str")
clade.12<- drop.tip(clade.11, "Hel_hec")
clade.13<- drop.tip(clade.12,"Col_dir")
clade.14<- drop.tip(clade.13, "Hyp_pau")
clade.15<- drop.tip(clade.14, "Nym_pol")
clade.16<- drop.tip(clade.15, "Mel_cin")
clade.17<- drop.tip(clade.16,"Apa_iri")
clade.18<- drop.tip(clade.17, "Bib_hyp")
clade.19<- drop.tip(clade.18, "Mar_ors")
clade.20<- drop.tip(clade.19, "Apo_cra")
clade.21<- drop.tip(clade.20, "Pse_par")
clade.22 <- drop.tip(clade.21, "Lep_sin")
clade.23<- drop.tip(clade.22, "Dis_spi")
plot(clade.23)
data2 <- as.numeric(data[,2])
model2 <- ace(data2, clade.23, type="discrete", method="ML", model="ARD")
summary(model2)
d <-logLik(model2)
deviance(model2)
AIC(model2)
plot(clade.23, type="phylogram", cex=0.8, font=3, label.offset = 0.004)
co <- c("red", "blue", "green", "black")
nodelabels(pie = model2$lik.anc, piecol = co, cex = 0.5)
And that is when I get the error. There is no error if I use the original tree without trimming. But, when i trim them to my requirements, it goes in the negative.
Here is the data
tree file
data file
The matrix you are using for the proportions of the pie has complex numbers in it. To see this, try:
class(model2$lik.anc[1,1])
The rows of that matrix define the proportions of the pies, and they need to sum to 1. Your code produces a plot with pies if I replace the pie matrix in the nodelabels function like this:
nodelabels(pie = matrix(0.25, 64, 4), piecol = co, cex = 0.5)
because now there is a legitimate matrix for the pie argument with rows that sum to 1.
As for why you have complex numbers in that matrix, I am not sure. It is probably related to all the warnings produced by the ace in your example. But that is a completely different issue.
I had the same problem with my data. I put my data into the matrix (like Slow Ioris suggested) and then unlisted the matrix.
x <- matrix(data=c(model2$lik.anc[,1],model2$lik.anc[,2],model2$lik.anc[,3],model2$lik.anc[,4]))
plotTree(tree,ftype="i",label.offset = 0.02)
nodelabels(pie = unlist(x))
For other people having the same problem also after purging imaginable parts of their data: The nodelabels function gives the same error when you provide a data.frame instead of a matrix to pie.

Calculate equation from .csv file input and plot result over barplot

I coulnd't found any post with a related subject. I actually don't know if its posible.
So I have my. csv file:
Periodo;Teorico;Real;F1;F2;F3
20140101;50;20;7;7;16
20140108;55;29;11;5;5
20140115;52;21,4;8,6;10;12
20140122;66;32;9;8;17
I asign it to a data.frame:
df<-read.csv2('d:\\xxx\\test2.csv', header = T, sep = ";")
Then I do barplot function:
bp <- barplot(t(df[,-c(1:2)]),col=c("blue", "red", "green", "yellow"),legend=colnames(df[,-c(1:2)]),args.legend = list(x="topleft"))
axis(side = 1, at = bp, labels = df$Periodo)
title(main = "Teorico = Real + F1+F2+F3", font.main = 4)
Now I must calculate the following function: (efficiency function)
((Teorico-Real)/Teorico)*100
And represent the result of the function of each row on the top of each Periodo (week).
If you could help me with the code for the function and "replotting" parts or give some guidelines or posts related to this I would be really gratefull.
Thanks
You can try:
lbls <- round(((df$Teorico - df$Real) / df$Teorico)* 100)
mtext(lbls, at=bp)
(I just used round to make it look better.)

Legend in multiple plot in R

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.

Resources