Useful R code in ggplot

 

Date: 2024-05-01
R version: 3.5.0
*Corresponding author: matthew.malishev [at] gmail.com
This document can be found at https://github.com/darwinanddavis/UsefulCode

Overview

Same deal as Useful Code 1 and 2 except just gglot because it’s too difficult sifting through the other docs.

Remove annoying stock gridlines from plot window

# option 1
p1 <- p + labs(title = "Option 1") + theme_classic()
p1

# option 2 with inputs to toggle
p2 <- p + labs(title = "Option 2") + theme_bw() + theme(panel.border = element_blank(), panel.grid.major = element_blank(), 
    panel.grid.minor = element_blank(), axis.line = element_line(colour = "black"))
p2
# alternative (after loading ggridges library) theme_ridges(grid=F,center_axis_labels = T)

Setting global graphics theme for ggplot

plot_it_now <- function(bg) {
    # bg = colour to plot bg
    theme(panel.border = element_blank(), panel.grid.major = element_blank(), panel.grid.minor = element_blank(), 
        panel.background = element_rect(fill = bg, colour = bg), plot.background = element_rect(fill = bg)) + 
        theme(axis.line = element_line(color = "white")) + theme(axis.ticks = element_line(color = "white")) + 
        theme(plot.title = element_text(colour = "white")) + theme(axis.title.x = element_text(colour = "white"), 
        axis.title.y = element_text(colour = "white")) + theme(axis.text.x = element_text(color = "white"), 
        axis.text.y = element_text(color = "white")) + theme(legend.key = element_rect(fill = bg)) + 
        theme(legend.title = element_text(colour = "white")) + theme(legend.text = element_text(colour = "white"))
}
plot_it_now("black")

Put plot in function to take dynamic data inputs

Ref: http://jcborras.net/carpet/visualizing-political-divergences-2012-local-elections-in-helsinki.html

hr.mass.plot <- function(d) {
    p <- ggplot(d, aes(HR, Mass, color = colfunc)) + geom_density_2d(data = d, aes(x = HR, y = Mass), 
        stat = "density2d", position = "identity", color = adjustcolor("orange", alpha = 0.8), size = 1.5, 
        contour = T, lineend = "square", linejoin = "round")
    p <- p + geom_point(data = d, aes(x = HR, y = Mass), color = colfunc, fill = colfunc) + scale_color_manual(values = magma(8))
    p <- p + scale_y_continuous(limits = c(-200, 200), name = "Mass lost (g)")
    p <- p + scale_x_continuous(limits = c(0, 0.35), name = expression("Home range area (km^2)"))
    p <- p + theme_classic()
    print(p)
}
hr.mass.plot(d)

Using ggplot when looping through for loop and saving to dir

pdf("mypdf.pdf", onefile = T)
for (i in 1:3) {
    par(bty = "n", las = 1)
    grid.arrange(ggplot(data, aes(x = X, y = Y, fill = ..x..)) + geom_point() + labs(title = paste0("Title_", 
        i)) + xlab("X") + ylab("Y"))
}
# end loop
dev.off()



# geom_density_ridges() # scale = overlap

# geom_density_ridges(scale = 5, size=0.2,color='white', rel_min_height = 0.01,fill=col,alpha=0.5) +

# scale_fill_viridis option = 'magma', 'inferno','plasma', 'viridis', 'cividis'

Converting lists and dataframes to usable format for ggplot (melt package)

require(reshape2)  # melt package   
nn <- 10  # reps
mm <- data.frame(X = rep(LETTERS, nn), Y = sample(nn, replace = T), Z = rep(paste(LETTERS, "_", rnorm(1)), 
    nn))
# plot
y_m <- melt(mm)
head(y_m)
ggplot(data = y_m, aes(x = X, y = value, group = Z, colour = factor(value))) + geom_point(aes(size = value)) + 
    geom_line() + theme_classic()

Insert math expression in plot or legend title

xx = sample(100, 100)
yy = rnorm(100)

title1 <- bquote("Density = " ~ r[xy] ~ "and" ~ B^2 ~ +beta ~ alpha)
ggplot() + geom_point(aes(x = xx, y = yy), color = xx) + labs(title = title1, xlab = title1, yab = title1, 
    colour = title1)

Create double line break with expression in legend title (and labels)

ggplot() + scale_color_manual(expression(atop("text", atop(textstyle(epsilon)))))

