1. Significantly Lower API Costs

Direct LLM queries with large context windows can get expensive, quickly, especially when working with extensive documentation. The vector DB approach only sends the most relevant chunks to the LLM, drastically reducing token usage and API costs.

2. Superior Query Performance

RAG systems deliver faster responses given that:

• The vector search quickly identifies the most relevant content
• The LLM only processes small, highly relevant chunks rather than entire documents
• The system caches embeddings, making subsequent similar queries even faster

3. Scalability

As your collection grows (imagine adding more specialized packages or books to your library), a vector DB scales gracefully. The search performance remains consistent whether you have 3 books or 300, while direct LLM approaches would require increasingly larger context windows.

4. Higher Accuracy for Domain-Specific Questions

By retrieving specific, relevant context from your documentation, RAG systems provide more precise answers tailored to your exact versions and implementations rather than the LLM’s general knowledge.

CRM Systems

When we ponder Customer Relationship Management, we find ourselves amidst a vast sea of data, encompassing customer interactions, preferences, transaction histories, and much more. In the traditional approach, this data might be stored in spreadsheets or databases as tabular data. While this method is straightforward, it often leads to a fragmented view of the customer, with data scattered across multiple tables or sheets.

Herein lies the profound advantage of employing R6 in a CRM context:

Unified Customer View: By defining an R6 class for a customer, you encapsulate all relevant information and behaviors related to that customer in one place. This approach fosters a holistic view of each customer, integrating data from various sources. It allows for more coherent and comprehensive analysis and decision-making.

Behavior Encapsulation: With R6, you’re not just storing data; you’re also encapsulating behaviors. For instance, an R6 class for a customer could include methods to calculate lifetime value, predict churn, or even trigger personalized marketing actions. This encapsulation of behavior with data enriches the CRM’s capabilities.

Flexibility and Scalability: R6’s object-oriented nature allows for more scalable and adaptable solutions. As business needs evolve, you can extend or modify the R6 classes without overhauling your entire data structure. This flexibility is crucial in the ever-changing business landscape.

Interactivity and Automation: R6 classes can interact with each other, enabling automated workflows. For instance, a class representing an email campaign can interact with the customer class to send personalized emails, log interactions, and update customer profiles, all in an automated manner.

# Defining a Customer class
Customer <- R6::R6Class("Customer",
    public = list(
        name = NULL,
        email = NULL,
        transaction_history = list(),
        initialize = function(name, email) {
            self$name <- name
            self$email <- email
        },
        record_transaction = function(transaction) {
            self$transaction_history <- c(self$transaction_history, list(transaction))
        },
        calculate_lifetime_value = function() {
          self$transaction_history |> 
            purrr::map_dbl(~ .x$amount) |> 
            sum()
        }
    )
)

# Example usage
customer1 <- Customer$new(name = "John Doe", email = "john@example.com")
customer1$record_transaction(list(date = "2021-01-01", amount = 100))
customer1$record_transaction(list(date = "2021-02-01", amount = 150))
lifetime_value <- customer1$calculate_lifetime_value()

print(lifetime_value)

[1] 250

In this enriched example, our Customer class now not only stores basic information but also tracks transaction history and calculates the lifetime value. This enriched model provides a more dynamic and insightful perspective on the customer, far surpassing the static nature of spreadsheets or basic tabular data.

Financial Modeling

Let’s craft an R6 class that models a portfolio of financial instruments, each with its own characteristics and behaviors. This portfolio can include various types of investments like stocks, bonds, and mutual funds, each represented by their own R6 classes.

The beauty of using R6 in this context lies in its ability to encapsulate the complexities of financial instruments within their respective classes, thereby making the overall portfolio management more intuitive and robust. Let’s delve into this with a code example:

library(R6)

# Define a generic FinancialInstrument class
FinancialInstrument <- R6::R6Class("FinancialInstrument",
    public = list(
        identifier = NULL,
        principal = NULL,
        initialize = function(identifier, principal) {
            self$identifier = identifier
            self$principal = principal
        },
        calculate_return = function() {
            # Placeholder for return calculation
        }
    )
)

# Extend FinancialInstrument for specific types
Stock <- R6::R6Class("Stock", inherit = FinancialInstrument,
    public = list(
        dividend_yield = NULL,
        initialize = function(identifier, principal, dividend_yield) {
            super$initialize(identifier, principal)
            self$dividend_yield = dividend_yield
        },
        calculate_return = function() {
            return(self$principal * self$dividend_yield)
        }
    )
)

Bond <- R6::R6Class("Bond", inherit = FinancialInstrument,
    public = list(
        interest_rate = NULL,
        initialize = function(identifier, principal, interest_rate) {
            super$initialize(identifier, principal)
            self$interest_rate = interest_rate
        },
        calculate_return = function() {
            return(self$principal * self$interest_rate)
        }
    )
)

# Define a Portfolio class that can hold multiple financial instruments
Portfolio <- R6::R6Class("Portfolio",
    public = list(
        instruments = list(),
        add_instrument = function(instrument) {
            self$instruments[[instrument$identifier]] <- instrument
        },
        total_return = function() {
          self$instruments |> 
            purrr::map_dbl(\(x) x$calculate_return()) |> 
            sum()
        }
    )
)

# Example usage
portfolio <- Portfolio$new()
portfolio$add_instrument(Stock$new("AAPL", 10000, 0.02))
portfolio$add_instrument(Bond$new("US-Gov", 5000, 0.03))

total_return <- portfolio$total_return()
print(total_return)

[1] 350

In this expanded scenario, we have:

• A base class FinancialInstrument that defines a generic financial instrument.
• Derived classes Stock and Bond that inherit from FinancialInstrument and implement specific behaviors, such as different ways of calculating returns.
• A Portfolio class that can contain a collection of different financial instruments. It can calculate the total return of the portfolio by summing the returns of each individual instrument.

