Bit by Bit

Elements of Code and Style

Level Up with Shiny for R
posit::conf(2024)

2024-08-12

Coding for humans

card(card_header("Cost vs Earnings"),
     layout_sidebar(sidebar = sidebar(
                    open = FALSE, position = "right",
                    radioButtons("cost_group_by",
                                 "Group By",
                                 choices = c("Predominant Degree" = "deg_predominant",
                                             "Campus Setting" = "locale_type",
                                             "Testing Requirements" = "adm_req_test"))),
                    plotOutput("plot_cost")), full_screen = TRUE)

card(card_header("Cost vs Earnings"),
     layout_sidebar(sidebar = sidebar(
                    open = FALSE, position = "right",
                    radioButtons("cost_group_by",
                                 "Group By",
                                 choices = c("Predominant Degree" = "deg_predominant",
                                             "Campus Setting" = "locale_type",
                                             "Testing Requirements" = "adm_req_test"))),
                    plotOutput("plot_cost")), full_screen = TRUE)

card(
  card_header("Cost vs Earnings"),
  layout_sidebar(
    sidebar = sidebar(
      open = FALSE,
      position = "right",
      radioButtons(
        "cost_group_by",
        "Group By",
        choices = c(
          "Predominant Degree" = "deg_predominant",
          "Campus Setting" = "locale_type",
          "Testing Requirements" = "adm_req_test"
        ),
      ),
    ),
    plotOutput("plot_cost"),
  ),
  full_screen = TRUE
)

card(
  card_header("Cost vs Earnings"),
  layout_sidebar(
    sidebar = sidebar(
      open = FALSE,
      position = "right",
      radioButtons(
        "cost_group_by",
        "Group By",
        choices = c(
          "Predominant Degree" = "deg_predominant",
          "Campus Setting" = "locale_type",
          "Testing Requirements" = "adm_req_test"
        ),
      ),
    ),
    plotOutput("plot_cost"),
  ),
  full_screen = TRUE
)

card(
  card_header("Cost vs Earnings"),
  layout_sidebar(
    sidebar = sidebar(
      open = FALSE,
      position = "right",
      radioButtons(
        "cost_group_by",
        "Group By",
        choices = c(
          "Predominant Degree" = "deg_predominant",
          "Campus Setting" = "locale_type",
          "Testing Requirements" = "adm_req_test"
        ),
      ),
    ),
    plotOutput("plot_cost"),
  ),
  full_screen = TRUE
)

Code Folding

Automating code styling

{styler}: tidyverse style in a package

Automating code styling

{grkstyle}: MY style in a package

# In ~/.Rprofile or Console
grkstyle::use_grk_style()

# Then use {styler} addins as normal

# Easily switch between tabs and spaces
grkstyle::grk_reindent_tabs_dir()
grkstyle::grk_reindent_spaces_dir()

card_example <- r"(
card(card_header("Cost vs Earnings"),
     layout_sidebar(sidebar = sidebar(
                    open = FALSE, position = "right",
                    radioButtons("cost_group_by",
                                 "Group By",
                                 choices = c("Predominant Degree" = "deg_predominant",
                                             "Campus Setting" = "locale_type",
                                             "Testing Requirements" = "adm_req_test"))),
                    plotOutput("plot_cost")), full_screen = TRUE)
)"

styler::style_text(card_example)
card(card_header("Cost vs Earnings"),
  layout_sidebar(
    sidebar = sidebar(
      open = FALSE, position = "right",
      radioButtons("cost_group_by",
        "Group By",
        choices = c(
          "Predominant Degree" = "deg_predominant",
          "Campus Setting" = "locale_type",
          "Testing Requirements" = "adm_req_test"
        )
      )
    ),
    plotOutput("plot_cost")
  ),
  full_screen = TRUE
)
grkstyle::grk_style_text(card_example)
card(
  card_header("Cost vs Earnings"),
  layout_sidebar(
    sidebar = sidebar(
      open = FALSE,
      position = "right",
      radioButtons(
        "cost_group_by",
        "Group By",
        choices = c(
          "Predominant Degree" = "deg_predominant",
          "Campus Setting" = "locale_type",
          "Testing Requirements" = "adm_req_test"
        )
      )
    ),
    plotOutput("plot_cost")
  ),
  full_screen = TRUE
)

Garrick’s Golden Guideline

  • A function call fits on a single line

  • Or it has one argument per line

  • Oh, and closing parentheses are on their own line

Comments

Code comments

Comments provide

# Information and context
# Structure ----
#' Documentation
#'
#' @param output The output file path

Structural Comments

# Setup -----------------------------------------------------------------------

# UI --------------------------------------------------------------------------
  # | Sidebar ----
  # | - Accordion ----
  # | - Other Inputs ----
  # | Main ----
  # | - Value Boxes ----
  # | - Cards ----