ggplot() + scale_color_manual(name = expression(atop("Productivity", atop(textstyle((mg ~ C ~ L^{
    -1
} ~ d^{
    -1
})  # this is bracketed text
)))))

Adding text lables to plots

require(ggplot2)
xx = sample(100, 100)
yy = rnorm(100)
df <- data.frame(X = xx, Y = yy)

ggplot(df) + geom_point(aes(xx, yy, size = 5), colour = xx, show.legend = F) + geom_text(aes(xx, yy, 
    label = xx), check_overlap = T, size = yy + 5) + theme_classic()

# add bg label
ggplot() + geom_line(aes(xx, yy, size = 5), colour = xx, show.legend = F) + geom_label(aes(xx, yy, label = xx), 
    size = yy + 5, color = yy + 5, fill = xx) + theme_classic()

Add text only to final point (plus other methods)

require(directlabels)
df <- tibble("x" = sample(10,5),
             "y" = sample(10,5),
             "label" = LETTERS[1:5])

ggplot() +
  geom_point(data = df, aes(x,y)) +
  geom_dl(aes(label = label), 
          method = list(
            dl.trans(x = x + 0.3, y = y + 0), # expand x/y axis to fit in labels  
            list(dl.combine("first.points","last.points")), cex = 0.5 # add labels to first and last points
            )
          ) +
  scale_x_continuous( ..., expand = c(0, 1.5))

Calling data frame columns with weird formatting

# use ticks, not quotations

require(ggplot2)
df <- data.frame(X = rnorm(1000), `Y col with spaces` = sample(1000, replace = T))

# incorrect y col, but doesn't throw error
ggplot(df, aes(X, "Y col with spaces")) + geom_line()

# same issue even when matching col name
ggplot(df, aes(X, "Y.col.with.spaces")) + geom_line()

# usable y col
ggplot(df, aes(X, Y.col.with.spaces)) + geom_line()

Use POSIX format

Code Meaning
%a Abbreviated weekday
%A Full weekday
%b Abbreviated month
%B Full month
%c Locale-specific date and time
%d Decimal date
%H Decimal hours (24 hour)
%I Decimal hours (12 hour)
%j Decimal day of the year
%m Decimal month
%M Decimal minute
%p Locale-specific AM/PM
%S Decimal second
%U Decimal week of the year (starting on Sunday)
%w Decimal Weekday (0=Sunday)
%W Decimal week of the year (starting on Monday)
%x Locale-specific Date
%X Locale-specific Time
%y 2-digit year
%Y 4-digit year
%z Offset from GMT
%Z Time zone (character)

require(nycflights13);require(dplyr);require(ggplot2)
flights %>% str
flights$time_hour %>% class # already posix
flights_mod <- flights$time_hour %>% as.character() # convert posix to character

# turn into posix year month day hour minute second format
require(lubridate)
flights_mod <- flights_mod %>% ymd_hms()  
flights_mod %>% class

# make new df with fewer data 
df <- data.frame("Date"=flights_mod[1:100000],
                 "Delay"=flights$arr_delay[1:100000])

ggplot(df, aes(Delay,Date)) + geom_tile() +
  scale_y_datetime(date_breaks = "1 month", 
                   date_minor_breaks = "1 week", # optional 
                   date_labels = "%B %Y" # full month and year
                  ) +
  theme_classic()

Plotting multiple plots per window (with different plot size ratios) with gridExtra

require(gridExtra)

nn <- 100 # create sample
p <- ggplot()+geom_point(aes(sample(nn,replace=T),rnorm(nn),size=runif(nn),color=rainbow(nn)),show.legend = F)+theme_classic()

# put plots into list 
ggplot_list <- list(p,p,p,p)

# 3 plots above, 1 below
grid.arrange(
  grobs = ggplot_list, # list with ggplots or grobs
  widths = c(1, 1, 1),
  layout_matrix = rbind(c(1, 2, 3),
                        c(4, 4, 4))
)

# 3 plots above with first plot 2 plots wide 
grid.arrange(
  grobs = ggplot_list, # list with ggplots or grobs
  widths = c(2, 1, 1), # widths (2,1,1) of total plots for each row (3) 
  layout_matrix = rbind(c(1, 2, 3), 
                        c(4, 4, 4))
)

# 2 plots below with third plot 3 plots wide 
grid.arrange(
  grobs = ggplot_list, # list with ggplots or grobs
  widths = c(2, 1, 1),
  layout_matrix = rbind(c(1, 2, NA),
                        c(3, 3, 4))
)

