Building Web App with Shiny in R - Day 2

Building Web App with Shiny in R - Day 2

출처

https://www.datacamp.com/courses/building-web-applications-in-r-with-shiny (Building Web Applications in R with Shiny, DataCamp, Mine Cetinkaya-Rundel)

참고자료

https://www.rstudio.com/resources/cheatsheets/ (Rstudio Cheat Sheets)

https://shiny.rstudio.com/ (Shiny homepage)

Building Web App with Shiny in R - Day 2.

Loading packages

require(shiny)

## Loading required package: shiny

require(shinythemes)

## Loading required package: shinythemes

require(tidyverse)

## Loading required package: tidyverse

## ─ Attaching packages ────────────────────────────────────── tidyverse 1.2.1 ─

## ✔ ggplot2 2.2.1     ✔ purrr   0.2.5
## ✔ tibble  1.4.2     ✔ dplyr   0.7.5
## ✔ tidyr   0.8.1     ✔ stringr 1.3.0
## ✔ readr   1.1.1     ✔ forcats 0.3.0

## ─ Conflicts ─────────────────────────────────────── tidyverse_conflicts() ─
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()

require(DT)

## Loading required package: DT

## 
## Attaching package: 'DT'

## The following objects are masked from 'package:shiny':
## 
##     dataTableOutput, renderDataTable

require(tools)

## Loading required package: tools

Loading datasets

load(url("http://s3.amazonaws.com/assets.datacamp.com/production/course_4850/datasets/movies.Rdata"))
movies_codebook <- read_csv("http://s3.amazonaws.com/assets.datacamp.com/production/course_4850/datasets/movies_codebook.csv")

## Parsed with column specification:
## cols(
##   Column = col_integer(),
##   `Variable name` = col_character(),
##   Description = col_character()
## )

calculating some values

min_date <- min(movies$thtr_rel_date)
max_date <- max(movies$thtr_rel_date)

UI

ui - nested R functions that assemble an HTML user interface for the app.

ui <- navbarPage(
  title = "Pages",
  
  ## Main Page
  tabPanel(
    "Main Page",
    fluidPage(
      
      titlePanel("Movie browser, 1970 - 2014", windowTitle = "Movies"),
      
      sidebarLayout(
        
        sidebarPanel(
          
          h3("Plotting"),
          
          selectInput(
            inputId = "y", 
            label = "Y-axis:",
            choices = c("IMDB rating" = "imdb_rating", 
                        "IMDB number of votes" = "imdb_num_votes", 
                        "Critics Score" = "critics_score",
                        "Audience Score" = "audience_score", 
                        "Runtime" = "runtime"), 
            selected = "audience_score"),
          selectInput(
            inputId = "x", 
            label = "X-axis:",
            choices = c("IMDB rating" = "imdb_rating", 
                        "IMDB number of votes" = "imdb_num_votes", 
                        "Critics Score" = "critics_score", 
                        "Audience Score" = "audience_score", 
                        "Runtime" = "runtime"), 
            selected = "critics_score"),
          
          textInput(
            inputId = "plot_title", 
            label = "Plot title", 
            placeholder = "Enter text to be used as plot title"),
          
          hr(),
          h3("Subsetting"),
          
          checkboxGroupInput(
            inputId = "selected_type",
            label = "Select movie type(s):",
            choices = c("Documentary", "Feature Film", "TV Movie"),
            selected = "Feature Film"),
          
          hr(),
          
          checkboxInput(
            inputId = "show_data",
            label = "Show data table",
            value = TRUE),
          
          br(), br(),
          
          h5("Built with",
             img(
               src = "https://www.rstudio.com/wp-content/uploads/2014/04/shiny.png", height = "30px"),
             "by",
             img(
               src = "https://www.rstudio.com/wp-content/uploads/2014/07/RStudio-Logo-Blue-Gray.png",
               height = "30px"),
             ".")
          ),
        
        mainPanel(
          tabsetPanel(
            type = "tabs",
            id = "tabsetpanel",
            
            tabPanel(
              title = "Plot", 
              plotOutput(outputId = "scatterplot"),
              
              br(),
              
              h5(textOutput("description"))),
            
            tabPanel(
              title = "Data", 
              br(),
              DT::dataTableOutput(outputId = "moviestable")),
            
            tabPanel(
              "Codebook", 
              br(),
              dataTableOutput(outputId = "codebook"))
            )
          )
        )
      )
    ),
  
  ## Date page
  tabPanel(
    "Date page",
    fluidPage(
      sidebarLayout(
        
        sidebarPanel(
          HTML(
            paste0(
              "Movies released between the following dates will be plotted. Pick dates between ",
              min_date, " and ", max_date, ".")),
          
          br(), br(),
          
          dateRangeInput(
            inputId = "date",
            label = "Select dates:",
            start = "2013-01-01", end = "2014-01-01",
            min = min_date, max = max_date,
            startview = "year")
          ),
        mainPanel(
          plotOutput(outputId = "scatterplot2")
          )
        )
      )
    ),
  
  ## Hover page
  tabPanel(
    "Hover page",
    fluidPage(
      
      br(),
      
      sidebarLayout(
        sidebarPanel(
          selectInput(
            inputId = "y2",
            label = "Y-axis:",
            choices = c("imdb_rating", "imdb_num_votes",
                        "critics_score", "audience_score", "runtime"),
            selected = "audience_score"),
          selectInput(
            inputId = "x2",
            label = "X-axis:",
            choices = c("imdb_rating", "imdb_num_votes",
                        "critics_score", "audience_score", "runtime"),
            selected = "critics_score")
          ),
        
        mainPanel(
          plotOutput(
            outputId = "scatterplot3",
            hover = "plot_hover"),
          dataTableOutput(
            outputId = "moviestable3"),
          br()
          )
        )
      )
    ),
  
  ## Brush page
  tabPanel(
    "Brush page",
    fluidPage(
      br(),
      
      sidebarLayout(
        sidebarPanel(
          selectInput(
            inputId = "y4",
            label = "Y-axis:",
            choices = c("imdb_rating", "imdb_num_votes",
                        "critics_score", "audience_score", "runtime"),
            selected = "audience_score"),
          selectInput(
            inputId = "x4",
            label = "X-axis:",
            choices = c("imdb_rating", "imdb_num_votes",
                        "critics_score", "audience_score", "runtime"),
            selected = "critics_score")
          ),
        
        mainPanel(
          plotOutput(
            outputId = "scatterplot4",
            brush = "plot_brush"),
          dataTableOutput(outputId = "moviestable4"),
          br()
          )
        )
      )
    )
  )