This object-oriented approach provided by R6 allows for clear separation and encapsulation of the logic for each type of financial instrument. It makes the code modular, easier to understand, and maintain. For a business leader or data analyst, this translates to a system that is more adaptable to new types of financial instruments and changing financial models, ultimately aiding in making more informed investment decisions.

Library System

Let’s develop a simplified system for managing a library which includes tracking books, patrons, and book loans. This example will demonstrate how R6 can be used to model real-world entities and their interactions.

In our library system, we’ll have three main classes:

1. Book: Represents a book in the library.
2. Patron: Represents a library member who can borrow books.
3. Library: Manages the collection of books and patrons, and handles book loans.

Here’s the R code for this use case:

library(R6)

# Book class
Book <- R6::R6Class("Book",
    public = list(
        title = NULL,
        author = NULL,
        is_loaned = FALSE,
        initialize = function(title, author) {
            self$title <- title
            self$author <- author
            self$is_loaned <- FALSE
        },
        loan = function() {
            self$is_loaned <- TRUE
        },
        return_book = function() {
            self$is_loaned <- FALSE
        }
    )
)

# Patron class
Patron <- R6::R6Class("Patron",
    public = list(
        name = NULL,
        books_loaned = list(),
        transaction_history = list(),
        initialize = function(name) {
            self$name <- name
            self$books_loaned <- list()
            self$transaction_history <- list()
        },
        borrow_book = function(book) {
            if (!book$is_loaned) {
                book$loan()
                self$books_loaned[[book$title]] <- book
                self$transaction_history <- c(self$transaction_history, 
                                              list(paste(Sys.time(), ": Borrowed", book$title)))
            } else {
                message("This book is currently loaned out.")
            }
        },
        return_book = function(book) {
            book$return_book()
            self$books_loaned[[book$title]] <- NULL
            self$transaction_history <- c(self$transaction_history, 
                                          list(paste(Sys.time(), ": Returned", book$title)))
        },
        get_transaction_history = function() {
            return(self$transaction_history)
        }
    )
)

# Library class
Library <- R6::R6Class("Library",
    public = list(
        books = list(),
        patrons = list(),
        initialize = function() {
            self$books <- list()
            self$patrons <- list()
        },
        add_book = function(book) {
            self$books[[book$title]] <- book
        },
        add_patron = function(patron) {
            self$patrons[[patron$name]] <- patron
        }
    )
)

# Example usage
library_system <- Library$new()
book1 <- Book$new("The Great Gatsby", "F. Scott Fitzgerald")
book2 <- Book$new("1984", "George Orwell")
patron1 <- Patron$new("John Doe")

library_system$add_book(book1)
library_system$add_book(book2)
library_system$add_patron(patron1)

# John Doe borrows "The Great Gatsby"
patron1$borrow_book(library_system$books[["The Great Gatsby"]])

# Check if the book is loaned
print(library_system$books[["The Great Gatsby"]]$is_loaned)

[1] TRUE

# John Doe returns "The Great Gatsby"
patron1$return_book(library_system$books[["The Great Gatsby"]])

# Check if the book is loaned
print(library_system$books[["The Great Gatsby"]]$is_loaned)

[1] FALSE

# View John Doe's transaction history
print(patron1$get_transaction_history())

[[1]]
[1] "2023-11-28 14:49:54.173788 : Borrowed The Great Gatsby"

[[2]]
[1] "2023-11-28 14:49:54.175161 : Returned The Great Gatsby"

In the above example:

• The Book class represents a book with methods to loan and return it
• The Patron class represents a library member who can borrow and return books
  • The Patron class includes a transaction_history list to record each borrowing and returning action
  • Methods borrow_book and return_book append a descriptive string and timestamp to the transaction_history each time they are called
  • get_transaction_history retrieves and displays the transaction history
• The Library class manages the collection of books and patrons
  • It allows adding books and patrons to the library

This code provides a simple yet effective demonstration of how R6 can be used to model and manage real-world entities and their interactions, showcasing the utility of object-oriented programming in R. Any time John Doe borrows or returns a book, the transaction is recorded. You can then view all his transactions by calling the get_transaction_history method on his Patron object.

Beginner Resources

• Official Shiny website: shiny.rstudio.com
  • Includes example galleries for inspiration
• Deploying your Shiny app to shinyapps.io: shiny.rstudio.com/articles/shinyapps.html
• Shiny extension packages:
  • {bs4Dash}: How to start? (step-by-step)
    • Brings Bootstrap 4 support to Shiny themes
    • Relies on AdminLTE HTML template
  • {bslib}: Customizing “stock” Shiny apps
    • Globally style your Shiny Bootstrap themes
    • Use Sass variables to further customize your apps with “Sassy CSS” (*.scss)

Advanced Resources

• Hadley Wickham’s Mastering Shiny: mastering-shiny.org/
• {golem} for modularizing and packaging Shiny apps: thinkr-open.github.io/golem/index.html
• Engineering Production-Grade Shiny Apps: engineering-shiny.org/
• Outstanding User Interfaces with Shiny: unleash-shiny.rinterface.com/
• Automating Dockerfile creation for Shiny apps: www.jumpingrivers.com/blog/shiny-auto-docker

Shiny Inspiration

• Posit’s Shiny gallery: shiny.rstudio.com/gallery/
• Appsilon’s Shiny demos: demo.appsilon.com/
• Shiny Contest submissions by Stefan Schliebs:
  • 2021: New Zealand Commute Explorer
  • 2020: R Blog Explorer
  • 2019: R Package Explorer

Size on Disk

Query Performance

Size vs Performance

Intro to Sodium

The following example uses {sodium} to generate a keypair and encrpt / decrypt a serialized message (representing the iris data set). One major benefit of encrypting objects like this is that you can publicly expose these encrypted objects since you alone hold the key to decrypt them. If you’re working with GitHub Actions, GitLab CI/CD, or another git-backed repository, you can save these encrypted messages in your public repo - If someone forks or clones your repository, they’ll be unable to decrypt the object without the hash key initially created in the keypair generation step.