Arranging multiplot panels

# https://patchwork.data-imaginist.com/articles/guides/assembly.html
# devtools::install_github('thomasp85/patchwork')
require(patchwork)

p1 <- ggplot(mtcars) + geom_point(aes(mpg, disp, col = cyl), show.legend = F) + ggtitle("Plot 1") + theme_classic()
p2 <- ggplot(mtcars) + geom_point(aes(mpg, cyl, col = disp), show.legend = F) + ggtitle("Plot 2") + theme_classic()

p3 <- p1
p4 <- p2

# 2 plots, 2 cols
p1 + p2

# multi rows
(p1 | p2 | p3)/p4  # 3 plots top, 1 bottom (2 rows)  

p1/(p2 | p3)  # 1 plot top, 2 bottom (2 rows)  

# 2 plots, 2 rows and 2 cols
wrap_plots(p1, p2, p3, p4)

# 3 plots, 2 cols
patch <- p1 + p2
p3 + patch

# non ggplot content eg. text
p1 + grid::textGrob("Some text")

p1 + gridExtra::tableGrob(mtcars[1:10, c("mpg", "disp")])

# title, subs, and captions
patchwork <- (p1 + p2)/p3
patchwork + plot_annotation(title = "ttl", subtitle = "subttl", caption = "caption")

Setting legend to custom aes elements, e.g. color, shape, linetype

# set 'labs' arguments to same title as in 'scale_color_manual'
# legend values automatically matches arguments passed to colvec
# NB specifying the labels arg in scale_color_manual overrides labs  

require(ggplot2)

snack_df <- data.frame(
  "X"=sample(100,10,replace=F),
  "Y"=sample(100,10,replace=F),
  "Sum"=runif(10),
  "Size"=rep(LETTERS[1:5],each=2)
)
colvec <- colorspace::sequential_hcl(length(unique(snack_df$Size)), "SunsetDark")
legend_ttl <- "This is your legend"
legend_pars <- unique(snack_df$Size) # not run
                       
ggplot(snack_df,aes(X,Y)) +
  geom_line(aes(group=Size,color=Size,linetype=Size),size=1) +
  geom_point(aes(group=Size,color=Size,shape=Size),size=3) +
  scale_color_manual(name=legend_ttl,
                     # labels = legend_pars, # this overrides labs 
                     values = colvec) +
  geom_text(aes(X,Y,
                label=c(Size)
                ),
            check_overlap = T,
            size=5,vjust=-1,hjust=1.2) +
  labs(title="Plot title",x="X",y="Y",
       # ----- these are the legend key arguments
       colour=legend_ttl,
       fill=legend_ttl,
       linetype=legend_ttl,
       shape=legend_ttl) + # check shape 
  theme_classic() 

Pass variables as user arguments to plotting function

Option 1

# http://www.rebeccabarter.com/blog/2020-02-05_rstudio_conf/
require(tidyverse)
require(dplyr)
midwest %>% head
plotMidwestTidy <- function(var1, var2) {
    ggplot(midwest) + geom_point(aes(x = {
        {
            var1
        }
    }, y = {
        {
            var2
        }
    }  # wrap vars in double curly braces  
))
}

plotMidwestTidy(popdensity, poptotal) + theme_bw()

Option 2 Can’t use character class as user argument

require(ggplot2)
my_theme <- theme_classic()
colour_var <- "class"
facet_var <- "drv"

ggplot(mpg) + geom_point(aes(displ, hwy, colour = colour_var)) + facet_wrap(vars(facet_var)) + my_theme

Placing .data in front of your variables and wrapping them with double square braces ‘[[]]’ solves this.

require(ggplot2)
my_theme <- theme_classic()
colour_var <- "class"
facet_var <- "drv"

ggplot(mpg) + geom_point(aes(displ, hwy, colour = .data[[colour_var]])) + facet_wrap(vars(.data[[facet_var]])) + 
    my_theme + ggtitle(paste0(colour_var, " vs ", facet_var))

Use conditional statements in ggplot objects

require(ggplot2)
cond1 <- F
cond2 <- T
p <- ggplot(mtcars) + geom_point(aes(mpg, hp, size = 3), show.legend = F) + theme_classic()
p <- p + if (cond1 == T) {
    # execute condition 1 and add to plot
    geom_line(aes(mpg, hp, size = 3), color = "red", show.legend = F)
}
p <- p + if (cond2 == T) {
    # execute condition 2 and add to plot
    geom_line(aes(mpg, hp, size = 2), color = "blue", show.legend = F)
}
p