# Server ----------------------------------------------------------------------
server <- function(input, output, session) {
  # Value Boxes ----
  # Plot ----
  # Map ----
}

Open _examples/02-bslib/99_app.R in the IDE as an example.

Informational Comments?

# Load the Shiny library
library(shiny)

# Define the user interface for the application
ui <- fluidPage(
  
  # Create a title for the application
  titlePanel("My Shiny App"), 
  
  # Create a sidebar layout
  sidebarLayout(
    
    # Define the sidebar panel
    sidebarPanel(
      # Create a numeric input field
      numericInput("num", "Enter a number:", value = 10) 
    ),
    
    # Define the main panel
    mainPanel(
      # Output the result as a text
      textOutput("result") 
    )
  )
)

# Define the server logic for the application
server <- function(input, output) {
  
  # Create a reactive expression to calculate the square of the input
  output$result <- renderText({
    # Calculate the square of the input number
    input$num^2 
  })
}

# Run the application
shinyApp(ui = ui, server = server)

How to write better comments

  1. Some say: Comments should explain why, not what (or the how)
    NOPE! What, why and how are all allowed

  2. Comments should help make the code easier to read and understand.

  3. Explain the code to someone else:

    • What won’t they know unless they talk to you?
    • What might they get wrong if weren’t there?

Case Study: Joe Cheng

shiny/R/middleware.R
# This file contains a general toolkit for routing and combining bits of
# HTTP-handling logic. It is similar in spirit to Rook (and Rack, and WSGI, and
# Connect, and...) but adds cascading and routing.
#
# This file is called "middleware" because that's the term used for these bits
# of logic in these other frameworks. However, our code uses the word "handler"
# so we'll stick to that for the rest of this document; just know that they're
# basically the same concept.
#
# ## Intro to handlers
#
# A **handler** (or sometimes, **httpHandler**) is a function that takes a
# `req` parameter--a request object as described in the Rook specification--and
# returns `NULL`, or an `httpResponse`.
#
## ------------------------------------------------------------------------

#' Create an HTTP response object
#'
#' @param status HTTP status code for the response.
#' @param content_type The value for the `Content-Type` header.
#' @param content The body of the response, given as a single-element character
#'   vector (will be encoded as UTF-8) or a raw vector.
#' @param headers A named list of additional headers to include. Do not include
#'   `Content-Length` (as it is automatically calculated) or `Content-Type` (the
#'   `content_type` argument is used instead).
#'
#' @examples
#' httpResponse(
#'   status = 405L,
#'   content_type = "text/plain",
#'   content = "The requested method was not allowed"
#' )
#'
#' @keywords internal
#' @export
httpResponse <- function(
    status = 200L,
    content_type = "text/html; charset=UTF-8",
    content = "",
    headers = list()) {
  # Make sure it's a list, not a vector
  headers <- as.list(headers)
  if (is.null(headers$`X-UA-Compatible`)) {
    headers$`X-UA-Compatible` <- "IE=edge,chrome=1"
  }
  resp <- list(
    status = status, content_type = content_type, content = content,
    headers = headers
  )
  class(resp) <- "httpResponse"
  return(resp)
}

#
# You can think of a web application as being simply an aggregation of these
# functions, each of which performs one kind of duty. Each handler in turn gets
# a look at the request and can decide whether it knows how to handle it. If
# so, it returns an `httpResponse` and processing terminates; if not, it
# returns `NULL` and the next handler gets to execute. If the final handler
# returns `NULL`, a 404 response should be returned.
#
# We have a similar construct for websockets: **websocket handlers** or
# **wsHandlers**. These take a single `ws` argument which is the websocket
# connection that was just opened, and they can either return `TRUE` if they
# are handling the connection, and `NULL` to pass responsibility on to the next
# wsHandler.
#
# ### Combining handlers
#
# Since it's so common for httpHandlers to be invoked in this "cascading"
# fashion, we'll introduce a function that takes zero or more handlers and
# returns a single handler. And while we're at it, making a directory of static
# content available is such a common thing to do, we'll allow strings
# representing paths to be used instead of handlers; any such strings we
# encounter will be converted into `staticHandler` objects.
#
## ------------------------------------------------------------------------
joinHandlers <- function(handlers) {
  # Zero handlers; return a null handler
  if (length(handlers) == 0) {
    return(function(req) NULL)
  }

  # Just one handler (function)? Return it.
  if (is.function(handlers)) {
    return(handlers)
  }

  handlers <- lapply(handlers, function(h) {
    if (is.character(h)) {
      return(staticHandler(h))
    } else {
      return(h)
    }
  })

  # Filter out NULL
  handlers <- handlers[!sapply(handlers, is.null)]

  if (length(handlers) == 0) {
    return(function(req) NULL)
  }
  if (length(handlers) == 1) {
    return(handlers[[1]])
  }

  function(req) {
    for (handler in handlers) {
      response <- handler(req)
      if (!is.null(response)) {
        return(response)
      }
    }
    return(NULL)
  }
}

