Dynamic UI

http://onesixx.com/shiny-cheat-sheet-link-ui-with-the-server-renderand-output/
http://zevross.com/blog/2016/04/19/r-powered-web-applications-with-shiny-a-tutorial-and-cheat-sheet-with-40-example-apps/  

dynamic UI 생성방법 5가지

사용자 Input에 따라 반응하는 UI 만들기

https://shiny.rstudio.com/articles/dynamic-ui.html

•  conditionalPanel ()
  ui.R 에서  정의하는 conditionalPanel()은 dynamic하게  shown/hidden할 UI요소들 묶어서 조건에 따라 반응한다.
•  renderUI () function
   server.R 에서 정의하는 renderUI()는   ui.R의 uiOutput()와 같이 사용하며,
  reactive을 이용하여 UI함수가 호출되도록 만들어 놓고, Input에 따라 reactive가 반응할때,   UI에서 미리 정의해 놓은 결과를  보여준다.
•  insertUI() 와 removeUI()
    server.R 에서 정의하는 insertUI()는
  allow you to add and remove arbitrary chunks of UI code (all independent from one another), as many times as you want, whenever you want, wherever you want.
• Use JavaScript
  to modify the webpage directly.
• shinyjs
  hide/show , toggle

renderUI (uiOutput)

example01 : http://shiny.rstudio.com/gallery/dynamic-ui.html

library(shiny)
# UI -----------------------------------------------------------------
ui <- basicPage(
  tags$h3("DynamicUI Using uiOutput & renderUI", style="color:blue;"),
  
  radioButtons(inputId="radio", "Choose one:", width="100%", inline=T,
               choiceNames  = list("KOREA", "America"),
               choiceValues = list("kor", "us"),
               selected = "kor"),
  
  tags$h4("Where do you wanna go?"),
  uiOutput("city")
)
# Server -----------------------------------------------------------------
server <- function(input, output, session){
 
  reative_rdo <- reactive(input$radio)
  output$city <- renderUI({
    reative_rdo()
    select_nation   <- isolate(input$radio)
    switch(select_nation,
      "kor"= {selectInput("myselect", "Choose City:", choices=c("Seoul", "Pusan"))},
      "us" = {selectInput("myselect", "Choose City:", choices=c("NewYork", "san francisco"))}
    )
  })
    
}

shinyApp(ui, server)

library(shiny)

ui <- fluidPage(
  titlePanel("Dynamically generated UI components"),
  sidebarPanel(
    selectInput("sel_inputType", "Input type",
      choices=c("slider", "text", "numeric",
                "checkbox", "checkboxGroup",
                "radioButtons", "selectInput", "Multi-select",
                "date", "daterange")),
    uiOutput("ui")
  ),
  mainPanel(
    fluidRow(
      column(12,
        tags$p("Input type:"),
          verbatimTextOutput("txtInputType"),
        tags$p("Dynamic input value:"),
          verbatimTextOutput("dynamic_value")
      )
    )
  )
)

server <- function(input, output, session) {
  output$ui <- renderUI({
    if (is.null(input$sel_inputType)) return()
    switch(input$sel_inputType,
      "slider"       = sliderInput("dynamic", "Dynamic", min=1, max=20, value=10),
      "text"         = textInput("dynamic", "Dynamic", value="starting value"),
      "numeric"      = numericInput("dynamic", "Dynamic", value=12),
      "checkbox"     = checkboxInput("dynamic", "Dynamic", value=TRUE),
      "checkboxGroup"= checkboxGroupInput("dynamic", "Dynamic", choices=c("Opt1"="1", "Opt2"="2"),\tselected="2"),
      "radioButtons" = radioButtons("dynamic", "Dynamic", choices=c("Opt1"="1", "Opt2"="2"),\tselected="2"),
      "selectInput"  = selectInput("dynamic", "Dynamic", choices=c("Opt1"="1", "Opt2"="2"),\tselected="2"),
      "Multi-select" = selectInput("dynamic", "Dynamic", choices=c("Opt1"="1", "Opt2"="2"),\tselected=c("1","2"), multiple=T),
      "date"         = dateInput("dynamic", "Dynamic"),
      "daterange"    = dateRangeInput("dynamic", "Dynamic")
    )
  })
  
  output$txtInputType <- renderText({
    input$sel_inputType
  })
  
  output$dynamic_value <- renderPrint({
    str(input$dynamic)
  })
}