Make calendar plot

require(sugrrants)
require(nycflights13)
ff <- flights
ff <- ff %>% mutate(date = flights$time_hour %>% as.Date())
fdf <- frame_calendar(ff, x = distance, y = arr_delay, date = date, nrow = 4)
p <- ggplot(fdf) + geom_line(aes(x = .distance, y = .arr_delay, group = date)) + theme_void()
p %>% prettify()

Plot benchmark results

https://stackoverflow.com/questions/29803253/r-extracting-coordinates-from-spatialpolygonsdataframe

res <- microbenchmark(raster::geom(atf_sp), ggplot2::fortify(atf_sp), spbabel::sptable(atf_sp), as.data.frame(as(as(atf_sp, 
    "SpatialLinesDataFrame"), "SpatialPointsDataFrame")))
ggplot2::autoplot(res)

Flip, rotate, and reorder

Flip axis directions

# rotate
print(p, vp = viewport(angle = -30))
p + coord_flip()
p + scale_y_reverse()
graphics.off()

Reorder data within variables to have custom plot order

ggplot() + geom_bar(data = df, aes(year, value, fill = factor(var1, level = unique(var1))  # reorder to match order data is listed within variable
))

Colour palettes

Match df column/variable to custom colour scale

require(colorspace)
mycolors <- sequential_hcl(d %>% pull(var1) %>% n_distinct(), "Tofino")
names(mycolors) <- d$var1 %>% unique %>% factor %>% levels
custom_colors <- scale_colour_manual(name = "Title", values = mycolors)

ggplot() + geom_sf(data = d) + custom_colors  # add scale 

require(colorspace)
require(scales)

# match sequential colpal as sequential values in df
colv <- colorRampPalette(colors = c(col_low, col_high))
colpal <- colv(d$value %>% length)
d$colpal <- colpal

# match sequential colpal to unique values in df var
colpal <- sequential_hcl(d$value %>% length, "Sunset")
pal <- col_numeric(palette = colpal, domain = d$value)
d <- d %>% mutate(colpal = pal(value))

# match custom palette colpal to unique values in df var
colv <- colorRampPalette(colors = c(col_low, col_high))
colpal <- colv(d$value %>% length)
pal <- col_numeric(palette = colpal, domain = d$value)
d <- d %>% mutate(colpal = pal(value))

# add optional highlight colours
d <- d %>% mutate_at("colpal", funs(case_when(id_name == "name1" ~ "red", TRUE ~ colpal)))

# match colours based on df variable values
d <- d %>% mutate(colpal = case_when(id_name %in% "name1" ~ "red", TRUE ~ colpal  # or e.g. 'blue'
))
ggplot() + geom_sf(data = d, aes(col = colpal)) + scale_color_manual(values = d$colpal %>% unique)  # then add manual colpal from df 

Loop through different colpals and save plots to dir

vars <- df$var1 %>% unique
colv <- c("Peach", "PinkYl", "Burg")
for (i in seq_along(vars)) {
    df <- df %>% filter(var1 == vars[i])
    xlab <- "Month"
    ylab <- "Day"
    nn <- df %>% pull(var2) %>% n_distinct()
    colpal <- c(sequential_hcl(nn, colv[i]) %>% .[nn], sequential_hcl(nn, colv[i]) %>% .[1])  # set col gradient
    ggplot() + geom_tile(data = df, aes(v1, v2, fill = ar2)) + scale_fill_gradient(low = colpal[1], high = colpal[2], 
        guide = "colourbar", na.value = "transparent")  # create custom gradient
    
    ggsave(here::here("plot", var1[i], "_activity.png"), device = "png")
}

Create gradient colour for area plot (AUC)

library(minisvg)
library(devout)
library(devoutsvg)
library(poissoned)
library(svgpatternsimple)
require(ggplot2)
require(ggdark)

# create gradient
gradient_pattern <- create_pattern_gradient(id = "p1", angle = 90, colour1 = "#1A1A1A", colour2 = "#63CB99", 
    alpha = 0.8)

gradient_pattern$show()

# save gradient as svg
my_pattern_list <- list(`#000001` = list(fill = gradient_pattern))

