knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.path = "man/figures/README-"
)

tjmisc

R-CMD-check

The goal of tjmisc is to gather miscellaneous helper functions, mostly for use in my dissertation.

Apologies in advance. I think "misc" packages are kind of bad because packages should be focused on specific problems: for example, my helper packages for working on polynomials, printing numbers or tidying MCMC samples. Having modular code snapping together like Lego blocks is better than a grab-bag of functions, it's true, but using library(helpers) is much, much better than using source("helpers.R"). So here we are... in the grab-bag.

Installation

You can install the tjmisc from github with:

# install.packages("devtools")
devtools::install_github("tjmahr/tjmisc")

Examples

Sample groups of data

sample_n_of() is like dplyr's sample_n() but it samples groups.

library(dplyr, warn.conflicts = FALSE)
library(tjmisc)
set.seed(11022017)

data <- tibble::tibble(
  day = 1:10 %>% rep(10) %>% sort(),
  id  = 1:10 %>% rep(10),
  block = letters[1:5] %>% rep(10) %>% sort() %>% rep(2),
  value = rnorm(100) %>% round(2)
)

# data from 3 days
sample_n_of(data, 3, day)

# data from 1 id
sample_n_of(data, 1, id)

# data from 2 block-id pairs
sample_n_of(data, 2, block, id)

Tidy quantiles

tidy_quantile() returns a dataframe with quantiles for a given variable. I like to use it to select values for plotting model predictions.

penguins <- palmerpenguins::penguins

penguins %>% 
  tidy_quantile(bill_length_mm)

penguins %>% 
  group_by(species) %>% 
  tidy_quantile(bill_length_mm)

Tidy correlations

tidy_correlation() calculates correlations between pairs of selected dataframe columns. It accepts dplyr::select() selection semantics, and it respects grouped dataframes.

penguins %>% 
  tidy_correlation(bill_length_mm, bill_depth_mm, flipper_length_mm)

penguins %>%
  dplyr::group_by(species) %>%
  tidy_correlation(dplyr::ends_with("mm"))

Pairwise comparisons

compare_pairs() compares all pairs of values among levels of a categorical variable. Hmmm, that sounds confusing. Here's an example. We compute the difference in average score between each pair of workers.

to_compare <- nlme::Machines %>%
  group_by(Worker) %>%
  summarise(avg_score = mean(score)) %>%
  print()

to_compare %>%
  compare_pairs(Worker, avg_score) %>%
  rename(difference = value) %>%
  mutate(
    across(where(is.numeric), round, 1)
  )

Plotting a matrix

ggmatplot() plots the columns of a matrix as individual lines, much like matplot() in base R.

Here we plot a spline basis matrix for penguin bill length. By default it plots the columns with unique row number as the x-axis.

# Create a 10-column natural spline bases
sorted_lengths <- sort(penguins$bill_length_mm)
length_ns <- splines::ns(sorted_lengths, df = 10)
ggmatplot(length_ns)

Alternatively, you can supply a column number and make it the x axis. In this example, we bind on the original data and use it as the x-axis column. This makes the lines much smoother because the spline basis was built on the bill lengths, not on row numbers.

ggmatplot(cbind(sorted_lengths, length_ns), x_axis_column = 1)

By default, duplicated rows are removed. We can choose to keep them. The little flat steps along the curve are the repeated rows. We can also change the number of colors to use. The package also provides annotate_label_grey() for making labels on ggplot2's default grey background.

ggmatplot(length_ns, unique_rows = FALSE, n_colors = 1) + 
  annotate_label_grey("splines!", 20, .65, size = 5)

Et cetera

ggpreview() is like ggplot2's ggsave() but it saves an image to a temporary file and then opens it in the system viewer. If you've ever found yourself in a loop of saving a plot, leaving RStudio to doubleclick the file, sighing, going back to RStudio, tweaking the height or width or plot theme, ever so slowly spiraling in on your desired plot, then ggpreview() is for you.

seq_along_rows() saves a few keystrokes in for-loops that iterate over dataframe rows.

cars %>% head(5) %>% seq_along_rows()
cars %>% head(0) %>% seq_along_rows()

is_same_as_last and replace_if_same_as_last() are helpers for formatting tables. I use them to replace repeating values in a text column with blanks.

mtcars %>% 
  tibble::rownames_to_column("name") %>% 
  slice(1:10) %>% 
  select(cyl, name, mpg) %>% 
  arrange(cyl, mpg) %>% 
  mutate_at(c("cyl"), replace_if_same_as_last, "") %>% 
  knitr::kable()

