library(shiny)
data(movies, package = "jrYr")

Introduction to Shiny

Shiny

Task

Create a new R markdown document

File -> New File -> R markdown

Code chunks

```r
# R code
```

Chunk options

echo

```r
# R code
```

eval

```r
# R code
```

Combining

```r
# R code
```

Shiny in R markdown

\noindent---
title: "First app"
runtime: shiny
---

Input: control widgets

Input: control widgets

Select box

selectInput(inputId = "movie_type", # unique id
            label = "Movie genre", # Text for web
            choices = c("romance", "action", "thriller"),
            selected = "action")

Slider

sliderInput(inputId = "movie_rating",
            label = "Movie rating",
            min = 0, max = 10, value = 5)

Numeric input

numericInput(inputId = "movie_length",
             label = "Movie length",
             min = 1, max = 330, value = 100)

Widgets

1) http://shiny.rstudio.com/gallery/widget-gallery.html

Rendered outputs

Rendered output

Function | Output type ---------|------------ renderPlot() | R graphics output renderPrint() | printed output renderTable() | Data frame, matrix renderText() | Character vectors

Example: movies

renderText(input$movie_type)

Example: movies

renderText({
  type = movies[, input$movie_type] == 1
  nrow(movies[type, ])
})

Or

renderPlot({
  type = movies[, input$movie_type] == 1
  hist(movies[type, ]$length)
})

Task

In the previous task we created a selectInput() to let the user choose a movie classification

selectInput(inputId = "movie_type",
            label = "Movie classification",
            choices = c("U", "PG", "12A", "15", "18"),
            selected = "12A")
data(movies, package = "jrYr")
pg_movies = movies[movies$classification == "PG", ]
nrow(pg_movies)

Reactive programming

Problem

This is inefficient

renderText({
  type = movies[, input$movie_type] == 1
  nrow(movies[type, ])
})

renderPlot({
  type = movies[, input$movie_type] == 1
  hist(movies[type, ]$length)
})

Solution: reactiveValues()

rvs = reactiveValues(data = movies)

Solution: observe()

observe({
    type = movies[, input$movie_type] == 1
    rvs$data = movies[type, ]
})

Solution

rvs = reactiveValues(data = movies)

observe({
  type = movies[, input$movie_type] == 1
  rvs$data = movies[type, ]
})

renderText({
  nrow(rvs$data)
})

renderPlot({
  hist(rvs$data$length)
})

Problem

Problem

We may not want the app to update every time we change an input

Solution: observeEvent(), actionButton()

rvs = reactiveValues(data = movies)

actionButton("plot_button", "Plot it now!!!")

observeEvent(input$plot, {
  type = movies[, input$movie_type] == 1
  rvs$data = movies[type, ]
})

renderPlot({
  hist(rvs$data$length)
})

htmlwidgets

The plotly package

library("ggplot2")
data(movies, package = "jrYr")
g = ggplot(movies, aes(x = length, y = rating)) +
  geom_point()
g

The plotly package

library("plotly")
ggplotly(g)

Shiny and plotly

library("ggplot2")
library("plotly")
data(movies, package = "jrYr")
selectInput(inputId = "movie_type",
            label = "Movie genre",
            choices = c("romance", "action", "thriller"))
rvs = reactiveValues(data = movies)

observe({
  type = movies[, input$movie_type] == 1
  rvs$data = movies[type, ]
})

renderPlotly({
  ggplotly(ggplot(rvs$data, aes(x = length)) +
    geom_histogram())
})

Interactive tables with DT

library("DT")
datatable(movies)

Interactive tables with DT

library("ggplot2")
library("plotly")
library("DT")
data(movies, package = "jrYr")
selectInput(inputId = "movie_type",
            label = "Movie genre",
            choices = c("romance", "action", "thriller"))
rvs = reactiveValues(data = movies)
observeEvent(input$movie_type, {
  rvs$data = movies[movies[, input$movie_type] == 1, ]
})
renderDataTable({
  datatable(rvs$data[, 1:5])
})

A shiny app

The ui.R file

library("shiny")
fluidPage(
  titlePanel("Shiny happy people"), #title
  ## Sidebar with a slider input for no. of points
  sidebarLayout(
    sidebarPanel(
      selectInput(inputId = "movie_type", # unique id
                  label = "Movie genre", # Text for web
                  choices = c("romance", "action", "thriller"),
                  selected = "action")
    ),
    ## Show a plot of the generated distribution
    mainPanel(plotOutput("scatter"))
  )
)

The server.R file

library("shiny")
data(movies, package = "jrYr")

# Function always has input & output
function(input, output) {
  rvs = reactiveValues(data = movies)

  observeEvent(input$movie_type, {
    rvs$data = movies[movies[, input$movie_type] == 1, ]
  })

  output$scatter = renderPlot({
    plot(x = rvs$data$duration, y = rvs$data$rating)
  })

}

Output objects

Output function | creates ----------------|--------- htmlOutput | raw HTML imageOutput | image plotOutput | plot tableOutput | table textOutput | text uiOutput | raw HTML verbatimTextOutput | text

The fluidPage function

fluidPage(
  titlePanel("Title panel"), # Title
  ## Sidebar style
  sidebarLayout(
    sidebarPanel("The sidebar"),
    mainPanel("Main panel")
  )
)

sidebarLayout: swap sides

sidebarLayout(position = "right",
  sidebarPanel("The sidebar"),
  mainPanel("Main panel")
)

sidebarLayout

sidebarLayout(
  sidebarPanel("The sidebar", p("Choose an option")),
  mainPanel("Main panel")
)

Layout

ui = fluidPage(
  titlePanel("I love movies"), #Title
  fluidRow(# Define a row
    column(4, # Two columns: width 4 & 8
           wellPanel(
             selectInput("movie_type", label = "Movie genre",
                         c("Romance", "Action", "Animation"))
           )
     ),
    column(8, plotOutput("scatter"))
  )
)


jr-packages/jrYr documentation built on Dec. 18, 2019, 4:43 a.m.