svgout(filename = "line-chart-with-gradient-shade.svg", pattern_list = my_pattern_list, width = 10, height = 5)

# plot
ggplot(btc, aes(x = Date, y = Price)) + geom_line(color = "#63CB99", size = 0.4, alpha = 0.9) + geom_area(alpha = 0.3, 
    fill = "#000001", color = alpha(0.1)) + ggtitle("BTC price, USD") + scale_y_continuous(labels = scales::comma)

Glow effect for line plot

require(ggshadow)
require(ggplot2)
require(ggthemes)

ggplot(btc, aes(x = Date, y = Price)) + geom_glowline(color = "gold", shadowcolour = "orange") + theme_solarized_2(light = FALSE) + 
    theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())

Images

Fill plot view with image

require(png)
require(jpeg)
imgr <- img %>% readPNG()
ggplot() + annotation_raster(imgr, -Inf, Inf, -Inf, Inf)

Fill geom with patterns/images https://coolbutuseless.github.io/package/ggpattern/index.html

Read in png, recolor, write as svg, and append to df

here::here("img",paste0(ifh,".png")) %>% 
  image_read(strip = T) %>% 
  # image_scale(c(100,100)) %>% 
  image_fill("transparent") %>%
  image_colorize(color = colv_hi,opacity = 70) %>%  # recolor img
  image_write(here::here("img",paste0(ifh,"2.png")) ,format = "png", depth=NULL)

# append to df 
df$img <- here::here("img",paste0(ifh,"2.png"))

Create custom geom

library(ggplot2)
x <- 1:100

my_geom_y <- function(yy, colour = "black") {
    list(geom_line(aes(y = yy), col = colour), data = data.frame(x, yy), geom_point(aes(y = yy), col = colour, 
        data = data.frame(x, yy)))
}

ggplot(aes(x)) + my_geom_y(x, "red") + my_geom_y(dlnorm(x), "blue") + my_geom_y((x^1.1), "black") + my_geom_y(x/2, 
    "yellow")

Highlight variables in plot

library(ggplot2)
library(gghighlight)
ggplot(mpg, aes(x = cty, y = hwy)) + geom_point(color = "red", size = 2) + gghighlight(class == "midsize")

Set inner circle width for circular barplot

ylim <- 40
ggplot() + geom_histogram(data = d, aes(xx, id, fill = yy), size = 0, position = "stack", stat = "identity", 
    show.legend = F) + scale_fill_manual(values = adjustcolor(colv, 1), aesthetics = c("col", "fill")) + 
    facet_wrap(~zz) + theme_classic() + coord_polar(start = 0.25) + scale_x_continuous(breaks = 1:12, 
    labels = xtick) + # option 1
scale_y_continuous(expand = c(0.2, 0)) + # option 2
scale_y_continuous(limits = c(-10, NA), breaks = seq(0, ylim, ylim/4), labels = seq(0, ylim, ylim/4))

Add histogram dist to boxplots (from Eli data)

limits <- d$yy %>% unique
colv <-  colorspace::sequential_hcl(limits, "Blues")
require(ggdist)
ggplot(data = d, aes(x = xx, y = yy, 
                     col = yy, fill = yy
                     )) +
  geom_boxplot(outlier.color = NA) + # boxplot
  geom_jitter(height = 0.2) + # jitter points
  ggdist::stat_dots(binwidth = 0.2, # opt 1: dot plot
                    side = "left", 
                    justification = 1.1,
                    col = NA) + 
  ggdist::stat_halfeye(slab_type = "pdf",
                       limits = c(1, NA), # rm data < 1
                       adjust = 0.5, # opt 2: point dist
                       width = 0.5, 
                       .width = 0, # decrease iqr line width
                       justification = -0.5, # move dist above box
                       point_colour = NA) +
  scale_y_discrete(limits=limits) + # reorder xaxis
  scale_colour_manual(values = colv,aesthetics = "col", limits = limits, labels = limits) + # keep solid col for boxplot
  scale_fill_manual(values = adjustcolor(colv,0.7), aesthetics = "fill",limits = limits, labels = limits) + # add alpha to boxplot fill
  theme_classic()

Maintain order of variables in df when plotting

limits <- df$var1 %>% pull
df %>% ggplot() + geom_col(aes(x, y)) + scale_x_discrete(limits = limits)

# option 2 (works for factor variables with barplot)
require(forcats)
df %>% ggplot() + geom_bar(aes(fct_infreq(y)))

