In mkoohafkan/ggsubplot2: Subplots: ggplots within ggplots

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

library(dplyr)
library(tidyr)
library(purrr)
library(ggplot2)
# library(ggsubplot2)
devtools::load_all()

Demo 1: sub-facets

data(diamonds, package = "ggplot2")

d = diamonds %>%
    filter(
        between(price, 700, 5000),
        price < (7000 * carat - 1500),
        price > (6000 * carat - 2000)
    ) %>%
    mutate(
        carat.bin = cut(carat, seq(0.3, 1.2, by = 0.1),
            labels = seq(0.3, 1.1, by = 0.1)),
        price.bin = cut(price, seq(500, 5500, by = 500),
            seq(500, 5000, by = 500))
    ) %>%
    group_nest(carat.bin, price.bin) %>%
    mutate(plot = map(data,
        ~ ggplot(.x, aes(x = color, fill = color)) +
            geom_bar(position = "dodge") +
            scale_fill_discrete(guide = FALSE, drop = FALSE) +
            scale_x_discrete(NULL, drop = FALSE)
    ))

ggplot(d, aes(x = carat.bin, y = price.bin, plot = plot)) +
    geom_subfig(
        width = 1,
        height = 1,
        nudge_x = 0.5,
        nudge_y = 0.5,
        theme = theme_void(base_size = 8) +
            theme(panel.border = element_rect(fill = NA))) +
    xlab("Carat") +
    ylab("Price")

d = diamonds %>%
    filter(
        between(price, 700, 5000),
        price < (7000 * carat - 1500),
        price > (6000 * carat - 2000)
    ) %>%
    mutate(
        carat.bin = cut(carat, seq(0.3, 1.2, by = 0.1),
            labels = seq(0.3, 1.1, by = 0.1)),
        price.bin = cut(price, seq(500, 5500, by = 500),
            seq(500, 5000, by = 500))
    ) %>%
    group_nest(carat.bin, price.bin) %>%
    mutate(group = 1:n()) %>%
    unnest(data)


ggplot(d, aes(x = carat.bin, y = price.bin, group = group,
  subplot.x = color, subplot.fill = color)) +
    geom_subplot(
        width = 1,
        height = 1,
        nudge_x = 0.5,
        nudge_y = 0.5,
        subplot.geom = geom_bar(position = "dodge"),
        subplot.theme = theme_bw(base_size = 4)
  )

data(TitanicSurvival, package = "carData")

d = TitanicSurvival %>%
  filter(!is.na(age)) %>%
    group_nest(age.bin = cut(age, 5)) %>%
    mutate(plot = map(data,
        ~ ggplot(.x) + aes(x = age, color = survived) +
            geom_density() +
            facet_grid(sex ~ passengerClass) +
            ylab(NULL) +
            xlim(c(0, 80))
    ))

ggplot(d, aes(x = 1, y = age.bin, plot = plot)) +
    geom_subfig(width = 1, height = 1,
        theme = theme_bw(base_size = 8)) +
        theme_classic() +
        scale_x_continuous(NULL, labels = NULL)

Demo 2: mapping

library(sf)

nc <- st_read(system.file("shape/nc.shp", package = "sf"))
data(Crime, package = "Ecdat")

crimedat = Crime %>%
    group_nest(county) %>%
    mutate(plot = map(data,
        ~ ggplot(.x, aes(x = year, y = crmrte)) +
            geom_line(color = "red")
    ))

ncdat = nc %>%
    st_transform(3857) %>%
    bind_cols(as_tibble(st_coordinates(st_centroid(.)))) %>%
    left_join(crimedat, by = c("CRESS_ID" = "county"))

ggplot(ncdat) + geom_sf() +
    geom_subfig(aes(x = X, y = Y, plot = plot),
        width = 16000, height = 16000, theme = theme_void())

library(tidygraph)
library(ggraph)

set.seed(42)

g = tbl_graph(
    nodes = tibble(x = sample(seq(1, 100, by = 5), 6), y = sample(seq(1, 100, by = 5), 6)),
    edges = tibble(from = sample(1:3, 3), to = sample(4:6, 3))
) %N>%
    mutate(plot = map(1:n(),
            ~ ggplot(tibble(x = rnorm(1000, sd = .x)),
              aes(x = x)) +
                geom_histogram() 
    ))


ggraph(g, layout = "manual", x = x, y = y) +
    theme_graph() +
    geom_edge_link() +
    geom_node_tile(width = 10, height = 10) +
    geom_subfig(aes(x = x, y = y, plot = plot),
        theme = theme_void(),
        width = 10, height = 10)