I know that when you use par( fig=c( ... ), new=T ), you can create inset graphs. However, I was wondering if it is possible to use ggplot2 library to create 'inset' graphs.
UPDATE 1: I tried using the par() with ggplot2, but it does not work.
UPDATE 2: I found a working solution at ggplot2 GoogleGroups using grid::viewport().
Section 8.4 of the book explains how to do this. The trick is to use the grid package's viewports.
#Any old plot
a_plot <- ggplot(cars, aes(speed, dist)) + geom_line()
#A viewport taking up a fraction of the plot area
vp <- viewport(width = 0.4, height = 0.4, x = 0.8, y = 0.2)
#Just draw the plot twice
png("test.png")
print(a_plot)
print(a_plot, vp = vp)
dev.off()
Much simpler solution utilizing ggplot2 and egg. Most importantly this solution works with ggsave.
library(ggplot2)
library(egg)
plotx <- ggplot(mpg, aes(displ, hwy)) + geom_point()
plotx +
annotation_custom(
ggplotGrob(plotx),
xmin = 5, xmax = 7, ymin = 30, ymax = 44
)
ggsave(filename = "inset-plot.png")
Alternatively, can use the cowplot R package by Claus O. Wilke (cowplot is a powerful extension of ggplot2). The author has an example about plotting an inset inside a larger graph in this intro vignette. Here is some adapted code:
library(cowplot)
main.plot <-
ggplot(data = mpg, aes(x = cty, y = hwy, colour = factor(cyl))) +
geom_point(size = 2.5)
inset.plot <- main.plot + theme(legend.position = "none")
plot.with.inset <-
ggdraw() +
draw_plot(main.plot) +
draw_plot(inset.plot, x = 0.07, y = .7, width = .3, height = .3)
# Can save the plot with ggsave()
ggsave(filename = "plot.with.inset.png",
plot = plot.with.inset,
width = 17,
height = 12,
units = "cm",
dpi = 300)
I prefer solutions that work with ggsave. After a lot of googling around I ended up with this (which is a general formula for positioning and sizing the plot that you insert.
library(tidyverse)
plot1 = qplot(1.00*mpg, 1.00*wt, data=mtcars) # Make sure x and y values are floating values in plot 1
plot2 = qplot(hp, cyl, data=mtcars)
plot(plot1)
# Specify position of plot2 (in percentages of plot1)
# This is in the top left and 25% width and 25% height
xleft = 0.05
xright = 0.30
ybottom = 0.70
ytop = 0.95
# Calculate position in plot1 coordinates
# Extract x and y values from plot1
l1 = ggplot_build(plot1)
x1 = l1$layout$panel_ranges[[1]]$x.range[1]
x2 = l1$layout$panel_ranges[[1]]$x.range[2]
y1 = l1$layout$panel_ranges[[1]]$y.range[1]
y2 = l1$layout$panel_ranges[[1]]$y.range[2]
xdif = x2-x1
ydif = y2-y1
xmin = x1 + (xleft*xdif)
xmax = x1 + (xright*xdif)
ymin = y1 + (ybottom*ydif)
ymax = y1 + (ytop*ydif)
# Get plot2 and make grob
g2 = ggplotGrob(plot2)
plot3 = plot1 + annotation_custom(grob = g2, xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax)
plot(plot3)
ggsave(filename = "test.png", plot = plot3)
# Try and make a weird combination of plots
g1 <- ggplotGrob(plot1)
g2 <- ggplotGrob(plot2)
g3 <- ggplotGrob(plot3)
library(gridExtra)
library(grid)
t1 = arrangeGrob(g1,ncol=1, left = textGrob("A", y = 1, vjust=1, gp=gpar(fontsize=20)))
t2 = arrangeGrob(g2,ncol=1, left = textGrob("B", y = 1, vjust=1, gp=gpar(fontsize=20)))
t3 = arrangeGrob(g3,ncol=1, left = textGrob("C", y = 1, vjust=1, gp=gpar(fontsize=20)))
final = arrangeGrob(t1,t2,t3, layout_matrix = cbind(c(1,2), c(3,3)))
grid.arrange(final)
ggsave(filename = "test2.png", plot = final)
'ggplot2' >= 3.0.0 makes possible new approaches for adding insets, as now tibble objects containing lists as member columns can be passed as data. The objects in the list column can be even whole ggplots... The latest version of my package 'ggpmisc' provides geom_plot(), geom_table() and geom_grob(), and also versions that use npc units instead of native data units for locating the insets. These geoms can add multiple insets per call and obey faceting, which annotation_custom() does not. I copy the example from the help page, which adds an inset with a zoom-in detail of the main plot as an inset.
library(tibble)
library(ggpmisc)
p <-
ggplot(data = mtcars, mapping = aes(wt, mpg)) +
geom_point()
df <- tibble(x = 0.01, y = 0.01,
plot = list(p +
coord_cartesian(xlim = c(3, 4),
ylim = c(13, 16)) +
labs(x = NULL, y = NULL) +
theme_bw(10)))
p +
expand_limits(x = 0, y = 0) +
geom_plot_npc(data = df, aes(npcx = x, npcy = y, label = plot))
Or a barplot as inset, taken from the package vignette.
library(tibble)
library(ggpmisc)
p <- ggplot(mpg, aes(factor(cyl), hwy, fill = factor(cyl))) +
stat_summary(geom = "col", fun.y = mean, width = 2/3) +
labs(x = "Number of cylinders", y = NULL, title = "Means") +
scale_fill_discrete(guide = FALSE)
data.tb <- tibble(x = 7, y = 44,
plot = list(p +
theme_bw(8)))
ggplot(mpg, aes(displ, hwy, colour = factor(cyl))) +
geom_plot(data = data.tb, aes(x, y, label = plot)) +
geom_point() +
labs(x = "Engine displacement (l)", y = "Fuel use efficiency (MPG)",
colour = "Engine cylinders\n(number)") +
theme_bw()
The next example shows how to add different inset plots to different panels in a faceted plot. The next example uses the same example data after splitting it according to the century. This particular data set once split adds the problem of one missing level in one of the inset plots. As these plots are built on their own we need to use manual scales to make sure the colors and fill are consistent across the plots. With other data sets this may not be needed.
library(tibble)
library(ggpmisc)
my.mpg <- mpg
my.mpg$century <- factor(ifelse(my.mpg$year < 2000, "XX", "XXI"))
my.mpg$cyl.f <- factor(my.mpg$cyl)
my_scale_fill <- scale_fill_manual(guide = FALSE,
values = c("red", "orange", "darkgreen", "blue"),
breaks = levels(my.mpg$cyl.f))
p1 <- ggplot(subset(my.mpg, century == "XX"),
aes(factor(cyl), hwy, fill = cyl.f)) +
stat_summary(geom = "col", fun = mean, width = 2/3) +
labs(x = "Number of cylinders", y = NULL, title = "Means") +
my_scale_fill
p2 <- ggplot(subset(my.mpg, century == "XXI"),
aes(factor(cyl), hwy, fill = cyl.f)) +
stat_summary(geom = "col", fun = mean, width = 2/3) +
labs(x = "Number of cylinders", y = NULL, title = "Means") +
my_scale_fill
data.tb <- tibble(x = c(7, 7),
y = c(44, 44),
century = factor(c("XX", "XXI")),
plot = list(p1, p2))
ggplot() +
geom_plot(data = data.tb, aes(x, y, label = plot)) +
geom_point(data = my.mpg, aes(displ, hwy, colour = cyl.f)) +
labs(x = "Engine displacement (l)", y = "Fuel use efficiency (MPG)",
colour = "Engine cylinders\n(number)") +
scale_colour_manual(guide = FALSE,
values = c("red", "orange", "darkgreen", "blue"),
breaks = levels(my.mpg$cyl.f)) +
facet_wrap(~century, ncol = 1)
In 2019, the patchwork package entered the stage, with which you can create
insets
easily by using the inset_element() function:
require(ggplot2)
require(patchwork)
gg1 = ggplot(iris, aes(Sepal.Length, Sepal.Width)) +
geom_point()
gg2 = ggplot(iris, aes(Sepal.Length)) +
geom_density()
gg1 +
inset_element(gg2, left = 0.65, bottom = 0.75, right = 1, top = 1)
Related
I want to annotate some text on last facet of the plot with the following code:
library(ggplot2)
p <- ggplot(mtcars, aes(mpg, wt)) + geom_point()
p <- p + facet_grid(. ~ cyl)
p <- p + annotate("text", label = "Test", size = 4, x = 15, y = 5)
print(p)
But this code annotates the text on every facet. How can I get the annotated text on only one facet?
Function annotate() adds the same label to all panels in a plot with facets. If the intention is to add different annotations to each panel, or annotations to only some panels, a geometry has to be used instead of annotate(). To use a geometry, such as geom_text() we need to assemble a data frame containing the text of the labels in one column and columns for the variables to be mapped to other aesthetics, as well as the variable(s) used for faceting.
Typically you'd do something like this:
ann_text <- data.frame(mpg = 15,wt = 5,lab = "Text",
cyl = factor(8,levels = c("4","6","8")))
p + geom_text(data = ann_text,label = "Text")
It should work without specifying the factor variable completely, but will probably throw some warnings:
Function annotate() adds the same label to all panels in a plot with facets. If the intention is to add different annotations to each panel, or annotations to only some panels, a geometry has to be used instead of annotate(). To use a geometry, such as geom_text() we need to assemble a data frame containing the text of the labels in one column and columns for the variables to be mapped to other aesthetics, as well as the variable(s) used for faceting. This answer exemplifies this for both facet_wrap() and facet_grid().
Here's the plot without text annotations:
library(ggplot2)
p <- ggplot(mtcars, aes(mpg, wt)) +
geom_point() +
facet_grid(. ~ cyl) +
theme(panel.spacing = unit(1, "lines"))
p
Let's create an additional data frame to hold the text annotations:
dat_text <- data.frame(
label = c("4 cylinders", "6 cylinders", "8 cylinders"),
cyl = c(4, 6, 8)
)
p + geom_text(
data = dat_text,
mapping = aes(x = -Inf, y = -Inf, label = label),
hjust = -0.1,
vjust = -1
)
Alternatively, we can manually specify the position of each label:
dat_text <- data.frame(
label = c("4 cylinders", "6 cylinders", "8 cylinders"),
cyl = c(4, 6, 8),
x = c(20, 27.5, 25),
y = c(4, 4, 4.5)
)
p + geom_text(
data = dat_text,
mapping = aes(x = x, y = y, label = label)
)
We can also label plots across two facets:
dat_text <- data.frame(
cyl = c(4, 6, 8, 4, 6, 8),
am = c(0, 0, 0, 1, 1, 1)
)
dat_text$label <- sprintf(
"%s, %s cylinders",
ifelse(dat_text$am == 0, "automatic", "manual"),
dat_text$cyl
)
p +
facet_grid(am ~ cyl) +
geom_text(
size = 5,
data = dat_text,
mapping = aes(x = Inf, y = Inf, label = label),
hjust = 1.05,
vjust = 1.5
)
Notes:
You can use -Inf and Inf to position text at the edges of a panel.
You can use hjust and vjust to adjust the text justification.
The text label data frame dat_text should have a column that works with your facet_grid() or facet_wrap().
If anyone is looking for an easy way to label facets for reports or publications, the egg (CRAN) package has pretty nifty tag_facet() & tag_facet_outside() functions.
library(ggplot2)
p <- ggplot(mtcars, aes(qsec, mpg)) +
geom_point() +
facet_grid(. ~ am) +
theme_bw(base_size = 12)
# install.packages('egg', dependencies = TRUE)
library(egg)
Tag inside
Default
tag_facet(p)
Note: if you want to keep the strip text and background, try adding strip.text and strip.background back in theme or remove theme(strip.text = element_blank(), strip.background = element_blank()) from the original tag_facet() function.
tag_facet <- function(p, open = "(", close = ")", tag_pool = letters, x = -Inf, y = Inf,
hjust = -0.5, vjust = 1.5, fontface = 2, family = "", ...) {
gb <- ggplot_build(p)
lay <- gb$layout$layout
tags <- cbind(lay, label = paste0(open, tag_pool[lay$PANEL], close), x = x, y = y)
p + geom_text(data = tags, aes_string(x = "x", y = "y", label = "label"), ..., hjust = hjust,
vjust = vjust, fontface = fontface, family = family, inherit.aes = FALSE)
}
Align top right & use Roman numerals
tag_facet(p, x = Inf, y = Inf,
hjust = 1.5,
tag_pool = as.roman(1:nlevels(factor(mtcars$am))))
Align bottom left & use capital letters
tag_facet(p,
x = -Inf, y = -Inf,
vjust = -1,
open = "", close = ")",
tag_pool = LETTERS)
Define your own tags
my_tag <- c("i) 4 cylinders", "ii) 6 cyls")
tag_facet(p,
x = -Inf, y = -Inf,
vjust = -1, hjust = -0.25,
open = "", close = "",
fontface = 4,
size = 5,
family = "serif",
tag_pool = my_tag)
Tag outside
p2 <- ggplot(mtcars, aes(qsec, mpg)) +
geom_point() +
facet_grid(cyl ~ am, switch = 'y') +
theme_bw(base_size = 12) +
theme(strip.placement = 'outside')
tag_facet_outside(p2)
Edit: adding another alternative using the stickylabeller package
- `.n` numbers the facets numerically: `"1"`, `"2"`, `"3"`...
- `.l` numbers the facets using lowercase letters: `"a"`, `"b"`, `"c"`...
- `.L` numbers the facets using uppercase letters: `"A"`, `"B"`, `"C"`...
- `.r` numbers the facets using lowercase Roman numerals: `"i"`, `"ii"`, `"iii"`...
- `.R` numbers the facets using uppercase Roman numerals: `"I"`, `"II"`, `"III"`...
# devtools::install_github("rensa/stickylabeller")
library(stickylabeller)
ggplot(mtcars, aes(qsec, mpg)) +
geom_point() +
facet_wrap(. ~ am,
labeller = label_glue('({.l}) am = {am}')) +
theme_bw(base_size = 12)
Created by the reprex package (v0.2.1)
I think for the answer above lab="Text" is useless, the code below is also ok.
ann_text <- data.frame(mpg = 15,wt = 5,
cyl = factor(8,levels = c("4","6","8")))
p + geom_text(data = ann_text,label = "Text" )
However if you want to label differently in different sub-graphs, it will be ok in this way:
ann_text <- data.frame(mpg = c(14,15),wt = c(4,5),lab=c("text1","text2"),
cyl = factor(c(6,8),levels = c("4","6","8")))
p + geom_text(data = ann_text,aes(label =lab) )
Expanding slightly on joran's excellent answer, to clarify how the label dataframe works.
You can think of "mpg" and "wt" as the x and y coordinates, respectively (I find it easier to keep track of the original variable names than renaming them, as in Kamil's also-excellent answer). You need one row per label, and the "cyl" column shows which facet each row is associated with.
ann_text<-data.frame(mpg=c(25,15),wt=c(3,5),cyl=c(6,8),label=c("Label 1","Label 2"))
ann_text
> mpg wt cyl label
> 25 3 6 Label 1
> 15 5 8 Label 2
p <- ggplot(mtcars, aes(mpg, wt)) + geom_point()
p <- p + facet_grid(. ~ factor(cyl))
p + geom_text(data = ann_text,label=ann_text$label)
I did not know about the egg package,
so here is a plain ggplot2 package solution
library(tidyverse)
library(magrittr)
Data1=data.frame(A=runif(20, min = 0, max = 100), B=runif(20, min = 0, max = 250), C=runif(20, min = 0, max = 300))
Data2=data.frame(A=runif(20, min = -10, max = 50), B=runif(20, min = -5, max = 150), C=runif(20, min = 5, max = 200))
bind_cols(
Data1 %>% gather("Vars","Data_1"),
Data2 %>% gather("Vars","Data_2")
) %>% select(-Vars1) -> Data_combined
Data_combined %>%
group_by(Vars) %>%
summarise(r=cor(Data_1,Data_2),
r2=r^2,
p=(pt(abs(r),nrow(.)-2)-pt(-abs(r),nrow(.)-2))) %>%
mutate(rlabel=paste("r:",format(r,digits=3)),
plabel=paste("p:",format(p,digits=3))) ->
label_df
label_df %<>% mutate(x=60,y=190)
Data_combined %>%
ggplot(aes(x=Data_1,y=Data_2,color=Vars)) +
geom_point() +
geom_smooth(method="lm",se=FALSE) +
geom_text(data=label_df,aes(x=x,y=y,label=rlabel),inherit.aes = FALSE) +
geom_text(data=label_df,aes(x=x,y=y-10,label=plabel),inherit.aes = FALSE) +
facet_wrap(~ Vars)
To make it clear, I am looking for a simple way of adding a 90-degree-rotated histogram or density plot whose x-axis aligns with the y-axis of the example plot given below.
library(ggplot2)
library(tibble)
x <- seq(100)
y <- rnorm(100)
my_data <- tibble(x = x, y = y)
ggplot(data = my_data, mapping = aes(x = x, y = y)) +
geom_line()
Created on 2019-01-28 by the reprex package (v0.2.1)
I'd try it with either geom_histogram or geom_density, the patchwork library, and dynamically setting limits to match the plots.
Rather than manually setting limits, get the range of y-values, set that as the limits in scale_y_continuous or scale_x_continuous as appropriate, and add some padding with expand_scale. The first plot is the line plot, and the second and third are distribution plots, with the axes flipped. All have the scales set to match.
library(ggplot2)
library(tibble)
library(patchwork)
y_range <- range(my_data$y)
p1 <- ggplot(data = my_data, mapping = aes(x = x, y = y)) +
geom_line() +
scale_y_continuous(limits = y_range, expand = expand_scale(mult = 0.1))
p2_hist <- ggplot(my_data, aes(x = y)) +
geom_histogram(binwidth = 0.2) +
coord_flip() +
scale_x_continuous(limits = y_range, expand = expand_scale(mult = 0.1))
p2_dens <- ggplot(my_data, aes(x = y)) +
geom_density() +
coord_flip() +
scale_x_continuous(limits = y_range, expand = expand_scale(mult = 0.1))
patchwork allows you to simply add plots to each other, then add the plot_layout function where you can customize the layout.
p1 + p2_hist + plot_layout(nrow = 1)
p1 + p2_dens + plot_layout(nrow = 1)
I've generally seen these types of plots where the distribution is shown in a "marginal" plot—that is, setup to be secondary to the main (in this case, line) plot. The ggExtra package has a marginal plot, but it only seems to work where the main plot is a scatterplot.
To do this styling manually, I'm setting theme arguments on each plot inline as I pass them to plot_layout. I took off the axis markings from the histogram so its left side is clean, and shrunk the margins on the sides of the two plots that meet. In plot_layout, I'm scaling the widths so the histogram appears more in the margins of the line chart. The same could be done with the density plot.
(p1 +
theme(plot.margin = margin(r = 0, unit = "pt"))
) +
(p2_hist +
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.y = element_blank(),
plot.margin = margin(l = 0, unit = "pt"))
) +
plot_layout(nrow = 1, widths = c(1, 0.2))
Created on 2019-01-28 by the reprex package (v0.2.1)
You can try using geom_histogram or geom_density, however it's a little bit complicated as you have to rotate axis for them (while keeping original orientation for geom_line). I would use geom_violin (which is a density plot, but mirrored). If you want to get only one sided violin plot you can use custom geom_flat_violin geom. It was first posted by #David Robinson on his gists.
I used this geom in different answer, however I don't think that it's a duplicate as you need to put it at the end of the plot and combine with different geom.
Final code is:
library(ggplot2)
ggplot(data.frame(x = seq(100), y = rnorm(100))) +
geom_flat_violin(aes(100, y), color = "red", fill = "red", alpha = 0.5, width = 10) +
geom_line(aes(x, y))
geom_flat_violin code:
library(dplyr)
"%||%" <- function(a, b) {
if (!is.null(a)) a else b
}
geom_flat_violin <- function(mapping = NULL, data = NULL, stat = "ydensity",
position = "dodge", trim = TRUE, scale = "area",
show.legend = NA, inherit.aes = TRUE, ...) {
layer(
data = data,
mapping = mapping,
stat = stat,
geom = GeomFlatViolin,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
trim = trim,
scale = scale,
...
)
)
}
GeomFlatViolin <-
ggproto(
"GeomFlatViolin",
Geom,
setup_data = function(data, params) {
data$width <- data$width %||%
params$width %||% (resolution(data$x, FALSE) * 0.9)
# ymin, ymax, xmin, and xmax define the bounding rectangle for each group
data %>%
dplyr::group_by(.data = ., group) %>%
dplyr::mutate(
.data = .,
ymin = min(y),
ymax = max(y),
xmin = x,
xmax = x + width / 2
)
},
draw_group = function(data, panel_scales, coord)
{
# Find the points for the line to go all the way around
data <- base::transform(data,
xminv = x,
xmaxv = x + violinwidth * (xmax - x))
# Make sure it's sorted properly to draw the outline
newdata <-
base::rbind(
dplyr::arrange(.data = base::transform(data, x = xminv), y),
dplyr::arrange(.data = base::transform(data, x = xmaxv), -y)
)
# Close the polygon: set first and last point the same
# Needed for coord_polar and such
newdata <- rbind(newdata, newdata[1,])
ggplot2:::ggname("geom_flat_violin",
GeomPolygon$draw_panel(newdata, panel_scales, coord))
},
draw_key = draw_key_polygon,
default_aes = ggplot2::aes(
weight = 1,
colour = "grey20",
fill = "white",
size = 0.5,
alpha = NA,
linetype = "solid"
),
required_aes = c("x", "y")
)
You could use egg::ggarrange(). So basically what you want is this:
p <- ggplot(data=my_data, mapping=aes(x=x, y=y)) +
geom_line() + ylim(c(-2, 2))
q <- ggplot(data=my_data, mapping=aes(x=y)) +
geom_histogram(binwidth=.05) + coord_flip() + xlim(c(-2, 2))
egg::ggarrange(p, q, nrow=1)
Result
Data
set.seed(42)
my_data <- data.frame(x=seq(100), rnorm(100))
my_data1 <- count(my_data, vars=c("y"))
p1 <- ggplot(data = my_data, mapping = aes(x = x, y = y)) + geom_line()
p2 <- ggplot(my_data1,aes(x=freq,y=y))+geom_line()+theme(axis.title.y = element_blank(),axis.text.y = element_blank())
grid.draw(cbind(ggplotGrob(p1), ggplotGrob(p2), size = "last"))
I want to highlight 4 single points in a scatter plot with a box surrounding the name associated with the plot. I am using ggrepel to create the boxes surrounding the plots and to repel them.
This is the code I have:
library(ggplot2)
gg <- ggplot(X, aes(x = XX, y = XY)) +
geom_point(col = "steelblue", size = 3) +
geom_smooth(method = "lm", col = "firebrick", se = FALSE) +
labs(title = "XX vs XY", subtitle = "X", y = "XX", x = "XY") +
scale_x_continuous(breaks = seq(76, 82, 1)) +
scale_y_continuous(breaks = seq(15, 19, 1))
library(ggrepel)
gg + geom_text_repel(aes(label = Female), size = 3, data = X)
gg + geom_label_repel(aes(label = Female), size = 2, data = X)
With that code, I obtain boxes surrounding all the plots. However, I only want to have the boxes in 4 specific plots and no boxes in the other plots. How can I do that?
Thanks in advance! Regards,
TD
Consider for example this plot using the data mtcars and the function coord_flip
library(ggplot2)
library(Hmisc)
ggplot(mtcars,aes(x=gear,y=cyl)) + stat_summary(aes(color=as.factor(rep(1:2,16))),
fun.data=mean_cl_boot, position=position_dodge(0.4)) + coord_flip()
The fact that error bars are horizontal on the graph but vertical in the legend bothers me :) How can I rotate these symbols?
Tweak the legend key
GeomPointrange$draw_key <- function (data, params, size) {
draw_key_vpath <- function (data, params, size) {
# only need to change the x&y coords so that the line is horizontal
# originally, the vertical line was `0.5, 0.1, 0.5, 0.9`
segmentsGrob(0.1, 0.5, 0.9, 0.5,
gp = gpar(col = alpha(data$colour, data$alpha),
lwd = data$size * .pt, lty = data$linetype,
lineend = "butt"), arrow = params$arrow)
}
grobTree(draw_key_vpath(data, params, size),
draw_key_point(transform(data, size = data$size * 4), params))
}
Then plot
ggplot(mtcars,aes(x=gear,y=cyl)) +
stat_summary(aes(color=as.factor(rep(1:2,16))),
fun.data=mean_cl_boot, position=position_dodge(0.4)) +
coord_flip()
I'm not coming up with an answer that works within the normal ggplot2 workflow, so for now, here's a hacky answer. Turn off the stat_summary legend. Then, add point and line geoms with data that is outside the range of the actual data you want to plot. This will create the point and horizontal line legend that you want. Then set the plot axis limits to include only the range of your real data, so that the fake data points are not visible.
ggplot(mtcars, aes(x=gear, y=cyl, color=as.factor(rep(1:2,16)))) +
stat_summary(fun.data=mean_cl_boot, position=position_dodge(0.4), show.legend=FALSE) +
geom_line(aes(y=cyl-100)) +
geom_point(aes(y=cyl-100), size=2.5) +
coord_flip(ylim=range(mtcars$cyl))
Another option would be to rotate the legend-key grobs by 90 degrees using grid functions, but I'll leave that for someone who's more skilled with grid than I am.
The ggstance package provides an easy to implement solution here:
library(ggplot2)
library(ggstance)
ggplot(mtcars,aes(x=cyl,y=gear)) + stat_summaryh(aes(color=as.factor(rep(1:2,16))),
fun.data=mean_cl_boot_h, position = position_dodgev(height = 0.4))
or as a geom:
df <- data.frame(x = 1:3, y = 1:3)
ggplot(df, aes(x, y, colour = factor(x))) +
geom_pointrangeh(aes(xmin = x - 1, xmax = x + 1))
Following up #eipi10's suggestion to use grid functions to edit the grobs - the relevant grobs are segments. There are two possibilities: 1) rotate the segment grobs; or 2) edit the x and y coordinates of the endpoints of the segment grobs.
library(ggplot2)
library(Hmisc)
library(grid)
p = ggplot(mtcars,aes(x=gear,y=cyl)) +
stat_summary(aes(color=as.factor(rep(1:2,16))),
fun.data=mean_cl_boot, position=position_dodge(0.4)) +
coord_flip()
g = ggplotGrob(p)
# Get names of segment grobs
grid.ls(grid.force(g))$name # "GRID.segments"
# Check the structure of the segment grobs
str(getGrob(grid.force(g), gPath("GRID.segments"), grep = TRUE, global = TRUE))
# Edit the segment grobs using the editGrob() function
# 1) Rotate the segments
g <- editGrob(grid.force(g), gPath("GRID.segments"), grep = TRUE, global = TRUE,
vp = viewport(angle = 90))
# 2) set end points of segments
# g <- editGrob(grid.force(g), gPath("GRID.segments"), grep = TRUE, global = TRUE,
# x0 = unit(0.1, "npc"), y0 = unit(0.5, "npc"), x1 = unit(0.9, "npc"), y1 = unit(0.5, "npc"))
# Draw it
grid.newpage()
grid.draw(g)
Edited from: https://gist.github.com/grantmcdermott/d86af2b8f21f4082595c0e717eea5a90
The main point is to use geom_pointrangeh from ggstance and remember to specify aes w.r.t. x-axis.
library(tidyverse)
library(broom)
library(hrbrthemes)
library('ggstance')
library('jtools')
df =
mtcars %>%
mutate(vs = factor(vs), am = factor(am))
fit1 = lm(mpg ~ vs * am * wt, data = df)
fit1_coefs = tidy(fit1, conf.int = T)
fit2 = lm(mpg ~ vs / am / wt, data = df)
fit2_coefs = tidy(fit2, conf.int = T)
bind_rows(
fit1_coefs %>% mutate(model = "Model 1"),
fit2_coefs %>% mutate(model = "Model 2")
) %>%
filter(grepl("wt", term)) %>%
## Optional regexp work to make plot look nicier
mutate(
am = ifelse(grepl("am1", term), "Automatic", "Manual"),
vs = ifelse(grepl("vs1", term), "V-shaped", "Straight"),
x_lab = paste(am, vs, sep="\n")
) %>%
ggplot(aes(col = model,y=x_lab, x=estimate, xmin=conf.low, xmax=conf.high)) +
geom_pointrangeh(position = position_dodge(width = 0.5)) +
guides(color = guide_legend(reverse = TRUE)) +
geom_vline(xintercept = 0, col = "black",lty=4) +
labs(x = NULL, y = NULL,title = "Title") +
theme_nice() +
theme(plot.title = element_text(hjust = 0.5))
Is there a method to overlay something analogous to a density curve when the vertical axis is frequency or relative frequency? (Not an actual density function, since the area need not integrate to 1.) The following question is similar:
ggplot2: histogram with normal curve, and the user self-answers with the idea to scale ..count.. inside of geom_density(). However this seems unusual.
The following code produces an overinflated "density" line.
df1 <- data.frame(v = rnorm(164, mean = 9, sd = 1.5))
b1 <- seq(4.5, 12, by = 0.1)
hist.1a <- ggplot(df1, aes(v)) +
stat_bin(aes(y = ..count..), color = "black", fill = "blue",
breaks = b1) +
geom_density(aes(y = ..count..))
hist.1a
#joran's response/comment got me thinking about what the appropriate scaling factor would be. For posterity's sake, here's the result.
When Vertical Axis is Frequency (aka Count)
Thus, the scaling factor for a vertical axis measured in bin counts is
In this case, with N = 164 and the bin width as 0.1, the aesthetic for y in the smoothed line should be:
y = ..density..*(164 * 0.1)
Thus the following code produces a "density" line scaled for a histogram measured in frequency (aka count).
df1 <- data.frame(v = rnorm(164, mean = 9, sd = 1.5))
b1 <- seq(4.5, 12, by = 0.1)
hist.1a <- ggplot(df1, aes(x = v)) +
geom_histogram(aes(y = ..count..), breaks = b1,
fill = "blue", color = "black") +
geom_density(aes(y = ..density..*(164*0.1)))
hist.1a
When Vertical Axis is Relative Frequency
Using the above, we could write
hist.1b <- ggplot(df1, aes(x = v)) +
geom_histogram(aes(y = ..count../164), breaks = b1,
fill = "blue", color = "black") +
geom_density(aes(y = ..density..*(0.1)))
hist.1b
When Vertical Axis is Density
hist.1c <- ggplot(df1, aes(x = v)) +
geom_histogram(aes(y = ..density..), breaks = b1,
fill = "blue", color = "black") +
geom_density(aes(y = ..density..))
hist.1c
Try this instead:
ggplot(df1,aes(x = v)) +
geom_histogram(aes(y = ..ncount..)) +
geom_density(aes(y = ..scaled..))
library(ggplot2)
smoothedHistogram <- function(dat, y, bins=30, xlabel = y, ...){
gg <- ggplot(dat, aes_string(y)) +
geom_histogram(bins=bins, center = 0.5, stat="bin",
fill = I("midnightblue"), color = "#E07102", alpha=0.8)
gg_build <- ggplot_build(gg)
area <- sum(with(gg_build[["data"]][[1]], y*(xmax - xmin)))
gg <- gg +
stat_density(aes(y=..density..*area),
color="#BCBD22", size=2, geom="line", ...)
gg$layers <- gg$layers[2:1]
gg + xlab(xlabel) +
theme_bw() + theme(axis.title = element_text(size = 16),
axis.text = element_text(size = 12))
}
dat <- data.frame(x = rnorm(10000))
smoothedHistogram(dat, "x")