class: center, middle, inverse, title-slide # Interactive Visualization ## Shiny 1 ### Dave Armstrong ### May 27, 2020 --- # shiny Shiny is an R package that - allows you to build web-based applications directly from R - uses the R code that you write to build a webpage that talks to a shiny server --- # the basics A shiny app has two basic parts: - the **.purple[user interface]** (UI) is what defines and lays out the user-facing content of the app. - the **.purple[server]** defines what calculations are done on the server and what objects will be returned to the UI and in what formats. .pull-left[.full-width[ 1. open a new R-script document, 2. type `shinyApp` and hit the tab key to get a template. ]] .pull-right[.full-width[ <img src="shinyapp.gif" width="400" height="200"> ]] --- # shiny app skeleton ```r library(shiny) ui <- fluidPage( ) server <- function(input, output, session) { } shinyApp(ui, server) ``` You could (and probably will for "real" problems) put the server code in one file and the ui code in a different one. --- # planning You'll want to plan out a few things before you start. - what do ou want the app to show people? - what inputs need to exist to make that happen? These two things will help you build the UI. - The server file also needs to be specified, but those --- # ui layout Inside the `fluidPage` function, you could specify the traditional: - `sidebarLayout` - `sidebarPanel()` - `mainPanel()` - `fluidRow` for each row, and within each row - `column()` designations, where the first argument is the width. Normally, the widths of all columns add to 12. --- # app skeleton with `sidebarLayout` ```r library(shiny) ui <- fluidPage( * sidebarLayout( * sidebarPanel( * * ), * mainPanel( * * ) * ) ) server <- function(input, output, session) { } shinyApp(ui, server) ``` --- # first app - number of histogram bins First, let's plan what we'll need: **.purple[UI:]** - Input: number of bins. - Output: histogram **.purple[Server:]** - Create/get data - Make histogram using input number of bins. --- # types of inputs Lots of options (a nice gallery is [here](https://shiny.rstudio.com/tutorial/written-tutorial/lesson3/)) - Buttons: `actionButton`, `submitButton` - Binary/Categorical: `checkboxInput`, `checkboxGroupInput`, `radioButtons` - Dates: `dateInput`, `dateRangeInput` - Files: `fileInput` - Numbers: `numericInput`, `sliderInput`, - Selection from Choice: `selectInput` - Text: `textInput` We need the number of bins, so we will use ... -- `numericInput()` --- # adding inputs to ui ```r library(shiny) ui <- fluidPage( sidebarLayout( sidebarPanel( * numericInput( * inputId="nbins", * label="Number of Bins", * value=10, * min=4, * max=30, * width='100px') ), mainPanel( ) ) ) server <- function(input, output, session) { } shinyApp(ui, server) ``` --- # server-side calculations We have to make or get data. We'll make it with `rnorm()`. ```r library(shiny) ui <- fluidPage( sidebarLayout( sidebarPanel( numericInput( inputId="nbins", label="Number of Bins", value=10, min=4, max=30, width='100px') ), mainPanel( ) ) ) server <- function(input, output, session) { * x <- rnorm(100) } shinyApp(ui, server) ``` --- # writing functions in R Your workspace (where all the objects you make are stored), is labeled in RStudio as .purple[Global Environment]. - .purple[Environments] in R are self-contained "buckets" for objects - functions, data, models, etc... Functions in R create their own environments (that is, they are self-contained). - Functions have can see all of the elements of their parent environments (i.e., the environment from which they were spawned), but not the other way around. - Unless explicitly done (rarely a good idea), a function doesn't over-write a value in its parent environment. Functions are defined in R by the `function()` function (maybe "the function() function" should be a new Schoolhouse Rocks song). --- # example ```r x <- 1 fun <- function(number){ x <- number } fun(3) x ``` ``` ## [1] 1 ``` --- # arguments Functions take arguments, generally of a few different types - - formula (like a linear model): `y ~ x + z` - character string (often the name of a variable in data): `"polity2"` - logical: `TRUE` or `FALSE` (can be abbreviated by `T` or `F`, but shouldn't be) - vector: a number of a group of numbers often times the values of a variable. - data: a data frame or similar. Default values of a function are specified with an `=` in the function definition. For example: ```r fun <- function(n=3){ n+4 } ``` Here, the default for `n` is 3. If no alternative value is specified the function will use 3. - If not default is specified, the function fails if no value is given. --- # output functions How do we send objects back to the UI? Add them to the `output` object. - `renderDataTable` render a DataTable - `renderImage` render images from an external source (not plots made and printed directly from R) - `renderPlot` render plots made and printed directly from R - `renderPrint` render any printed object output. - `renderTable` render data frame-like structures - `renderText` render character strings - `renderUI` render elements for the UI. We need to output a plot, so we'll use ... -- `renderPlot()` --- # render plot in server ```r library(shiny) *library(ggplot2) ui <- fluidPage( sidebarLayout( sidebarPanel( numericInput( inputId="nbins", label="Number of Bins", value=10, min=4, max=30, width='100px') ), mainPanel( ) ) ) server <- function(input, output, session) { x <- rnorm(100) * output$histo <- renderPlot( * ggplot(mapping=aes(x=x)) + * geom_histogram(bins=input$nbins) + * theme_minimal() ) } shinyApp(ui, server) ``` --- # including output in UI All of the `render*` functions also have `*output` functions that includes rendered output in the UI. For example: - `dataTableOutput` - `htmlOutput` - `imageOutput` - `plotOutput` - `tableOutput` - `textOutput` - `uiOutput` - `verbatimTextOutput` We have a plot so we'll use ... -- `plotOutput()` --- # include rendered plot in ui ```r library(shiny) library(ggplot2) ui <- fluidPage( sidebarLayout( sidebarPanel( numericInput( inputId="nbins", label="Number of Bins", value=10, min=4, max=30, width='100px') ), mainPanel( * plotOutput( * "histo", * width="100%" * ) ) ) ) server <- function(input, output, session) { x <- rnorm(n=100) output$histo <- renderPlot( ggplot(mapping=aes(x=x)) + geom_histogram(bins=input$nbins) + theme_minimal() ) } shinyApp(ui, server) ``` --- # run the app Opening the app and clicking the <img src="run_app.png", height="25px"> button will run the app. You should see something like this: <center> <img src="app01-full.png" width="600px" height="300px"> </center> --- # your turn! Add an input that changes the number of observations drawn in the normal distribution.
03
:
00
--- # reactive contexts - add to UI: ```r numericInput( inputId = "nObs", label = "Number of Observations", value=100, min=25, max=1000, step=25 ) ``` - server is: ```r x <- rnorm(input$nObs) output$histo <- renderPlot( ggplot(mapping=aes(x=x)) + geom_histogram(bins=input$nbins) + theme_minimal() ) ``` -- ``` .getReactiveEnvironment()$currentContext() : Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.) ``` --- # reactive contexts 2 Whenever you use an element from the `input` object, it must be in a "reactive" context. - reactive contexts are those that look to see when inputs are updated and then re-evaluate the expressions within upon update. - All of the `render*` functions are reactive. - `eventReactive()`, `reactive()` and `reactiveValues()` respond to changing events, too. - `observeEvent()` also responds to inputs, but doesn't itself make a reactive object. -- Advice: if you only need it once, put it in the `render*` function, otherwise make it its own reactive object. --- # fixed server function ```r server <- function(input, output, session) { output$histo <- renderPlot({ * x <- rnorm(input$nObs) ggplot(mapping=aes(x=x)) + geom_histogram(bins=input$nbins) + theme_minimal() }) } ``` or ```r server <- function(input, output, session) { * x <- reactive({ * rnorm(input$nObs) * }) output$histo <- renderPlot({ * ggplot(mapping=aes(x=x())) + geom_histogram(bins=input$nbins) + theme_minimal() }) } ``` --- # Break
15
:
00
--- # categorical inputs What if we wanted to be able to change the distribution that generates the data? - Uniform(-3,3) - `\(\chi_3^{2}\)` - Normal(0,1) - `\(F_{2,10}\)` This is a categorical input, so we will use ... -- Not as clear here, we could use `radioButtons` or `selectInput`. --- # `radioButton` - Add to ui: ```r radioButtons( inputId = "dist", label = "Distribution", choices = c("Normal"="norm", "Chi-squared(3)"="chi2", "F(2,10)" = "fdist", "Uniform(-3,3)" = "unif")) ) ``` - Replace the definition of `x` in the server with: ```r x <- switch(input$dist, "norm" = rnorm(input$nObs), "chi2" = rchisq(input$nObs, 3), "fdist" = rf(input$nObs, 2, 10), "unif" = runif(input$nObs, -3,3)) ``` --- # You try it! Add two things to the app as it stands now. 1. A line that gives the theoretical density of the distribution. - hint: in `ggplot()`, `y = ..density..` will plot densities instead of frequencies. - hint: we used `rnorm()`, `rchisq()`, `rf()` and `runif()` above to make the data, the `dnorm(x)`, `dchisq(x, 3)`, `df(x, 2,10)` and `dunif(x,-3,3)` functions give the PDF of the distribution evaluated at `\(x\)`. 2. Add an element to the UI that allows you to turn the line on and off.
10
:
00
--- # updating x My server function: ```r output$histo <- renderPlot({ x <- switch(input$dist, "norm" = rnorm(input$nObs), "chi2" = rchisq(input$nObs, 3), "fdist" = rf(input$nObs, 2, 10), "unif" = runif(input$nObs, -3,3)) s <- seq(min(x), max(x), length=250) y.theoretical <- switch(input$dist, "norm" = dnorm(s), "chi2" = dchisq(s, 3), "fdist" = df(s, 2, 10), "unif" = dunif(s, -3,3)) g <- ggplot() + geom_histogram(aes(x=x, y=..density..), bins=input$nbins) + theme_minimal() if(input$lineOn){ g <- g + geom_line(aes(x=s, y = y.theoretical), col="red") } g }) ``` Everything inside `renderPlot()` updates if **any** input changes. --- # alternative Using `reactive()` to generate `x`, means that `x` will only change if `nObs` or `dist` changes in the input object. ```r x <- reactive({ x <- switch(input$dist, "norm" = rnorm(input$nObs), "chi2" = rchisq(input$nObs, 3), "fdist" = rf(input$nObs, 2, 10), "unif" = runif(input$nObs, -3,3)) s <- seq(min(x), max(x), length=250) y.theoretical <- switch(input$dist, "norm" = dnorm(s), "chi2" = dchisq(s, 3), "fdist" = df(s, 2, 10), "unif" = dunif(s, -3,3)) list(x=x, s=s, y.theoretical=y.theoretical) }) output$histo <- renderPlot({ g <- ggplot() + geom_histogram(aes(x=x()$x, y=..density..), bins=input$nbins) + theme_minimal() if(input$lineOn){ g <- g + geom_line(aes(x=x()$s, y = x()$y.theoretical), col="red") } g }) ``` --- # covid dashboard Let's go back to the COVID dashboard that we put together. - Now that we're using shiny, we can use the `{shinydashboard}` package to make nice looking dashboards with shiny. - Note, we could also includ shiny elements in a `flexdashboard` environment, but the `{shinydashboard}` package is more in keeping with the general format of shiny apps. The COVID Dashboard that we put together before is coded into this framework in the file `01-covid-dashboard.r` file in the `04-cov-shinydashboard` folder. - We will do it without the linked data first. --- # ui ```r library(shinydashboard) library(plotly) library(htmltools) source("../full_height_box.r") ui <- dashboardPage( dashboardHeader(title="COVID-19 Dashboard"), dashboardSidebar(), dashboardBody( fluidRow( column(width=7, * box(id="map-container", title="Map of COVID-19 Cases", plotlyOutput("map"), width=NULL) ), column(width=5, box(title="COVID-19 Cases by Republican Vote", plotlyOutput("scatter"), width=NULL), box(title="Data", DT::dataTableOutput("tab"), width=NULL) ) ) ), * full_height_box("map-container", "map"), ) ``` --- # server ```r [data processing ...] output$map <- renderPlotly({ plot_ly(tmp, split = ~ text, color = ~log(cases), alpha = 1, hoverinfo="text", hoveron="fill", showlegend=FALSE) }) output$scatter <- renderPlotly({ plot_ly(tmp, x=~repvote, y=~cases, width="100%", type="scatter", height=300) %>% add_markers() %>% layout(xaxis=list(title="Republican Vote"), yaxis=list(title="Number of COVID-19 Cases")) }) output$tab <- DT::renderDataTable({ tmp %>% datatable(extensions="Scroller", class="compact", colnames = c("County", "State", "# Cases", "Republican\nVote"), rownames=FALSE, options = list(paging=FALSE, pageLength = 20, scrollY = "350px", columnDefs = list(list(className = 'dt-center', targets = 0:3), list(visible=FALSE, targets=c(4,5))))) %>% formatRound(columns = "repvote", digits=0) }) ``` --- # adding some more interactivity We know how the dashboard works now and also how shiny works, let's add in a selector that lets you choose the state. - One way to do this is to specify all of the choices (i.e., write them out by hand). This way is ... - cumbersome - error-prone - did I mention, cumbersome already? That said, let's see how it would work if we just gave people the choice of a few states - Maine, Maryland, Michigan, Wisconsin (let's say). --- # ui ```r ui <- dashboardPage( dashboardHeader(title="COVID-19 Dashboard"), dashboardSidebar( * selectInput( * inputId = "inpState", * label = "Choose a State", * choices=c("Maine", "Maryland", "Michigan", "Wisconsin"), * width="200px") ), dashboardBody( fluidRow( column(width=7, box(id="map-container", title="Map of COVID-19 Cases", plotlyOutput("map"), width=NULL) ), column(width=5, box(title="COVID-19 Cases by Republican Vote", plotlyOutput("scatter"), width=NULL), box(title="Data", DT::dataTableOutput("tab"), width=NULL) ) ) ), full_height_box("map-container", "map"), ) ``` --- # server ```r * tmp <- reactive({counties_covid %>% filter(state == input$inpState) %>% select(NAMELSAD, st, cases, repvote, geometry) %>% mutate(text = paste(NAMELSAD, "\n", cases, " cases", sep=""), repvote = repvote*100) * }) output$map <- renderPlotly({ * plot_ly(tmp(), split = ~ text, color = ~log(cases), alpha = 1, hoverinfo="text", hoveron="fill", showlegend=FALSE) }) output$scatter <- renderPlotly({ * plot_ly(tmp(), x=~repvote, y=~cases, width="100%", type="scatter", height=300) %>% add_markers() %>% layout(xaxis=list(title="Republican Vote"), yaxis=list(title="Number of COVID-19 Cases")) }) output$tab <- DT::renderDataTable({ * tmp() %>% datatable(extensions="Scroller", class="compact", colnames = c("County", "State", "# Cases", "Republican\nVote"), rownames=FALSE, options = list(paging=FALSE, pageLength = 20, scrollY = "350px", columnDefs = list(list(className = 'dt-center', targets = 0:3), list(visible=FALSE, targets=c(4,5))))) %>% formatRound(columns = "repvote", digits=0) }) ``` --- # getting choices from data We can get the data from the choices, though we have to add this to the server: ```r output$state_selector <- renderUI({ chc <- sort(unique(na.omit(counties_covid$state))) selectInput( inputId = "inpState", label = "Choose a State", choices = chc ) }) ``` And in the ui, we replace this: ```r selectInput( inputId = "inpState", label = "Choose a State", choices=c("Maine", "Maryland", "Michigan", "Wisconsin"), width="200px") ``` with this: ```r uiOutput("state_selector") ``` --- # Your Turn! Time for you to work on a bigger project. In the `05-country-app` folder, there is a dataset called `country` that's saved in the `country.rda` file. You can load the data with the `load()` function. I want you to make an app that 1. makes a scatter plot of two variables, 2. allows you to specify variables for each axis 3. allows you to specify variables for the color and size of the points. 4. animates the plot by year. Hints on the next slide ...
30
:
00
--- # hints 1. `sapply(country, function(x)attr(x, "label"))` will return a named vector of values where the variable's descriptive label is the entry and the "name" attached to each entry is the variable name. This could help with some choices. 2. Using `req(input$x)` at the top of a reactive function will prevent the function from running if `input$x` is `NULL`, `NA`, `""` or otherwise non-existant. 3. The `plot_ly()` function doesn't take string inputs for variable names. For example, `plot_ly(country, x="polity2", y="unemploy")` doesn't work. Instead, you could do the following: ```r args <- list( x = country[[input$x]], y = country[[input$y]] type="scatter", mode="markers") do.call(plot_ly, args) ``` --- # tabs and navigation What if we wanted to put the plots in one tab and the data in another. - add inside `sidebarMenu()`: ```r menuItem("Plots", tabName = "plots", icon = icon("image")), menuItem("Data", tabName = "data", iicon = icon("table")) ``` - add inside `dashboardBody()` ```r tabItems( tabItem(tabName = "data", [plot output] ), tabItem(tabName = "data", [data output] ) ) ``` Look at the dashboard. --- # music review app: tabsets/navigation Make a music reviews app that - plot average review over time by critic (year-month or year) - compares selected critics with a statistical model. - conducts a sentiment analysis and plots average sentiment by average rating per critic over time. --- # planning Think about ... - what are the specific inputs and outputs you want? - how do you structure the app? - what can be done ahead of time and what must be done in reaction to the data?
05
:
00
--- # app ui Build the UI for the app. Leave the server blank for now and put placeholders for the outputs.
15
:
00
--- # server 1 Make the plot of average review over time by critic.
10
:
00
--- # server 2 Make the model that compares the selected critics.
10
:
00
--- # semtiment analysis Make the sentiment analysis (there is good introduction [here](https://www.tidytextmining.com/sentiment.html)).
15
:
00
--- # work on own app Now, I want you to try some of these things out on your own data.