fct_add_counts() adds counts to a factor's labels.

# Create a factor with some random counts
set.seed(20190124)
random_penguins <- penguins %>% 
  dplyr::sample_n(250, replace = TRUE)

table(random_penguins$species)

# Updated factors
random_penguins$species %>% levels()
random_penguins$species %>% fct_add_counts() %>% levels()

You can tweak the format for the first label. I like to use this for plotting by stating the unit next to the first count.

random_penguins$species %>% 
  fct_add_counts(first_fmt = "{levels} ({counts} penguins)") %>% 
  levels()

Behind the scenes, fct_add_counts() uses the function fct_glue_labels() to construct labels using a glue-templating string. Therefore, fct_glue_labels() would be a more appropriate function for generic relabeling using glue:

random_penguins$species %>% 
  fct_glue_labels(
    fmt = "{tolower(levels)}", 
    first_fmt = "Species: {tolower(levels)}"
  ) %>% 
  levels()

Comparing two sets

When I need to merge two datasets together, I have to go through a little dance to figure out which elements are in your_data and which are in my_data. compare_sets() performs all of R's set operations so I can skim over the differences.

your_data <- c(1, 2, 3, 3, 4, 5)
my_data <- c(4, 4, 4, 5, 6, 7, 8)
str(compare_sets(your_data, my_data))

Jekyll helpers

I also include functions I use to create and maintain my website. jekyll_create_rmd_draft() creates a post in the _R/_drafts folder.

withr::with_dir(tempdir(), {
  dir.create("_R")
  dir.create("_R/_drafts")

  # Basic use
  jekyll_create_rmd_draft(slug = "today-i-learned")

  # Accepts a date
  jekyll_create_rmd_draft(
    slug = "yesterday-i-learned", 
    date = Sys.Date() - 1
  )

  # Filler text used if slug is not provided
  jekyll_create_rmd_draft()
})

More involved demos

These are things that I would have used in the demo above but cut and moved down here to keep that overview succinct.

Comparing pairs of values over a posterior distribution

I wrote compare_pairs() to compute posterior differences in Bayesian models. For the sake of example, let's fit a Bayesian model of average bill length for each species in penguins. We could get these estimates more directly using the default dummy-coding of factors, but let's ignore that for now.

library(rstanarm)
m <- stan_glm(
  bill_length_mm ~ species - 1,
  penguins,
  family = gaussian
)

Now, we have a posterior distribution of species means.

newdata <- data.frame(species = unique(penguins$species))

p_means <- posterior_linpred(m, newdata = newdata) %>%
  as.data.frame() %>%
  tibble::as_tibble() %>%
  setNames(newdata$species) %>%
  tibble::rowid_to_column("draw") %>%
  tidyr::gather(species, mean, -draw) %>%
  print()

For each posterior sample, we can compute pairwise differences of means with compare_means().

pair_diffs <- compare_pairs(p_means, species, mean) %>%
  print()

library(ggplot2)

ggplot(pair_diffs) +
  aes(x = pair, y = value) +
  stat_summary(fun.data = median_hilow, geom = "linerange") +
  stat_summary(fun.data = median_hilow, fun.args = list(conf.int = .8),
               size = 2, geom = "linerange") +
  stat_summary(fun.y = median, size = 5, shape = 3, geom = "point") +
  labs(x = NULL, y = "Difference in posterior means") +
  coord_flip()

...which should look like the effect ranges in the dummy-coded models.

m2 <- update(m, bill_length_mm ~ species)
m3 <- update(
  m, 
  bill_length_mm ~ species, 
  data = penguins %>% mutate(species = forcats::fct_rev(species))
)

Give or take a few decimals of precision and give or take changes in signs because of changes in who was subtracted from whom.

# Adelie versus others
m2 %>% 
  posterior_interval(regex_pars = "species") %>% 
  round(2)

# Gentoo versus others
m3 %>% 
  rstanarm::posterior_interval(regex_pars = "species") %>% 
  round(2)

# differences from compare_pairs()
pair_diffs %>% 
  tidyr::spread(pair, value) %>% 
  select(-draw) %>% 
  as.matrix() %>% 
  posterior_interval() %>% 
  round(2)


tjmahr/tjmisc documentation built on Feb. 8, 2023, 12:21 p.m.