R/vennplot.R
In wangjiaxuan666/xbox: author's packages for himself
Defines functions
vennplot
Documented in
vennplot
#' Draw an area-proportional Venn diagram of 2 or 3 circles change by wangjiaxuan
#'
#' The function from bioVenn R packages(https://cran.r-project.org/web/packages/BioVenn/index.html), I improve the data output and delete the `output` parameter.
#' on the next step , I want be add the ggplot2 on the function which draw venn plot. or change the postion of group title name whcih is on the circ point now.
#'
#' This function creates an area-proportional Venn diagram of 2 or 3 circles, based on lists of (biological) identifiers.
#' It requires three parameters: input lists X, Y and Z. For a 2-circle Venn diagram, one of these lists
#' should be left empty. Duplicate identifiers are removed automatically, and a mapping from Entrez and/or
#' Affymetrix to Ensembl IDs is available. BioVenn is case-sensitive. In SVG mode, text and numbers can be dragged and dropped.
#'
#' When using a BioVenn diagram for a publication, please cite:
#' BioVenn - a web application for the comparison and visualization of biological lists using area-proportional Venn diagrams
#' T. Hulsen, J. de Vlieg and W. Alkema, BMC Genomics 2008, 9 (1): 488
#'
#' @param list_x (Required) List with IDs from dataset X
#' @param list_y (Required) List with IDs from dataset Y
#' @param list_z (Required) List with IDs from dataset Z
#' @param title (Optional) The title of the Venn diagram
#' @param t_f (Optional) The font of the main title (default is "serif")
#' @param t_fb (Optional) The font "face" of the main title (1=plain, 2=bold, 3=italic, 4=bold-italic; default is 2)
#' @param t_s (Optional) The size of the main title (cex; relative to the standard size; default is 1.5)
#' @param t_c (Optional) The colour of the main title (default is "black")
#' @param subtitle (Optional) The subtitle of the Venn diagram (default is "(C) 2007-2020 Tim Hulsen")
#' @param st_f (Optional) The font of the subtitle (default is "serif")
#' @param st_fb (Optional) The font "face" of the subtitle (1=plain, 2=bold, 3=italic, 4=bold-italic; default is 2)
#' @param st_s (Optional) The size of the subtitle (cex; relative to the standard size; default is 1.2)
#' @param st_c (Optional) The colour of the subtitle (default is "black")
#' @param xtitle (Optional) The X title of the Venn diagram (default is "ID set X")
#' @param xt_f (Optional) The font of the X title (default is "serif")
#' @param xt_fb (Optional) The font "face" of the X title (1=plain, 2=bold, 3=italic, 4=bold-italic; default is 2)
#' @param xt_s (Optional) The size of the X title (cex; relative to the standard size; default is 1)
#' @param xt_c (Optional) The colour of the X title (default is "black")
#' @param ytitle (Optional) The Y title of the Venn diagram (default is "ID set Y")
#' @param yt_f (Optional) The font of the Y title (default is "serif")
#' @param yt_fb (Optional) The font "face" of the Y title (1=plain, 2=bold, 3=italic, 4=bold-italic; default is 2)
#' @param yt_s (Optional) The size of the Y title (cex; relative to the standard size; default is 1)
#' @param yt_c (Optional) The colour of the Y title (default is "black")
#' @param ztitle (Optional) The Z title of the Venn diagram (default is "ID set Z")
#' @param zt_f (Optional) The font of the Z title (default is "serif")
#' @param zt_fb (Optional) The font "face" of the Z title (1=plain, 2=bold, 3=italic, 4=bold-italic; default is 2)
#' @param zt_s (Optional) The size of the Z title (cex; relative to the standard size; default is 1)
#' @param zt_c (Optional) The colour of the Z title (default is "black")
#' @param nrtype (Optional) The type of the numbers to be displayed: absolute (abs) numbers or percentages (pct) (default is "abs")
#' @param nr_f (Optional) The font of the numbers (default is "serif")
#' @param nr_fb (Optional) The font "face" of the numbers (1=plain, 2=bold, 3=italic, 4=bold-italic; default is 2)
#' @param nr_s (Optional) The size of the numbers (cex; relative to the standard size; default is 1)
#' @param nr_c (Optional) The colour of the numbers (default is "black")
#' @param x_c (Optional) The colour of the X circle (default is "red")
#' @param y_c (Optional) The colour of the X circle (default is "green")
#' @param z_c (Optional) The colour of the X circle (default is "blue")
#' @param bg_c (Optional) The background colour (default is "white")
#' @param width (Optional) The width of the output file (in pixels for BMP/JPEG/PNG/TIF or in centiinch for PDF/SVG; default is 1000)
#' @param height (Optional) The height of the output file (in pixels for BMP/JPEG/PNG/TIF or in centiinch for PDF/SVG; default is 1000)
#' @param filename (Optional) The name of the output file (default is "biovenn" + extension of the selected output format)
#' @return An image of the Venn diagram is generated in the desired output format.
#' @return Also returns an object with thirteen lists: X, Y, Z, X only, Y only, Z only, XY, XZ, YZ, XY only, XZ only, YZ only, XYZ.
#' @import graphics grDevices plotrix
#' @examples
#' list_x <- c("1007_s_at","1053_at","117_at","121_at","1255_g_at","1294_at")
#' list_y <- c("1255_g_at","1294_at","1316_at","1320_at","1405_i_at")
#' list_z <- c("1007_s_at","1405_i_at","1255_g_at","1431_at","1438_at","1487_at","1494_f_at")
#' biovenn <- vennplot(list_x, list_y, list_z, subtitle="Example diagram", nrtype="abs")
#' @export
vennplot <- function(list_x = NULL,
list_y = NULL,
list_z = NULL,
title="Venn Plot",
subtitle="Creat diagram by R packages xbox",
t_f="serif", t_fb=2, t_s=1.5, t_c="black",
st_f="serif", st_fb=4, st_s=1.5, st_c="black",
xtitle="X Set", xt_f="serif", xt_fb=2, xt_s=1.5, xt_c="white",
ytitle="Y Set", yt_f="serif", yt_fb=2, yt_s=1.5, yt_c="white",
ztitle="Z Set", zt_f="serif", zt_fb=2, zt_s=1.5, zt_c="white",
nrtype="abs", nr_f="serif", nr_fb=2, nr_s=1, nr_c="black",
x_c="#02786A", y_c="#D23918", z_c="#4C8045", bg_c="white",
width=100, height=100, filename=NULL
){
# Make input lists unique
list_x <- unique(list_x)
list_y <- unique(list_y)
list_z <- unique(list_z)
# Generate lists and calculate numbers
x <- length(list_x)
y <- length(list_y)
z <- length(list_z)
list_xy <- intersect(list_x, list_y)
xy <- length(list_xy)
list_xz <- intersect(list_x, list_z)
xz <- length(list_xz)
list_yz <- intersect(list_y, list_z)
yz <- length(list_yz)
list_xyz <- intersect(list_xy, list_z)
xyz <- length(list_xyz)
list_all <- unique(c(x,y,z))
xyz_all <- length(list_all)
list_xy_only <- setdiff(list_xy, list_xyz)
xy_only <- length(list_xy_only)
list_xz_only <- setdiff(list_xz, list_xyz)
xz_only <- length(list_xz_only)
list_yz_only <- setdiff(list_yz, list_xyz)
yz_only <- length(list_yz_only)
list_x_only <- setdiff(list_x, c(list_xy, list_xz))
x_only <- length(list_x_only)
list_y_only <- setdiff(list_y, c(list_xy,list_yz))
y_only <- length(list_y_only)
list_z_only <- setdiff(list_z, c(list_xz,list_yz))
z_only <- length(list_z_only)
# Print numerical outpu
venn_data <- data.frame(
check.names = FALSE,
x.total = x,
y.total = y,
z.total = z,
x.only = x_only,
y_only = y_only,
z_only = z_only,
`xuy` = xy,
`xuz` = xz,
`yuz` = yz,
`xny` = xy_only,
`xnz` = xz_only,
`ynz` = yz_only,
`xnynz` = xyz,
`xuyuz` = xyz_all
)
cat(paste(rep("-",getOption("width")),collapse=""),"\n")
cat("Venn Data:","\n")
print.data.frame(venn_data,row.names = FALSE)
cat(paste(rep("-",getOption("width")),collapse=""),"\n")
# -V- NOT CHANGE by ME
# function
# Define sq function
sq <- function(nr)
{
nr=nr^2
return(nr)
}
# Define sqr function
sqr <- function(nr)
{
nr=sqrt(round(abs(nr)))
return(nr)
}
# Define arccos function
arccos <- function(nr)
{
nr=acos(min(max(-1,round(nr,5)),1))
return(nr)
}
# Set width and height of plotting area
width_p=1000
height_p=1000
# Amplification
amp=100000/(x+y+z-xy-xz-yz+xyz)
x_text=x
x=x*amp
y_text=y
y=y*amp
z_text=z
z=z*amp
xy_text=xy
xy=xy*amp
xz_text=xz
xz=xz*amp
yz_text=yz
yz=yz*amp
xyz_text=xyz
xyz=xyz*amp
total=x+y+z-xy-xz-yz+xyz
total_text=x_text+y_text+z_text-xy_text-xz_text-yz_text+xyz_text
# Radius calculation
x_r=sqr(x/pi)
y_r=sqr(y/pi)
z_r=sqr(z/pi)
# Distance calculation (with 0.001 error margin)
xy_d=x_r+y_r
if(x&&y)
{
while(xy*0.999>sq(x_r)*arccos((sq(xy_d)+sq(x_r)-sq(y_r))/(2*xy_d*x_r))+sq(y_r)*arccos((sq(xy_d)+sq(y_r)-sq(x_r))/(2*xy_d*y_r))-0.5*sqr(round((xy_d+x_r+y_r)*(xy_d+x_r-y_r)*(xy_d-x_r+y_r)*(-xy_d+x_r+y_r),5)))
{
xy_d=xy_d-min(x_r,y_r)/1000.0
}
}
xz_d=x_r+z_r
if(x&&z)
{
while(xz*0.999>sq(x_r)*arccos((sq(xz_d)+sq(x_r)-sq(z_r))/(2*xz_d*x_r))+sq(z_r)*arccos((sq(xz_d)+sq(z_r)-sq(x_r))/(2*xz_d*z_r))-0.5*sqr(round((xz_d+x_r+z_r)*(xz_d+x_r-z_r)*(xz_d-x_r+z_r)*(-xz_d+x_r+z_r),5)))
{
xz_d=xz_d-min(x_r,z_r)/1000.0
}
}
yz_d=y_r+z_r
if(y&&z)
{
while(yz*0.999>sq(y_r)*arccos((sq(yz_d)+sq(y_r)-sq(z_r))/(2*yz_d*y_r))+sq(z_r)*arccos((sq(yz_d)+sq(z_r)-sq(y_r))/(2*yz_d*z_r))-0.5*sqr(round((yz_d+y_r+z_r)*(yz_d+y_r-z_r)*(yz_d-y_r+z_r)*(-yz_d+y_r+z_r),5)))
{
yz_d=yz_d-min(y_r,z_r)/1000.0
}
}
# Distance calculation for horizontally plotted diagrams
if(xy_d>xz_d+yz_d)
{
xy_d=xz_d+yz_d
}
if(xz_d>xy_d+yz_d)
{
xz_d=xy_d+yz_d
}
if(yz_d>xy_d+xz_d)
{
yz_d=xy_d+xz_d
}
# Angle calculation
x_a=arccos((sq(xy_d)+sq(xz_d)-sq(yz_d))/(2*xy_d*xz_d))
y_a=arccos((sq(xy_d)+sq(yz_d)-sq(xz_d))/(2*xy_d*yz_d))
z_a=arccos((sq(xz_d)+sq(yz_d)-sq(xy_d))/(2*xz_d*yz_d))
x_yz=xz_d*sin(z_a)
y_yz=xy_d*cos(y_a)
# PPU calculation
width_h=max(y_r+y_yz,x_r,z_r-yz_d+y_yz)+max(x_r,y_r-y_yz,z_r+yz_d-y_yz)
ppu_h=width_p/width_h
width_v=max(x_r+x_yz,y_r,z_r)+max(y_r,z_r,x_r-x_yz)
ppu_v=height_p/width_v
ppu=min(ppu_h,ppu_v)
# Circle center calculation
x_h=max(x_r,y_r+y_yz,z_r-yz_d+y_yz)
x_v=max(x_r,y_r-x_yz,z_r-x_yz)
y_h=max(x_r-y_yz,y_r,z_r-yz_d)
y_v=max(x_r+x_yz,y_r,z_r)
z_h=max(x_r+yz_d-y_yz,y_r+yz_d,z_r)
z_v=max(x_r+x_yz,y_r,z_r)
# Calculate intersection points X-Y (first inner, then outer)
xy_i_h_part1=(x_h+y_h)/2+((y_h-x_h)*(sq(x_r)-sq(y_r)))/(2*sq(xy_d))
xy_i_v_part1=(x_v+y_v)/2+((y_v-x_v)*(sq(x_r)-sq(y_r)))/(2*sq(xy_d))
xy_i_h_part2=2*((x_v-y_v)/sq(xy_d))*sqr((xy_d+x_r+y_r)*(xy_d+x_r-y_r)*(xy_d-x_r+y_r)*(-xy_d+x_r+y_r))/4
xy_i_v_part2=2*((x_h-y_h)/sq(xy_d))*sqr((xy_d+x_r+y_r)*(xy_d+x_r-y_r)*(xy_d-x_r+y_r)*(-xy_d+x_r+y_r))/4
xy_i1_h=xy_i_h_part1-xy_i_h_part2
xy_i1_v=xy_i_v_part1+xy_i_v_part2
xy_i2_h=xy_i_h_part1+xy_i_h_part2
xy_i2_v=xy_i_v_part1-xy_i_v_part2
# Calculate intersection points X-Z (first inner, then outer)
xz_i_h_part1=(x_h+z_h)/2+((z_h-x_h)*(sq(x_r)-sq(z_r)))/(2*sq(xz_d))
xz_i_v_part1=(x_v+z_v)/2+((z_v-x_v)*(sq(x_r)-sq(z_r)))/(2*sq(xz_d))
xz_i_h_part2=2*((x_v-z_v)/sq(xz_d))*sqr((xz_d+x_r+z_r)*(xz_d+x_r-z_r)*(xz_d-x_r+z_r)*(-xz_d+x_r+z_r))/4
xz_i_v_part2=2*((x_h-z_h)/sq(xz_d))*sqr((xz_d+x_r+z_r)*(xz_d+x_r-z_r)*(xz_d-x_r+z_r)*(-xz_d+x_r+z_r))/4
xz_i1_h=xz_i_h_part1+xz_i_h_part2
xz_i1_v=xz_i_v_part1-xz_i_v_part2
xz_i2_h=xz_i_h_part1-xz_i_h_part2
xz_i2_v=xz_i_v_part1+xz_i_v_part2
# Calculate intersection points Y-Z (first inner, then outer)
yz_i_h_part1=(y_h+z_h)/2+((z_h-y_h)*(sq(y_r)-sq(z_r)))/(2*sq(yz_d))
yz_i_v_part1=(y_v+z_v)/2+((z_v-y_v)*(sq(y_r)-sq(z_r)))/(2*sq(yz_d))
yz_i_h_part2=2*((y_v-z_v)/sq(yz_d))*sqr((yz_d+y_r+z_r)*(yz_d+y_r-z_r)*(yz_d-y_r+z_r)*(-yz_d+y_r+z_r))/4
yz_i_v_part2=2*((y_h-z_h)/sq(yz_d))*sqr((yz_d+y_r+z_r)*(yz_d+y_r-z_r)*(yz_d-y_r+z_r)*(-yz_d+y_r+z_r))/4
yz_i1_h=yz_i_h_part1-yz_i_h_part2
yz_i1_v=yz_i_v_part1+yz_i_v_part2
yz_i2_h=yz_i_h_part1+yz_i_h_part2
yz_i2_v=yz_i_v_part1-yz_i_v_part2
# Number fill point calculation of XYZ
if(x&&y&&z)
{
xyz_f_h=(xy_i1_h+xz_i1_h+yz_i1_h)/3
xyz_f_v=(xy_i1_v+xz_i1_v+yz_i1_v)/3
}
# Number fill point calculation of X-only
# For XYZ diagrams
if(x&&y&&z&&xy&&xz)
{
xyz_yz_i1=sqr(sq(xyz_f_h-yz_i1_h)+sq(xyz_f_v-yz_i1_v))
x_ratio_h=(xyz_f_h-yz_i1_h)/xyz_yz_i1
x_ratio_v=(xyz_f_v-yz_i1_v)/xyz_yz_i1
x_out_h=x_h-x_r*x_ratio_h
x_out_v=x_v-x_r*x_ratio_v
x_f_h=(x_out_h+yz_i1_h)/2
x_f_v=(x_out_v+yz_i1_v)/2
}
# For XY diagrams or XYZ diagrams without XZ overlap
else if(x&&y&&!z||x&&y&&z&&!xz)
{
xy_f_h=(xy_i1_h+xy_i2_h)/2
xy_f_v=(xy_i1_v+xy_i2_v)/2
x_in_h=y_h+cos(y_a)*y_r
x_in_v=y_v-sin(y_a)*y_r
x_out_h=x_h+cos(y_a)*x_r
x_out_v=x_v-sin(y_a)*x_r
x_f_h=(x_out_h+x_in_h)/2
x_f_v=(x_out_v+x_in_v)/2
}
# For XZ diagrams or XYZ diagrams without XY overlap
else if(x&&!y&&z||x&&y&&z&&!xy)
{
xz_f_h=(xz_i1_h+xz_i2_h)/2
xz_f_v=(xz_i1_v+xz_i2_v)/2
x_in_h=z_h-cos(z_a)*z_r
x_in_v=z_v-sin(z_a)*z_r
x_out_h=x_h-cos(z_a)*x_r
x_out_v=x_v-sin(z_a)*x_r
x_f_h=(x_out_h+x_in_h)/2
x_f_v=(x_out_v+x_in_v)/2
}
# Number fill point calculation of Y-only
# For XYZ diagrams
if(x&&y&&z&&xy&&yz)
{
xyz_xz_i1=sqr(sq(xyz_f_h-xz_i1_h)+sq(xyz_f_v-xz_i1_v))
y_ratio_h=(xyz_f_h-xz_i1_h)/xyz_xz_i1
y_ratio_v=(xyz_f_v-xz_i1_v)/xyz_xz_i1
y_out_h=y_h-y_r*y_ratio_h
y_out_v=y_v-y_r*y_ratio_v
y_f_h=(y_out_h+xz_i1_h)/2
y_f_v=(y_out_v+xz_i1_v)/2
}
# For XY diagrams or XYZ diagrams without YZ overlap
else if(x&&y&&!z||x&&y&&z&&!yz)
{
xy_f_h=(xy_i1_h+xy_i2_h)/2
xy_f_v=(xy_i1_v+xy_i2_v)/2
y_in_h=x_h-cos(y_a)*x_r
y_in_v=x_v+sin(y_a)*x_r
y_out_h=y_h-cos(y_a)*y_r
y_out_v=y_v+sin(y_a)*y_r
y_f_h=(y_out_h+y_in_h)/2
y_f_v=(y_out_v+y_in_v)/2
}
# For YZ diagrams or XYZ diagrams without XY overlap
else if(!x&&y&&z||x&&y&&z&&!xy)
{
yz_f_h=(yz_i1_h+yz_i2_h)/2
yz_f_v=(yz_i1_v+yz_i2_v)/2
y_in_h=z_h-z_r
y_in_v=z_v
y_out_h=y_h-y_r
y_out_v=y_v
y_f_h=(y_out_h+y_in_h)/2
y_f_v=(y_out_v+y_in_v)/2
}
# Number fill point calculation of Z-only
# For XYZ diagrams
if(x&&y&&z&&xz&&yz)
{
xyz_xy_i1=sqr(sq(xyz_f_h-xy_i1_h)+sq(xyz_f_v-xy_i1_v))
z_ratio_h=(xyz_f_h-xy_i1_h)/xyz_xy_i1
z_ratio_v=(xyz_f_v-xy_i1_v)/xyz_xy_i1
z_out_h=z_h-z_r*z_ratio_h
z_out_v=z_v-z_r*z_ratio_v
z_f_h=(z_out_h+xy_i1_h)/2
z_f_v=(z_out_v+xy_i1_v)/2
}
# For XZ diagrams or XYZ diagrams without YZ overlap
else if(x&&!y&&z||x&&y&&z&&!yz)
{
xz_f_h=(xz_i1_h+xz_i2_h)/2
xz_f_v=(xz_i1_v+xz_i2_v)/2
z_in_h=x_h+cos(z_a)*x_r
z_in_v=x_v+sin(z_a)*x_r
z_out_h=z_h+cos(z_a)*z_r
z_out_v=z_v+sin(z_a)*z_r
z_f_h=(z_out_h+z_in_h)/2
z_f_v=(z_out_v+z_in_v)/2
}
# For YZ diagrams or XYZ diagrams without XZ overlap
else if(!x&&y&&z||x&&y&&z&&!xz)
{
yz_f_h=(yz_i1_h+yz_i2_h)/2
yz_f_v=(yz_i1_v+yz_i2_v)/2
z_in_h=y_h+z_r
z_in_v=y_v
z_out_h=z_h+y_r
z_out_v=z_v
z_f_h=(z_out_h+z_in_h)/2
z_f_v=(z_out_v+z_in_v)/2
}
# Number fill point calculation of XY-only
if(x&&y&&z)
{
dh=(xyz_f_h-z_h)-(xy_i2_h-z_h)
dv=(xyz_f_v-z_v)-(xy_i2_v-z_v)
dr=sqr(sq(dh)+sq(dv))
D=(xy_i2_h-z_h)*(xyz_f_v-z_v)-(xyz_f_h-z_h)*(xy_i2_v-z_v)
z_in_h=z_h+(D*dv-dh*sqr(sq(z_r)*sq(dr)-sq(D)))/sq(dr)
z_in_v=z_v+(-D*dh-abs(dv)*sqr(sq(z_r)*sq(dr)-sq(D)))/sq(dr)
xy_f_h=(z_in_h+xy_i2_h)/2
xy_f_v=(z_in_v+xy_i2_v)/2
}
# Number fill point calculation of XZ-only
if(x&&y&&z)
{
dh=(xyz_f_h-y_h)-(xz_i2_h-y_h)
dv=(xyz_f_v-y_v)-(xz_i2_v-y_v)
dr=sqr(sq(dh)+sq(dv))
D=(xz_i2_h-y_h)*(xyz_f_v-y_v)-(xyz_f_h-y_h)*(xz_i2_v-y_v)
y_in_h=y_h+(D*dv-dh*sqr(sq(y_r)*sq(dr)-sq(D)))/sq(dr)
y_in_v=y_v+(-D*dh-abs(dv)*sqr(sq(y_r)*sq(dr)-sq(D)))/sq(dr)
xz_f_h=(y_in_h+xz_i2_h)/2
xz_f_v=(y_in_v+xz_i2_v)/2
}
# Number fill point calculation of YZ-only
if(x&&y&&z)
{
dh=(xyz_f_h-x_h)-(yz_i2_h-x_h)
dv=(xyz_f_v-x_v)-(yz_i2_v-x_v)
dr=sqr(sq(dh)+sq(dv))
D=(yz_i2_h-x_h)*(xyz_f_v-x_v)-(xyz_f_h-x_h)*(yz_i2_v-x_v)
x_in_h=x_h+(D*dv-dh*sqr(sq(x_r)*sq(dr)-sq(D)))/sq(dr)
x_in_v=x_v+(-D*dh+abs(dv)*sqr(sq(x_r)*sq(dr)-sq(D)))/sq(dr)
yz_f_h=(x_in_h+yz_i2_h)/2
yz_f_v=(x_in_v+yz_i2_v)/2
}
# Number fill point calculation for horizontally plotted diagrams
if(xy_d==xz_d+yz_d||xz_d==xy_d+yz_d||yz_d==xy_d+xz_d)
{
# No X-only and no Y-only
if(x&&!x_only&&y&&!y_only)
{
xz_f_v=yz_f_v=xyz_f_v=x_v
xz_f_h=(max(y_h+y_r,x_h-x_r)+(x_h+x_r))/2
yz_f_h=((y_h-y_r)+min(y_h+y_r,x_h-x_r))/2
#z_f_h, z_f_v stay the same
}
# No X-only and no Z-only
else if(x&&!x_only&&z&&!z_only)
{
xy_f_v=yz_f_v=xyz_f_v=x_v
xy_f_h=((x_h-x_r)+min(x_h+x_r,z_h-z_r))/2
yz_f_h=(max(x_h+x_r,z_h-z_r)+(z_h+z_r))/2
#y_f_h, y_f_v stay the same
}
# No Y-only and no Z-only
else if(y&&!y_only&&z&&!z_only)
{
yz_f_v=xz_f_v=xyz_f_v=x_v
yz_f_h=(max(x_h+x_r,y_h-y_r)+(y_h+y_r))/2
xz_f_h=(max(y_h+y_r,z_h-z_r)+(z_h+z_r))/2
#x_f_h, x_f_v stay the same
}
# No X-only
else if(x&&!x_only)
{
yz_f_v=xyz_f_v=x_v
# X is subset of Y
if(!xz_only)
{
z_f_h=(max(x_h+x_r,y_h+y_r)+(z_h+z_r))/2
z_f_v=x_v
xy_f_h=(max(y_h-y_r,x_h-x_r)+(z_h-z_r))/2
xy_f_v=x_v
yz_f_h=(max(x_h+x_r,z_h-z_r)+(y_h+y_r))/2
#y_f_h, y_f_v stay the same
}
# X is subset of Z
else if(!xy_only)
{
y_f_h=((y_h-y_r)+min(z_h-z_r,x_h-x_r))/2
y_f_v=x_v
xz_f_h=(max(y_h+y_r,x_h-x_r)+(x_h+x_r))/2
xz_f_v=x_v
yz_f_h=((z_h-z_r)+min(y_h+y_r,x_h-x_r))/2
#z_f_h, z_f_v stay the same
}
}
# No Y-only
else if(y&&!y_only)
{
xz_f_v=xyz_f_v=x_v
# Y is subset of X
if(!yz_only)
{
z_f_h=(max(y_h+y_r,x_h+x_r)+(z_h+z_r))/2
z_f_v=x_v
xy_f_h=((y_h-y_r)+min(y_h+y_r,z_h-z_r))/2
xy_f_v=x_v
xz_f_h=(max(y_h+y_r,z_h-z_r)+(x_h+x_r))/2
#x_f_h, x_f_v stay the same
}
# Y is subset of Z
else if(!xy_only)
{
x_f_h=(max(y_h+y_r,z_h+z_r)+(x_h+x_r))/2
x_f_v=x_v
yz_f_h=((y_h-y_r)+max(y_h+y_r,x_h-x_r))/2
yz_f_v=x_v
xz_f_h=(max(y_h+y_r,x_h-x_r)+(z_h+z_r))/2
#z_f_h, z_f_v stay the same
}
}
# No Z-only
else if(z&&!z_only)
{
xy_f_v=xyz_f_v=x_v
# Z is subset of X
if(!yz_only)
{
y_f_h=((y_h-y_r)+min(x_h-x_r,z_h-z_r))/2
y_f_v=x_v
xz_f_h=(max(y_h+y_r,z_h-z_r)+(z_h+z_r))/2
xz_f_v=x_v
xy_f_h=((x_h-x_r)+min(y_h+y_r,z_h-z_r))/2
#x_f_h, x_f_v stay the same
}
# Z is subset of Y
else if(!xz_only)
{
x_f_h=((x_h-x_r)+min(y_h-y_r,z_h-z_r))/2
x_f_v=x_v
yz_f_h=(max(x_h+x_r,z_h-z_r)+(z_h+z_r))/2
yz_f_v=x_v
xy_f_h=((y_h-y_r)+min(x_h+x_r,z_h-z_r))/2
#y_f_h, y_f_v stay the same
}
}
xyz_f_h=(max(x_h-x_r,y_h-y_r,z_h-z_r)+min(x_h+x_r,y_h+y_r,z_h+z_r))/2
}
#Get file type:change by wangjaixuan0123
if(!is.null(filename)){
r = regexpr("\\.[a-zA-Z]*$", filename)
if(r == -1) stop("Improper filename")
ending = substr(filename, r + 1, r + attr(r, "match.length"))
f = switch(ending,
pdf = function(x, ...) pdf(x, ...),
png = function(x, ...) png(x, units="px", ...),
jpeg = function(x, ...) jpeg(x, units="px", ...),
jpg = function(x, ...) jpeg(x, units="px", ...),
tiff = function(x, ...) tiff(x, units="px", ...),
bmp = function(x, ...) bmp(x, units="px", ...),
stop("File type should be: pdf, png, bmp, jpg, tiff")
)
f(filename, height = height, width = width)
}
# Draw circles
opar<-graphics::par(no.readonly=TRUE)
on.exit(graphics::par(opar))
graphics::par(pty="s",bg=bg_c)
graphics::plot(0,type="n",axes=FALSE,xlim=c(0,width_p),ylim=c(height_p,0),xlab="",ylab="",xaxt="none",yaxt="none")
graphics::par(family=t_f)
graphics::title(main=title,line=1,font.main=t_fb,cex.main=t_s,col.main=t_c)
graphics::par(family=st_f)
graphics::title(sub=subtitle,line=1,font.sub=st_fb,cex.sub=st_s,col.sub=st_c)
plotrix::draw.circle(ppu*x_h,ppu*x_v,ppu*x_r,lty=0,col=grDevices::rgb(grDevices::col2rgb(x_c)[,1][1],grDevices::col2rgb(x_c)[,1][2],grDevices::col2rgb(x_c)[,1][3],maxColorValue=255,alpha=128))
plotrix::draw.circle(ppu*y_h,ppu*y_v,ppu*y_r,lty=0,col=grDevices::rgb(grDevices::col2rgb(y_c)[,1][1],grDevices::col2rgb(y_c)[,1][2],grDevices::col2rgb(y_c)[,1][3],maxColorValue=255,alpha=128))
plotrix::draw.circle(ppu*z_h,ppu*z_v,ppu*z_r,lty=0,col=grDevices::rgb(grDevices::col2rgb(z_c)[,1][1],grDevices::col2rgb(z_c)[,1][2],grDevices::col2rgb(z_c)[,1][3],maxColorValue=255,alpha=128))
# Print numbers
if(length(nrtype)>0)
{
if(nrtype=="abs")
{
if(x_only)
{
graphics::text(ppu*x_f_h,ppu*x_f_v,x_only,adj=c(0.5,0.5),col=nr_c,family=nr_f,font=nr_fb,cex=nr_s)
}
if(y_only)
{
graphics::text(ppu*y_f_h,ppu*y_f_v,y_only,adj=c(0.5,0.5),col=nr_c,family=nr_f,font=nr_fb,cex=nr_s)
}
if(z_only)
{
graphics::text(ppu*z_f_h,ppu*z_f_v,z_only,adj=c(0.5,0.5),col=nr_c,family=nr_f,font=nr_fb,cex=nr_s)
}
if(xy_only)
{
graphics::text(ppu*xy_f_h,ppu*xy_f_v,xy_only,adj=c(0.5,0.5),col=nr_c,family=nr_f,font=nr_fb,cex=nr_s)
}
if(xz_only)
{
graphics::text(ppu*xz_f_h,ppu*xz_f_v,xz_only,adj=c(0.5,0.5),col=nr_c,family=nr_f,font=nr_fb,cex=nr_s)
}
if(yz_only)
{
graphics::text(ppu*yz_f_h,ppu*yz_f_v,yz_only,adj=c(0.5,0.5),col=nr_c,family=nr_f,font=nr_fb,cex=nr_s)
}
if(xyz)
{
graphics::text(ppu*xyz_f_h,ppu*xyz_f_v,xyz_text,adj=c(0.5,0.5),col=nr_c,family=nr_f,font=nr_fb,cex=nr_s)
}
}
else if(nrtype=="pct")
{
if(x_only)
{
graphics::text(ppu*x_f_h,ppu*x_f_v,paste0(round(x_only/total_text*100,2),"%"),adj=c(0.5,0.5),col=nr_c,family=nr_f,font=nr_fb,cex=nr_s)
}
if(y_only)
{
graphics::text(ppu*y_f_h,ppu*y_f_v,paste0(round(y_only/total_text*100,2),"%"),adj=c(0.5,0.5),col=nr_c,family=nr_f,font=nr_fb,cex=nr_s)
}
if(z_only)
{
graphics::text(ppu*z_f_h,ppu*z_f_v,paste0(round(z_only/total_text*100,2),"%"),adj=c(0.5,0.5),col=nr_c,family=nr_f,font=nr_fb,cex=nr_s)
}
if(xy_only)
{
graphics::text(ppu*xy_f_h,ppu*xy_f_v,paste0(round(xy_only/total_text*100,2),"%"),adj=c(0.5,0.5),col=nr_c,family=nr_f,font=nr_fb,cex=nr_s)
}
if(xz_only)
{
graphics::text(ppu*xz_f_h,ppu*xz_f_v,paste0(round(xz_only/total_text*100,2),"%"),adj=c(0.5,0.5),col=nr_c,family=nr_f,font=nr_fb,cex=nr_s)
}
if(yz_only)
{
graphics::text(ppu*yz_f_h,ppu*yz_f_v,paste0(round(yz_only/total_text*100,2),"%"),adj=c(0.5,0.5),col=nr_c,family=nr_f,font=nr_fb,cex=nr_s)
}
if(xyz)
{
graphics::text(ppu*xyz_f_h,ppu*xyz_f_v,paste0(round(xyz_text/total_text*100,2),"%"),adj=c(0.5,0.5),col=nr_c,family=nr_f,font=nr_fb,cex=nr_s)
}
}
}
# Print texts
if(x)
{
graphics::text(ppu*x_h,ppu*x_v,xtitle,adj=c(0.5,0.5),col=xt_c,family=xt_f,font=xt_fb,cex=xt_s)
}
if(y)
{
graphics::text(ppu*y_h,ppu*y_v,ytitle,adj=c(0.5,0.5),col=yt_c,family=yt_f,font=yt_fb,cex=yt_s)
}
if(z)
{
graphics::text(ppu*z_h,ppu*z_v,ztitle,adj=c(0.5,0.5),col=zt_c,family=zt_f,font=zt_fb,cex=zt_s)
}
# Write to file
if(!is.null(filename)){grDevices::dev.off()}
# Return lists
venn_list = list("x"=list_x,"y"=list_y,"z"=list_z,"x_only"=list_x_only,"y_only"=list_y_only,"z_only"=list_z_only,"xy"=list_xy,"xz"=list_xz,"yz"=list_yz,"xy_only"=list_xy_only,"xz_only"=list_xz_only,"yz_only"=list_yz_only,"xyz"=list_xyz)
venn <- list("number" = venn_data, "id" = venn_list)
invisible(venn)
}
wangjiaxuan666/xbox documentation built on Sept. 4, 2024, 5:03 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions vennplot
Documented in vennplot
#' Draw an area-proportional Venn diagram of 2 or 3 circles change by wangjiaxuan
#'
#' The function from bioVenn R packages(https://cran.r-project.org/web/packages/BioVenn/index.html), I improve the data output and delete the `output` parameter.
#' on the next step , I want be add the ggplot2 on the function which draw venn plot. or change the postion of group title name whcih is on the circ point now.
#'
#' This function creates an area-proportional Venn diagram of 2 or 3 circles, based on lists of (biological) identifiers.
#' It requires three parameters: input lists X, Y and Z. For a 2-circle Venn diagram, one of these lists
#' should be left empty. Duplicate identifiers are removed automatically, and a mapping from Entrez and/or
#' Affymetrix to Ensembl IDs is available. BioVenn is case-sensitive. In SVG mode, text and numbers can be dragged and dropped.
#'
#' When using a BioVenn diagram for a publication, please cite:
#' BioVenn - a web application for the comparison and visualization of biological lists using area-proportional Venn diagrams
#' T. Hulsen, J. de Vlieg and W. Alkema, BMC Genomics 2008, 9 (1): 488
#'
#' @param list_x (Required) List with IDs from dataset X
#' @param list_y (Required) List with IDs from dataset Y
#' @param list_z (Required) List with IDs from dataset Z
#' @param title (Optional) The title of the Venn diagram
#' @param t_f (Optional) The font of the main title (default is "serif")
#' @param t_fb (Optional) The font "face" of the main title (1=plain, 2=bold, 3=italic, 4=bold-italic; default is 2)
#' @param t_s (Optional) The size of the main title (cex; relative to the standard size; default is 1.5)
#' @param t_c (Optional) The colour of the main title (default is "black")
#' @param subtitle (Optional) The subtitle of the Venn diagram (default is "(C) 2007-2020 Tim Hulsen")
#' @param st_f (Optional) The font of the subtitle (default is "serif")
#' @param st_fb (Optional) The font "face" of the subtitle (1=plain, 2=bold, 3=italic, 4=bold-italic; default is 2)
#' @param st_s (Optional) The size of the subtitle (cex; relative to the standard size; default is 1.2)
#' @param st_c (Optional) The colour of the subtitle (default is "black")
#' @param xtitle (Optional) The X title of the Venn diagram (default is "ID set X")
#' @param xt_f (Optional) The font of the X title (default is "serif")
#' @param xt_fb (Optional) The font "face" of the X title (1=plain, 2=bold, 3=italic, 4=bold-italic; default is 2)
#' @param xt_s (Optional) The size of the X title (cex; relative to the standard size; default is 1)
#' @param xt_c (Optional) The colour of the X title (default is "black")
#' @param ytitle (Optional) The Y title of the Venn diagram (default is "ID set Y")
#' @param yt_f (Optional) The font of the Y title (default is "serif")
#' @param yt_fb (Optional) The font "face" of the Y title (1=plain, 2=bold, 3=italic, 4=bold-italic; default is 2)
#' @param yt_s (Optional) The size of the Y title (cex; relative to the standard size; default is 1)
#' @param yt_c (Optional) The colour of the Y title (default is "black")
#' @param ztitle (Optional) The Z title of the Venn diagram (default is "ID set Z")
#' @param zt_f (Optional) The font of the Z title (default is "serif")
#' @param zt_fb (Optional) The font "face" of the Z title (1=plain, 2=bold, 3=italic, 4=bold-italic; default is 2)
#' @param zt_s (Optional) The size of the Z title (cex; relative to the standard size; default is 1)
#' @param zt_c (Optional) The colour of the Z title (default is "black")
#' @param nrtype (Optional) The type of the numbers to be displayed: absolute (abs) numbers or percentages (pct) (default is "abs")
#' @param nr_f (Optional) The font of the numbers (default is "serif")
#' @param nr_fb (Optional) The font "face" of the numbers (1=plain, 2=bold, 3=italic, 4=bold-italic; default is 2)
#' @param nr_s (Optional) The size of the numbers (cex; relative to the standard size; default is 1)
#' @param nr_c (Optional) The colour of the numbers (default is "black")
#' @param x_c (Optional) The colour of the X circle (default is "red")
#' @param y_c (Optional) The colour of the X circle (default is "green")
#' @param z_c (Optional) The colour of the X circle (default is "blue")
#' @param bg_c (Optional) The background colour (default is "white")
#' @param width (Optional) The width of the output file (in pixels for BMP/JPEG/PNG/TIF or in centiinch for PDF/SVG; default is 1000)
#' @param height (Optional) The height of the output file (in pixels for BMP/JPEG/PNG/TIF or in centiinch for PDF/SVG; default is 1000)
#' @param filename (Optional) The name of the output file (default is "biovenn" + extension of the selected output format)
#' @return An image of the Venn diagram is generated in the desired output format.
#' @return Also returns an object with thirteen lists: X, Y, Z, X only, Y only, Z only, XY, XZ, YZ, XY only, XZ only, YZ only, XYZ.
#' @import graphics grDevices plotrix
#' @examples
#' list_x <- c("1007_s_at","1053_at","117_at","121_at","1255_g_at","1294_at")
#' list_y <- c("1255_g_at","1294_at","1316_at","1320_at","1405_i_at")
#' list_z <- c("1007_s_at","1405_i_at","1255_g_at","1431_at","1438_at","1487_at","1494_f_at")
#' biovenn <- vennplot(list_x, list_y, list_z, subtitle="Example diagram", nrtype="abs")
#' @export
vennplot <- function(list_x = NULL,
list_y = NULL,
list_z = NULL,
title="Venn Plot",
subtitle="Creat diagram by R packages xbox",
t_f="serif", t_fb=2, t_s=1.5, t_c="black",
st_f="serif", st_fb=4, st_s=1.5, st_c="black",
xtitle="X Set", xt_f="serif", xt_fb=2, xt_s=1.5, xt_c="white",
ytitle="Y Set", yt_f="serif", yt_fb=2, yt_s=1.5, yt_c="white",
ztitle="Z Set", zt_f="serif", zt_fb=2, zt_s=1.5, zt_c="white",
nrtype="abs", nr_f="serif", nr_fb=2, nr_s=1, nr_c="black",
x_c="#02786A", y_c="#D23918", z_c="#4C8045", bg_c="white",
width=100, height=100, filename=NULL
){
# Make input lists unique
list_x <- unique(list_x)
list_y <- unique(list_y)
list_z <- unique(list_z)
# Generate lists and calculate numbers
x <- length(list_x)
y <- length(list_y)
z <- length(list_z)
list_xy <- intersect(list_x, list_y)
xy <- length(list_xy)
list_xz <- intersect(list_x, list_z)
xz <- length(list_xz)
list_yz <- intersect(list_y, list_z)
yz <- length(list_yz)
list_xyz <- intersect(list_xy, list_z)
xyz <- length(list_xyz)
list_all <- unique(c(x,y,z))
xyz_all <- length(list_all)
list_xy_only <- setdiff(list_xy, list_xyz)
xy_only <- length(list_xy_only)
list_xz_only <- setdiff(list_xz, list_xyz)
xz_only <- length(list_xz_only)
list_yz_only <- setdiff(list_yz, list_xyz)
yz_only <- length(list_yz_only)
list_x_only <- setdiff(list_x, c(list_xy, list_xz))
x_only <- length(list_x_only)
list_y_only <- setdiff(list_y, c(list_xy,list_yz))
y_only <- length(list_y_only)
list_z_only <- setdiff(list_z, c(list_xz,list_yz))
z_only <- length(list_z_only)
# Print numerical outpu
venn_data <- data.frame(
check.names = FALSE,
x.total = x,
y.total = y,
z.total = z,
x.only = x_only,
y_only = y_only,
z_only = z_only,
`xuy` = xy,
`xuz` = xz,
`yuz` = yz,
`xny` = xy_only,
`xnz` = xz_only,
`ynz` = yz_only,
`xnynz` = xyz,
`xuyuz` = xyz_all
)
cat(paste(rep("-",getOption("width")),collapse=""),"\n")
cat("Venn Data:","\n")
print.data.frame(venn_data,row.names = FALSE)
cat(paste(rep("-",getOption("width")),collapse=""),"\n")
# -V- NOT CHANGE by ME
# function
# Define sq function
sq <- function(nr)
{
nr=nr^2
return(nr)
}
# Define sqr function
sqr <- function(nr)
{
nr=sqrt(round(abs(nr)))
return(nr)
}
# Define arccos function
arccos <- function(nr)
{
nr=acos(min(max(-1,round(nr,5)),1))
return(nr)
}
# Set width and height of plotting area
width_p=1000
height_p=1000
# Amplification
amp=100000/(x+y+z-xy-xz-yz+xyz)
x_text=x
x=x*amp
y_text=y
y=y*amp
z_text=z
z=z*amp
xy_text=xy
xy=xy*amp
xz_text=xz
xz=xz*amp
yz_text=yz
yz=yz*amp
xyz_text=xyz
xyz=xyz*amp
total=x+y+z-xy-xz-yz+xyz
total_text=x_text+y_text+z_text-xy_text-xz_text-yz_text+xyz_text
# Radius calculation
x_r=sqr(x/pi)
y_r=sqr(y/pi)
z_r=sqr(z/pi)
# Distance calculation (with 0.001 error margin)
xy_d=x_r+y_r
if(x&&y)
{
while(xy*0.999>sq(x_r)*arccos((sq(xy_d)+sq(x_r)-sq(y_r))/(2*xy_d*x_r))+sq(y_r)*arccos((sq(xy_d)+sq(y_r)-sq(x_r))/(2*xy_d*y_r))-0.5*sqr(round((xy_d+x_r+y_r)*(xy_d+x_r-y_r)*(xy_d-x_r+y_r)*(-xy_d+x_r+y_r),5)))
{
xy_d=xy_d-min(x_r,y_r)/1000.0
}
}
xz_d=x_r+z_r
if(x&&z)
{
while(xz*0.999>sq(x_r)*arccos((sq(xz_d)+sq(x_r)-sq(z_r))/(2*xz_d*x_r))+sq(z_r)*arccos((sq(xz_d)+sq(z_r)-sq(x_r))/(2*xz_d*z_r))-0.5*sqr(round((xz_d+x_r+z_r)*(xz_d+x_r-z_r)*(xz_d-x_r+z_r)*(-xz_d+x_r+z_r),5)))
{
xz_d=xz_d-min(x_r,z_r)/1000.0
}
}
yz_d=y_r+z_r
if(y&&z)
{
while(yz*0.999>sq(y_r)*arccos((sq(yz_d)+sq(y_r)-sq(z_r))/(2*yz_d*y_r))+sq(z_r)*arccos((sq(yz_d)+sq(z_r)-sq(y_r))/(2*yz_d*z_r))-0.5*sqr(round((yz_d+y_r+z_r)*(yz_d+y_r-z_r)*(yz_d-y_r+z_r)*(-yz_d+y_r+z_r),5)))
{
yz_d=yz_d-min(y_r,z_r)/1000.0
}
}
# Distance calculation for horizontally plotted diagrams
if(xy_d>xz_d+yz_d)
{
xy_d=xz_d+yz_d
}
if(xz_d>xy_d+yz_d)
{
xz_d=xy_d+yz_d
}
if(yz_d>xy_d+xz_d)
{
yz_d=xy_d+xz_d
}
# Angle calculation
x_a=arccos((sq(xy_d)+sq(xz_d)-sq(yz_d))/(2*xy_d*xz_d))
y_a=arccos((sq(xy_d)+sq(yz_d)-sq(xz_d))/(2*xy_d*yz_d))
z_a=arccos((sq(xz_d)+sq(yz_d)-sq(xy_d))/(2*xz_d*yz_d))
x_yz=xz_d*sin(z_a)
y_yz=xy_d*cos(y_a)
# PPU calculation
width_h=max(y_r+y_yz,x_r,z_r-yz_d+y_yz)+max(x_r,y_r-y_yz,z_r+yz_d-y_yz)
ppu_h=width_p/width_h
width_v=max(x_r+x_yz,y_r,z_r)+max(y_r,z_r,x_r-x_yz)
ppu_v=height_p/width_v
ppu=min(ppu_h,ppu_v)
# Circle center calculation
x_h=max(x_r,y_r+y_yz,z_r-yz_d+y_yz)
x_v=max(x_r,y_r-x_yz,z_r-x_yz)
y_h=max(x_r-y_yz,y_r,z_r-yz_d)
y_v=max(x_r+x_yz,y_r,z_r)
z_h=max(x_r+yz_d-y_yz,y_r+yz_d,z_r)
z_v=max(x_r+x_yz,y_r,z_r)
# Calculate intersection points X-Y (first inner, then outer)
xy_i_h_part1=(x_h+y_h)/2+((y_h-x_h)*(sq(x_r)-sq(y_r)))/(2*sq(xy_d))
xy_i_v_part1=(x_v+y_v)/2+((y_v-x_v)*(sq(x_r)-sq(y_r)))/(2*sq(xy_d))
xy_i_h_part2=2*((x_v-y_v)/sq(xy_d))*sqr((xy_d+x_r+y_r)*(xy_d+x_r-y_r)*(xy_d-x_r+y_r)*(-xy_d+x_r+y_r))/4
xy_i_v_part2=2*((x_h-y_h)/sq(xy_d))*sqr((xy_d+x_r+y_r)*(xy_d+x_r-y_r)*(xy_d-x_r+y_r)*(-xy_d+x_r+y_r))/4
xy_i1_h=xy_i_h_part1-xy_i_h_part2
xy_i1_v=xy_i_v_part1+xy_i_v_part2
xy_i2_h=xy_i_h_part1+xy_i_h_part2
xy_i2_v=xy_i_v_part1-xy_i_v_part2
# Calculate intersection points X-Z (first inner, then outer)
xz_i_h_part1=(x_h+z_h)/2+((z_h-x_h)*(sq(x_r)-sq(z_r)))/(2*sq(xz_d))
xz_i_v_part1=(x_v+z_v)/2+((z_v-x_v)*(sq(x_r)-sq(z_r)))/(2*sq(xz_d))
xz_i_h_part2=2*((x_v-z_v)/sq(xz_d))*sqr((xz_d+x_r+z_r)*(xz_d+x_r-z_r)*(xz_d-x_r+z_r)*(-xz_d+x_r+z_r))/4
xz_i_v_part2=2*((x_h-z_h)/sq(xz_d))*sqr((xz_d+x_r+z_r)*(xz_d+x_r-z_r)*(xz_d-x_r+z_r)*(-xz_d+x_r+z_r))/4
xz_i1_h=xz_i_h_part1+xz_i_h_part2
xz_i1_v=xz_i_v_part1-xz_i_v_part2
xz_i2_h=xz_i_h_part1-xz_i_h_part2
xz_i2_v=xz_i_v_part1+xz_i_v_part2
# Calculate intersection points Y-Z (first inner, then outer)
yz_i_h_part1=(y_h+z_h)/2+((z_h-y_h)*(sq(y_r)-sq(z_r)))/(2*sq(yz_d))
yz_i_v_part1=(y_v+z_v)/2+((z_v-y_v)*(sq(y_r)-sq(z_r)))/(2*sq(yz_d))
yz_i_h_part2=2*((y_v-z_v)/sq(yz_d))*sqr((yz_d+y_r+z_r)*(yz_d+y_r-z_r)*(yz_d-y_r+z_r)*(-yz_d+y_r+z_r))/4
yz_i_v_part2=2*((y_h-z_h)/sq(yz_d))*sqr((yz_d+y_r+z_r)*(yz_d+y_r-z_r)*(yz_d-y_r+z_r)*(-yz_d+y_r+z_r))/4
yz_i1_h=yz_i_h_part1-yz_i_h_part2
yz_i1_v=yz_i_v_part1+yz_i_v_part2
yz_i2_h=yz_i_h_part1+yz_i_h_part2
yz_i2_v=yz_i_v_part1-yz_i_v_part2
# Number fill point calculation of XYZ
if(x&&y&&z)
{
xyz_f_h=(xy_i1_h+xz_i1_h+yz_i1_h)/3
xyz_f_v=(xy_i1_v+xz_i1_v+yz_i1_v)/3
}
# Number fill point calculation of X-only
# For XYZ diagrams
if(x&&y&&z&&xy&&xz)
{
xyz_yz_i1=sqr(sq(xyz_f_h-yz_i1_h)+sq(xyz_f_v-yz_i1_v))
x_ratio_h=(xyz_f_h-yz_i1_h)/xyz_yz_i1
x_ratio_v=(xyz_f_v-yz_i1_v)/xyz_yz_i1
x_out_h=x_h-x_r*x_ratio_h
x_out_v=x_v-x_r*x_ratio_v
x_f_h=(x_out_h+yz_i1_h)/2
x_f_v=(x_out_v+yz_i1_v)/2
}
# For XY diagrams or XYZ diagrams without XZ overlap
else if(x&&y&&!z||x&&y&&z&&!xz)
{
xy_f_h=(xy_i1_h+xy_i2_h)/2
xy_f_v=(xy_i1_v+xy_i2_v)/2
x_in_h=y_h+cos(y_a)*y_r
x_in_v=y_v-sin(y_a)*y_r
x_out_h=x_h+cos(y_a)*x_r
x_out_v=x_v-sin(y_a)*x_r
x_f_h=(x_out_h+x_in_h)/2
x_f_v=(x_out_v+x_in_v)/2
}
# For XZ diagrams or XYZ diagrams without XY overlap
else if(x&&!y&&z||x&&y&&z&&!xy)
{
xz_f_h=(xz_i1_h+xz_i2_h)/2
xz_f_v=(xz_i1_v+xz_i2_v)/2
x_in_h=z_h-cos(z_a)*z_r
x_in_v=z_v-sin(z_a)*z_r
x_out_h=x_h-cos(z_a)*x_r
x_out_v=x_v-sin(z_a)*x_r
x_f_h=(x_out_h+x_in_h)/2
x_f_v=(x_out_v+x_in_v)/2
}
# Number fill point calculation of Y-only
# For XYZ diagrams
if(x&&y&&z&&xy&&yz)
{
xyz_xz_i1=sqr(sq(xyz_f_h-xz_i1_h)+sq(xyz_f_v-xz_i1_v))
y_ratio_h=(xyz_f_h-xz_i1_h)/xyz_xz_i1
y_ratio_v=(xyz_f_v-xz_i1_v)/xyz_xz_i1
y_out_h=y_h-y_r*y_ratio_h
y_out_v=y_v-y_r*y_ratio_v
y_f_h=(y_out_h+xz_i1_h)/2
y_f_v=(y_out_v+xz_i1_v)/2
}
# For XY diagrams or XYZ diagrams without YZ overlap
else if(x&&y&&!z||x&&y&&z&&!yz)
{
xy_f_h=(xy_i1_h+xy_i2_h)/2
xy_f_v=(xy_i1_v+xy_i2_v)/2
y_in_h=x_h-cos(y_a)*x_r
y_in_v=x_v+sin(y_a)*x_r
y_out_h=y_h-cos(y_a)*y_r
y_out_v=y_v+sin(y_a)*y_r
y_f_h=(y_out_h+y_in_h)/2
y_f_v=(y_out_v+y_in_v)/2
}
# For YZ diagrams or XYZ diagrams without XY overlap
else if(!x&&y&&z||x&&y&&z&&!xy)
{
yz_f_h=(yz_i1_h+yz_i2_h)/2
yz_f_v=(yz_i1_v+yz_i2_v)/2
y_in_h=z_h-z_r
y_in_v=z_v
y_out_h=y_h-y_r
y_out_v=y_v
y_f_h=(y_out_h+y_in_h)/2
y_f_v=(y_out_v+y_in_v)/2
}
# Number fill point calculation of Z-only
# For XYZ diagrams
if(x&&y&&z&&xz&&yz)
{
xyz_xy_i1=sqr(sq(xyz_f_h-xy_i1_h)+sq(xyz_f_v-xy_i1_v))
z_ratio_h=(xyz_f_h-xy_i1_h)/xyz_xy_i1
z_ratio_v=(xyz_f_v-xy_i1_v)/xyz_xy_i1
z_out_h=z_h-z_r*z_ratio_h
z_out_v=z_v-z_r*z_ratio_v
z_f_h=(z_out_h+xy_i1_h)/2
z_f_v=(z_out_v+xy_i1_v)/2
}
# For XZ diagrams or XYZ diagrams without YZ overlap
else if(x&&!y&&z||x&&y&&z&&!yz)
{
xz_f_h=(xz_i1_h+xz_i2_h)/2
xz_f_v=(xz_i1_v+xz_i2_v)/2
z_in_h=x_h+cos(z_a)*x_r
z_in_v=x_v+sin(z_a)*x_r
z_out_h=z_h+cos(z_a)*z_r
z_out_v=z_v+sin(z_a)*z_r
z_f_h=(z_out_h+z_in_h)/2
z_f_v=(z_out_v+z_in_v)/2
}
# For YZ diagrams or XYZ diagrams without XZ overlap
else if(!x&&y&&z||x&&y&&z&&!xz)
{
yz_f_h=(yz_i1_h+yz_i2_h)/2
yz_f_v=(yz_i1_v+yz_i2_v)/2
z_in_h=y_h+z_r
z_in_v=y_v
z_out_h=z_h+y_r
z_out_v=z_v
z_f_h=(z_out_h+z_in_h)/2
z_f_v=(z_out_v+z_in_v)/2
}
# Number fill point calculation of XY-only
if(x&&y&&z)
{
dh=(xyz_f_h-z_h)-(xy_i2_h-z_h)
dv=(xyz_f_v-z_v)-(xy_i2_v-z_v)
dr=sqr(sq(dh)+sq(dv))
D=(xy_i2_h-z_h)*(xyz_f_v-z_v)-(xyz_f_h-z_h)*(xy_i2_v-z_v)
z_in_h=z_h+(D*dv-dh*sqr(sq(z_r)*sq(dr)-sq(D)))/sq(dr)
z_in_v=z_v+(-D*dh-abs(dv)*sqr(sq(z_r)*sq(dr)-sq(D)))/sq(dr)
xy_f_h=(z_in_h+xy_i2_h)/2
xy_f_v=(z_in_v+xy_i2_v)/2
}
# Number fill point calculation of XZ-only
if(x&&y&&z)
{
dh=(xyz_f_h-y_h)-(xz_i2_h-y_h)
dv=(xyz_f_v-y_v)-(xz_i2_v-y_v)
dr=sqr(sq(dh)+sq(dv))
D=(xz_i2_h-y_h)*(xyz_f_v-y_v)-(xyz_f_h-y_h)*(xz_i2_v-y_v)
y_in_h=y_h+(D*dv-dh*sqr(sq(y_r)*sq(dr)-sq(D)))/sq(dr)
y_in_v=y_v+(-D*dh-abs(dv)*sqr(sq(y_r)*sq(dr)-sq(D)))/sq(dr)
xz_f_h=(y_in_h+xz_i2_h)/2
xz_f_v=(y_in_v+xz_i2_v)/2
}
# Number fill point calculation of YZ-only
if(x&&y&&z)
{
dh=(xyz_f_h-x_h)-(yz_i2_h-x_h)
dv=(xyz_f_v-x_v)-(yz_i2_v-x_v)
dr=sqr(sq(dh)+sq(dv))
D=(yz_i2_h-x_h)*(xyz_f_v-x_v)-(xyz_f_h-x_h)*(yz_i2_v-x_v)
x_in_h=x_h+(D*dv-dh*sqr(sq(x_r)*sq(dr)-sq(D)))/sq(dr)
x_in_v=x_v+(-D*dh+abs(dv)*sqr(sq(x_r)*sq(dr)-sq(D)))/sq(dr)
yz_f_h=(x_in_h+yz_i2_h)/2
yz_f_v=(x_in_v+yz_i2_v)/2
}
# Number fill point calculation for horizontally plotted diagrams
if(xy_d==xz_d+yz_d||xz_d==xy_d+yz_d||yz_d==xy_d+xz_d)
{
# No X-only and no Y-only
if(x&&!x_only&&y&&!y_only)
{
xz_f_v=yz_f_v=xyz_f_v=x_v
xz_f_h=(max(y_h+y_r,x_h-x_r)+(x_h+x_r))/2
yz_f_h=((y_h-y_r)+min(y_h+y_r,x_h-x_r))/2
#z_f_h, z_f_v stay the same
}
# No X-only and no Z-only
else if(x&&!x_only&&z&&!z_only)
{
xy_f_v=yz_f_v=xyz_f_v=x_v
xy_f_h=((x_h-x_r)+min(x_h+x_r,z_h-z_r))/2
yz_f_h=(max(x_h+x_r,z_h-z_r)+(z_h+z_r))/2
#y_f_h, y_f_v stay the same
}
# No Y-only and no Z-only
else if(y&&!y_only&&z&&!z_only)
{
yz_f_v=xz_f_v=xyz_f_v=x_v
yz_f_h=(max(x_h+x_r,y_h-y_r)+(y_h+y_r))/2
xz_f_h=(max(y_h+y_r,z_h-z_r)+(z_h+z_r))/2
#x_f_h, x_f_v stay the same
}
# No X-only
else if(x&&!x_only)
{
yz_f_v=xyz_f_v=x_v
# X is subset of Y
if(!xz_only)
{
z_f_h=(max(x_h+x_r,y_h+y_r)+(z_h+z_r))/2
z_f_v=x_v
xy_f_h=(max(y_h-y_r,x_h-x_r)+(z_h-z_r))/2
xy_f_v=x_v
yz_f_h=(max(x_h+x_r,z_h-z_r)+(y_h+y_r))/2
#y_f_h, y_f_v stay the same
}
# X is subset of Z
else if(!xy_only)
{
y_f_h=((y_h-y_r)+min(z_h-z_r,x_h-x_r))/2
y_f_v=x_v
xz_f_h=(max(y_h+y_r,x_h-x_r)+(x_h+x_r))/2
xz_f_v=x_v
yz_f_h=((z_h-z_r)+min(y_h+y_r,x_h-x_r))/2
#z_f_h, z_f_v stay the same
}
}
# No Y-only
else if(y&&!y_only)
{
xz_f_v=xyz_f_v=x_v
# Y is subset of X
if(!yz_only)
{
z_f_h=(max(y_h+y_r,x_h+x_r)+(z_h+z_r))/2
z_f_v=x_v
xy_f_h=((y_h-y_r)+min(y_h+y_r,z_h-z_r))/2
xy_f_v=x_v
xz_f_h=(max(y_h+y_r,z_h-z_r)+(x_h+x_r))/2
#x_f_h, x_f_v stay the same
}
# Y is subset of Z
else if(!xy_only)
{
x_f_h=(max(y_h+y_r,z_h+z_r)+(x_h+x_r))/2
x_f_v=x_v
yz_f_h=((y_h-y_r)+max(y_h+y_r,x_h-x_r))/2
yz_f_v=x_v
xz_f_h=(max(y_h+y_r,x_h-x_r)+(z_h+z_r))/2
#z_f_h, z_f_v stay the same
}
}
# No Z-only
else if(z&&!z_only)
{
xy_f_v=xyz_f_v=x_v
# Z is subset of X
if(!yz_only)
{
y_f_h=((y_h-y_r)+min(x_h-x_r,z_h-z_r))/2
y_f_v=x_v
xz_f_h=(max(y_h+y_r,z_h-z_r)+(z_h+z_r))/2
xz_f_v=x_v
xy_f_h=((x_h-x_r)+min(y_h+y_r,z_h-z_r))/2
#x_f_h, x_f_v stay the same
}
# Z is subset of Y
else if(!xz_only)
{
x_f_h=((x_h-x_r)+min(y_h-y_r,z_h-z_r))/2
x_f_v=x_v
yz_f_h=(max(x_h+x_r,z_h-z_r)+(z_h+z_r))/2
yz_f_v=x_v
xy_f_h=((y_h-y_r)+min(x_h+x_r,z_h-z_r))/2
#y_f_h, y_f_v stay the same
}
}
xyz_f_h=(max(x_h-x_r,y_h-y_r,z_h-z_r)+min(x_h+x_r,y_h+y_r,z_h+z_r))/2
}
#Get file type:change by wangjaixuan0123
if(!is.null(filename)){
r = regexpr("\\.[a-zA-Z]*$", filename)
if(r == -1) stop("Improper filename")
ending = substr(filename, r + 1, r + attr(r, "match.length"))
f = switch(ending,
pdf = function(x, ...) pdf(x, ...),
png = function(x, ...) png(x, units="px", ...),
jpeg = function(x, ...) jpeg(x, units="px", ...),
jpg = function(x, ...) jpeg(x, units="px", ...),
tiff = function(x, ...) tiff(x, units="px", ...),
bmp = function(x, ...) bmp(x, units="px", ...),
stop("File type should be: pdf, png, bmp, jpg, tiff")
)
f(filename, height = height, width = width)
}
# Draw circles
opar<-graphics::par(no.readonly=TRUE)
on.exit(graphics::par(opar))
graphics::par(pty="s",bg=bg_c)
graphics::plot(0,type="n",axes=FALSE,xlim=c(0,width_p),ylim=c(height_p,0),xlab="",ylab="",xaxt="none",yaxt="none")
graphics::par(family=t_f)
graphics::title(main=title,line=1,font.main=t_fb,cex.main=t_s,col.main=t_c)
graphics::par(family=st_f)
graphics::title(sub=subtitle,line=1,font.sub=st_fb,cex.sub=st_s,col.sub=st_c)
plotrix::draw.circle(ppu*x_h,ppu*x_v,ppu*x_r,lty=0,col=grDevices::rgb(grDevices::col2rgb(x_c)[,1][1],grDevices::col2rgb(x_c)[,1][2],grDevices::col2rgb(x_c)[,1][3],maxColorValue=255,alpha=128))
plotrix::draw.circle(ppu*y_h,ppu*y_v,ppu*y_r,lty=0,col=grDevices::rgb(grDevices::col2rgb(y_c)[,1][1],grDevices::col2rgb(y_c)[,1][2],grDevices::col2rgb(y_c)[,1][3],maxColorValue=255,alpha=128))
plotrix::draw.circle(ppu*z_h,ppu*z_v,ppu*z_r,lty=0,col=grDevices::rgb(grDevices::col2rgb(z_c)[,1][1],grDevices::col2rgb(z_c)[,1][2],grDevices::col2rgb(z_c)[,1][3],maxColorValue=255,alpha=128))
# Print numbers
if(length(nrtype)>0)
{
if(nrtype=="abs")
{
if(x_only)
{
graphics::text(ppu*x_f_h,ppu*x_f_v,x_only,adj=c(0.5,0.5),col=nr_c,family=nr_f,font=nr_fb,cex=nr_s)
}
if(y_only)
{
graphics::text(ppu*y_f_h,ppu*y_f_v,y_only,adj=c(0.5,0.5),col=nr_c,family=nr_f,font=nr_fb,cex=nr_s)
}
if(z_only)
{
graphics::text(ppu*z_f_h,ppu*z_f_v,z_only,adj=c(0.5,0.5),col=nr_c,family=nr_f,font=nr_fb,cex=nr_s)
}
if(xy_only)
{
graphics::text(ppu*xy_f_h,ppu*xy_f_v,xy_only,adj=c(0.5,0.5),col=nr_c,family=nr_f,font=nr_fb,cex=nr_s)
}
if(xz_only)
{
graphics::text(ppu*xz_f_h,ppu*xz_f_v,xz_only,adj=c(0.5,0.5),col=nr_c,family=nr_f,font=nr_fb,cex=nr_s)
}
if(yz_only)
{
graphics::text(ppu*yz_f_h,ppu*yz_f_v,yz_only,adj=c(0.5,0.5),col=nr_c,family=nr_f,font=nr_fb,cex=nr_s)
}
if(xyz)
{
graphics::text(ppu*xyz_f_h,ppu*xyz_f_v,xyz_text,adj=c(0.5,0.5),col=nr_c,family=nr_f,font=nr_fb,cex=nr_s)
}
}
else if(nrtype=="pct")
{
if(x_only)
{
graphics::text(ppu*x_f_h,ppu*x_f_v,paste0(round(x_only/total_text*100,2),"%"),adj=c(0.5,0.5),col=nr_c,family=nr_f,font=nr_fb,cex=nr_s)
}
if(y_only)
{
graphics::text(ppu*y_f_h,ppu*y_f_v,paste0(round(y_only/total_text*100,2),"%"),adj=c(0.5,0.5),col=nr_c,family=nr_f,font=nr_fb,cex=nr_s)
}
if(z_only)
{
graphics::text(ppu*z_f_h,ppu*z_f_v,paste0(round(z_only/total_text*100,2),"%"),adj=c(0.5,0.5),col=nr_c,family=nr_f,font=nr_fb,cex=nr_s)
}
if(xy_only)
{
graphics::text(ppu*xy_f_h,ppu*xy_f_v,paste0(round(xy_only/total_text*100,2),"%"),adj=c(0.5,0.5),col=nr_c,family=nr_f,font=nr_fb,cex=nr_s)
}
if(xz_only)
{
graphics::text(ppu*xz_f_h,ppu*xz_f_v,paste0(round(xz_only/total_text*100,2),"%"),adj=c(0.5,0.5),col=nr_c,family=nr_f,font=nr_fb,cex=nr_s)
}
if(yz_only)
{
graphics::text(ppu*yz_f_h,ppu*yz_f_v,paste0(round(yz_only/total_text*100,2),"%"),adj=c(0.5,0.5),col=nr_c,family=nr_f,font=nr_fb,cex=nr_s)
}
if(xyz)
{
graphics::text(ppu*xyz_f_h,ppu*xyz_f_v,paste0(round(xyz_text/total_text*100,2),"%"),adj=c(0.5,0.5),col=nr_c,family=nr_f,font=nr_fb,cex=nr_s)
}
}
}
# Print texts
if(x)
{
graphics::text(ppu*x_h,ppu*x_v,xtitle,adj=c(0.5,0.5),col=xt_c,family=xt_f,font=xt_fb,cex=xt_s)
}
if(y)
{
graphics::text(ppu*y_h,ppu*y_v,ytitle,adj=c(0.5,0.5),col=yt_c,family=yt_f,font=yt_fb,cex=yt_s)
}
if(z)
{
graphics::text(ppu*z_h,ppu*z_v,ztitle,adj=c(0.5,0.5),col=zt_c,family=zt_f,font=zt_fb,cex=zt_s)
}
# Write to file
if(!is.null(filename)){grDevices::dev.off()}
# Return lists
venn_list = list("x"=list_x,"y"=list_y,"z"=list_z,"x_only"=list_x_only,"y_only"=list_y_only,"z_only"=list_z_only,"xy"=list_xy,"xz"=list_xz,"yz"=list_yz,"xy_only"=list_xy_only,"xz_only"=list_xz_only,"yz_only"=list_yz_only,"xyz"=list_xyz)
venn <- list("number" = venn_data, "id" = venn_list)
invisible(venn)
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.