---
GA: UA-159972578-2
---
###### tags: `R` `Shiny` `Visualization` `Report` `資料視覺化`
# ShinyApp介紹
Reference from <i class="fa fa-book fa-fw"></i> [Building Web Applications with Shiny in R](https://learn.datacamp.com/courses/building-web-applications-with-shiny-in-r).
![](https://i.imgur.com/8Tu5XTW.png)
View another note on <i class="fa fa-book fa-fw"></i> [Shiny Dashboard](https://hackmd.io/@ritatang242/HyfyCZpQI).
Example
---
```{r}
ui = fluidPage({
...
})
server = function(input, output, session{
...
}
shinyApp(ui, server)
```
* * *
Special Packages
---
- Plotly
- plotlyOutput()
- renderPlotly({})
```{r}
# 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({})
```{r}
# 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({})
```{r}
# 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 <i class="fa fa-book fa-fw"></i> [Leaflet套件介紹與範例](https://rpubs.com/RitaTang/leaflet)
```{r}
# 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()
```{r}
mutate(ingredient = forcats::fct_reorder(ingredient, tf_idf))
```
UI
---
### Example
```{r}
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](http://shinyapps.dreamrs.fr/shinyWidgets/)
### 1. Siderbar
+ Text
```{r}
textInput('name', 'label')
```
+ Single Select
```{r}
selectInput('name', 'label', choices = c('M','F'), selected = 'M')
```
+ Slider
```{r}
sliderInput('name', 'label', min = 0, max = 10, value = 1, step = 2)
```
+ Date Range
```{r}
dateRangeInput('name', 'label', start = "2010-01-01", end = "2019-12-01")
```
+ Checkbox
```{r}
checkboxGroupInput('name', 'label', choices = c('Maybe', 'Yes', 'No'), selected = 'Maybe')
```
+ Drop down Picker
```{r}
pickerInput('name', 'label', choices = c("Don't Know", "No", "Yes"), multiple = FALSE)
```
+ actionButton
```{r}
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
```{r}
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
```{r}
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
```{r}
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.
```{r}
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.
```{r}
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.
```{r}
observeEvent(input$button_name, {
showModal(modalDialog(text, title = 'About'))
})
```
### 2. Other Tools
+ observe
+ Add an observer to display notifications
```{r}
observe({
showNotification(
paste('You have entered the name', input$name)
)
})
```
+ validate
+ Add validation that user selected a input
```{r}
output$age <- renderPlot({
validate(
need(input$mental_vs_physical != 0, 'Please select an input for mental versus physical health.') # condition, label
)
...
})
```
+ dplyr::count
```{r}
count(ingredient, name = 'nb_recipes') # equals to: group_by(ingredient) %>% summarise(nb_recipes = n())
```