# reverse variable order
df %>% ggplot() + geom_bar(aes(fct_rev(y)))

Insert plot inset within main plot

### opt 1 first create and save plot inset to local dir
plot_inset <- ggplot() + geom_point(data = inset_data)
# 
ggsave("plot_inset.png", plot_inset)
plot_inset <- "plot_inset.png" %>% readPNG()  # read in saved plot

# main plot
ggplot() + geom_sf(data = data) + # add plot inset
annotation_raster(plot_inset, xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax) + # themes
theme_nothing()

### opt 2
ggdraw() + draw_plot(main1, 0, 0, 1, 1) + draw_plot(legend1, 0.15, 0.7, 0.18, 0.18)

Legends

Custom shape for legend

# ?draw_key # see available glyphs 
require(ggplot2)
require(dplyr)
require(colorspace)

glyph <- "pointrange"
df <- data.frame(xx = rep(1:5,each=3),
                 yy = 1:15,
                 group = rep(c("A","B","C"),each=5))
ggplot(data=df,aes(xx,yy,col = group, fill = group)) + 
  geom_line(key_glyph = glyph) + # set shape for legend
  scale_fill_discrete_sequential(name = paste0(glyph, " legend"), "Reds", aesthetics = "col") +
  theme_bw() +
  guides(col = guide_legend(
    override.aes = list(size = 1)  # set custom legend size 
    ))

Fine tune legend features e.g. text, padding, vertical/horizontal spacing

df <- data.frame(xx = sample(100, 100), yy = rnorm(100))
ggplot(data = df, aes(xx, yy, col = yy, fill = yy)) + geom_point() + theme_classic() + theme(legend.position = "bottom") + 
    # legend guide for colourbar
guides(fill = guide_colorbar(title = "Continuous", label.position = "left")) + # legend guid for categorical
guides(fill = guide_legend(title = "Categorical", label.position = "right"))

Toggle legend when using scale_*_() functions

ggplot() + geom_point(data = df, aes(fill = var1)) + scale_fill_manual(values = colpal, aesthetics = "fill", 
    guide = F)  # T/F to toggle show legend 

Customise attributes of two separate legends e.g. size and colour bar

# set colourbar for var1 (color gradient) but also change colour/fill of legend for var2 (size)

ggplot() + geom_sf(data = df, aes(col = var1, fill = var1, size = var2)) + # var 1 attributes (colour/fill gradient)
scale_fill_gradientn(name = title1, colours = adjustcolor(colpal, 0.5), aesthetics = c("col", "fill"), 
    na.value = "#EFEFEF") + # var 2 attributes (size)
guides(size = guide_legend(title = title2, override.aes = list(fill = col_var2, alpha = 0.5, col = col_var2)  # change colour for size legend (var2)
))

Change legend font, size, bg, opacity, and position

opac <- 0.5
theme(legend.position=c(0.2,0.2), #xy from bottom left
        legend.key.size = unit(0.5, "cm"), # size
        legend.background = element_rect(fill=alpha(fg, opac)), # legend background
        legend.title = element_text(family = family,colour = col_font),
        legend.text = element_text(family = family,colour = col_font)
  ) 

Biscale legend

require(biscale)

data <- bi_class(df, sf1, sf2, dim = 3)
legend <- bi_legend(pal = "GrPink",
                    dim = 3,
                    xlab = "More sf1",
                    ylab = "More sf2",
                    size = 12)
map <- ggplot() +
  geom_tile(data = data , aes(x = x, y = y, fill = bi_class), show.legend = F) +
  bi_scale_fill(pal = "GrPink", dim = 3) + # create biscale
  bi_theme()
  
# combine legend and map 
ggdraw() +
  draw_plot(map, 0, 0, 1, 1) +
  draw_plot(legend, 0.15, 0.7, 0.18, 0.18)

Blank theme with full legend

require(ggthemes)
p1 + theme_map() + theme(legend.background = element_rect(fill = "transparent"))

Setting custom legend position for wrapped/stacked plots

require(patchwork)
# can specify legend position using theme(legend.position=...)
wrap_plots(p, p1, p2, ncol = 2, guides = "collect"  #'keep' 'auto'
)

Combine df aes elements (e.g. colour and size) into one legend

