Shiny reactive :: Action Button

Published by onesixx on

https://shiny.rstudio.com/articles/action-buttons.html

 

  •  observeEvent()  : 코드블럭을 trigger 함. 
      (with reactiveValues) : 상호작용하는 여러 action button에 대해 Object를 저장하는 역할 
  •  eventReactive() : 계산된 ouput을 update한다. 

Pattern 0 – 기본

actionButton("buttonID", "Label 버튼명")

ui.R

fluidPage(
    titlePanel("Action Button"),

    sidebarPanel( actionButton("button_id","click Me") ),
    mainPanel(verbatimTextOutput("text_val") )
)

server.R

server<-function(input, output,session){
    output$text_val <- renderPrint({ input$button_id })
}

 

Pattern 1 – Command  w/ observeEvent()

server.R에서 Input$buttonID 값은 Click할때마다 1씩 증가하여  상태(state)를 변경한다. 
다른 Shiny Widget과 달리 Action Button은 Reactive programming의  observeEvent() 를 활용하여, 
reactive value를 모니터링하다가 state변경(Click)시에   observeEvent() 의 두번째 argument를 실행한다. 
* observeEvent()는 어떤값이 들어오는지는 상관없다.  

ui.R

fluidPage(
    tags$head(tags$script(src = "js/message-handler.js")),

    sidebarPanel( actionButton("button_id","click Me") )
)

server.R

function(input, output,session){
    observeEvent(input$button_id,{
        session$sendCustomMessage(type = 'testmessage',
            message = 'Good Job fro pressing button'
        )
    })
}

www/ js/ message-handler.js

Shiny.addCustomMessageHandler("testmessage",
  function(message) {
    alert(JSON.stringify(message));
  }
);

 

Pattern 2 – Delay reactions w/ eventReactive()

eventReactive() 는 첫번째 인수의 reactive 값을 모니터링하고,  두번째 인수를 isolate하고 있다가,
state변경시, 해당 reactive expression을   렌더링에  사용한다.  
 *  eventReactive() 는 버튼이 Click되기전까지는 Null을 return한다. 결과적으로 그래프는 나타나지 않는다. 

ui.R

fluidPage(
    sidebarPanel( 
        numericInput("num_id", "seed NO.", 50),
        actionButton("button_id","Go!") 
    ),
    mainPanel(
        plotOutput("plot_id",height="300px")
    )
)

server.R

function(input, output,session){
    ev <- eventReactive(input$button_id, {
        runif(input$num_id) # random Number from uniform  num_id
    })
    output$plot_id <- renderPlot({
        hist(ev())
    })

 

Pattern 3 – Dueling  

1) buttons

하나의 Object을 조정하는 여러개의 action buttons이 있는경우,    reactiveValues()와 함께 observeEvent() 를 활용하면 서로 버튼끼리 경합을 시킬수 있다
 reactiveValues() 는 reactive values object를 생성한다. 이 값은 input 값과는 달리, 이런 값들은 프로그램적으로 변경이 가능하다. 
각 버튼의 값은  observeEvent()으로 모니터링하고, 각 call은  reactiveValues() 에서 만들어진 값의 내용을 update한다. 

ui.R

fluidPage(
    sidebarPanel( 
        actionButton("button_01_id","Uniform"), 
        actionButton("button_02_id","Normal") 
    ),
    mainPanel(
        plotOutput("plot_id", height="300px")
    )
)

server.R

function(input, output,session){
    rv <- reactiveValues(data = NULL)
    
    observeEvent(input$button_01_id, { 
        rv$data <- runif(100)
    })
    observeEvent(input$button_02_id, {
        rv$data <- rnorm(100)
    })  
    
    output$plot_id <- renderPlot({
        if (is.null(rv$data)) return()
        hist(rv$data)
    })
}

 

2) Reset buttons

ui.R

fluidPage(
    sidebarPanel( 
        actionButton("button_id","Uniform"), 
        actionButton("reset_id", "Reset") 
    ),
    mainPanel(
        plotOutput("plot_id", height="300px")
    )
)

server.R

function(input, output,session){
    rv <- reactiveValues(data = NULL)
    
    observeEvent(input$button_id, { 
        rv$data <- runif(100)
    })
    observeEvent(input$reset_id, {
        rv$data <- NULL
    })  
    
    output$plot_id <- renderPlot({
        if (is.null(rv$data)) return()
        hist(rv$data)
    })
}

 

3) Reset on tab

아래 요소들은 tabPanel을 사용해 메뉴/탭을 만드는데,   observeEvent() 으로 메뉴/탭 이동을 모니터링하여 Reset되도록 만든다. 

  • navbarPage()
  • navlistPanel()
  • tabsetPanel()

reactive Value를 하나 만들어 놓고, tabsetPanel이 변경되면 False로 만들고, ActionButton과 함께 모니터링한다.

ui.R

fluidPage(
    sidebarLayout(
        sidebarPanel(
            tabsetPanel(id="tabset_id",
                tabPanel("Uniform",
                    numericInput("uniCount_id", "Count", 100),
                    sliderInput("uniSlider_id", "Range",
                        min=-100, max=100, value=c(-10, 10))),
                tabPanel("Normal",
                    numericInput("normCount_id", "Count", 100),
                    numericInput("normMean_id",  "Mean",    0),
                    numericInput("normSd_id",    "Std Dev", 1) )),
            actionButton("button_id", "Plot")
        ),
        mainPanel(
            plotOutput("plot_id")
        )
    )
)

server.R

function(input, output, session){
    rv <- reactiveValues(doPlot=FALSE)
    observeEvent(input$button_id, {
        # 0 coerced to FALSE else TRUE
        rv$doPlot <- input$button_id
    })
    observeEvent(input$tabset_id, {
        rv$doPlot <- FALSE
    })  
    
    output$plot_id <- renderPlot({
        if(rv$doPlot==FALSE) return()
        isolate({
            data <- if(input$tabset_id=="Uniform") {
                runif(input$uniCount_id, input$uniSlider_id[1], input$uniSlider_id[2])
            }else{
                rnorm(input$normCount_id, input$normMean_id, input$normSd_id)
            }
            hist(data)
        })
    })
}

 

Categories: Shiny

onesixx

Blog Owner

Leave a Reply

Your email address will not be published.