Home > OS >  shiny: editable table not shown when reactive initial values depending on input value
shiny: editable table not shown when reactive initial values depending on input value

Time:07-19

I need to output a table that depends on an input value and is editable. But the output shows "no data available in table". I cannot figure out why. The ideal output will be like the verbatimTextOutput on the upper right corner, and editable. Any help? Thanks!

library(shiny)
library(shinydashboard)
library(DT)
library(tibble)
library(dplyr)


cars_df<-mtcars%>%
  tibble::rownames_to_column(var = "brand")%>%
  select(brand,mpg,cyl)%>%
  mutate(eff = ifelse(mpg>20, "he","le"))

ui <- dashboardPage(
  dashboardHeader(title = "test"),
  dashboardSidebar(),
  dashboardBody(
    fluidRow(
      column(
        width = 6,
        selectizeInput(inputId = "brand",
                       label = "Brand",
                       choices = cars_df$brand),
        selectizeInput(inputId = "efficiency",
                       label = "Efficiency",
                       choices = c("he","le"),
                       selected = "he"),
        selectizeInput(inputId = "cyl",
                       label = "Cylinder",
                       choices = cars_df$cyl)
      ),
      column(
        width = 6,
        verbatimTextOutput("reactiveDF")
      )
    ),
    actionButton("update", label = "Update", class = "btn-primary"),
    br(), br(),
    DTOutput("cars")
  )
)

server <- function(input, output, session) {
  
  carstbl <- reactive(
    cars_df%>%
      filter(eff == input[["efficiency"]])
  )
  
  output[["cars"]] <- renderDT({
    datatable(
      isolate(carstbl()), 
      editable = list(target = "cell", disable = list(columns = c(0, 1))),
      extensions = 'Buttons',
      options = list(
        dom = 'frtBip',
        buttons = c('csv')
      )
    )
  })
  
  
  observeEvent(input[["cars_cell_edit"]], {
    info <- input[["cars_cell_edit"]] 
    carstbl(editData(carstbl(), info))

  })
  
  output[["reactiveDF"]] <- renderPrint({ # just to check
    carstbl()
  })
}

shinyApp(ui, server)

CodePudding user response:

Try this

cars_df<-mtcars%>%
  tibble::rownames_to_column(var = "brand")%>%
  select(brand,mpg,cyl)%>%
  mutate(eff = ifelse(mpg>20, "he","le"))

ui <- dashboardPage(
  dashboardHeader(title = "test"),
  dashboardSidebar(),
  dashboardBody(
    fluidRow(
      column(
        width = 6,
        selectizeInput(inputId = "brand",
                       label = "Brand",
                       choices = cars_df$brand),
        selectizeInput(inputId = "efficiency",
                       label = "Efficiency",
                       choices = c("he","le"),
                       selected = "he"),
        selectizeInput(inputId = "cyl",
                       label = "Cylinder",
                       choices = cars_df$cyl)
      ),
      column(
        width = 6,
        verbatimTextOutput("reactiveDF")
      )
    ),
    actionButton("update", label = "Update", class = "btn-primary"),
    br(), br(),
    DTOutput("cars")
  )
)

server <- function(input, output, session) {
  rv <- reactiveValues()
  carstbl <- reactive(
    cars_df%>%
      filter(eff == input[["efficiency"]])
  )
  
  output[["cars"]] <- renderDT({
    datatable(
      #isolate(carstbl()), 
      rv$df,
      editable = list(target = "cell", disable = list(columns = c(0, 1))),
      extensions = 'Buttons',
      options = list(
        dom = 'frtBip',
        buttons = c('csv')
      )
    )
  })
  
  observe({rv$df <- carstbl()})
  
  observeEvent(input[["cars_cell_edit"]], {
    info <- input[["cars_cell_edit"]] 
    #carstbl(editData(carstbl(), info))
    str(info)
    print(info)
    i = info$row
    j = info$col
    v = info$value
    rv$df[i, j] <<- DT::coerceValue(v, rv$df[i, j])
  })
  
  output[["reactiveDF"]] <- renderPrint({ # just to check
    rv$df
  })
}

shinyApp(ui, server)
  • Related