Dynamic UI

Published by onesixx on 17-09-1817-09-18

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

ui	server
uiOuput	renderUI
uiOuput	InsertUI/ RemoveUI
ConditionalPanel
Use JavaScript		웹페이지에서 직접 수정
useShinyjs		ex) hide/show , toggle

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"),	selected="2"),
      "radioButtons" = radioButtons("dynamic", "Dynamic", choices=c("Opt1"="1", "Opt2"="2"),	selected="2"),
      "selectInput"  = selectInput("dynamic", "Dynamic", choices=c("Opt1"="1", "Opt2"="2"),	selected="2"),
      "Multi-select" = selectInput("dynamic", "Dynamic", choices=c("Opt1"="1", "Opt2"="2"),	selected=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)

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

renderUI (uiOutput)

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

ex> SideBar내 select Input 간 Dynamic

Tab 간 Dynamic

Dynamic UI (with renderUI & outputUI)

Example app: Dynamic user interface

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

renderUI sweetalertR

onesixx

Shiny

the condition has length > 1 and only the first element will be used

Shiny

Reset renderPlot

Shiny

Promise

Dynamic UI

dynamic UI 생성방법 5가지

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

renderUI (uiOutput)

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

ex> SideBar내 select Input 간 Dynamic

Tab 간 Dynamic

Dynamic UI (with renderUI & outputUI)

Example app: Dynamic user interface

ex> BC Liquor Store data (bcl-data)

renderUI sweetalertR

onesixx

Related Posts