Update reactive data frame in shiny gives replacement error

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 one he wants to display as selectInput() via a pickerInput(). If he selects the value1 he should be able to update all of its 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. When I try to update my dataframe with:

dt<-reactive({input$button
    name<-c("John","Jack","Bill")
    value1<-c(2,4,6)
    dt<-data.frame(name,value1)
    dt$value1<-dt$value1*isolate(input$num)
    dt
})

I get :replacement has 0 rows, data has 3

My dt needs to be read as reactive since in my original app it is loaded via fileInput()

library(DT)
    library(shiny)
    ui <- fluidPage(
        titlePanel(p("Spatial app", style = "color:#3474A7")),
        sidebarLayout(
            sidebarPanel(
                uiOutput("inputp1"),
                uiOutput("NUM"),
                #Add the output for new pickers
                uiOutput("pickers"),
                actionButton("button", "Update")
            ),
            
        mainPanel(
            DTOutput("table")
        )
    )
)

# server()
server <- function(input, output) {
    dt<-reactive({
        name<-c("John","Jack","Bill")
        value1<-c(2,4,6)
        dt<-data.frame(name,value1)
        dt$value1<-dt$value1*isolate(input$num)
        dt
        
    })
    output$NUM<-renderUI({
        if("value1" %in% colnames(dt())){
            numericInput("num", label = ("value"), value = 1)
            
        }
        else{
            return(NULL)
        }
    })
    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({
            input$button2
            div(lapply(input$p1, function(x){
                if (is.numeric(dt()[[x]])) {
                    sliderInput(inputId=x, label=x, min=min(dt()[x]), max=max(dt()[[x]]), value=c(min(dt()[[x]]),max(dt()[[x]])))
                }
                else if (is.factor(dt()[[x]])) {
                    pickerInput(
                        inputId = x#The colname of selected column
                        ,
                        label = x #The colname of selected column
                        ,
                        choices = as.character(unique(dt()[,x]))#all rows of selected column
                        ,
                        multiple = TRUE,options = list(`actions-box` = TRUE)
                        
                    )
                }
                
                
            }))
        })
    })
    output_table <- reactive({
        req(input$p1, sapply(input$p1, function(x) input[[x]]))
        dt_part <- dt()
        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)

You do need req() in a few instances. Also, it is not clear what you are trying to do in output$NUM. What is if("value1" %in% colnames(dt())) supposed to do? — YBS
this numeric input exists only if the 'value1' column exists in the uploaded file — firmo23
In that case, your current logic will not work. You need input$num to create dt(), but you need dt() to create input$num. It is better to multiple by input$num later. So, it may be better to create reactiveValues object as your dataframe to enable updating it. — YBS

YBS YBS · Accepted Answer · 2020-09-09T20:20:28

Try this code. I am not clear on what you are trying to do in output_table() data frame.

library(shiny)
library(shinyWidgets)
# ui object

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

    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$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)

Update reactive data frame in shiny gives replacement error

2 Answers