#
# Note that we don't have an equivalent of `joinHandlers` for wsHandlers. It's
# easy to imagine it, we just haven't needed one.
#
# ### Handler routing
#
# Handlers do not have a built-in notion of routing. Conceptually, given a list
# of handlers, all the handlers are peers and they all get to see every request
# (well, up until the point that a handler returns a response).
#
# You could implement routing in each handler by checking the request's
# `PATH_INFO` field, but since it's such a common need, let's make it simple by
# introducing a `routeHandler` function. This is a handler
# [decorator](http://en.wikipedia.org/wiki/Decorator_pattern) and it's
# responsible for 1) filtering out requests that don't match the given route,
# and 2) temporarily modifying the request object to take the matched part of
# the route off of the `PATH_INFO` (and add it to the end of `SCRIPT_NAME`).
# This way, the handler doesn't need to figure out about what part of its URL
# path has already been matched via routing.
#
# (BTW, it's safe for `routeHandler` calls to nest.)
#
## -----------------------------------------------------------------------

Case Study: Davis Vaughn

dplyr/R/across.R
# Loop in such an order that all functions are applied
# to a single column before moving on to the next column
for (i in seq_n_cols) {
  var <- vars[[i]]
  col <- data[[i]]

  context_poke("column", var)

  for (j in seq_fns) {
    fn <- fns[[j]]
    out[[k]] <- fn(col, ...)
    k <- k + 1L
  }
}

Case Study: Davis Vaughn

dplyr/R/across.R
# Loop in such an order that all functions are applied
# to a single column before moving on to the next column
for (i in seq_n_cols) {
  var <- vars[[i]]
  col <- data[[i]]
  context_poke("column", var)
  for (j in seq_fns) {
    fn <- fns[[j]]
    out[[k]] <- fn(col, ...)
    k <- k + 1L
  }
}

shiny/R/knit.R
# If there's an R Markdown runtime option set but it isn't set to Shiny, then
# return a warning indicating the runtime is inappropriate for this object.
# Returns NULL in all other cases.
shiny_rmd_warning <- function() {
  runtime <- knitr::opts_knit$get("rmarkdown.runtime")
  if (!is.null(runtime) && runtime != "shiny") {
    # note that the RStudio IDE checks for this specific string to detect Shiny
    # applications in static document
    list(structure(
      "Shiny application in a static R Markdown document",
      class = "rmd_warning"
    ))
  } else {
    NULL
  }
}

What does this code do?

Hot tip: Use early returns

Use this one weird trick to make your code easier to read!

Naming things is hard

What will this function do?

avg_sat_scores(scorecard, "2020-21")

What’s a better name?

Feitelson’s three-step plan

  1. Select the concepts to include in the name.
  2. Choose the words to represent each concept.
  3. Construct a name using these words.

Give this function a better name

library(collegeScorecard)
library(dplyr)
library(ggplot2)

avg_sat_scores <- function(scorecard, year_start = "2020-21") {
  scorecard |>
    filter(
      !is.na(score_sat_avg),
      academic_year >= year_start
    ) |>
    mutate(
      admissions_rate = case_when(
        rate_admissions < 0.5  ~ "Highly Selective",
        rate_admissions >= 0.5 ~ "Wide Acceptance",
        .default = "Unknown"
      )
    ) |>
    ggplot() +
    aes(score_sat_avg, fill = academic_year) +
    geom_density(alpha = 0.5, show.legend = FALSE) +
    facet_grid(academic_year ~ admissions_rate, switch = "y") +
    labs(
      x = "Average SAT Score",
      y = NULL,
    ) +
    theme_minimal(18) +
    theme(
      strip.text.y.left = element_text(angle = 0),
      axis.text.y = element_blank(),
    )
}

Naming shiny things (outputs)

plot_cost
plot_cost_avg
plot_cost_avg_by_month
text_n_undergrads
ui_n_undergrads
vb_n_undergrads

Did you know

All IDs should be unique in an application. See ?shiny::NS().

Naming shiny things (inputs)

Follow the data and how it’s supposed to be used.

input$n_undergrads
input$cost_avg_range
input$cost_avg_min

Naming shiny things (other things)

What are some other useful prefixes in Shiny?

* example_

Switch away from if

switch(
  input$type,
  "types" = inspectdf::inspect_types(df),
  "cat" = inspectdf::inspect_cat(df),
  "num" = inspectdf::inspect_num(df),
  "na" = inspectdf::inspect_na(df)
)