The example below was written by Jeroen Ooms on rOpenSci and is part of the documentation for the {sodium} package. I added the last step to show how to unserialize() an object previously decrypted.

library(sodium)

# Generate keypair:
key <- sodium::keygen()
pub <- sodium::pubkey(key)

# Encrypt message with pubkey
msg <- serialize(iris, NULL)
ciphertext <- sodium::simple_encrypt(msg, pub)

# Decrypt message with private key
out <- sodium::simple_decrypt(ciphertext, key)

# Unserialize the decrypted message & assign iris data to new obj
iris_new <- unserialize(out)

Sodium + Cyphr

Using the {sodium} and {cyphr} packages, the code snippets below showcase three key steps: 3a) data encryption, 3b) in-line decryption (to be used as a script intended to run with a GitHub Actions Workflow every six hours), and 3c) the GitHub Actions YAML file to configure the automation workflow.

Using this approach, I can safely expose an encrypted RDS file on my public GitHub repo that contains secret API credentials for accessing Meetup.com and fetching new events that may have been posted. The encrypted RDS file can only be decrypted using the keypair hash saved with the MEETUP_PWD environment variable on my GitHub repo, a secret env var only visible to me.

NOTE: For the purposes of GitHub Actions and the config YAML file covered in Step 3c, this file lives in the following path on my GitHub repo: ~/.github/workflows/main.yml

Step 3a: Encrypt

# The following is a one-time key encryption setup

library(sodium)
library(cyphr)
library(meetupr)

# After doing a one-time interactive auth with {meetupr},
# your Meetup token will be stored as an RDS file in the 
# same path as your {meetupr} package:
token_path <- 
  path.expand(
    file.path("~", "Library", "Application Support", 
              "meetupr", "meetup_token.rds")
  )

meetupr::meetup_auth(
  token = NULL,
  cache = TRUE,
  use_appdir = FALSE,
  token_path = token_path
)

# Encrypt the existing token to safely save 
# meetupr_secret.rds in a public repo
sodium_key <- sodium::keygen()

# In your working environment, save a secret env var called
# "MEETUPR_PWD" using the randomly generated sodium_key
Sys.setenv("MEETUPR_PWD" = sodium::bin2hex(sodium_key))

# Create a key for use with {cyphr}
key <- cyphr::key_sodium(sodium::hex2bin(Sys.getenv("MEETUPR_PWD")))

# Encrypt the RDS and save as meetupr_secret.rds
# in the working environment
cyphr::encrypt_file(
  token_path,
  key = key,
  dest = "meetupr_secret.rds"
)

Step 3b: Decrypt

# This script was saved as "meetup_events.R" and it is run as part
# of the GitHub Actions workflow on line 37 of the YAML file covered
# in "Step 3c: GitHub Actions YAML"

library(dplyr)
library(stringr)
library(lubridate)
library(purrr)
library(meetupr)
library(cyphr)

# Generate Key with MEETUPR_PWD env var for MeetupR data CI/CD
key <- cyphr::key_sodium(sodium::hex2bin(Sys.getenv("MEETUPR_PWD")))

temptoken <- tempfile(fileext = ".rds")

cyphr::decrypt_file("meetupr_secret.rds",
                    key = key,
                    dest = temptoken)

token <- readRDS(temptoken)[[1]]

# Non-Interactive Meetup Authorization
token <- meetupr::meetup_auth(
  token = token,
  use_appdir = FALSE,
  cache = FALSE
)

# Save a temporary, updated Meetup personal access token that will
# be used downstream with the meetupr::get_events() function
Sys.setenv(MEETUPR_PAT = temptoken)

# Create a character vector of the Meetup accounts for data collection
socal_groups <- c("SOCAL-RUG", 
                  "Santa-Barbara-R-Users-Group", 
                  "Real-Data-Science-USA-R-Meetup",
                  "useR-Group-in-San-Luis-Obispo-County", 
                  "rladies-irvine",
                  "rladies-la",
                  "rladies-pasadena",
                  "rladies-riverside",
                  "rladies-santa-barbara",
                  "rladies-san-diego")

# Create a function for getting upcoming and past Meetup events
get_meetup_events <- function(x) {
  if (length(meetupr::get_events(urlname = x)) > 0) {
    meetupr::get_events(urlname = x) |> 
      dplyr::mutate(chapter = x)
  }
}

# Using purrr, iterate through each Meetup account, collect 
# event data, and row-bind the resulting event listings
events_raw <- 
  purrr::map_dfr(.x = socal_groups, .f = get_meetup_events) |> 
  dplyr::select(chapter, dplyr::everything())

# Data clean up
events <- 
  events_raw |> 
  dplyr::filter(
    status != "draft",
    !stringr::str_detect(title, "Cross-post|cross-post"),
    !stringr::str_detect(description, "Cross-post|cross-post")) |> 
  dplyr::distinct() |> 
  dplyr::arrange(dplyr::desc(time)) |>
  dplyr::mutate(
    Upcoming = dplyr::if_else(status == "published", "&#x2713;", ""),
    Chapter = dplyr::case_when(
      chapter == "SOCAL-RUG" ~ "SoCal RUG",
      chapter == "Santa-Barbara-R-Users-Group" ~ "Santa Barbara RUG",
      chapter == "Real-Data-Science-USA-R-Meetup" ~ "Los Angeles RUG",
      chapter == "useR-Group-in-San-Luis-Obispo-County" ~ "SLO RUG",
      chapter == "rladies-irvine" ~ "R-Ladies Irvine",
      chapter == "rladies-la" ~ "R-Ladies Los Angeles",
      chapter == "rladies-pasadena" ~ "R-Ladies Pasadena",
      chapter == "rladies-riverside" ~ "R-Ladies Riverside",
      chapter == "rladies-santa-barbara" ~ "R-Ladies Santa Barbara",
      chapter == "rladies-san-diego" ~ "R-Ladies San Diego",
      TRUE ~ chapter),
    Event = paste0('<a href=', '"', link, '">', title, '</a>'),
    Date = lubridate::as_date(time),
    Time = format.POSIXct(time, format = "%I:%M %p")) |> 
  dplyr::select(Upcoming, Chapter, Event, Date, "Time (PST)" = Time)