require(dplyr)
require(ggplot2)
require(colorspace)
df <- tibble(x = 1:10, y = 11:20, size = 1:10)
colpal <- sequential_hcl(df$size %>% n_distinct(), "Burg")
ggplot() + geom_point(data = df, aes(x, y, size = size, colour = size)) + scale_colour_gradientn(colours = colpal, 
    aesthetics = "colour", guide = "legend")

Update legend title

ggplot() + labs(fill = "title")  # opt 1
ggplot() + guides(fill = guide_legend(title = "title"))  # opt 2
ggplot() + scale_fill_discrete(name = "title")  # opt 3

Axes

Add brackets to axes

# install.packages('lemon')
require(lemon)
ggplot() + geom_jitter(data = mpg, aes(cyl, hwy, colour = class), width = 0.2) + coord_flex_cart(bottom = brackets_horizontal(tick.length = 0))

Extract variable name as character

require(ggplot2)
require(palmerpenguins)
my_theme <- theme_classic()
plot_penguin <- function(v1, v2, v3) {
    var1 <- ensym(v1)  # turn var into character 
    var2 <- ensym(v2)
    var3 <- ensym(v3)
    ggplot(penguins) + geom_point(aes({
        {
            var1
        }
    }, {
        {
            var2
        }
    }, colour = {
        {
            var3
        }
    })) + my_theme + ggtitle(paste0(var1, " vs ", var2, " by ", var3))
}
plot_penguin(bill_depth_mm, bill_length_mm, species)

Remove buffer around maps to crop map to plot edges

p1 + scale_x_continuous(expand = c(0, 0)) + scale_y_continuous(expand = c(0, 0))

Text/titles

Set text behind plot area/map/data

ggplot() + geom_text(data = ttl, aes(x, y, label = label), check_overlap = T) + geom_sf(data = sf) + 
    coord_sf(crs = prj, xlim = c(bbox[1], bbox[3]), ylim = c(bbox[2], bbox[4])) + labs(x = NULL, y = NULL) + 
    # themes
theme_nothing() + theme(panel.grid.major = element_line(colour = border, linetype = 3, size = 0.2), plot.background = element_rect(fill = "transparent", 
    colour = NA), panel.background = element_rect(fill = "transparent"), axis.text = element_blank(), 
    axis.ticks.length = unit(0, "null"), plot.margin = unit(c(0.1, 0.1, 0.1, 0.1), "mm"), panel.ontop = F)

Customise ggplot text with colours