shinyApp(ui, server)

ex> SideBar내 select Input 간 Dynamic

UI에서 하나의 object의 결과가 다른 object에 영향을 줄 때,  (즉 UI에서 Object의 property가 Dynamic하게 변경될 때) ui.R에서해당 updateComponent로UI컨트롤을 변경하는 것이 아니라, uiOutput()으로 위치만 정의하고,
server.R에서 정의와 처리를 동시에 한다.

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("dataset1", "Dataset:", choices=c("iris", "mtcars")),
      uiOutput("var_vx"),     #selectInput("vx", "X:", choices=NULL),
      uiOutput("var_vy")      #selectInput("vy", "Y:", choices=NULL)
    ),
    mainPanel(
      plotOutput("p")
    )
  )
)

server <- function(input, output, session){
  var <- reactive({ 
    switch(input$dataset1, "iris"=names(iris), "mtcars"=names(mtcars)) 
  })
  
  output$var_vx <- renderUI({
    varX <- var()
    selectInput("vx", "X:", choices=varX)
  })
  output$var_vy <- renderUI({
    varY <- var()
    selectInput("vy", "Y:", choices=varY)
  })
  
  output$p <- renderPlot({
    get(input$dataset1) %>% ggplot(aes(x=get(input$vx), y=get(input$vy))) +
                              geom_point(size=3, shape=1, alpha=0.5) +
                              labs(x=input$vx, y=input$vy)
  })
}

shinyApp(ui, server)

Tab 간 Dynamic

Dynamic UI (with renderUI & outputUI)

If you want to return a block of UI elements – say a paragraph,
then a text box and a selector – you would use renderUI and uiOutput(outputUI) and instead of returning one object,
you return a list or tagList of objects (these functions can be used interchangeably).

Example app: Dynamic user interface

하나의 Object를 return받는 것 대신, Object의 list를 return한다.
아래 예에서,  my_output_UI output 은  h4 header and a selector의 list 이다.

The selector gets updated when the user clicks on the button (note observeEvent).
Each time the user clicks the button the selections gets updated.

library(shiny)

# initial selections---------------------------------------------
init_env01  <- function(){
    env <- new.env()
    env$city <- c("Seoul", "Pusan")         # initial value
    return(env)
}
env <- init_env01()

# UI -----------------------------------------------------------------
ui <- basicPage(
    tags$h3("DynamicUI Using uiOutput & renderUI", style="color:blue;"),
    
    uiOutput("my_output_UI"),           # Server에서 처리 
    
    textInput("mytext", "add cities:"),
    actionButton("mybutton", "Click to add to cities")
)

# Server -----------------------------------------------------------------
server <- function(input, output, session){
    # return a list of UI elements
    output$my_output_UI <- renderUI({
        list(
            tags$h4("My selection list"),
            selectInput("myselect", "", choices=env$city)
        )
    })    
    # update the selection list. "<<-"
    observeEvent(input$mybutton,{
        env$city <<- c(input$mytext, env$city)
        updateSelectInput(session, "myselect", choices=env$city, selected=env$city[1])
    })
}

shinyApp(ui, server)

Without uiOutput, renderUI

library(shiny)
# initial selections---------------------------------------------
init_env01  <- function(){
    env <- new.env()
    env$city <- c("Seoul", "Pusan")         # initial value
    return(env)
}
env <- init_env01()
# UI -----------------------------------------------------------------
ui <- basicPage(
    tags$h3("DynamicUI Using uiOutput & renderUI", style="color:blue;"),
    
    tags$h4("Where do you wanna go?"),
    selectInput("myselect", "Choose City:", choices=env$city),
    
    textInput("mytext", "add cities:"),
    actionButton("mybutton", "Click to add to cities")
)
# Server -----------------------------------------------------------------
server <- function(input, output, session){
    # update the selection list. "<<-"
    observeEvent(input$mybutton,{
        env$city <<- c(input$mytext, env$city)
        updateSelectInput(session, "myselect", choices=env$city, selected=env$city[1])
    })
}

shinyApp(ui, server)

ex> BC Liquor Store data (bcl-data)

https://www.r-bloggers.com/building-shiny-apps-an-interactive-tutorial/
https://stackoverflow.com/questions/37092002/creating-reactive-renderui

library(shiny)
library(ggplot2)
library(dplyr)