saveRDS(events, file = "events/events_past_and_upcoming.rds")

Step 3c: GitHub Actions YAML

name: Render and Deploy Quarto Blog
on:
  pull_request:
    branches: [ master ]
  push:
    branches: [ master ]
  schedule:
    - cron:  '0 */6 * * *'

jobs:
  build:
    runs-on: ubuntu-latest
    steps:
      - name: Checkout Repo
        uses: actions/checkout@v3
        with:
          fetch-depth: 0
          
      - name: Install libsodium
        run: sudo apt-get install -y libsodium-dev

      - name: Setup Quarto CLI
        uses: quarto-dev/quarto-actions/setup@v2
        with:
          version: 1.2.280

      - name: Setup R 
        uses: r-lib/actions/setup-r@v2
        with:
          r-version: '4.2.2'
          use-public-rspm: true
      
      - name: Setup renv
        uses: r-lib/actions/setup-renv@v2

      - name: Fetch Events from Meetup
        run: source(here::here("helpers", "meetup_events.R"))
        env:
          MEETUPR_PWD: ${{ secrets.MEETUPR_PWD }}
        shell: Rscript {0}

      - name: Render and Publish to Netlify
        uses: quarto-dev/quarto-actions/publish@v2
        with:
          target: netlify
          NETLIFY_AUTH_TOKEN: ${{ secrets.NETLIFY_AUTH_TOKEN }}

1: Clone Repo

We’ll start by forking this GitHub repo into your repository to allow you to experiment with my code without actually changing anything in my original project repo. To do this, navigate to my GitHub repo ( JavOrraca/bslib_demo_shiny) and click on the Fork button in the top-right of the repo. This will prompt you to “Create a new fork” - Typically, I like to keep all of the defaults intact. When you’re ready to create the new fork, simply hit the Create fork button on the bottom of the screen.

Assuming you kept the original repository name, you should see a newly created repo titled “bslib_demo_shiny” in your GitHub repositories. It contains a full copy of all files and folders found in my original project repo.

Next, you’ll want to clone this repo to your local machine. Using the RStudio IDE, navigate to its menu bar and click on File -> New Project -> Version Control -> Git, copy/paste your repo’s clone URL, choose your local project directory path of choice, and click on Create Project.

RStudio IDE’s New Project Wizard will launch in a popup window after selecting New Project from the file menu. You should expect the following:

This process will create a local clone of all files and folders found on your remote GitHub repo. Once all files are downloaded for this project, the files and folder structure will look like this:

├── Dockerfile
├── LICENSE
├── README.md
├── bslib_demo_shiny.Rproj
├── global.R
├── helpers
│ ├── custom_theme.R
│ ├── footer.R
│ └── navbar.R
├── modules
│ ├── mod_About.R
│ ├── mod_Mapping.R
│ ├── mod_Overview.R
│ └── mod_Reports.R
├── renv
│ ├── activate.R
│ ├── library
│ │ └── R-4.2
│ ├── sandbox
│ │ └── R-4.2
│ ├── settings.dcf
│ └── staging
├── renv.lock
├── server.R
├── ui.R
├── www
│ ├── Shiny_Demo_Preview.png
│ ├── blr_logo-primary.png
│ └── styles.scss

2: Install Packages

It’s important to make note of the renv folder. This Shiny app relies on the renv package to manage project-package dependencies. If the Shiny app requires different package versions than those installed on your system’s main R library path, this approach will install the necessary packages in the renv directory.

To install the required R packages for this app, follow the instructions presented in your RStudio IDE Console immediately after cloning the GitHub repo or execute the command renv::restore(). This process will restore the package state as recorded in the renv.lock file - This “lockfile” records all of the R package names and versions required to run this specific Shiny app.

Once the project-package dependencies are installed, test launch the Shiny app by running shiny::runApp() in the Console or by clicking on the Run App button in the RStudio IDE. The Run App button only appears if you’re inside the global.R, ui.R, and server.R files - These three filenames are unique to Shiny and the RStudio IDE recognizes them as such.

3: App Customization

While there are many ways to configure a Shiny app, the global aesthetics of this app have been configured using the bslib and thematic packages. These packages provide tools for customizing Bootstrap themes and they introduce Sass variables to Shiny (in my opinion, making the customization process much more unified).

The default Bootstrap version for bslib is version 5, however, this app was designed using Bootstrap 4. The thematic package provides a centralized approach to styling certain R visualizations such as those generated from ggplot2.

To fully customize the color scheme and overall theme of the app to your liking, make revisions to the following files that are sourced at runtime:

# Overarching bslib theme
fn_custom_theme <- function() {
  bslib::bs_theme(
    version = "4",
    base_font = sass::font_google("Open Sans"),
    bg = "#ffffff",
    fg = "#1d2d42",
    primary = "#f3d436", 
    secondary = "#1d2d42",
    success = "#1d2d42") |> 
    bs_add_variables("border-bottom-width" = "6px",
                     "border-color" = "$primary",
                     .where = "declarations") |> 
    bs_add_rules(sass::sass_file("www/styles.scss"))
}

# Thematic theme for ggplot2 outputs
fn_thematic_theme <- function() {
  thematic::thematic_theme(
    bg = "#ffffff",
    fg = "#1d2d42",
    accent = "#f3d436",
    font = font_spec(sass::font_google("Open Sans"), scale = 1.75)
  )
}

fn_footer <- function(){
  tags$footer(
    HTML(
      "This web app demo was developed by <a href='https://www.javierorracadeatcu.com'>Javier Orraca-Deatcu</a> with R + Shiny"
    )
  )
}

fn_navbar <- function(){
  div(
    class = "bloomreach_logo",
    a(href = "https://www.bloomreach.com/",
      img(src = "blr_logo-primary.png",
          title = "Bloomreach")
    )
  )
}