require(ggtext)
ttl <- paste0("<span style='font-family: Avenir;'>Climate risk in Vietnam <br>
<span style='font-size: 30pt'> Exposure of 
  <span style='color:",colv1,";'>Coffee</span>, 
  <span style='color:",colv2,";'>Cashew</span>, and 
  <span style='color:",colv3,";'>Cassava</span>  
  </span></span>") %>% purrr::map(htmltools::HTML)

p + theme(plot.title = element_markdown(lineheight = 1)) + # add custom ggtext
  labs(title = ttl) 

# vlist <- c(coff,cash,cass)
# lapply(vlist,function(x) {colnames(x) = rep(c('Index',"geometry"),times = vlist %>% length/2)})

Add curved arrows/points to text labels, unicode chars, math expressions, etc

require(ggrepel)
require(ggplot2)
set.seed(42)
ggplot(mtcars, aes(wt, mpg, label = carb)) + geom_point(color = "red") + geom_text_repel(nudge_x = 0.15, 
    box.padding = 0.5, nudge_y = 1, segment.curvature = -0.1, segment.ncp = 3, segment.angle = 20)

Use sf geometry coords when adding text

var1 <- df$size
ggplot() + geom_sf(data = sf) + geom_text(data = df, aes(df$geometry %>% st_coordinates %>% .[, 1], df$geometry %>% 
    st_coordinates %>% .[, 2], label = .data[[var1]]))

Repel labels (df and sf)

city_df_labels <- city_df %>% mutate_at("city", str_to_upper) %>% mutate_at("city", ~str_replace_all(., 
    " ", "\n"))  #  %>% 
# slice(-c(6,8,10,18,28))

# repel labels for sf and projected sf
ggplot() + geom_text_repel(data = city_df_labels, aes(label = city, geometry = geometry), stat = "sf_coordinates", 
    col = path_col, size = city_label_size, min.segment.length = Inf, max.overlaps = Inf)

# repel labels for df
ggplot() + geom_text_repel(data = city_df_labels, aes(lon, lat, label = city), col = path_col, size = city_label_size, 
    min.segment.length = Inf, max.overlaps = Inf)

Add text grob as plot area

require(patchwork)
require(gridExtra)
require(grid)

# opt 1
fh_grob <- "Some text"
(p1 + p2) + grid::textGrob(fh_grob)

# opt 2 - display df in plot window
fh_grob <- data.frame(1:10)
pft <- gridExtra::tableGrob(fh_grob)
gridExtra::grid.arrange(p1, pft)

Save/saving plots

Save as any output

require(rstudioapi)
p %>% rstudioapi::savePlotAsImage("p.png", format = "png", width, height)

Size

Scale size of points manually

ggplot() + geom_point(data = df, aes(x, y, size = var1)) + scale_size("size_area", range = c(-20, 20))

Plot types

Contour/heatmap

bins = 50
ll <- 6  # match to 'levels' in plot (get from plotting first)
lcol <- sequential_hcl(ll, "Reds")
ggplot() + geom_density2d_filled(data = df, aes(lon, lat, fill = ..level.., col = ..level.., bins = bins)) + 
    scale_fill_gradientn(colors = colpal, aesthetics = c("col", "fill"))

Freescale grid layout

require(tmap)

# opt 1 - convert to spdf
spp <- sf %>% as("Spatial")
ggplot() +
  geom_spatial_tile(data = spp) + 
  facet_wrap(~id, scales = "free")

# opt 2 - tmap
require(tmap)
sf %>% 
  tm_shape() +
  tm_borders(group = "id") + # set plot area
  tm_polygons("area",palette = "BuPu",legend.show = F) +
  tm_facets(by = "id") + # facet by var
  tm_layout(frame = F, 
            frame.lwd = NA, 
            panel.label.bg.color = NA,
            panel.label.size = 2,
            main.title = ttl, 
            main.title.position = "center",
            main.title.size = 3,
            main.title.fontface = "bold") 

Mosaic/tile plot

require(ragg)
# tile, pattern and mosaic plots {ragg}

Animated plots (see commented out examples below)

Value dot plot (see commented out examples below)

Interactive map and chart plots (ggiraph)

library(tidycensus)
library(tidyverse)
library(ggiraph)
library(scales)
library(patchwork)
library(tigris)

us_wfh <- get_acs(geography = "state", variables = "DP03_0024P", year = 2022, survey = "acs1", geometry = TRUE) %>% 
    filter(GEOID != "11") %>% shift_geometry(position = "outside") %>% mutate(tooltip = paste(NAME, estimate, 
    sep = ": "))

gg <- ggplot(us_wfh, aes(fill = estimate)) + geom_sf_interactive(aes(tooltip = tooltip, data_id = GEOID), 
    size = 0.1) + scale_fill_viridis_c(option = "rocket", direction = -1, labels = label_percent(scale = 1)) + 
    labs(title = "Percent of workers who work at home", caption = "Data source: 2022 1-year ACS, US Census Bureau", 
        fill = "ACS estimate") + theme_void()

gg_bar <- ggplot(us_wfh, aes(y = estimate, x = reorder(NAME, -estimate), fill = estimate)) + geom_col_interactive(aes(data_id = GEOID)) + 
    scale_fill_viridis_c(guide = "none", option = "rocket", direction = -1) + scale_y_continuous(labels = scales::label_percent(scale = 1)) + 
    theme_minimal(base_size = 8) + labs(x = "", y = "") + theme(axis.text.x = element_text(angle = 45, 
    vjust = 1, hjust = 1), legend.position = "bottom", legend.direction = "horizontal")

girafe(ggobj = wrap_plots(gg, gg_bar, widths = c(8, 8), heights = c(6, 2), ncol = 1), options = list(opts_hover(css = ""), 
    opts_hover_inv(css = "opacity:0.25;")))

Word clouds

devtools::install_github("lchiffon/wordcloud2")  # need to use dev ver
figpath <- here::here("face.png")  # needs to be black and white
wcld <- data.frame(keyword = LETTERS[1:20], freq = sample(100, 20))

# run twice if first time doesn't run
wordcloud2(wcld, figPath = figpath, color = c("skyblue", "red"), backgroundColor = "pink")

# other options https://spencerschien.info/post/data_viz_how_to/dense_word_clouds/
# https://lepennec.github.io/ggwordcloud/
# https://stackoverflow.com/questions/42028462/wordcloud-with-a-specific-shape