Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Update subsetted datatable in Shiny

Tags:

r

shiny

The data my Shiny-app loads must be verified and corrected before used.

But I can't get the changes to stick. For example, in the MWE, changing the number of Pears from 18 to 12 doesn't update the data.table indata.dt.

How can the edits stay, and also propagate to the second tab?

MWE:

## Load libraries
library(data.table)
library(shiny)
library(DT)
## Simulate loaded data
indata.dt <- data.table(Category=c("Fruits", "Fruits", "Fruits", "Vegetables", "Vegetables"),
                 Item=c("Apple", "Pear", "Orange", "Cucumber", "Tomato"),
                 Count=c(17L, 18L, 23L, 5L, 8L))
## UI
ui <- fluidPage(
  titlePanel("GreensApp"),
  tabsetPanel(type = "tabs",
              tabPanel("Define Items",
                       sidebarLayout(
                         sidebarPanel(
                           selectInput(inputId="selectedCategory", label="Choose a category:",
                                       choices=sort(unique(indata.dt$Category)),
                                       multiple=FALSE
                           )
                         ),
                         mainPanel(
                           DT::dataTableOutput("table1")
                         )
                       )
              ),
              tabPanel("See the updated table",
                       DT::dataTableOutput("table2")
              )
  )
)
## Server
server <- function(input, output) {
  filterData <- reactive({
    indata.dt[Category==input$selectedCategory, list(Item, Count)]
  })
  output$table1 <- DT::renderDataTable({
    DT::datatable(filterData(), selection="single", rownames=FALSE, editable=list(target="cell"))
  })
  output$table2 <- DT::renderDataTable({
    DT::datatable(filterData(), selection="single", rownames=FALSE)
  })
  observeEvent(input$table1_cell_edit, {
    cell <- input$table1_cell_edit
    indata.dt[cell$row, cell$col] <- cell$value
  })
}
# Run
shinyApp(ui = ui, server = server)

Problem can be observed by editing a fruit-count, selecting vegetables and then fruits again. The new count returned to the original value.

like image 978
Chris Avatar asked May 07 '26 09:05

Chris


1 Answers

This should do, I've also added a notification so its an int. Because you are working with data.tablewe need to be careful how to assign variables to it, so I used := instead

## Load libraries
library(data.table)
library(shiny)
library(DT)
## Simulate loaded data
indata.dt <- data.table(Category=c("Fruits", "Fruits", "Fruits", "Vegetables", "Vegetables"),
                        Item=c("Apple", "Pear", "Orange", "Cucumber", "Tomato"),
                        Count=c(17L, 18L, 23L, 5L, 8L))
## UI
ui <- fluidPage(
    titlePanel("GreensApp"),
    tabsetPanel(type = "tabs",
                tabPanel("Define Items",
                         sidebarLayout(
                             sidebarPanel(
                                 selectInput(inputId="selectedCategory", label="Choose a category:",
                                             choices=sort(unique(indata.dt$Category)),
                                             multiple=FALSE
                                 )
                             ),
                             mainPanel(
                                 DT::dataTableOutput("table1")
                             )
                         )
                ),
                tabPanel("See the updated table",
                         DT::dataTableOutput("table2")
                )
    )
)

server <- function(input, output, session) {
    v <- reactiveValues()
    v$indata.dt <- indata.dt

    observeEvent(input$selectedCategory,{
        req(input$selectedCategory)
        v$indata.dt2 <- v$indata.dt[Category==input$selectedCategory, list(Item, Count)]
    })

    output$table1 <- DT::renderDataTable({
        DT::datatable(v$indata.dt2, selection="single", rownames=FALSE, editable=list(target="cell"))
    })
    output$table2 <- DT::renderDataTable({
        DT::datatable(v$indata.dt2, selection="single", rownames=FALSE)
    })
    observeEvent(input$table1_cell_edit, {
        cell <- input$table1_cell_edit
        value <- as.integer(cell$value)
        if(is.na(value)){
            value <- 0
            showNotification("Needs to be an integer, reseting to zero", duration = 5,type = 'warning')
        }

        v$indata.dt2[cell$row,Count := value]
        v$indata.dt[cell$row,Count := value]
    })
}
# Run
shinyApp(ui = ui, server = server)
like image 115
Pork Chop Avatar answered May 09 '26 23:05

Pork Chop