4: Example Tweaks

Now that we’ve covered the files in your Shiny project that need to be updated if you want to deploy your own custom-styled demo Shiny app, let’s pivot to a real world example. Let’s say our name is Steve Wozniak and we want to design a Shiny app that invokes a retro Apple feel… After finding a decent logo to use and saving it to www/retro_apple_logo.png, below are the steps that we would need to follow to update our app:

• helpers/custom_theme.R
  • Line 5: base_font = sass::font_google("Press Start 2P", local = FALSE, display = "swap"),
  • Line 8: primary = "#01c700",
  • Line 22: accent = "#01c700",
• helpers/footer.R
  • Line 4: "This web app demo was developed by <a href='http://www.woz.org/'>Steve Wozniak</a> with R + Shiny"
• helpers/navbar.R
  • Line 3: class = "retro_apple",
  • Line 4: a(href = "http://www.apple.com/",
  • Line 5: img(src = "retro_apple_logo.png",
  • Line 6: title = "Apple")

Let’s give this app a test run and see how it changed the appearance:

So far, so good! We’ve got a retro logo (re-sized to fit in the top-left of the navbar), a retro font (pulled from Google Fonts), and the primary and accent colors have been updated from yellow to neon green. There are several additional edits we could make but for now, I like it.

5: App Deployment

Now we’re ready to publish your newly revised Shiny app. We’ll use the shinyapps.io platform by Posit to push-button deploy our app from the RStudio IDE. For our needs, a free account will suffice as the free tier allows up to 5 Shiny app deployments with a combined 25 monthly active hours of usage. It’s important to note that if someone launches your app and keeps it running in a tab, this is considered “active” runtime, so encourage your shinyapps.io users to close the browser window when they’re done using your app.

If you do not have a shinyapps.io account or you have not synced your RStudio IDE to shinyapps.io via security token, please review the shinyapps.io Getting Started documentation. Once you’re set up, it will be a breeze to publish your app. If you’re stuck, again feel free to reach out to me directly.

Similar to the way that the Run App button will present itself if you’re inside the global.R, ui.R, or server.R files, you’ll also see a blue sync-looking button that gives you the power of push-button deployment from within the RStudio IDE:

Clicking that button will open a new window to help you publish your app to the shinyapps.io servers. The title you select will be the name of the application on your shinyapps.io dashboard and it will also be included in the URL of your app. For example, I named my app “Bloomreach_Shiny_App” so the URL to visit my app is https://javierorraca.shinyapps.io/Bloomreach_Shiny_App/.

If you use a title that already exists in your shinyapps.io dashboard, you will force overwrite the prior app with the same name, so take caution when publishing. More often than not, it’s desired to overwrite an app so that you can regularly push updates to production to the same URL, however, there are instances where this behavior would not be desired. Regardless of your publishing intention, RStudio IDE will provide a warning to confirm that you want to write over a shinyapps.io application with the same name.

Since the Dockerfile is not relevant to this project deployment, I recommend un-checking Dockerfile from the list of file from which to publish. Once you’re ready, click on Publish and a new tab, Deploy, will be visible in the bottom-left of your RStudio IDE. This process takes several minutes since shinyapps.io will 1) install an R image with all the project-package dependencies needed to run your Shiny app, and 2) build and deploy the Shiny app itself. Once publishing is complete, you should see something like this:

6: Git Commit & Push

Now that you’ve successfully published your application from the RStudio IDE, wrap up your changes and commit / push them back to your GitHub repo. There are several ways to do this (GitHub Desktop app, Terminal, Windows Powershell, etc.) but I’ve found the easiest to be within the RStudio IDE. First, you’ll want to commit (or save) a local snapshot of the edits you’ve made from the remote GitHub repo. Since this commit is saved locally, you’ll also need to push this commit back to your GitHub repo.

Under the Git pane, click on Commit to open a window that allows you to inspect the files that were modified, added, deleted, etc. The quickest way to stage all files for commit is to click on any of the filenames you edited in the top-left pane of the commit popup window, select all files using the Select All keystroke (Ctrl+A on Windows or Cmd+A on Mac), then click on the Stage button. Write a message in the blank top-right message box for this commit - Keep it succinct about the file(s) changes that you’ve made. Click on the Commit button under the message box and this saves a local snapshot of the changes you’ve made.

To push the changes back to GitHub, click on the green Push button in the top-right of the commit window and this will push your locally committed changes to your remote GitHub repo. Now, in addition to the live app that you’ve deployed, you’ll also be able to direct end users to your GitHub repo with your app’s source code.

Libraries

# Install dev packages
devtools::install_github("tylermorganwall/rayshader")
devtools::install_github("tylermorganwall/rayimage")

# Load libraries
library(rayshader)
library(raster)
library(osmdata)
library(sf)
library(dplyr)
library(ggplot2)

# Source elevation data
laguna <- raster::raster("./USGS_one_meter_x42y372_CA_SoCal_Wildfires_B1_2018.tif")

EDA

To better explore the data, lets begin by visualizing the elevation data with rayshader defaults to understand the topography that we are working with. Before we can render this visual, we need to transform the laguna data object (assigned above) to a matrix. For faster rendering and prototyping, you can also resize the matrix using rayshader::resize_matrix(). This resizing will downscale your full dataset using bilinear interpolation.

# Transform the spatial data structure into a regular R matrix
laguna_mat <- rayshader::raster_to_matrix(laguna)

# Create small version of matrix for quick visual prototyping
laguna_small <- rayshader::resize_matrix(laguna_mat, 0.1)

# Plot base map using basic color defaults
laguna_small %>% 
  rayshader::height_shade() %>% 
  rayshader::plot_map()

Cropping

I wanted to focus on downtown Laguna Beach but this only represents a small fraction of the raw LIDAR. To get the desired lat-long range of downtown Laguna Beach, I used Google Maps to get the endpoints of my desired box. To accomplish this cropping, below, we relied on a custom cropping function that TMW shared on the rayshader site.

