--- 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()) ```