Is there any alternative to ggtern in R? - r

Its looks like that ggtern has not been synchronised with new version of ggplot2.
Therefore we can not use ggtern.
library(ggtern)
set.seed(1)
plot <- ggtern(data = data.frame(x = runif(100),
y = runif(100),
z = runif(100)),
aes(x, y, z))
plot + stat_density_tern(geom = 'polygon',
n = 200,
aes(fill = ..level..,
alpha = ..level..)) +
geom_point() +
theme_rgbw() +
labs(title = "Example Density/Contour Plot") +
scale_fill_gradient(low = "blue",high = "red") +
guides(color = "none", fill = "none", alpha = "none")
Error: geom_point requires the following missing aesthetics: x and y
Does anyone have in find other options for ternary diagrams apart from ggtern in R?

Manually, you could plot the points with a function: (I used the formulas at https://en.wikipedia.org/wiki/Ternary_plot)
I'm not familiar with the output of stat_density_tern so I'm not sure what is expected from that part.
library(tidyverse)
tern <- function(df) {
df %>% mutate(x_pos = 0.5 * (2*y + z) / (x+y+z),
y_pos = sqrt(3) / 2 * z / (x+y+z))
}
tern(plot) %>%
ggplot(aes(x_pos, y_pos)) +
geom_point() +
annotate("path", x = c(0, 0.5, 1, 0), y = c(0,sqrt(3)/2,0,0)) +
coord_equal()

this worked for me! Uninstall ggtern and ggplot2 then
install_version("ggplot2", version = "3.3.0", repos = "http://cran.us.r-project.org")
install.packages("ggtern")
library(ggtern)

I use the following script which also supports making diagrams with 4 or more corners. It also divides the points into colored clusters by cutting a hierarchical clustering at the height where it has 32 subtrees, and it draws a line from each point to its two nearest neighbors.
library(tidyverse)
library(ggforce)
library(colorspace)
t=as.matrix(read.csv("https://pastebin.com/raw/1EDJJtHU",row.names=1,check.names=F))/100
fst=as.matrix(read.csv("https://pastebin.com/raw/6JmN2hRY",row.names=1))
mult=t%*%cmdscale(fst,ncol(fst)-1)
# t=cbind(t[,2]+t[,1],t[,8]+t[,9],rowSums(t[,-c(1,2,8,9)]))
# colnames(t)=c("Baltic + North_Atlantic","Siberian + East_Asian","Other")
# t=cbind(t[,2],t[,1],t[,8]+t[,9],rowSums(t[,-c(1,2,8,9)]))
# colnames(t)=c("Baltic","North_Atlantic","Siberian + East_Asian","Other")
ncorn=ncol(t)
start=ifelse(ncorn==4,.25,0)
corners=sapply(c(sin,cos),\(x)x((start+seq(0,2,,ncorn+1)[-(ncorn+1)])*pi))
corners=corners*min(2/diff(apply(corners,2,range)))
corners[,2]=corners[,2]-mean(range(corners[,2]))
xy=t%*%corners
grid=if(ncorn==3)do.call(rbind.data.frame,apply(simplify=F,rbind(c(1,2,3,2),c(1,3,2,3),c(2,1,3,1)),1,\(x)cbind(
seq(corners[x[1],1],corners[x[2],1],,11),
seq(corners[x[1],2],corners[x[2],2],,11),
seq(corners[x[3],1],corners[x[4],1],,11),
seq(corners[x[3],2],corners[x[4],2],,11)
)))else if(ncorn==4)do.call(rbind.data.frame,apply(simplify=F,rbind(c(1,2,4,3),c(1,4,2,3)),1,\(x)cbind(
seq(corners[x[1],1],corners[x[2],1],,11),
seq(corners[x[1],2],corners[x[2],2],,11),
seq(corners[x[3],1],corners[x[4],1],,11),
seq(corners[x[3],2],corners[x[4],2],,11)
)))else rbind.data.frame(cbind(corners,rbind(corners[-1,],corners[1,])),cbind(corners,matrix(colMeans(corners),ncorn,2,T)))
seg=as.data.frame(cbind(xy[rep(1:nrow(xy),each=2),],xy[apply(as.matrix(dist(mult)),1,\(x)order(x)[2:3]),]))
k=as.factor(cutree(hclust(dist(mult)),32))
set.seed(0)
hue=seq(0,360,,nlevels(k)+1)%>%head(-1)%>%sample()
pal1=hex(colorspace::HSV(hue,.6,1))
pal2=hex(colorspace::HSV(hue,.3,1))
angle=head(seq(360,0,length.out=ncorn+1),-1)
angle=ifelse(angle>90&angle<=270,angle+180,angle)
ggplot(as.data.frame(xy),aes(x=V1,y=V2))+
geom_polygon(data=as.data.frame(corners),fill="gray25")+
(if(ncorn>=5)geom_text(data=as.data.frame(corners),aes(x=1.04*V1,y=1.04*V2),label=colnames(t),size=3.2,angle=angle,color="gray85") # use rotated labels
else geom_text(data=as.data.frame(corners),aes(x=V1,y=1.03*V2),vjust=(1-corners[,2])/2,hjust=(1+corners[,1])/2,label=colnames(t),size=3.2,color="gray85"))+ # don't rotate labels
geom_segment(data=grid,aes(x=V1,y=V2,xend=V3,yend=V4),color="gray30",size=.4)+
ggforce::geom_mark_hull(aes(group=!!k,color=!!k,fill=!!k),concavity=1000,radius=unit(.15,"cm"),expand=unit(.15,"cm"),alpha=.15,size=.1)+
geom_segment(data=seg,aes(x=V1,y=V2,xend=V3,yend=V4),color="gray10",size=.25)+
geom_point(aes(color=k),size=.5)+
geom_text(aes(label=rownames(xy),color=!!k),size=2.2,vjust=-.6)+
coord_fixed(xlim=c(-1,1),ylim=c(-1,1))+
scale_fill_manual(values=pal1)+
scale_color_manual(values=pal2)+
theme(
axis.text=element_blank(),
axis.ticks=element_blank(),
axis.title=element_blank(),
legend.position="none",
panel.background=element_rect(fill="gray20"),
panel.grid=element_blank(),
plot.background=element_rect(fill="gray20",color=NA,size=0),
plot.margin=margin(0,0,0,0)
)
ggsave("1.png",width=7,height=7)
Or here's another version that uses Voronoi tesselation to plot the points (https://ggforce.data-imaginist.com/reference/geom_delvor.html):
t=read.table("https://pastebin.com/raw/CeLAEiAq")
t=distinct(t[,-1]) # geom_voronoi_tile doesn't handle a large number of overlapping points
pop=t[,1]
t=as.matrix(t[,-1])
ncorn=ncol(t)
start=ifelse(ncorn==4,.25,0)
corners=sapply(c(sin,cos),\(x)x((start+seq(0,2,,ncorn+1)[-(ncorn+1)])*pi))
corners=corners*min(2/diff(apply(corners,2,range))) # resize so bigger one of width and height is 2
corners[,2]=corners[,2]-mean(range(corners[,2])) # center vertically
xy=as.data.frame(t%*%corners)
# # use a simple grid with line from each corner to center for a plot with more than 3 corners
# grid=rbind.data.frame(cbind(corners,rbind(corners[-1,],corners[1,])),cbind(corners,matrix(colMeans(corners),ncorn,2,T)))
# use a grid with 10 subdivisions per side for a triangle plot
grid=do.call(rbind.data.frame,apply(simplify=F,rbind(c(1,2,3,2),c(1,3,2,3),c(2,1,3,1)),1,\(x)cbind(
seq(corners[x[1],1],corners[x[2],1],,11),
seq(corners[x[1],2],corners[x[2],2],,11),
seq(corners[x[3],1],corners[x[4],1],,11),
seq(corners[x[3],2],corners[x[4],2],,11)
)))
centers=data.frame(aggregate(xy,list(pop),mean),row.names=1)
set.seed(0)
color=as.factor(sample(length(unique(pop))))
cl=rbind(c(60,80),c(25,95),c(30,70),c(70,50),c(60,100),c(20,50),c(15,40))
hues=max(ceiling(length(color)/nrow(cl)),8)
pal1=as.vector(apply(cl,1,\(x)hcl(seq(15,375,,hues+1)[-(hues+1)],x[1],x[2])))
pal2=as.vector(apply(cl,1,\(x)hcl(seq(15,375,,hues+1)[-(hues+1)],if(x[2]>=60).5*x[1]else .1*x[1],if(x[2]>=60).2*x[2]else 95)))
xy=xy+runif(nrow(xy)*2)/1e3 # add a small random factor to prevent errors because of overlapping points
ggplot(xy,aes(V1,V2))+
geom_segment(data=grid,aes(V1,V2,xend=V3,yend=V4),color="gray85",size=.3)+
ggforce::geom_voronoi_tile(aes(group=0,fill=color[as.factor(pop)],color=color[as.factor(pop)]),size=.07,max.radius=.055)+ # `group=0` is just an arbitrary constant
# ggrepel::geom_label_repel(data=centers,aes(V1,V2,color=color,fill=color),label=rownames(centers),max.overlaps=Inf,point.size=0,size=2.3,alpha=.8,label.r=unit(.1,"lines"),label.padding=unit(.1,"lines"),label.size=.1,box.padding=0,segment.size=.3)+
geom_label(data=centers,aes(V1,V2,color=color,fill=color),label=rownames(centers),size=2.3,alpha=.8,label.r=unit(.1,"lines"),label.padding=unit(.1,"lines"),label.size=.1)+
coord_fixed(xlim=c(-1.08,1.08),ylim=c(-1.08,1.08),expand=F)+
scale_fill_manual(values=pal1)+
scale_color_manual(values=pal2)+
theme(
axis.text=element_blank(),
axis.ticks=element_blank(),
axis.title=element_blank(),
legend.position="none",
panel.background=element_rect(fill="white")
)
ggsave("1.png",width=7,height=7)

Related

How to stack (overlap) legend items in ggplot2

I was wondering if it is possible to "stack" the items of the legend on a ggplot2 map (or any package that allows to produce the same result).
For spatial (sf, etc.) objects there is at least one package, mapsf, that produces the desired output, but I would like to produce this type of legend also for non-spatial objects (dataframes/tibble, etc.).
See here a reprex:
# A regular plot with ggplot2
library(ggplot2)
# A plot
ggplot(mtcars, aes(wt, mpg)) +
geom_point(aes(size = drat))
# A map with the circles of the legend "stacked" (overlapping points)
# Need to conver to sf
mtcars_sf <- sf::st_as_sf(mtcars, coords = c("wt", "mpg"))
library(mapsf)
# See the legend on the top-right corner (blue arrow)
mf_map(x = mtcars_sf)
mf_map(x = mtcars_sf, var = "drat", type = "prop",
inches = .2)
As Allan said, there is (to my knowledge) no general way to do this. But you can hack this together for your custom graph. Thomas Pedersen's awesome packages ggforce and patchwork are your friend.
I am essentially faking a legend. The challenge is to get the right dimensions between main plot and legend, and to stitch the legend in a reasonable way to the main plot. This is achieved by using carefully chosen radii on geom_ellipse, setting the coordinate ratio accordingly, and adjusting the coordinate limits from both plots. More comments in the code.
library(ggplot2)
library(ggforce)
library(patchwork)
## we cannot just use geom_point,
## because the size of the circles need to correspond to the legend later
## you will need to play around with this constant
r_constant <- 25
mtcars$r <- mtcars$drat / r_constant
## this is to make the points round - it will have an effect on the panel dimension
ellipse_fac <- .1
p <-
ggplot(mtcars) +
geom_ellipse(aes(x0 = wt, y0 = mpg, a = r, b = r / ellipse_fac, angle = 0), fill = "darkred") +
theme(legend.position = "none") +
coord_equal(ellipse_fac)
## for the legend, chose rounded values from the radius range
unique_r <- unique(plyr::round_any(mtcars$r, .1))
y_circles <- floor(min(mtcars$mpg))
## I'm sorting the radii decreasingly, so that the circles overlap correctly
circles <- data.frame(x = 0, r = sort(unique_r, decreasing = TRUE))
## the segment / label poistion is also arbitrary
x_lab <- max(circles$r) + .1
y_seg <- y_circles + 2 * circles$r / ellipse_fac
p_leg <-
ggplot(circles) +
geom_ellipse(aes(x0 = x, y0 = y_circles + r / ellipse_fac, a = r, b = r / ellipse_fac, angle = 0), fill = "darkred", alpha = .5) +
geom_segment(aes(x = x, xend = x_lab, y = y_seg, yend = y_seg)) +
geom_text(aes(x = x_lab, y = y_seg, label = r), hjust = 0) +
## you need to set the ylimits similar to the main plot for control of legend position
coord_equal(ratio = ellipse_fac, ylim = range(mtcars$mpg), clip = "off") +
theme_void() +
## also need to set a margin
theme(plot.margin = margin(r = .2, unit = "in"))
p + p_leg
I've added an alpha just for aesthetic reasons

adjust heights of two plots (nrow=1) with ggarrange

How can I display two plots in one row with R function ggarrange() so that they have the same dimensions, in particular the same height?
In this example, the second plot is a bit higher than the first plot. I would like to increase the size of a1_plot, so that it matches the size of a2_plot.
# required packages
library(ggplot2)
library(ggbreak)
library(directlabels)
library(ggpubr)
# make dataframe
df1 <- data.frame(first_column=c("value_1","value_2","value_3","value_4","value_4","value_5"),
second_column=c("123","123","325","325","656","656"),
third_column=c(12,13,1,19,200,360),
fourth_column=c(1,124,155,3533,5533,6666))
# plot 1
a1_plot <-
ggplot(df1, aes(x=third_column, y=fourth_column, colour=second_column)) +
scale_x_continuous(breaks = c(0,50,100,150,200,250,300)) +
ylab("Fourth column")+ xlab("Third column") +
scale_x_break(breaks = c(210,400)) +
geom_dl(mapping=aes(x=third_column, y=fourth_column, label=second_column),
method = list(dl.trans(x = x + 0.1), dl.combine("last.points"))) +
theme(legend.position = "none")
# plot 2
a2_plot <-
ggplot(data=df1)+
geom_point(aes(x=second_column, y=fourth_column) +
xlab("X axis")+ ylab("Y axis") +
theme(legend.position = "none")
# merge plot1 and plot2
ggarrange(print(a1_plot), print(a2_plot), labels = c('a1', 'a2'))
I was unable to change the height of plot 1. By adjusting the margins of plot 2, the problem has been solved.
theme(legend.position = "none", plot.margin = unit(x=c(3.6,5,3.9,0), units = "mm"))

Legend position based on coordinates in ggplot2

Using ggplot2's legend.position (and legend.justification), the two available parameters indicate the relative position of the legend, but what if I want to position the legend based on the coordinates of the plot?
I can't find a way to do it.
This is strange as annotate gives an x and y argument that allows such things.
Here is some toy data
library(ggplot2)
ggplot(data = mtcars, aes(x = mpg,y = disp,color = factor(cyl))) +
geom_point() +
theme(legend.position = c(0.01,0.01),
legend.justification = c(0,0))
Which gives:
What about if I want the bottom-left corner of the legend to be on coordinates (10,100)?
I don't think there is an easy way to do it. The only approach i could think of is to build the plot object to extract the ranges of the axes in order to convert (10, 100) into a relative coordinate that can be used with legend position. Admittedly, this is very hacky...
library(tidyverse)
p <- ggplot(data = mtcars, aes(x = mpg, y = disp, color = factor(cyl))) +
geom_point()
ranges <- ggplot_build(p) %>%
pluck("layout", "panel_params", 1) %>%
`[`(c("x.range", "y.range"))
x <- (10 - ranges$x.range[1]) / (ranges$x.range[2] - ranges$x.range[1])
y <- (100 - ranges$y.range[1]) / (ranges$y.range[2] - ranges$y.range[1])
p + theme(legend.position = c(x, y), legend.justification = c(0, 0))
Created on 2021-07-21 by the reprex package (v1.0.0)

Change y-axis of dot plot to reflect actual count using geom_dotplot

I am trying to create a dot plot using geom_dotplot of ggplot2.
However, as shown in the examples on this page, the scales of y-axis range from 0 to 1. I wonder how I can change the y-axis scale so the values reflect the actual count of the data.
Here is an example which might be helpful.
library(ggplot2)
library(ggExtra)
library(dplyr)
# use the preloaded iris package in R
irisdot <- head(iris["Petal.Length"],15)
# find the max frequency (used `dplyr` package). Here n is the label for frequency returned by count().
yheight <- max(dplyr::count(irisdot, Petal.Length)["n"])
# basic dotplot (binwidth = the accuracy of the data)
dotchart = ggplot(irisdot, aes(x=Petal.Length), dpi = 600)
binwidth = 0.1
dotsize = 1
dotchart = dotchart + geom_dotplot(binwidth=binwidth, method="histodot", dotsize = dotsize, fill="blue")
# use coor_fixed(ratio=binwidth*dotsize*max frequency) to setup the right y axis height.
dotchart = dotchart +
theme_bw() +
coord_fixed(ratio=binwidth*dotsize*yheight)
# tweak the theme a little bit
dotchart = dotchart + theme(panel.background=element_blank(),
panel.border = element_blank(),
panel.grid.minor = element_blank(),
# plot.margin=unit(c(-4,0,-4,0), "cm"),
axis.line = element_line(colour = "black"),
axis.line.y = element_blank(),
)
# add more tick mark on x axis
dotchart = dotchart + scale_x_continuous(breaks = seq(1,1.8,0.1))
# add tick mark on y axis to reflect frequencies. Note yheight is max frequency.
dotchart = dotchart + scale_y_continuous(limits=c(0, 1), expand = c(0, 0), breaks = seq(0, 1,1/yheight), labels=seq(0,yheight))
# remove x y lables and remove vertical grid lines
dotchart = dotchart + labs(x=NULL, y=NULL) + removeGridX()
dotchart
I don't know why it works. It seems that the height of y axis for geom_dotplot is 1. The ratio between x and y was setup by coor_fixed(ratio=binwidth * dotsize * max frequency).
I would recommend you to use geom_histogram instead.
library(ggplot2)
ggplot(mtcars, aes(x = mpg)) +
geom_histogram(binwidth=1)
The issue seem to be in that geom_dotplot cannot be converted to count, as seen in the github issue here.

Average line for 2D Histogram?

I am a very new user of "R" and have a question.I am currently working on making 2D Histograms on R. The material necessarily does not matter but how do I plot an average line on the 2D Histogram. The code I am running is this:
load("mydatabin.RData")
# Color housekeeping
library(RColorBrewer)
rf <- colorRampPalette(rev(brewer.pal(11,'Spectral')))
r <- rf(32)
# Create normally distributed data for plotting
x <- mydata$AGE
y <- mydata$BP
df <- data.frame(x,y)
# Plot
plot(df, pch=16, col='black', cex=0.5)
This gives me a scatter plot and then to turn it into a 2D Histogram I do:
library(ggplot2)
# Default call (as object)
p <- ggplot(df, aes(x,y))
h3 <- p + stat_bin2d()
h3
# Default call (using qplot)
qplot(x,y,data=df, geom='bin2d')
After this I do:
h3 <- p + stat_bin2d(bins=25) + scale_fill_gradientn(colours=r)
h3
to add color.
Therefore, from here how do I plot an average line of the data.
And if anyone can tell me how to plot a heat map that looks like this using mydatebin.RData:
Thanks.
You can use geom_hline or geom_vline in ggplot2, passing y/xintercept as a parameter to draw a line. In your case, the parameter can be an average of one of your column to draw an average line. See the code for the example.
I also played around and tried two different ways to draw 2D histograms. Yours seems better and more precise, though I removed colorBrewer.
library(ggplot2)
# Create normally distributed data for plotting
x <- rnorm(10000)
y <- rnorm(10000)
df <- data.frame(x,y)
# stat_density2d way, with average lines
p1 <- ggplot(df,aes(x=x,y=y))+
stat_density2d(aes(fill=..level..), geom="polygon") +
scale_fill_gradient(low="navy", high="yellow") +
# Here go average lines
geom_hline(yintercept = mean(df$y), color = "red") +
geom_vline(xintercept = mean(df$x), color = "red") +
# Just to remove grid and set background color
theme(line = element_blank(),
panel.background = element_rect(fill = "navy"))
p1
# stat_bin2d way, with average lines
p2 <- ggplot(df, aes(x,y)) +
stat_bin2d(bins=50) +
scale_fill_gradient(low="navy", high="yellow") +
# Here go average lines
geom_hline(yintercept = mean(df$y), color = "red") +
geom_vline(xintercept = mean(df$x), color = "red") +
# Just to remove grid and set background color
theme(line = element_blank(),
panel.background = element_rect(fill = "navy"))
p2

Resources