Server

server - a function with instructions on how to build and rebuild the R objects displayed in the UI

server <- function(input, output, session) {
  
  ## Main page
  movies_selected <- reactive({
    req(input$selected_type)
    filter(movies, title_type %in% input$selected_type)
    })
  
  x <- reactive({ toTitleCase(str_replace_all(input$x, "_", " ")) })
  y <- reactive({ toTitleCase(str_replace_all(input$y, "_", " ")) })
  
  output$scatterplot <- renderPlot({
    ggplot(data = movies_selected(), aes_string(x = input$x, y = input$y)) +
      geom_point() +
      labs(x = x(),
           y = y(),
           color = toTitleCase(str_replace_all(input$z, "_", " ")),
           title = toTitleCase(input$plot_title))
  })
  
  output$description <- renderText({
    paste("The plot above shows the relationship between",
          x(),
          "and",
          y(),
          "for",
          nrow(movies_selected()),
          "movies.")
  })
  
  output$moviestable <- DT::renderDataTable(
    DT::datatable(data = movies_selected()[, 1:6], 
                  options = list(pageLength = 10), 
                  rownames = FALSE)
  )
  
  observeEvent(input$show_data, {
    if(input$show_data){
      showTab(inputId = "tabsetpanel", target = "Data", select = TRUE)
    } else {
      hideTab(inputId = "tabsetpanel", target = "Data")
    }
  })
  
  output$codebook <- renderDataTable({
    datatable(data = movies_codebook,
              options = list(pageLength = 10, lengthMenu = c(10, 25, 40)), 
              rownames = FALSE)
  })
  
  ## Date Page
  output$scatterplot2 <- renderPlot({
    req(input$date)
    movies_selected_date <- movies %>%
      filter(thtr_rel_date >= as.POSIXct(input$date[1]) & thtr_rel_date <= as.POSIXct(input$date[2]))
    ggplot(data = movies_selected_date, aes(x = critics_score, y = audience_score, color = mpaa_rating)) +
      geom_point()
  })
  
  ## Hover Page
  output$scatterplot3 <- renderPlot({
    ggplot(data = movies, aes_string(x = input$x2, y = input$y2)) +
      geom_point()
  })
  
  output$moviestable3 <- DT::renderDataTable({
    nearPoints(movies, coordinfo = input$plot_hover) %>% 
      select(title, audience_score, critics_score)
  })
  
  ## Brush Page
  output$scatterplot4 <- renderPlot({
    ggplot(data = movies, aes_string(x = input$x4, y = input$y4)) +
      geom_point()
  })
  
  output$moviestable4 <- DT::renderDataTable({
    brushedPoints(movies, brush = input$plot_brush) %>% 
      select(title, audience_score, critics_score)
  })
}

Combining

shinyApp(ui = ui, server = server)

Shiny applications not supported in static R Markdown documents

Result

Main Page

Date Page

Hover Page

Brush Page