Update reactive object with two actionbuttons in a shiny app

Question

I have the shiny app below in which the user uploads a file (here I just put the dt in a reactive function) and from there he can choose which columns he wants to display as selectInput() via a pickerInput(). Then he should be able to click on Update and see the table.

The user should also be able to update the value1 values by multiplying all of them with the numericInput() value1 and create a new sliderInput() and therefore update the dataframe that is displayed in the table as well. These changes should be applied only when the user clicks on Update2 actionbutton.

The problem is that dataframe should basically be affected by 2 actionbuttons and Im not sure that can be applied. The Update2 will work only when the numericInput() value1 is used.

library(shiny)
library(shinyWidgets)
library(DT)
# ui object

ui <- fluidPage(
    titlePanel(p("Spatial app", style = "color:#3474A7")),
    sidebarLayout(
        sidebarPanel(
            uiOutput("inputp1"),
            #Add the output for new pickers
            uiOutput("pickers"),
            actionButton("button", "Update")
        ),
        
        mainPanel(
            DTOutput("table"),
            numericInput("num", label = ("value"), value = 1),
            actionButton("button2", "Update 2")
            
        )
    )
)

# server()
server <- function(input, output, session) {
    DF1 <- reactiveValues(data=NULL)
    
    dt <- reactive({
        name<-c("John","Jack","Bill")
        value1<-c(2,4,6)
        dt<-data.frame(name,value1)
    })
    
    observe({
        DF1$data <- dt()
    })
    
    output$inputp1 <- renderUI({
        pickerInput(
            inputId = "p1",
            label = "Select Column headers",
            choices = colnames( dt()),
            multiple = TRUE,
            options = list(`actions-box` = TRUE)
        )
    })
    
    observeEvent(input$p1, {
        #Create the new pickers
        output$pickers<-renderUI({
            dt1 <- DF1$data
            div(lapply(input$p1, function(x){
                if (is.numeric(dt1[[x]])) {
                    sliderInput(inputId=x, label=x, min=min(dt1[[x]]), max=max(dt1[[x]]), value=c(min(dt1[[x]]),max(dt1[[x]])))
                }else { # if (is.factor(dt1[[x]])) {
                    selectInput(
                        inputId = x,       # The col name of selected column
                        label = x,         # The col label of selected column
                        choices = dt1[,x], # all rows of selected column
                        multiple = TRUE
                    )
                }
                
            }))
        })
    })
    
    
    dt2 <- eventReactive(input$button, {
        req(input$num)
        dt <- DF1$data ## here you can provide the user input data read inside this observeEvent or recently modified data DF1$data
        dt$value1<-dt$value1*isolate(input$num)
        
        dt
    })
    observe({DF1$data <- dt2()})
    
    output_table <- reactive({
        req(input$p1, sapply(input$p1, function(x) input[[x]]))
        dt_part <- dt2()
        for (colname in input$p1) {
            if (is.factor(dt_part[[colname]]) && !is.null(input[[colname]])) {
                dt_part <- subset(dt_part, dt_part[[colname]] %in% input[[colname]])
            } else {
                if (!is.null(input[[colname]][[1]])) {
                    dt_part <- subset(dt_part, (dt_part[[colname]] >= input[[colname]][[1]]) & dt_part[[colname]] <= input[[colname]][[2]])
                }
            }
        }
        dt_part
    })
    
    output$table<-renderDT({
        output_table()
    })
    
}

# shinyApp()
shinyApp(ui = ui, server = server)

YBS YBS · Accepted Answer · 2020-09-10T13:36:08

Sometimes, I am not clear if you are referring to value1 as a variable name in your data frame or numericInput value. Perhaps you are looking for this.

library(shiny)
library(shinyWidgets)
library(DT)
# ui object

ui <- fluidPage(
  titlePanel(p("Spatial app", style = "color:#3474A7")),
  sidebarLayout(
    sidebarPanel(
      uiOutput("inputp1"),
      #Add the output for new pickers
      actionButton("button", "Update"),
      uiOutput("pickers"),
      numericInput("num", label = ("value"), value = 1),
      actionButton("button2", "Update 2")
    ),
    
    mainPanel(
      DTOutput("table")
     
      
    )
  )
)

# server()
server <- function(input, output, session) {
  DF1 <- reactiveValues(data=NULL)
  
  dt <- reactive({
    name<-c("John","Jack","Bill")
    value1<-c(2,4,6)
    dt<-data.frame(name,value1)
  })
  
  observe({
    DF1$data <- dt()
  })
  
  output$inputp1 <- renderUI({
    pickerInput(
      inputId = "p1",
      label = "Select Column headers",
      choices = colnames( dt()),
      multiple = TRUE,
      options = list(`actions-box` = TRUE)
    )
  })
  
  observeEvent(input$p1, {
    #Create the new pickers
    output$pickers<-renderUI({
      dt1 <- DF1$data
      div(lapply(input$p1, function(x){
        if (is.numeric(dt1[[x]])) {
          sliderInput(inputId=x, label=x, min=min(dt1[[x]]), max=max(dt1[[x]]), value=c(min(dt1[[x]]),max(dt1[[x]])))
        }else { # if (is.factor(dt1[[x]])) {
          selectInput(
            inputId = x,       # The col name of selected column
            label = x,         # The col label of selected column
            choices = dt1[,x], # all rows of selected column
            multiple = TRUE
          )
        }
        
      }))
    })
  })
  
  
  dt2 <- eventReactive(input$button2, {
    req(input$num)
    dt <- DF1$data ## here you can provide the user input data read inside this observeEvent or recently modified data DF1$data
    dt$value1<-dt$value1*isolate(input$num)
    
    dt
  })
  observe({DF1$data <- dt2()})
  
  output_table <- reactive({
    req(input$p1, sapply(input$p1, function(x) input[[x]]))
    dt_part <- dt2()
    for (colname in input$p1) {
      if (is.factor(dt_part[[colname]]) && !is.null(input[[colname]])) {
        dt_part <- subset(dt_part, dt_part[[colname]] %in% input[[colname]])
      } else {
        if (!is.null(input[[colname]][[1]])) {
          dt_part <- subset(dt_part, (dt_part[[colname]] >= input[[colname]][[1]]) & dt_part[[colname]] <= input[[colname]][[2]])
        }
      }
    }
    dt_part
  })
  
  output$table<-renderDT({
    if (input$button | input$button2) {
      DF1$data
    }else return(NULL)
  })
  
}

# shinyApp()
shinyApp(ui = ui, server = server)

Update reactive object with two actionbuttons in a shiny app

1 Answers