readr ui at a glance

pkg-at-a-glance.r

#' the name of the package we want to check
pkg <- "tidyr"
library(pkg, character.only = TRUE)
#' do the work
pacman::p_load(readr, dplyr, tidyr, ggplot2)
`%||%` <- function(a, b) if (!is.null(a)) a else b
ui <- getNamespaceExports(pkg)
only_funs <- unlist(lapply(ui, function(x) is.function(get(x))))
ui <- ui[only_funs]
l <- lapply(ui, function(f) {
  formalArgs(f) %||% character(0)
  })
df <- data_frame(fun = ui, arg = l)

res <- df %>% 
  unnest(arg) %>% 
  mutate(lgl = 1) %>% 
  complete(fun, arg, fill = list(lgl = 0))

#' clustering...
hc_order <- function(three_col_tidy_df) {
  df <- three_col_tidy_df
  names(df) <- c("row", "key_col", "key_val")
  m <- spread(df, key_col, key_val)
  rownames(m) <- m$row
  m <- as.matrix(select(m, -row))
  hc <- hclust(dist(m))
  data_frame(obs_label = hc$labels, obs_order = hc$order)
}
fun_orders <- hc_order(res) %>% rename(fun = obs_label, fun_order = obs_order)
arg_orders <- hc_order(select(res, arg, fun, lgl)) %>% rename(arg = obs_label, arg_order = obs_order)
out <- left_join(left_join(res, fun_orders, by = "fun"),arg_orders, by = "arg")

#' plotting
out <- mutate(out, in_fun = factor(lgl, levels = c(0,1), labels = c("no", "yes")))
ggplot(out, aes(reorder(arg, arg_order), reorder(fun, fun_order))) + 
  geom_tile(aes(fill = in_fun), color = "grey90") + 
  theme(axis.text.x = element_text(angle = -45, vjust = 1, hjust = 0)) +
  labs(x = paste0("all arguments from exported functions in ", pkg),
       y = paste0("all exported functions in ",pkg),
       title = paste0("the user interface of ",pkg," at a glance.")) +
  scale_fill_manual(values = c("#f5f5f5","#66c2a5"))

r-pkg-ui-at-a-glance.md

the name of the package we want to check

pkg <- "readr"
library(pkg, character.only = TRUE)

do the work

pacman::p_load(readr, dplyr, tidyr, ggplot2)
`%||%` <- function(a, b) if (!is.null(a)) a else b
ui <- getNamespaceExports(pkg)
only_funs <- unlist(lapply(ui, function(x) is.function(get(x))))
ui <- ui[only_funs]
l <- lapply(ui, function(f) {
  formalArgs(f) %||% character(0)
  })
df <- data_frame(fun = ui, arg = l)

res <- df %>% 
  unnest(arg) %>% 
  mutate(lgl = 1) %>% 
  complete(fun, arg, fill = list(lgl = 0))

clustering...

hc_order <- function(three_col_tidy_df) {
  df <- three_col_tidy_df
  names(df) <- c("row", "key_col", "key_val")
  m <- spread(df, key_col, key_val)
  rownames(m) <- m$row
  m <- as.matrix(select(m, -row))
  hc <- hclust(dist(m))
  data_frame(obs_label = hc$labels, obs_order = hc$order)
}
fun_orders <- hc_order(res) %>% rename(fun = obs_label, fun_order = obs_order)
arg_orders <- hc_order(select(res, arg, fun, lgl)) %>% rename(arg = obs_label, arg_order = obs_order)
out <- left_join(left_join(res, fun_orders, by = "fun"),arg_orders, by = "arg")

plotting

out <- mutate(out, in_fun = factor(lgl, levels = c(0,1), labels = c("no", "yes")))
ggplot(out, aes(reorder(arg, arg_order), reorder(fun, fun_order))) + 
  geom_tile(aes(fill = in_fun), color = "grey90") + 
  theme(axis.text.x = element_text(angle = -45, vjust = 1, hjust = 0)) +
  labs(x = paste0("all arguments from exported functions in ", pkg),
       y = paste0("all exported functions in ",pkg),
       title = paste0("the user interface of ",pkg," at a glance.")) +
  scale_fill_manual(values = c("#f5f5f5","#66c2a5"))