# Crop to fit desired box around downtown Laguna Beach
lat_range <- c(33.541370925562376, 33.55945552155357)
long_range <- c(-117.79622401045448, -117.77493476466955)

convert_coords <- function(lat, long, from = CRS("+init=epsg:4326"), to) {
  data = data.frame(long = long, lat = lat)
  sp::coordinates(data) <- ~ long + lat
  sp::proj4string(data) = from
  # Convert to coordinate system specified by EPSG code
  xy = data.frame(sp::spTransform(data, to))
  colnames(xy) = c("x","y")
  return(unlist(xy))
}

raster::crs(laguna)

utm_bbox <- convert_coords(lat = lat_range,
                           long = long_range,
                           to = crs(laguna))

raster::extent(laguna)

extent_zoomed <- raster::extent(utm_bbox[1], utm_bbox[2], 
                                utm_bbox[3], utm_bbox[4])h

laguna_zoom <- raster::crop(laguna, extent_zoomed)

laguna_zoom_mat <- rayshader::raster_to_matrix(laguna_zoom)

Base Map

I was inspired by the relief shading work of Eduard Imhof, Swiss cartographer and mapping visionary. In particular, I loved the blueish-pink palette that Imhof popularized. When you get to this step, try adjusting the settings below to your liking. We will continue to build on top of this initial base map layer.

base_map <- laguna_zoom_mat %>% 
  rayshader::height_shade() %>% 
  rayshader::add_overlay(
    rayshader::sphere_shade(
      laguna_zoom_mat, 
      texture = rayshader::create_texture("#f5dfca","#63372c","#dfa283","#195f67","#c2d1cf",
                                          cornercolors = c("#ffc500", "#387642", "#d27441","#296176")),
      sunangle = 0, 
      colorintensity = 5)) %>%
  rayshader::add_shadow(rayshader::lamb_shade(laguna_zoom_mat), 0.2) %>%
  rayshader::add_overlay(
    rayshader::generate_altitude_overlay(
      rayshader::height_shade(laguna_zoom_mat, texture = "#91aaba"),
      laguna_zoom_mat,
      start_transition = min(laguna_zoom_mat)-200,
      end_transition = max(laguna_zoom_mat)))

rayshader::plot_map(base_map)

OpenStreetMap

OpenStreetMap (OSM) offers an open-source, editable geographic database of the world and the underlying data includes details for roads, buildings, hiking paths, rivers, etc. We’ll leverage the osmdata package for R to import OSM data (and utilizing the overpass API). The osmdata package processes routines in C++ for fast construction and loading into R. We’ll first load several layers of OSM details. Subsequently, we’ll convert those sf objects to the coordinate system we’re working with for this rayshader project.

osm_bbox = c(long_range[1],lat_range[1], long_range[2],lat_range[2])

laguna_highway <- osmdata::opq(osm_bbox) %>% 
  osmdata::add_osm_feature("highway") %>% 
  osmdata::osmdata_sf() 

# Transform coordinates to new projection
laguna_lines <- sf::st_transform(laguna_highway$osm_lines,
                                 crs = raster::crs(laguna))

# View streets as a ggplot2 render 
ggplot(laguna_lines, aes(color = osm_id)) + 
  geom_sf() +
  theme(legend.position = "none") +
  labs(title = "Open Street Map `highway` attribute in Laguna Beach")

Layering

To begin, lets simply layer all the “highway” OSM attributes on top of our base map using white lines to represent the lines.

# Transform sf LINESTRING geometry and create semi-transparent overlay
base_map %>% 
  rayshader::add_overlay(
    rayshader::generate_line_overlay(
      laguna_lines, extent = extent_zoomed,
      linewidth = 3, color = "white",
      heightmap = laguna_zoom_mat)) %>% 
  rayshader::plot_map()

I want different styles for different OSM lines so let’s continue by creating several groups of OSM lines.

# Subset layers of laguna_lines
laguna_trails <- laguna_lines %>% 
  dplyr::filter(highway %in% c("path", "bridleway", "steps", "track"))

laguna_footpaths <- laguna_lines %>% 
  dplyr::filter(highway %in% c("footway"))

laguna_roads <- laguna_lines %>% 
  dplyr::filter(highway %in% c("unclassified", "primary", 
                               "primary_link", "secondary", 
                               "tertiary", "residential", "service"))

# Create one encompassing layer with independent element styling
trails_layer <- 
  rayshader::generate_line_overlay(
    
    # Pink footpaths
    laguna_footpaths, extent = extent_zoomed,
    linewidth = 4, color = "pink",
    heightmap = laguna_zoom_mat) %>%
  
  # Note: While barely visible in the final outputs, the following
  # code adds an offset black shadow to the white dashed lines to
  # represent the hiking trails around Laguna Beach 
  rayshader::add_overlay(
    rayshader::generate_line_overlay(
      laguna_trails, extent = extent_zoomed,
      linewidth = 4, color = "black", lty = 3, offset = c(2,-2),
      heightmap = laguna_zoom_mat)) %>%
  rayshader::add_overlay(
    rayshader::generate_line_overlay(
      laguna_trails, extent = extent_zoomed,
      linewidth = 4, color = "white", lty = 3,
      heightmap = laguna_zoom_mat)) %>%
  
  # White roads
  rayshader::add_overlay(
    rayshader::generate_line_overlay(
      laguna_roads, extent = extent_zoomed,
      linewidth = 3, color = "white",
      heightmap = laguna_zoom_mat))

We’ll create some additional projections of OSM layers.

laguna_parking <- osmdata::opq(osm_bbox) %>% 
  osmdata::add_osm_feature("parking") %>% 
  osmdata::osmdata_sf() 

laguna_building <- osmdata::opq(osm_bbox) %>% 
  osmdata::add_osm_feature("building") %>% 
  osmdata::osmdata_sf()

laguna_parking_poly <- st_transform(laguna_parking$osm_polygons, crs = crs(laguna))
laguna_building_poly <- st_transform(laguna_building$osm_polygons, crs = crs(laguna))

