1 Introduction

Note: If you are working in RStudio, you can simply press “Knit” to render this bookdown (and open _book/index.html to see the result). More generally, in a console you can run the following:

litr::render("create-conformr/index.Rmd", output_format = litr::litr_gitbook())

1.1 Documentation Functions

These functions are used to generate plots and other explanatory assets. They should not really live here.

To convert a panel map into a Matrix

# Convert an incidence table from long form to an incidence matrix
inc_long_to_mtx <- function(inc_long, to, weights){
  inc_wide <- inc_long |>
    tidyr::pivot_wider(names_from = {{to}}, values_from = {{weights}})

  inc_mtx <- as.matrix(inc_wide[,-1])
  dimnames(inc_mtx)[[1]] <- inc_wide[,1, drop=TRUE]
  
  return(inc_mtx)
}

To plot an incidence matrix (without weights):

plt_inc_long_mtx <- function(inc_long, to, from, weights) {
  gg <- inc_long |>
    dplyr::mutate(src_case = dplyr::case_when(
      {{weights}}==1 ~ "one-to-one",
      is.na({{weights}}) ~ "none",
      {{weights}} < 1 ~ "one-to-many")) |>
  ggplot(aes(x={{to}}, y={{from}})) +
    geom_tile(aes(fill=src_case), col="grey") +
    scale_y_discrete(limits=rev) +
    scale_x_discrete(position='top') +
    scale_fill_brewer() +
    coord_fixed()  +
    labs(x = element_blank(), y = element_blank(), fill="source-to-target") +
    theme_minimal()
  return(gg)
}

To add labels for weights:

geom_text(data = dplyr::filter(inc_long, !is.na(weight)), aes(label=round(weight, 2)))

To plot dataframe as ggplot “matrix”:

plt_df_mtx <- function(x, cols_from, row_names){
  x |>
    dplyr::select({{row_names}}, {{cols_from}}) |>
    tidyr::pivot_longer({{cols_from}}, 
                        names_to = "var", values_to = "value") |>
  ggplot(aes(x=var, y={{row_names}})) +
    geom_tile(aes(fill=var), col="grey") +
    geom_text(aes(label=round(value, 2)), size=3) +
    scale_y_discrete(limits=rev) +
    scale_x_discrete(position='top') +
    scale_fill_brewer(palette="Greens") +
    coord_fixed()  +
    labs(x = element_blank(), y = element_blank()) +
    theme_minimal() +
    theme(legend.position="none")
}

To plot a sigmoid plot of a panel map:

library(ggbump)
library(cowplot)
library(dplyr)
library(ggplot2)

# Plot an incidence table (expanded panel map) as a ggplot sigmoid plot
plt_pm_sigmoid <- function(pm, from, to, weights){

  edges <- pm |>
    transmute(from = {{from}}, to = {{to}}, weighted = {{weights}})  

  ## calculate positions for nodes
  from_nodes <- distinct(edges, from) |> mutate(from_y = row_number())
  to_nodes <- distinct(edges, to) |> mutate(to_y = row_number() - 1 + 0.5)

  ## generate df for ggplot
  df <- edges |>
    ## generate mapping type/case variables
    group_by(from) |> 
    mutate(n_dest = n()) |>
    ungroup() |>
    group_by(to) |> 
    mutate(n_origin = n(),
           min_weight = min(weighted)) |>
    ungroup() |>
    mutate(value_case = case_when(n_dest == 1 ~ "one-to-one",
                                  n_dest > 1 ~ "one-to-many")) |>
    left_join(tribble(~value_case, ~line_type, ~font_type,
                      "one-to-one", "solid", "bold",
                      "one-to-many", "dashed", "italic"),
              by = "value_case") |>
    mutate(from_case = case_when(n_origin == 1 ~ "one-from-one",
                                 n_origin > 1 ~ "one-from-many",
                                 n_origin < 1 ~ "ERROR! origin codes < 1"),
           dest_case = case_when(min_weight < 1 ~ "contains split",
                                 min_weight == 1 ~ "aggregation only",
                                 min_weight > 1 ~ "ERROR! weight > 1")
    ) |> 
    ## add y-coordinates
    left_join(from_nodes, by = "from") |>
    left_join(to_nodes, by = "to") |>
    ## add x-coordinates
    mutate(from_x = 0,
           to_x = 5) |>
    ## give each from-out instruction a unique id
    mutate(idx = row_number())

plt_uw <- df |>
  ggplot(aes(x = from_x, xend = to_x, y = from_y, yend = to_y, group = idx)) +
  ## edges as sigmoid curves with line type
  geom_sigmoid(aes(linetype = I(line_type))) +
  # to/from nodes
  scale_y_reverse() +
  geom_text(aes(x = from_x - 0.5, label=from, fontface=I(font_type))) +
  geom_label(aes(x = to_x + 0.5, y = to_y, label=to, fill = dest_case)) +
  # edge labels
  geom_label(data = filter(df, value_case == "one-to-many"),
             aes(x = (((from_x + to_x) / 2) + to_x) / 2,
                 y = to_y,
                 label = weighted)) +
  geom_label(data = filter(df, value_case == "one-to-one"),
             aes(x = (from_x + to_x) / 4,
                 y = from_y,
                 label = weighted)) +
  # theme
  cowplot::theme_minimal_grid(font_size = 14, line_size = 0) +
  theme(legend.position = "bottom",
        panel.grid.major = element_blank(),
        axis.text.y = element_blank(),
        axis.text.x = element_blank(),
        plot.background = element_rect(fill = "white")) +
  labs(x = NULL, y = NULL, fill = "target-from-sources")

return(plt_uw)
}
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union