tags: R Shiny Visualization Report 資料視覺化

ShinyApp介紹

Reference from Building Web Applications with Shiny in R.

View another note on Shiny Dashboard.

Example

ui = fluidPage({
    ...
})

server = function(input, output, session{
    ...
}

shinyApp(ui, server)

---

Special Packages

• Plotly
  • plotlyOutput()
  • renderPlotly({})

# ui
plotly::plotlyOutput('plot_top_ingredients')

# server
output$plot_top_ingredients <- plotly::renderPlotly({
    rval_top_ingredients() %>% # reactive conductor
      ggplot(aes(x = ingredient, y = tf_idf)) +
      geom_col() +
      coord_flip()
})

• DT
  • DTOutput()
  • renderDT({})

# ui
DT::DTOutput('dt_top_ingredients')

# server
output$dt_top_ingredients <- DT::renderDT({
    recipes %>% 
      filter(cuisine == input$cuisine) %>% 
      count(ingredient, name = 'nb_recipes') %>% 
      arrange(desc(nb_recipes)) %>% 
      head(input$nb_ingredients)
})

• d3wordcloud
  • d3wordcloudOutput()
  • renderD3wordcloud({})

# ui
d3wordcloud::d3wordcloudOutput('wc_ingredients')

# server
output$wc_ingredients = d3wordcloud::renderD3wordcloud({
    df = rval_top_ingredients()
    d3wordcloud(words = df$ingredient, 
                freqs = df$nb_recipes, 
                tooltip = TRUE) # 類似plotly的互動標籤功能
})

• Leaflet (地圖)
  • leafletOutput()
  • renderLeaflet({})
  • Read More on Leaflet套件介紹與範例

# ui
leaflet::leafletOutput('map', height = '100%', width = '100%')

# server
leaftlet() %>%
    addTiles() %>% 
    setView(lng = -98.58, lat = 39.82, zoom = 5) %>% # 經度, 緯度, 放大幾次
    addTiles() %>% # 加上一層圖層
    addCircleMarkers( # 可設定經緯度標出地點, e.g.lng = nasa_fireball$lon
        popup = ~ summary, radius = ~ fatalities, # 彈出視窗, 圓半徑
        fillColor = 'red', color = 'red', weight = 1, # 邊框粗細
        label = nasa_fireball$date # 移到點上會顯示發生日期
      )

• forcats
  • fct_reorder()

mutate(ingredient = forcats::fct_reorder(ingredient, tf_idf))

UI

Example

ui <- fluidPage(
  titlePanel("My app"),
  theme = shinythemes::shinytheme("superhero"),
  sidebarLayout(
    sidebarPanel(
      selectInput('state', 'Choose a U.S. state', choises = unique(usa_ufo_sightings$state))
      dateRangeInput('date', 'Choose a data range', start = '1920-01-01', end = '2014-12-31')
    ),
    mainPanel(
      tabsetPanel(
        tabPanel('Plot', plotly::plotlyOutput('plot_trendy_names')),
        tabPanel('Table', DT::DTOutput('table_trendy_names'))
      )
    )
  )
)

Reference：Shiny Widget

1. Siderbar

• Text

textInput('name', 'label')

• Single Select

selectInput('name', 'label', choices = c('M','F'), selected = 'M')

• Slider

sliderInput('name', 'label', min = 0, max = 10, value = 1, step = 2)

• Date Range

dateRangeInput('name', 'label', start = "2010-01-01", end = "2019-12-01")

• Checkbox

checkboxGroupInput('name', 'label', choices = c('Maybe', 'Yes', 'No'), selected = 'Maybe')

• Drop down Picker

pickerInput('name', 'label', choices = c("Don't Know", "No", "Yes"), multiple = FALSE)

• actionButton

actionButton('button_name', 'Click Me!')

2. Theme

• shinythemes::shinytheme()
  • Valid themes are:
  • cerulean, cosmo, cyborg, darkly, flatly, journal, lumen, paper, readable, sandstone, simplex, slate, spacelab, superhero, united, yeti

theme = shinythemes::shinytheme('simplex')

• bootstrapPage
  • tag is used to set CSS

bootstrapPage(
    absolutePanel(top = 10, right = 10, id = 'controls', # 方匡之間沒有margin
      sliderInput(...),
      ...
    )
    tags$style(type = "text/css", "
        html, body {width:100%;height:100%}     
        #controls{background-color:white;padding:20px;} 
      ") # 設定controls(absolute panel)的style
    )
)

---

Server

Example

server <- function(input, output) {
  output$shapes <- renderPlot({
    usa_ufo_sightings %>%
      filter(
        state == input$state,
        date_sighted >= input$dates[1],
        date_sighted <= input$dates[2],
        mental_health_consequence %in% input$mental_health_consequence,
      ) %>%
      ggplot(aes(shape)) +
      geom_bar() +
      labs(x = "Shape", y = "# Sighted")
  })

  output$duration_table <- renderTable({
    usa_ufo_sightings %>%
      filter(
        state == input$state,
        date_sighted >= input$dates[1],
        date_sighted <= input$dates[2]
      ) %>%
      group_by(shape) %>%
      summarize(
        nb_sighted = n(),
        avg_duration_min = mean(duration_sec) / 60,
        median_duration_min = median(duration_sec) / 60,
        min_duration_min = min(duration_sec) / 60,
        max_duration_min = max(duration_sec) / 60
      )
  })
}

1. Reactive Programming

• Reactive Source
  • SelectInput
  • TextInput
  • etc.
• Reactive Endpoint
  • tableOutput
  • plotOutput
  • etc.
• Reactive Conductor

rval_bmi = reactive({input$weight/(input$height^2)})
# 在output裡面呼叫需加上括號：rval_bmi()

• isolate
  • Is used to prevent a reaction and NOT trigger it.
  • It allows an expression to read a reactive value without triggering re-execution when its value changes.
  • The text output updates only when user changes the height or weight, and NOT the name.

bmi <- rval_bmi()
isolate(paste("Hi", input$name, ". Your BMI is", round(bmi, 1)))

• eventReactive
  • Is used to create a calculated value that only updates in response to an event.
  • Use eventReactive to delay the execution of computing BMI until the user clicks on the button.

rval_bmi <- eventReactive(input$show_bmi, { # show_bmi is the button name
    input$weight/(input$height^2)
  })

• observeEvent
  • Is used to perform an action in response to an event.

observeEvent(input$button_name, {
    showModal(modalDialog(text, title = 'About'))
}) 

2. Other Tools

• observe
  • Add an observer to display notifications

observe({
    showNotification(
      paste('You have entered the name', input$name)
    )
  })

• validate
  • Add validation that user selected a input

  output$age <- renderPlot({
    validate(
      need(input$mental_vs_physical != 0, 'Please select an input for mental versus physical health.') # condition, label
    )
    ...
  })

• dplyr::count

count(ingredient, name = 'nb_recipes') # equals to: group_by(ingredient) %>% summarise(nb_recipes = n())