Related
I want to add a line on the top and bottom of my plots (bottom line below the x label and axis) created using ggplot2. So far I have added a rectangle around the plot, but I do not want the lines on the sides.
x <- 1:10
y <- rnorm(10,mean = x)
df <- data.frame(x,y)
library(ggplot2)
ggplot(data = df, mapping = aes(x,y)) + geom_point() +
theme(plot.background = element_rect(size = 1, color = 'blue'))
I hope you guys have a solution.
Will something similar to this work?
x <- 1:10
y <- rnorm(10,mean = x)
df <- data.frame(x,y)
ggplot(data = df, mapping = aes(x,y)) + geom_point() +
annotate(geom = 'segment',
y = Inf,
yend = Inf,
x = -Inf,
xend = Inf,
size = 2) +
theme(axis.line.x = element_line(size = 1))
Not a perfect, but working solution. You have to plot huge "-" (size = 1000) outside plot area. This solution is not perfect as you have to manually adjust position of "-" on the y-axis.
df <- data.frame(x = 1:10, y = 1:10)
library(ggplot2)
ggplot(df, aes(x, y)) +
geom_point() +
# Y position adjusted manually
geom_text(aes(5, 2.9, label = "-"), color = "blue", size = 1000) +
# Y position adjusted manually
geom_text(aes(5, 21.2, label = "-"), color = "blue", size = 1000) +
# Plot outside plot area
coord_cartesian(ylim = c(0, 10), clip = "off")
I am not completely happy with the solution as I don't fully grasp
how to change the size of the lines
why they are not perfectly aligned with top and bottom when using patchwork::wrap_plots()
why it does not show the top line using ggpubr::ggarrange() or cowplot::plot_grid()
but based on this code, I suggest the following solution:
library(ggplot2)
df <- data.frame(x = 1:5, y = 1:5)
p <- ggplot(data = df) + aes(x, y) + geom_point()
top_line <- grid::grobTree(grid::linesGrob(x = grid::unit(c(0, 1), "npc"), y = grid::unit(1, "npc")))
bot_line <- grid::grobTree(grid::linesGrob(x = grid::unit(c(0, 1), "npc"), y = grid::unit(0, "npc")))
patchwork::wrap_plots(top_line, p, bot_line,
ncol = 1, nrow = 3,
heights = c(0, 1, 0))
ggpubr::ggarrange(top_line, p, bot_line,
ncol = 1, nrow = 3,
heights = c(0, 1, 0))
cowplot::plot_grid(top_line, p, bot_line,
ncol = 1, nrow = 3,
rel_heights = c(0, 1, 0))
Created on 2022-08-25 with reprex v2.0.2
I would like to add plots on a world map on several locations.
With this code, I can add points on a map:
# Worldmap with two sites
library(rworldmap)
plot(worldmap[which(worldmap$REGION != "Antarctica"), ])
points(c(3, 80), c(10, 40), cex = 3, pch = 16)
But instead of these two points, I would like to add the two following plots:
# Plots associated to these two sites
x_list <- list()
x_list[[1]] <- rnorm(12, 10, 1)
x_list[[2]] <- rnorm(12, 15, 1)
y_list <- list()
y_list[[1]] <- rnorm(12, 10, 1)
y_list[[2]] <- rnorm(12, 15, 1)
plot(x_list[[1]], y_list[[1]], pch = 16)
plot(x_list[[2]], y_list[[2]], pch = 16)
The result should return something like this:
How can I achieve this (with base syntax or with ggplot2)?
You can use annotation_custom from ggplot2 to insert inset plots:
library(ggplot2)
library(dplyr)
worldmap <- map_data("world") %>%
filter(region != "Antarctica")
g1 <- ggplotGrob(
ggplot() +
geom_point(aes(x = x_list[[1]], y = y_list[[1]])) +
theme_void() +
theme(plot.background = element_rect(fill = "white")))
g2 <- ggplotGrob(
ggplot() +
geom_point(aes(x = x_list[[2]], y = y_list[[2]])) +
theme_void() +
theme(plot.background = element_rect(fill = "white")))
p <- ggplot(worldmap, aes(x=long, y=lat, group=group)) +
geom_map(map = worldmap,
aes(map_id = region),
fill = "white",
colour = "#7f7f7f",
size = 0.5)
p +
annotation_custom(grob = g1, xmin = 0, xmax = 40, ymin = 20, ymax = 40) +
annotation_custom(grob = g1, xmin = 80, xmax = 120, ymin = 0, ymax = 20)
How can I make a plot like this with two different-sized half circles (or other shapes such as triangles etc.)?
I've looked into a few options: Another post suggested using some unicode symbol, that didn't work for me. And if I use a vector image, how can I properly adjust the size parameter so the 2 circles touch each other?
Sample data (I would like to make the size of the two half-circles equal to circle1size and circle2size):
df = data.frame(circle1size = c(1, 3, 2),
circle2size = c(3, 6, 5),
middlepointposition = c(1, 2, 3))
And ultimately is there a way to position the half-circles at different y-values too, to encode a 3rd dimension, like so?
Any advice is much appreciated.
What you're asking for is a bar plot in polar coordinates. This can be done easily in ggplot2. Note that we need to map y = sqrt(count) to get the area of the half circle proportional to the count.
df <- data.frame(x = c(1, 2),
type = c("Investors", "Assignees"),
count = c(19419, 1132))
ggplot(df, aes(x = x, y = sqrt(count), fill = type)) + geom_col(width = 1) +
scale_x_discrete(expand = c(0,0), limits = c(0.5, 2.5)) +
coord_polar(theta = "x", direction = -1)
Further styling would have to be applied to remove the gray background, remove the axes, change the color, etc., but that's all standard ggplot2.
Update 1: Improved version with multiple countries.
df <- data.frame(x = rep(c(1, 2), 3),
type = rep(c("Investors", "Assignees"), 3),
country = rep(c("Japan", "Germany", "Korea"), each = 2),
count = c(19419, 1132, 8138, 947, 8349, 436))
df$country <- factor(df$country, levels = c("Japan", "Germany", "Korea"))
ggplot(df, aes(x=x, y=sqrt(count), fill=type)) + geom_col(width =1) +
scale_x_continuous(expand = c(0, 0), limits = c(0.5, 2.5)) +
scale_y_continuous(expand = c(0, 0)) +
coord_polar(theta = "x", direction = -1) +
facet_wrap(~country) +
theme_void()
Update 2: Drawing the individual plots at different locations.
We can do some trickery to take the individual plots and plot them at different locations in an enclosing plot. This works, and is a generic method that can be done with any sort of plot, but it's probably overkill here. Anyways, here is the solution.
library(tidyverse) # for map
library(cowplot) # for draw_text, draw_plot, get_legend, insert_yaxis_grob
# data frame of country data
df <- data.frame(x = rep(c(1, 2), 3),
type = rep(c("Investors", "Assignees"), 3),
country = rep(c("Japan", "Germany", "Korea"), each = 2),
count = c(19419, 1132, 8138, 947, 8349, 436))
# list of coordinates
coord_list = list(Japan = c(1, 3), Germany = c(2, 1), Korea = c(3, 2))
# make list of individual plots
split(df, df$country) %>%
map( ~ ggplot(., aes(x=x, y=sqrt(count), fill=type)) + geom_col(width =1) +
scale_x_continuous(expand = c(0, 0), limits = c(0.5, 2.5)) +
scale_y_continuous(expand = c(0, 0), limits = c(0, 160)) +
draw_text(.$country[1], 1, 160, vjust = 0) +
coord_polar(theta = "x", start = 3*pi/2) +
guides(fill = guide_legend(title = "Type", reverse = T)) +
theme_void() + theme(legend.position = "none") ) -> plotlist
# extract the legend
legend <- get_legend(plotlist[[1]] + theme(legend.position = "right"))
# now plot the plots where we want them
width = 1.3
height = 1.3
p <- ggplot() + scale_x_continuous(limits = c(0.5, 3.5)) + scale_y_continuous(limits = c(0.5, 3.5))
for (country in names(coord_list)) {
p <- p + draw_plot(plotlist[[country]], x = coord_list[[country]][1]-width/2,
y = coord_list[[country]][2]-height/2,
width = width, height = height)
}
# plot without legend
p
# plot with legend
ggdraw(insert_yaxis_grob(p, legend))
Update 3: Completely different approach, using geom_arc_bar() from the ggforce package.
library(ggforce)
df <- data.frame(start = rep(c(-pi/2, pi/2), 3),
type = rep(c("Investors", "Assignees"), 3),
country = rep(c("Japan", "Germany", "Korea"), each = 2),
x = rep(c(1, 2, 3), each = 2),
y = rep(c(3, 1, 2), each = 2),
count = c(19419, 1132, 8138, 947, 8349, 436))
r <- 0.5
scale <- r/max(sqrt(df$count))
ggplot(df) +
geom_arc_bar(aes(x0 = x, y0 = y, r0 = 0, r = sqrt(count)*scale,
start = start, end = start + pi, fill = type),
color = "white") +
geom_text(data = df[c(1, 3, 5), ],
aes(label = country, x = x, y = y + scale*sqrt(count) + .05),
size =11/.pt, vjust = 0)+
guides(fill = guide_legend(title = "Type", reverse = T)) +
xlab("x axis") + ylab("y axis") +
coord_fixed() +
theme_bw()
If you don't need to have ggplot2 map aesthetics other than x and y you could try egg::geom_custom,
# devtools::install_github("baptiste/egg")
library(egg)
library(grid)
library(ggplot2)
d = data.frame(r1= c(1,3,2), r2=c(3,6,5), x=1:3, y=1:3)
gl <- Map(mushroomGrob, r1=d$r1, r2=d$r2, gp=list(gpar(fill=c("bisque","maroon"), col="white")))
d$grobs <- I(gl)
ggplot(d, aes(x,y)) +
geom_custom(aes(data=grobs), grob_fun=I) +
theme_minimal()
with the following grob,
mushroomGrob <- function(x=0.5, y=0.5, r1=0.2, r2=0.1, scale = 0.01, angle=0, gp=gpar()){
grob(x=x,y=y,r1=r1,r2=r2, scale=scale, angle=angle, gp=gp , cl="mushroom")
}
preDrawDetails.mushroom <- function(x){
pushViewport(viewport(x=x$x,y=x$y))
}
postDrawDetails.mushroom<- function(x){
upViewport()
}
drawDetails.mushroom <- function(x, recording=FALSE, ...){
th2 <- seq(0,pi, length=180)
th1 <- th2 + pi
d1 <- x$r1*x$scale*cbind(cos(th1+x$angle*pi/180),sin(th1+x$angle*pi/180))
d2 <- x$r2*x$scale*cbind(cos(th2+x$angle*pi/180),sin(th2+x$angle*pi/180))
grid.polygon(unit(c(d1[,1],d2[,1]), "snpc")+unit(0.5,"npc"),
unit(c(d1[,2],d2[,2]), "snpc")+unit(0.5,"npc"),
id=rep(1:2, each=length(th1)), gp=x$gp)
}
# grid.newpage()
# grid.draw(mushroomGrob(gp=gpar(fill=c("bisque","maroon"), col=NA)))
I want to draw a segment below a density plot and I would like to have the distance be a constant number of pixels. Is this possible? I Know how to hardcode the distance. For example:
set.seed(40816)
library(ggplot2)
df.plot <- data.frame(x = rnorm(100, 0, 1))
ggplot(df.plot, aes(x = x)) + geom_density() +
geom_segment(aes(x = -1, y = -0.05, xend = 1, yend = -0.05),
linetype = "longdash")
produces :
But
df.plot <- data.frame(x = rnorm(100, 0, 4))
ggplot(df.plot, aes(x = x)) + geom_density() +
geom_segment(aes(x = -1, y = -0.025, xend = 1, yend = -0.025),
linetype = "longdash")
produces a plot with the segment much further away from the density
You could use annotation_grob,
set.seed(40816)
library(ggplot2)
df.plot <- data.frame(x = rnorm(100, 0, 1))
strainerGrob <- function(pos=unit(2,"mm"), gp=gpar(lty=2, lwd=2))
segmentsGrob(0, unit(1,"npc") - pos, 1, unit(1,"npc") - pos, gp=gp)
ggplot(df.plot, aes(x = x)) + geom_density() +
annotation_custom(strainerGrob(), xmin = -1, xmax = 1, ymin=-Inf, ymax=0) +
expand_limits(y=-0.1)
# data
set.seed (123)
xvar <- c(rnorm (1000, 50, 30), rnorm (1000, 40, 10), rnorm (1000, 70, 10))
yvar <- xvar + rnorm (length (xvar), 0, 20)
myd <- data.frame (xvar, yvar)
# density plot for xvar
upperp = 80 # upper cutoff
lowerp = 30 # lower cutoff
x <- myd$xvar
plot(density(x))
dens <- density(x)
x11 <- min(which(dens$x <= lowerp))
x12 <- max(which(dens$x <= lowerp))
x21 <- min(which(dens$x > upperp))
x22 <- max(which(dens$x > upperp))
with(dens, polygon(x = c(x[c(x11, x11:x12, x12)]),
y = c(0, y[x11:x12], 0), col = "green"))
with(dens, polygon(x = c(x[c(x21, x21:x22, x22)]),
y = c(0, y[x21:x22], 0), col = "red"))
abline(v = c(mean(x)), lwd = 2, lty = 2, col = "red")
# density plot with yvar
upperp = 70 # upper cutoff
lowerp = 30 # lower cutoff
x <- myd$yvar
plot(density(x))
dens <- density(x)
x11 <- min(which(dens$x <= lowerp))
x12 <- max(which(dens$x <= lowerp))
x21 <- min(which(dens$x > upperp))
x22 <- max(which(dens$x > upperp))
with(dens, polygon(x = c(x[c(x11, x11:x12, x12)]),
y = c(0, y[x11:x12], 0), col = "green"))
with(dens, polygon(x = c(x[c(x21, x21:x22, x22)]),
y = c(0, y[x21:x22], 0), col = "red"))
abline(v = c(mean(x)), lwd = 2, lty = 2, col = "red")
I need to plot two way density plot, I am not sure there is better way than the following:
ggplot(myd,aes(x=xvar,y=yvar))+
stat_density2d(aes(fill=..level..), geom="polygon") +
scale_fill_gradient(low="blue", high="green") + theme_bw()
I want to combine all three types in to one (I did not know if I can create two-way plot in ggplot), there is not prefrence on whether the solution be plots are in ggplot or base or mixed. I hope this is doable project, considering robustness of R. I personally prefer ggplot2.
Note: the lower shading in this plot is not right, red should be always lower and green upper in xvar and yvar graphs, corresponding to shaded region in xy density plot.
Edit: Ultimate expectation on the graph (thanks seth and jon for very close answer)
(1) removing space and axis tick labels etc to make it compact
(2) alignments of grids so that middle plot ticks and grids should align with side ticks and labels and size of plots look the same.
Here is the example for combining multiple plots with alignment:
library(ggplot2)
library(grid)
set.seed (123)
xvar <- c(rnorm (100, 50, 30), rnorm (100, 40, 10), rnorm (100, 70, 10))
yvar <- xvar + rnorm (length (xvar), 0, 20)
myd <- data.frame (xvar, yvar)
p1 <- ggplot(myd,aes(x=xvar,y=yvar))+
stat_density2d(aes(fill=..level..), geom="polygon") +
coord_cartesian(c(0, 150), c(0, 150)) +
opts(legend.position = "none")
p2 <- ggplot(myd, aes(x = xvar)) + stat_density() +
coord_cartesian(c(0, 150))
p3 <- ggplot(myd, aes(x = yvar)) + stat_density() +
coord_flip(c(0, 150))
gt <- ggplot_gtable(ggplot_build(p1))
gt2 <- ggplot_gtable(ggplot_build(p2))
gt3 <- ggplot_gtable(ggplot_build(p3))
gt1 <- ggplot2:::gtable_add_cols(gt, unit(0.3, "null"), pos = -1)
gt1 <- ggplot2:::gtable_add_rows(gt1, unit(0.3, "null"), pos = 0)
gt1 <- ggplot2:::gtable_add_grob(gt1, gt2$grobs[[which(gt2$layout$name == "panel")]],
1, 4, 1, 4)
gt1 <- ggplot2:::gtable_add_grob(gt1, gt2$grobs[[which(gt2$layout$name == "axis-l")]],
1, 3, 1, 3, clip = "off")
gt1 <- ggplot2:::gtable_add_grob(gt1, gt3$grobs[[which(gt3$layout$name == "panel")]],
4, 6, 4, 6)
gt1 <- ggplot2:::gtable_add_grob(gt1, gt3$grobs[[which(gt3$layout$name == "axis-b")]],
5, 6, 5, 6, clip = "off")
grid.newpage()
grid.draw(gt1)
note that this works with gglot2 0.9.1, and in the future release you may do it more easily.
And finally
you can do that by:
library(ggplot2)
library(grid)
set.seed (123)
xvar <- c(rnorm (100, 50, 30), rnorm (100, 40, 10), rnorm (100, 70, 10))
yvar <- xvar + rnorm (length (xvar), 0, 20)
myd <- data.frame (xvar, yvar)
p1 <- ggplot(myd,aes(x=xvar,y=yvar))+
stat_density2d(aes(fill=..level..), geom="polygon") +
geom_polygon(aes(x, y),
data.frame(x = c(-Inf, -Inf, 30, 30), y = c(-Inf, 30, 30, -Inf)),
alpha = 0.5, colour = NA, fill = "red") +
geom_polygon(aes(x, y),
data.frame(x = c(Inf, Inf, 80, 80), y = c(Inf, 80, 80, Inf)),
alpha = 0.5, colour = NA, fill = "green") +
coord_cartesian(c(0, 120), c(0, 120)) +
opts(legend.position = "none")
xd <- data.frame(density(myd$xvar)[c("x", "y")])
p2 <- ggplot(xd, aes(x, y)) +
geom_area(data = subset(xd, x < 30), fill = "red") +
geom_area(data = subset(xd, x > 80), fill = "green") +
geom_line() +
coord_cartesian(c(0, 120))
yd <- data.frame(density(myd$yvar)[c("x", "y")])
p3 <- ggplot(yd, aes(x, y)) +
geom_area(data = subset(yd, x < 30), fill = "red") +
geom_area(data = subset(yd, x > 80), fill = "green") +
geom_line() +
coord_flip(c(0, 120))
gt <- ggplot_gtable(ggplot_build(p1))
gt2 <- ggplot_gtable(ggplot_build(p2))
gt3 <- ggplot_gtable(ggplot_build(p3))
gt1 <- ggplot2:::gtable_add_cols(gt, unit(0.3, "null"), pos = -1)
gt1 <- ggplot2:::gtable_add_rows(gt1, unit(0.3, "null"), pos = 0)
gt1 <- ggplot2:::gtable_add_grob(gt1, gt2$grobs[[which(gt2$layout$name == "panel")]],
1, 4, 1, 4)
gt1 <- ggplot2:::gtable_add_grob(gt1, gt2$grobs[[which(gt2$layout$name == "axis-l")]],
1, 3, 1, 3, clip = "off")
gt1 <- ggplot2:::gtable_add_grob(gt1, gt3$grobs[[which(gt3$layout$name == "panel")]],
4, 6, 4, 6)
gt1 <- ggplot2:::gtable_add_grob(gt1, gt3$grobs[[which(gt3$layout$name == "axis-b")]],
5, 6, 5, 6, clip = "off")
grid.newpage()
grid.draw(gt1)
As in the example I linked to above you need the gridExtra package.
This is the g you gave.
g=ggplot(myd,aes(x=xvar,y=yvar))+
stat_density2d(aes(fill=..level..), geom="polygon") +
scale_fill_gradient(low="blue", high="green") + theme_bw()
use geom_rect to draw the two regions
gbig=g+geom_rect(data=myd,
aes( NULL,
NULL,
xmin=0,
xmax=lowerp,
ymin=-10,
ymax=20),
fill='red',
alpha=.0051,
inherit.aes=F)+
geom_rect(aes( NULL,
NULL,
xmin=upperp,
xmax=100,
ymin=upperp,
ymax=130),
fill='green',
alpha=.0051,
inherit.aes=F)+
opts(legend.position = "none")
This is a simple ggplot histogram; it lacks your colored regions,
but they are pretty easy
dens_top <- ggplot()+geom_density(aes(x))
dens_right <- ggplot()+geom_density(aes(x))+coord_flip()
Make an empty graph to fill in the corner
empty <- ggplot()+geom_point(aes(1,1), colour="white")+
opts(axis.ticks=theme_blank(),
panel.background=theme_blank(),
axis.text.x=theme_blank(),
axis.text.y=theme_blank(),
axis.title.x=theme_blank(),
axis.title.y=theme_blank())
Then use the grid.arrange function:
library(gridExtra)
grid.arrange(dens_top, empty ,
gbig, dens_right,
ncol=2,
nrow=2,
widths=c(4, 1),
heights=c(1, 4))
Not very pretty but the idea is there.
You will have to make sure the scales match too!
Building on Seth's answer (thank you Seth, and you deserve all credits), I improved some of issues raised by the questioner. As comments is too short to answer all issues I choose to use this as answer itself. A couple of issues are still there, need your help:
# data
set.seed (123)
xvar <- c(rnorm (1000, 50, 30), rnorm (1000, 40, 10), rnorm (1000, 70, 10))
yvar <- xvar + rnorm (length (xvar), 0, 20)
myd <- data.frame (xvar, yvar)
require(ggplot2)
# density plot for xvar
upperp = 80 # upper cutoff
lowerp = 30
middle figure
g=ggplot(myd,aes(x=xvar,y=yvar))+
stat_density2d(aes(fill=..level..), geom="polygon") +
scale_fill_gradient(low="blue", high="green") +
scale_x_continuous(limits = c(0, 110)) +
scale_y_continuous(limits = c(0, 110)) + theme_bw()
geom_rect two regions
gbig=g+ geom_rect(data=myd, aes( NULL, NULL, xmin=0,
xmax=lowerp,ymin=0, ymax=20), fill='red', alpha=.0051,inherit.aes=F)+
geom_rect(aes(NULL, NULL, xmin=upperp, xmax=110,
ymin=upperp, ymax=110), fill='green',
alpha=.0051,
inherit.aes=F)+
opts(legend.position = "none",
plot.margin = unit(rep(0, 4), "lines"))
Top histogram with shaded region
x.dens <- density(myd$xvar)
df.dens <- data.frame(x = x.dens$x, y = x.dens$y)
dens_top <- ggplot()+geom_density(aes(myd$xvar, y = ..density..))
+ scale_x_continuous(limits = c(0, 110)) +
geom_area(data = subset(df.dens, x <= lowerp), aes(x=x,y=y), fill = 'red')
+ geom_area(data = subset(df.dens, x >= upperp), aes(x=x,y=y), fill = 'green')
+ opts (axis.text.x=theme_blank(), axis.title.x=theme_blank(),
plot.margin = unit(rep(0, 4), "lines")) + xlab ("") + ylab ("") + theme_bw()
right histogram with shaded region
y.dens <- density(myd$yvar)
df.dens.y <- data.frame(x = y.dens$x, y = y.dens$y)
dens_right <- ggplot()+geom_density(aes(myd$yvar, y = ..density..))
+ scale_x_continuous(limits = c(0, 110)) +
geom_area(data = subset(df.dens.y, x <= lowerp), aes(x=x,y=y),
fill = 'red')
+ geom_area(data = subset(df.dens.y, x >= upperp), aes(x=x,y=y),
fill = 'green')
+ coord_flip() +
opts (axis.text.x=theme_blank(), axis.title.x=theme_blank(),
plot.margin = unit(rep(0, 4), "lines")) + xlab ("") + ylab ("")
+ theme_bw()
Make an empty graph to fill in the corner
empty <- ggplot()+geom_point(aes(1,1), colour="white")+
scale_x_continuous(breaks = NA) + scale_y_continuous(breaks = NA) +
opts(axis.ticks=theme_blank(),
panel.background=theme_blank(),
axis.text.x=theme_blank(),
axis.text.y=theme_blank(),
axis.title.x=theme_blank(),
axis.title.y=theme_blank())
Then use the grid.arrange function:
library(gridExtra)
grid.arrange(dens_top, empty , gbig, dens_right, ncol=2,nrow=2,
widths=c(2, 1), heights=c(1, 2))
PS: (1) Can somebody help to align the graphs perfectly ? (2) Can someone help to remove the additional space between plots, I tried adjust margins - but there is space between x and y density plot and central plot.