Previous chapter
Preparation ExercisePreparation Exercise
Next chapter

Preparation Exercise

Exploring NYTimes with Shiny

  • The NY Times has a number of useful and interesting APIs that will let you explore more than 150 years of articles, editiorals, and everything else. For this exercise we will specifically use the Archive API to pull headlines from user specified dates in history.
  • To access this or any of the other API keys you will need to register with the NY Times at https://developer.nytimes.com/accounts/create.
  • Make sure that you register for the Archive API and not one of the other options.
  • Your API key will be limited to at most 5 requests / sec and 1000 requests / day - we shouldn’t get anywhere near those limits but accidentally making a large number of requests in a short period of time can get your key blocked.

Task 1: Get Data From NYTimes

A function is provided for this task: get_nyt_archive.R Note: The overall structure of the data is consistent over time but some of the value and formatting are not.

Below you can find the source code of the function:

library(magrittr)
library(dplyr)
library(lubridate)

# Tested with get_nyt_archive(2018, 6, 1)
get_nyt_archive <- function(year, month, day, api_key ="0QuaDiZzYlPXE7wtwOFqtCdVi8IsMh6M")
{
  year = as.integer(year)
  month = as.integer(month)
  day = as.integer(day)
  
  stopifnot(!any(is.na(c(year,month,day))))
  stopifnot(year >= 1851)
  stopifnot(month >= 1 & month <= 12)
  stopifnot(day >= 1 & day <= 31)
  
  url = sprintf(
    "https://api.nytimes.com/svc/archive/v1/%d/%d.json?api-key=%s",
    year,month, api_key
  )
  
  date = paste(year, month, day, sep="/") %>% ymd()
  
  d = jsonlite::fromJSON(url,flatten = TRUE)$response$docs
  res = d %>%
    select(web_url,snippet, print_page, multimedia,
           pub_date, headline = headline.main) %>% 
    mutate(headline = stringi::stri_trans_totitle(headline))
  
  # optional: filter by date, print_page
  #   %>% filter(ymd_hms(pub_date) == date, print_page == 1L)
  
  stopifnot(is.data.frame(res))
  res
}

Task 2: Shiny Front End

Create an app that allows the user to select a year, month and day and view the headlines from that day. Your app should have the following features:

  • The user should be able to specify year, month, and day in a sidebar panel. Default value should be set to your birth year, month, and day.
  • The user should be able to supply their own API key, you are welcome to hard code your API key as the default value for this field.
  • The main panel should contain a neatly organzied and well formated list of front page NY Times headlines from the specified date.
  • The user should be able to click on any of the headlines (or attached UI element) and have a modal dialog box pop up that contains the title and first paragraph of the article as well as a link to the full article on nytimes.com.
  • You can get fancy and include any relevant multimedia links in the modal dialog box.

Template

For the front-end you can use template in the code below or download here.

library(shiny)
library(jsonlite)
library(dplyr)
library(lubridate)
library(stringi)

source("get_nyt_archive.R")

ui <- 
  
  
server <-
  
  
runApp(ui, server)

Module table

To have a nice table rendering in place you can also use the tableWithSelect module below or download here:

# A module that renders a datatable from the DT package.
#
# The server function returns a reactive expression that reflects
# when a user clicks on a row. If `reset`, then the selection is
# cleared as soon as it is registered with the server (i.e. the
# row doesn't stay highlighted in the UI).

tableWithSelectUI <- function(id) {
  ns <- NS(id)
  
  DT::dataTableOutput(ns("table"))
}

#' @param input,output,session Automatically provided by Shiny
#' @param dataset A reactive expression that returns a data frame
#' @param reset If TRUE (the default), clears the selection immediately
#' @param ... Additional arguments to DT::datatable
#' @return A reactive expression that returns the selected row index
tableWithSelect <- function(input, output, session, dataset, reset = TRUE, ...) {
  output$table <- DT::renderDataTable({
    DT::datatable(dataset(), selection = "single", ...)
  })

  if (reset) {
    observeEvent(input$table_rows_selected, {
      # Clear selection
      DT::dataTableProxy("table") %>% selectRows(NULL)
    })
  }
  
  reactive(req(input$table_rows_selected))
}

Solution

Solution

app.R

  • You can also download the code here.
library(shiny)
library(jsonlite)
library(dplyr)
library(lubridate)
library(stringi)

source("get_nyt_archive.R")
source("table_with_select.R")

ui <- fluidPage(
  titlePanel("NYTimes app"),
  
  sidebarLayout(
    # Sidebar with a slider input
    sidebarPanel(
      dateInput("birthdate", label = "Birthdate", value = as.Date("2000-01-01"))
    ),
    
    # Show a plot of the generated distribution
    mainPanel(
      tableWithSelectUI("tableselect")
    )
  )
)
  
  
server <- function(input, output, session) {
  dataset <- reactive({
    get_nyt_archive(year(input$birthdate), month(input$birthdate), day(input$birthdate))
  })
  
  selection <- callModule(tableWithSelect, "tableselect", dataset, cols = c("headline", "snippet"))
  
  observe({
    rownum <- selection()
    url <- dataset()[rownum, "web_url"]

    showModal(modalDialog(
      title = "Important message",
      fluidPage(
        titlePanel(dataset()[rownum, "headline"]),
        mainPanel(
          fluidRow(dataset()[rownum, "snippet"]),
          fluidRow(a(url, href=url, target="_blank"))
        )
      )
    ))
  })
}
  
shinyApp(ui, server)

table_with_select.R

  • The code for table_with_select.R has been slightly modified to allow for column selections.
  • You can also download the code here.
tableWithSelect <- function(input, output, session, dataset, cols = NULL, reset = TRUE, ...) {
  output$table <- DT::renderDataTable({
    if (is.null(cols)) {
      DT::datatable(dataset(), selection = "single", ...)
    } else {
      DT::datatable(dataset()[, cols, drop = FALSE], selection = "single", ...)
    }
  })

  if (reset) {
    observeEvent(input$table_rows_selected, {
      # Clear selection
      DT::dataTableProxy("table") %>% DT::selectRows(NULL)
    })
  }
  
  reactive(req(input$table_rows_selected))
}