Final Touches

Now we’re ready to build upon our base map and see the 2D visual in action. Let’s create a polygon layer of the parking and building features, and adding the styled trails_layer on top of that.

polygon_layer <- 
  rayshader::generate_polygon_overlay(laguna_parking_poly, 
                                      extent = extent_zoomed,
                                      heightmap = laguna_zoom_mat, 
                                      palette = "grey30") %>%
  rayshader::add_overlay(
    rayshader::generate_polygon_overlay(laguna_building_poly, 
                                        extent = extent_zoomed,
                                        heightmap = laguna_zoom_mat, 
                                        palette = "lightgrey"))

base_map %>% 
  rayshader::add_overlay(polygon_layer) %>%
  rayshader::add_overlay(trails_layer) %>%
  rayshader::plot_map()

Features

To render a 3D map, we follow a very similar pipeline to the 2D map but utilizing rayshader::plot_3d(). This function introduces new arguments and I spent much more time than I had anticipated in adjusting the zscale, zoom, rotation, pitch, and water specifications.

To exaggerate the elevation details in this area, I decided on a zscale < 1 that would still resemble the reality and beauty of the Laguna Beach hills. Too low of a zscale, e.g., zscale = 0.25, was too exaggerated for my liking. Once the 3D viewer renders your visual, enter rayshader::render_snapshot() into your console to take a flat snapshot of your 3D rendering, saving your snapshot if desired.

base_map %>% 
  rayshader::add_overlay(polygon_layer) %>%
  rayshader::add_overlay(trails_layer) %>%
  rayshader::plot_3d(heightmap = laguna_zoom_mat, 
                     zscale = 0.75, fov = 0, 
                     theta = -45, zoom = 0.75, phi = 45,
                     water = TRUE, waterdepth = 4, 
                     wateralpha = 0.4, watercolor = "lightblue",
                     waterlinecolor = "white", waterlinealpha = 0.5,
                     background = "white")

# Create 2D snapshot of 3D rendering
rayshader::render_snapshot()

Next Steps

I’ve seen some neat examples where developers add 3D polygons to their maps to represent residential housing, commercial properties, and public facilities. I recently read about methods for rendering much higher-resolution maps (this would be great for printing). Creating 3D flyovers with rayshader also looks surprisingly high-end for open-source software. These are all things I hope to revisit at some point in the near future. TMW knocked it out of the park with his package and tutorials, so I hope you find his content as useful as I did.

Session Info

R version 4.1.1 (2021-08-10)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Ubuntu 20.04.3 LTS

Matrix products: default
BLAS:   /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.9.0
LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.9.0