# ********************************************************************** ----
# * Data                                                                 ----
# ********************************************************************** ---
#bcl <- read.csv("bcl-data.csv", stringsAsFactors = FALSE)

rawDataUrl <- "http://pub.data.gov.bc.ca/datasets/176284/BC_Liquor_Store_Product_Price_List.csv"
bcl <- read.csv(rawDataUrl, stringsAsFactors = FALSE)
products <- c("BEER", "REFRESHMENT BEVERAGE", "SPIRITS", "WINE")

bcl <- dplyr::filter(bcl, PRODUCT_CLASS_NAME %in% products) %>%
          dplyr::select(PRODUCT_CLASS_NAME, 
                        PRODUCT_MINOR_CLASS_NAME, 
                        PRODUCT_LONG_NAME,
                        PRODUCT_COUNTRY_ORIGIN_NAME, 
                        PRODUCT_ALCOHOL_PERCENT, 
                        CURRENT_DISPLAY_PRICE,
                        SWEETNESS_CODE) %>%
              rename(Type           = PRODUCT_CLASS_NAME,
                     Subtype        = PRODUCT_MINOR_CLASS_NAME,
                     Name           = PRODUCT_LONG_NAME,
                     Country        = PRODUCT_COUNTRY_ORIGIN_NAME,
                     Alcohol_Content= PRODUCT_ALCOHOL_PERCENT,
                     Price          = CURRENT_DISPLAY_PRICE,
                     Sweetness      = SWEETNESS_CODE)
bcl$Type <- sub("^REFRESHMENT BEVERAGE$", "REFRESHMENT", bcl$Type)
bcl %>% head

# ********************************************************************** ----
# * ui                                                                   ----
# ********************************************************************** ---
ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      sliderInput( "I_sld_price","Price",        min=0, max=100, value=c(25, 40), pre="$" ),
      radioButtons("I_rdo_type", "Product type", choices=c("BEER","REFRESHMENT","SPIRITS","WINE"), selected="BEER"),
      uiOutput("O_dync_country")
    ),
    mainPanel(
      plotOutput( "O_plot_result"), br(),br(),
      tableOutput("O_tbl_result")
    )
  )
)
# ********************************************************************** ----
# * Server                                                               ---
# ********************************************************************** ---
server <- function(input, output, session) {
  react_filteredForCountry <- reactive({
    bcl %>% filter( Price >= input$I_sld_price[1],
                    Price <= input$I_sld_price[2],
                    Type  == input$I_rdo_type)
  })
  
  output$O_dync_country <- renderUI({
    dd <- react_filteredForCountry()
    if (!is.null(dd)) {
      selectInput("I_select_country", "Country", sort(unique(dd$Country)), selected="CANADA")
    }
  })
  
  react_filteredFull <- reactive({
    if (is.null(input$I_select_country)){ 
      return(react_filteredForCountry()) 
    }else{
      bcl %>% filter( Price >= input$I_sld_price[1],
                      Price <= input$I_sld_price[2],
                      Type  == input$I_rdo_type,
                      Country == input$I_select_country)
    }
  })
  
  output$O_plot_result <- renderPlot({
    if (!is.null(react_filteredFull())){ 
      react_filteredFull() %>% 
        ggplot(aes(x=Alcohol_Content)) + geom_histogram(binwidth=0.05)
    }else{
      return() 
    }
  })
  
  output$O_tbl_result <- renderTable({
    react_filteredFull()
  })
}

shinyApp(ui, server)

renderUI sweetalertR

library(sweetalertR)

server <- function(input, output, session) {
  output$sweetalertTrue <- renderUI({
    tagList(
      sweetalert(selector = "#AButton",
                 title = "Are you sure?",
                 text = "Too many Data.",
                 type = "warning",
                 showCancelButton = TRUE,
                 confirmButtonColor = '#DD6B55',
                 confirmButtonText = 'Yes, Load it!',
                 cancelButtonText = "No, cancel!",
                 closeOnConfirm = TRUE,
                 closeOnCancel = FALSE,
                 evalFunction = 'function(isConfirm){
                           if (isConfirm){
                           Shiny.onInputChange("loadWarning",Math.random());
                           } else {
                           swal("Cancelled", "Change date range and try again.", "error");
                           }}')
    )
  })
}

ui <- basicPage(
  actionButton("AButton", "Load Data"),
  htmlOutput("sweetalertTrue")
  #uiOutput("sweetalertTrue")
)

shinyApp(ui, server)