locale:
 [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C              
 [3] LC_TIME=en_US.UTF-8        LC_COLLATE=en_US.UTF-8    
 [5] LC_MONETARY=en_US.UTF-8    LC_MESSAGES=en_US.UTF-8   
 [7] LC_PAPER=en_US.UTF-8       LC_NAME=C                 
 [9] LC_ADDRESS=C               LC_TELEPHONE=C            
[11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C       

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] ggplot2_3.3.5    dplyr_1.0.7      sf_1.0-2         osmdata_0.1.6   
[5] raster_3.4-13    sp_1.4-5         rayshader_0.26.1

loaded via a namespace (and not attached):
 [1] rgl_0.107.14       Rcpp_1.0.7         lubridate_1.7.10   lattice_0.20-44   
 [5] png_0.1-7          prettyunits_1.1.1  class_7.3-19       ps_1.6.0          
 [9] assertthat_0.2.1   rprojroot_2.0.2    digest_0.6.27      foreach_1.5.1     
[13] utf8_1.2.2         R6_2.5.1           e1071_1.7-8        httr_1.4.2        
[17] pillar_1.6.2       rlang_0.4.11       progress_1.2.2     curl_4.3.2        
[21] callr_3.7.0        magick_2.7.3       pkgdown_1.6.1      desc_1.3.0        
[25] devtools_2.4.2     rgdal_1.5-23       htmlwidgets_1.5.3  munsell_0.5.0     
[29] proxy_0.4-26       compiler_4.1.1     xfun_0.25          pkgconfig_2.0.3   
[33] pkgbuild_1.2.0     htmltools_0.5.2    tidyselect_1.1.1   tibble_3.1.4      
[37] codetools_0.2-18   fansi_0.5.0        crayon_1.4.1       withr_2.4.2       
[41] grid_4.1.1         gtable_0.3.0       jsonlite_1.7.2     lifecycle_1.0.0   
[45] DBI_1.1.1          magrittr_2.0.1     scales_1.1.1       units_0.7-2       
[49] KernSmooth_2.23-20 cli_3.0.1          cachem_1.0.6       farver_2.1.0      
[53] fs_1.5.0           remotes_2.4.0      doParallel_1.0.16  testthat_3.0.4    
[57] xml2_1.3.2         ellipsis_0.3.2     generics_0.1.0     vctrs_0.3.8       
[61] iterators_1.0.13   tools_4.1.1        rayimage_0.6.2     glue_1.4.2        
[65] purrr_0.3.4        hms_1.1.0          processx_3.5.2     pkgload_1.2.1     
[69] parallel_4.1.1     fastmap_1.1.0      colorspace_2.0-2   sessioninfo_1.1.1 
[73] classInt_0.4-3     rvest_1.0.1        memoise_2.0.0      knitr_1.33        
[77] usethis_2.0.1     

Resources

• rayshader: https://www.rayshader.com/
• rayrender: http://www.rayrender.net/
• Tyler Morgan-Wall, PhD: https://www.tylermw.com/

What is it?

Coming from a converted caret-ista, it wasn’t an easy transition to the full tidymodels framework. I liked the way caret felt, and I did almost everything with it from resampling, modeling, tuning, to model evaluation. Enter tidymodels, a framework that feels like a deconstructed caret - Each major caret feature has been enhanced and wrapped into its own package. I’ve been using this framework for roughly one year and the rate at which this ecosystem has evolved has been impressive.

tidymodels is a collection of tidy-friendly packages written with a consistent vocabulary for reproducible machine learning workflows. Its core packages include the following:

• rsample: provides infrastructure for efficient data splitting and resampling

• parsnip: a tidy, unified interface to models that can be used to try a range of models without getting bogged down in the syntactical minutiae of the underlying packages

• recipes: a tidy interface to data pre-processing tools for feature engineering

• workflows: expands the traditional model-only recipe to a much more holistic blueprint for pre-processing, modeling, post-processing, and evaluation

• tune: helps you optimize the hyperparameters of your model and pre-processing steps

• yardstick: measures the effectiveness of models using performance metrics

• broom: converts the information in common statistical R objects into user-friendly, predictable formats

• dials: creates and manages tuning parameters and parameter grids

• usemodels: a helpful way to quickly create code snippets to fit models using the tidymodels framework

  • At the time of writing this, usemodels is still in very early development (version 0.1.0.). This package follows the usethis philosophy of automating repetitive project development tasks but with a focus on modeling. usemodels helped me fully transition from the caret meta-engine to parsnip + tune + dials + more of the tidymodels framework.

• stacks: similar to usemodels, this is an early-stage package for model stacking, an ensembling method that takes the outputs of many models and combines them to generate a new model that generates predictions informed by each of its members

Irregular Grid Searches

Irregular grid searches help you tune your models by cycling through randomized hyperparameters in an effort to yield the best (or at least better) performance. I’ve been using the dials package to create Latin hypercubes which is explained below, highlighting the benefits of this space-filling design vs a purely randomized irregular grid search. Max Kuhn’s “New in tidymodels” rstudio::global event provided me with a fresh reminder about why these methods are beneficial and how they actually optimize performance.

The documentation below was copied almost entirely from Chapter 13 of Max Kuhn and Julia Silge’s Tidy Modeling with R (“TMWR”). I’ve deleted certain bits and added minimal helper comments in brackets. If you find yourself statistically programming, bootstrapping / resampling, improving model performance through grid searches, maybe even ensemble stacking, I’d highly recommend that you bookmark the TMWR book.

set.seed(10)
mlp_param %>% 
  grid_random(size = 1000) %>% # 'size' is the number of combinations
  summary()
#>   hidden_units      penalty           epochs    
#>  Min.   : 1.00   Min.   :0.0000   Min.   :  10  
#>  1st Qu.: 3.00   1st Qu.:0.0000   1st Qu.: 259  
#>  Median : 6.00   Median :0.0000   Median : 480  
#>  Mean   : 5.58   Mean   :0.0432   Mean   : 496  
#>  3rd Qu.: 8.00   3rd Qu.:0.0050   3rd Qu.: 738  
#>  Max.   :10.00   Max.   :0.9932   Max.   :1000

library(ggforce)
set.seed(200)
mlp_param %>% 
  # The 'original = FALSE' option keeps penalty in log10 units
  grid_random(size = 15, original = FALSE) %>% 
  ggplot(aes(x = .panel_x, y = .panel_y)) + 
  geom_point() +
  geom_blank() +
  facet_matrix(vars(hidden_units, penalty, epochs), layer.diag = 2) + 
  labs(title = "Random design with 15 candidates")

set.seed(200)
mlp_param %>% 
  grid_latin_hypercube(size = 15, original = FALSE) %>% 
  ggplot(aes(x = .panel_x, y = .panel_y)) + 
  geom_point() +
  geom_blank() +
  facet_matrix(vars(hidden_units, penalty, epochs), layer.diag = 2) + 
  labs(title = "Latin Hypercube design with 15 candidates")

usemodels

In the spirit of sharing useful tips, tricks, and packages, I’d like to introduce you to Max Kuhn’s usemodels package. If you’re on the fence about adopting the tidymodels framework, this package is definitely for you. Even for experienced users, usemodels is an excellent way to quickly generate boilerplate code snippets that are algorithm-specific. This package is not yet on CRAN, so install it using the following:

# Installing usemodels from its GitHub repo
devtools::install_github("tidymodels/usemodels")

Given a simple formula and a data set, the use_* functions can create code that is appropriate for the data (given the model). [Note: The model formula will be in the form of y ~ a + b + c or y ~ . if you plan on including all available variables in your model.]

For example, using the palmerpenguins data with a glmnet model:

library(usemodels)
library(palmerpenguins)
data(penguins)
use_glmnet(body_mass_g ~ ., data = penguins)

# NOTE: The below will be printed in your console with your model recipe and tailored
# with the required pre-processing steps given your algorithm of choice (in this case,
# glmnet). The `usemodels` output also provides the code structure for a reproducible 
# workflow, made possible with the `workflows` package. Should you choose to tune
# your model, `usemodels` also provides code snippets for producing a grid of parameter
# combinations to use with your hyperparameter tuning grid search.

glmnet_recipe <- 
  recipe(formula = body_mass_g ~ ., data = penguins) %>% 
  step_novel(all_nominal(), -all_outcomes()) %>% 
  step_dummy(all_nominal(), -all_outcomes()) %>% 
  step_zv(all_predictors()) %>% 
  step_normalize(all_predictors(), -all_nominal()) 

glmnet_spec <- 
  linear_reg(penalty = tune(), mixture = tune()) %>% 
  set_mode("regression") %>% 
  set_engine("glmnet") 

glmnet_workflow <- 
  workflow() %>% 
  add_recipe(glmnet_recipe) %>% 
  add_model(glmnet_spec) 

glmnet_grid <- tidyr::crossing(penalty = 10^seq(-6, -1, length.out = 20), mixture = c(0.05, 
    0.2, 0.4, 0.6, 0.8, 1)) 

glmnet_tune <- 
  tune_grid(glmnet_workflow, resamples = stop("add your rsample object"), grid = glmnet_grid)

As of today’s date, this package includes templates available with the following code: use_cubist, use_earth, use_glmnet, use_kknn, use_ranger, and use_xgboost

stacks