Using Filtered Datatables in Shiny

How to use Shiny inputs to Filter Datatable that has been edited?

So far you only update the diplay.df$data, but you need to update the original start.df$data. I've included this in my solution, to find the correct row irrespective of the current filtering, I've introduced the column row_id that is hidden in the DT. Also, I've simplified your code a bit.

library(shiny)
library(shinydashboard)
library(tidyverse)
library(DT)

header <- dashboardHeader(title = "demo")
sidebar <- dashboardSidebar(
  sidebarMenu(
    downloadButton("downloadResults","Download Results"),
    checkboxInput("only_johns", "only_johns")
  )
)

body <- dashboardBody(
  tabItems(
    tabItem(
      tabName = 'admin', class = 'active', 
      fluidRow(
        box(
          dataTableOutput('userTable'), width = 6
        )
      )
    )
  )
)

ui <- dashboardPage(title = 'admin function test', header, sidebar, body)

server <- function(input, output, session){
  
  #1
  start.df <- reactiveValues(data=NA)
  start.df$data <- data.frame(userName = rep(c("John","Ida","Mike"),20),
                              id = 1:60,
                              row_id = 1:60,
                              stringsAsFactors = FALSE)
  
  
  #2  temp display filters df
  display.df <- reactiveValues(data=start.df)
  observeEvent(input$only_johns, {
    
    temp <- isolate(start.df$data)
    if (input$only_johns) {
      
      display.df$data <- temp[temp$userName == "John",]
    } else {
      display.df$data <- temp
    }
  })
  
  # Display editable datatable
  output$userTable <- renderDataTable({
    req(display.df$data)
    DT::datatable(isolate(display.df$data),
                  editable = TRUE,
                  rownames = FALSE,
                  options = list(
                    columnDefs = list(
                      list(
                        visible = FALSE,
                        targets = 2
                      )
                    )
                  ))
  })
  
  ###Tracking Changes###
  
  proxy = dataTableProxy('userTable')

  observeEvent(input$userTable_cell_edit, {
    
    display.df$data <- editData(display.df$data, input$userTable_cell_edit, rownames = FALSE)
    DT::replaceData(proxy, display.df$data, rownames = FALSE, resetPaging = FALSE)
    
    # update the data in the original df
    # get the correct row_id
    curr_row_id <- display.df$data[input$userTable_cell_edit[["row"]], "row_id", drop = TRUE]
    # get the correct column position
    column_pos <- input$userTable_cell_edit[["col"]] + 1 # DT starts indexing at 0
    # update the data
    temp <- start.df$data
    temp[temp$row_id == curr_row_id, column_pos] <- input$userTable_cell_edit[["value"]]
    start.df$data <- temp
  })
  
  
  output$downloadResults <- downloadHandler(
    filename = function(){paste("userTest.csv", sep = "")},
    content = function(file){write.csv(start.df$data, file, row.names = FALSE)}
  )
  
}

shinyApp(ui, server)

Edit

Here is a version where the page gets not reset. The problem was that with the edited data, display.df$data was changed, which triggered the rerendering of output$userTable and this resetted the page. To circumvent this, I've added another reactive value that contains the edited data and don't change display.df anymore, it is only changed by changing the input filtering.

library(shiny)
library(shinydashboard)
library(tidyverse)
library(DT)

header <- dashboardHeader(title = "demo")
sidebar <- dashboardSidebar(
  sidebarMenu(
    downloadButton("downloadResults","Download Results"),
    checkboxInput("only_johns", "only_johns")
  )
)

body <- dashboardBody(
  tabItems(
    tabItem(
      tabName = 'admin', class = 'active', 
      fluidRow(
        box(
          dataTableOutput('userTable'), width = 6
        )
      )
    )
  )
)

ui <- dashboardPage(title = 'admin function test', header, sidebar, body)

server <- function(input, output, session){
  
  #1
  start.df <- reactiveValues(data=NA)
  start.df$data <- data.frame(userName = rep(c("John","Ida","Mike"),20),
                              id = 1:60,
                              row_id = 1:60,
                              stringsAsFactors = FALSE)
  
  
  #2  temp display filters df
  display.df <- reactiveValues(data=isolate(start.df))
  edit.df <- reactiveValues(data = isolate(start.df))
  observeEvent(input$only_johns, {
    
    temp <- isolate(start.df$data)
    if (input$only_johns) {
      
      display.df$data <- temp[temp$userName == "John",]
      edit.df$data <- temp[temp$userName == "John",]
    } else {
      display.df$data <- temp
      edit.df$data <- temp
    }
  })
  
  # Display editable datatable
  output$userTable <- renderDataTable({
    req(display.df$data)
    DT::datatable(display.df$data,
                  editable = TRUE,
                  rownames = FALSE,
                  options = list(
                    columnDefs = list(
                      list(
                        visible = FALSE,
                        targets = 2
                      )
                    )
                  ))
  })
  
  ###Tracking Changes###
  
  proxy = dataTableProxy('userTable')

  observeEvent(input$userTable_cell_edit, {
    
    edit.df$data <- editData(edit.df$data, input$userTable_cell_edit, rownames = FALSE)
    DT::replaceData(proxy, edit.df$data, rownames = FALSE, resetPaging = FALSE)
    
    # update the data in the original df
    # get the correct row_id
    curr_row_id <- edit.df$data[input$userTable_cell_edit[["row"]], "row_id", drop = TRUE]
    # get the correct column position
    column_pos <- input$userTable_cell_edit[["col"]] + 1 # DT starts indexing at 0
    # update the data
    temp <- start.df$data
    temp[temp$row_id == curr_row_id, column_pos] <- input$userTable_cell_edit[["value"]]
    start.df$data <- temp
  })
  
  
  output$downloadResults <- downloadHandler(
    filename = function(){paste("userTest.csv", sep = "")},
    content = function(file){write.csv(start.df$data, file, row.names = FALSE)}
  )
  
}

shinyApp(ui, server)

Using filtered datatables in shiny

Just building up on @JasonAizkalns's example, you can hide some of the built-in column filters using jQuery. for example here the first two are hidden:

library(shiny)
library(DT)

shinyApp(
  ui = fluidPage(dataTableOutput('tbl'),
                 plotOutput('plot1')),
  server = function(input, output) {    
    output$tbl = renderDataTable({
      datatable(iris, filter="top",options = list(lengthChange = FALSE),callback=JS("
           //hide column filters for the first two columns
          $.each([0, 1], function(i, v) {
                $('input.form-control').eq(v).hide()
              });"))
    })
    output$plot1 = renderPlot({
      filtered_data <- input$tbl_rows_all
      hist(iris[filtered_data, "Sepal.Length"])
    })
  }
)

Capture filtered results from a datatable and store it as a new dataset in Shiny

Here is a solution that recreates the filtering on the original data based on the filter inputs stored in my_state$datatable_search_columns. The strings are turned into the correct filter conditions which are then applied to the data set before saving. Note that I haven't tested it with a condition in the global search bar:

library(shiny)
library(shinyWidgets)
library(dplyr)
library(tidyverse)
library(shinyjs)

ui <- fluidPage(
  titlePanel("Dataset Tool"),
  sidebarLayout(
    sidebarPanel(width = 3,
                 conditionalPanel(
                   condition = "input.tabs=='Datasets'",
                   uiOutput("ui_datasets"),
                   uiOutput("ui_storedataset"),
                   br(), br(),
                   wellPanel(
                     checkboxInput("data_remove", "Remove dataset from memory", 
                                   FALSE),
                     conditionalPanel(
                       condition = "input.data_remove == true",
                       uiOutput("ui_removedataset"),
                       actionButton("removeDataSetButton", 
                                    "Remove dataset")
                     )
                   )
                 )
                 
    ),
    mainPanel(
      tabsetPanel(id = "tabs",
                  tabPanel("Datasets",
                           DT::dataTableOutput("datatable")
                  )
      )
    )
  )
)

server = function(input, output,session) {
  
  my_data <- new.env()
  my_state <- list()
  my_info <- reactiveValues()
  datasetlist <- c()
  my_df <- list()
  df <- list()
  
  df_names <- c("diamonds", "mtcars")
  for (j in df_names) {
    df[[j]] <- get(j)
    datasetlist <- c(datasetlist, j)
  }
  my_info[["datasetlist"]] <- datasetlist
  my_df[["df"]] <- df
  
  output$ui_datasets <- renderUI({
    tagList(
      selectInput(
        inputId = "dataset",
        label = "Datasets:",
        choices = my_info[["datasetlist"]],
        multiple = FALSE
      )
    )
  })
  
  output$ui_storedataset <- renderUI({
    tagList(
      wellPanel(
        tags$table(
          tags$td(textInput("stored_name", 
                            "Store new dataset as:", 
                            "", 
                            placeholder = "name of the dataset")),
          tags$td(actionButton("view_store", 
                               "Store"), 
                  style = "padding-right:30px;")
        )
      )
    )
  })
  
  observeEvent(input$datatable_search_columns, {
    my_state$datatable_search_columns <<- input$datatable_search_columns
  })
  
  observeEvent(input$datatable_state, {
    my_state$datatable_state <<-
      if (is.null(input$datatable_state)) list() else input$datatable_state
  })
  
  output$datatable <- DT::renderDataTable({
    dat <- df[[(input$dataset)]]
    
    search <- my_state$datatable_state$search$search
    if (is.null(search)) search <- ""
    fbox <- if (nrow(dat) > 5e6) "none" else list(position = "top")
    
    
    DT::datatable(
      dat,
      filter = fbox,
      selection = "none",
      rownames = FALSE,
      fillContainer = FALSE,
      escape = FALSE,
      style = "bootstrap",
      options = list(
        stateSave = TRUE, 
        searchCols = lapply(my_state$datatable_search_columns, function(x) list(search = x)),
        search = list(search = search, regex = TRUE),
        order = {
          if (is.null(my_state$datatable_state$order)) {
            list()
          } else {
            my_state$datatable_state$order
          }
        },
        columnDefs = list(
          list(orderSequence = c("desc", "asc"), targets = "_all"),
          list(className = "dt-center", targets = "_all")
        ),
        autoWidth = TRUE,
        processing = isTRUE(fbox == "none"),
        pageLength = {
          if (is.null(my_state$datatable_state$length)) 10 else my_state$datatable_state$length
        },
        lengthMenu = list(c(5, 10, 25, 50, -1), c("5", "10", "25", "50", "All"))
      ),
      callback = DT::JS('$(window).on("unload", function() { table.state.clear(); })')
    )
  })
  
  observeEvent(input$view_store, {
    req(input$stored_name)
    
    dataset <- (input$stored_name)
    if (input$stored_name != dataset) {
      updateTextInput(session, inputId = "stored_name", value = dataset)
    }
    
    # get filter conditions
    filter_conditions <- lapply(my_state$datatable_search_columns, function(column) {
      # check if it is a numerical filter and extract the values
      if (str_detect(column, "\\.\\.\\.")) {
        vals <- strsplit(column, " ")
        c(as.numeric(vals[[1]][1]), as.numeric(vals[[1]][3])) # min/max values
      } else {
        if (column == "") {
          NA
        } else {
          vals <- strsplit(column, "\"")
          index <- seq(from = 2, to = length(vals[[1]]), by = 2)
          as.character(vals[[1]][index])
        }
      }
    })
    
    # do the filtering
    temp <- get(input$dataset)
    temp <- as.data.frame(temp)
    for (i in seq_along(filter_conditions)) {
      current_vals <- filter_conditions[[i]]
      
      if (all(is.numeric(current_vals))) {
        # it's a numeric column
        temp <- temp[temp[, i] >= current_vals[1] & temp[, i] <= current_vals[2], ]
      }
      
      if (all(is.character(current_vals))) {
        # it's a character column
        temp[, i] <- as.character(temp[, i])
        temp <- temp[temp[, i] %in% current_vals, ]
      }
    }
    
    my_data[[dataset]] <- temp
    updateSelectInput(session = session, inputId = "dataset", 
                      selected = input$dataset)
  })
  
  output$ui_removedataset <- renderUI({
    selectInput(
      inputId = "removeDataset",
      label = NULL,
      choices = my_info[["datasetlist"]],
      selected = NULL,
      multiple = TRUE,
      size = length(my_info[["datasetlist"]]),
      selectize = FALSE
    )
  })
  
  observeEvent(input$removeDataSetButton, {
    if (is.null(input$removeDataset)) return()
    datasets <- my_info[["datasetlist"]]
    if (length(datasets) > 1) { 
      removeDataset <- input$removeDataset
      if (length(datasets) == length(removeDataset)) {
        removeDataset <- removeDataset[-1]
      }
      suppressWarnings(rm(list = removeDataset, envir = my_data))
      my_info[["datasetlist"]] <- datasets[-which(datasets %in% removeDataset)]
    }
  })
  
}

shinyApp(ui = ui, server = server)

Edit

Here is a version where you can select the changed dataset after storing it:

library(shiny)
library(shinyWidgets)
library(dplyr)
library(tidyverse)
library(shinyjs)

ui <- fluidPage(
  titlePanel("Dataset Tool"),
  sidebarLayout(
    sidebarPanel(width = 3,
                 conditionalPanel(
                   condition = "input.tabs=='Datasets'",
                   uiOutput("ui_datasets"),
                   uiOutput("ui_storedataset"),
                   br(), br(),
                   wellPanel(
                     checkboxInput("data_remove", "Remove dataset from memory", 
                                   FALSE),
                     conditionalPanel(
                       condition = "input.data_remove == true",
                       uiOutput("ui_removedataset"),
                       actionButton("removeDataSetButton", 
                                    "Remove dataset")
                     )
                   )
                 )
                 
    ),
    mainPanel(
      tabsetPanel(id = "tabs",
                  tabPanel("Datasets",
                           DT::dataTableOutput("datatable")
                  )
      )
    )
  )
)

server = function(input, output,session) {
  
  my_data <- new.env()
  my_state <- list()
  my_info <- reactiveValues()
  datasetlist <- c()
  my_df <- list()
  df <- list()
  
  df_names <- c("diamonds", "mtcars")
  for (j in df_names) {
    df[[j]] <- get(j)
    datasetlist <- c(datasetlist, j)
  }
  my_info[["datasetlist"]] <- datasetlist
  my_df[["df"]] <- df
  
  output$ui_datasets <- renderUI({
    tagList(
      selectInput(
        inputId = "dataset",
        label = "Datasets:",
        choices = my_info[["datasetlist"]],
        multiple = FALSE
      )
    )
  })
  
  output$ui_storedataset <- renderUI({
    tagList(
      wellPanel(
        tags$table(
          tags$td(textInput("stored_name", 
                            "Store new dataset as:", 
                            "", 
                            placeholder = "name of the dataset")),
          tags$td(actionButton("view_store", 
                               "Store"), 
                  style = "padding-right:30px;")
        )
      )
    )
  })
  
  observeEvent(input$datatable_search_columns, {
    my_state$datatable_search_columns <<- input$datatable_search_columns
  })
  
  observeEvent(input$datatable_state, {
    my_state$datatable_state <<-
      if (is.null(input$datatable_state)) list() else input$datatable_state
  })
  
  output$datatable <- DT::renderDataTable({
    dat <- df[[(input$dataset)]]
    
    search <- my_state$datatable_state$search$search
    if (is.null(search)) search <- ""
    fbox <- if (nrow(dat) > 5e6) "none" else list(position = "top")
    
    
    DT::datatable(
      dat,
      filter = fbox,
      selection = "none",
      rownames = FALSE,
      fillContainer = FALSE,
      escape = FALSE,
      style = "bootstrap",
      options = list(
        stateSave = TRUE, 
        searchCols = lapply(my_state$datatable_search_columns, function(x) list(search = x)),
        search = list(search = search, regex = TRUE),
        order = {
          if (is.null(my_state$datatable_state$order)) {
            list()
          } else {
            my_state$datatable_state$order
          }
        },
        columnDefs = list(
          list(orderSequence = c("desc", "asc"), targets = "_all"),
          list(className = "dt-center", targets = "_all")
        ),
        autoWidth = TRUE,
        processing = isTRUE(fbox == "none"),
        pageLength = {
          if (is.null(my_state$datatable_state$length)) 10 else my_state$datatable_state$length
        },
        lengthMenu = list(c(5, 10, 25, 50, -1), c("5", "10", "25", "50", "All"))
      ),
      callback = DT::JS('$(window).on("unload", function() { table.state.clear(); })')
    )
  })
  
  observeEvent(input$view_store, {
    req(input$stored_name)
    
    dataset <- (input$stored_name)
    if (input$stored_name != dataset) {
      updateTextInput(session, inputId = "stored_name", value = dataset)
    }
    
    # get filter conditions
    filter_conditions <- lapply(my_state$datatable_search_columns, function(column) {
      # check if it is a numerical filter and extract the values
      if (str_detect(column, "\\.\\.\\.")) {
        vals <- strsplit(column, " ")
        c(as.numeric(vals[[1]][1]), as.numeric(vals[[1]][3])) # min/max values
      } else {
        if (column == "") {
          NA
        } else {
          vals <- strsplit(column, "\"")
          index <- seq(from = 2, to = length(vals[[1]]), by = 2)
          as.character(vals[[1]][index])
        }
      }
    })
    
    # do the filtering
    temp <- get(input$dataset)
    temp <- as.data.frame(temp)
    for (i in seq_along(filter_conditions)) {
      current_vals <- filter_conditions[[i]]
      
      if (all(is.numeric(current_vals))) {
        # it's a numeric column
        temp <- temp[temp[, i] >= current_vals[1] & temp[, i] <= current_vals[2], ]
      }
      
      if (all(is.character(current_vals))) {
        # it's a character column
        temp[, i] <- as.character(temp[, i])
        temp <- temp[temp[, i] %in% current_vals, ]
      }
    }
    
    df[[dataset]] <<- temp
    my_info[["datasetlist"]] <- c(my_info[["datasetlist"]], input$stored_name)
    updateSelectInput(session = session, inputId = "dataset", 
                      selected = input$dataset)
  })
  
  output$ui_removedataset <- renderUI({
    selectInput(
      inputId = "removeDataset",
      label = NULL,
      choices = my_info[["datasetlist"]],
      selected = NULL,
      multiple = TRUE,
      size = length(my_info[["datasetlist"]]),
      selectize = FALSE
    )
  })
  
  observeEvent(input$removeDataSetButton, {
    if (is.null(input$removeDataset)) return()
    datasets <- my_info[["datasetlist"]]
    if (length(datasets) > 1) { 
      removeDataset <- input$removeDataset
      if (length(datasets) == length(removeDataset)) {
        removeDataset <- removeDataset[-1]
      }
      suppressWarnings(rm(list = removeDataset, envir = my_data))
      my_info[["datasetlist"]] <- datasets[-which(datasets %in% removeDataset)]
    }
  })
  
}

shinyApp(ui = ui, server = server)

A few issues with your code I've noticed:

  • I recommend not to use get, this makes it less clear and debuggable where the data comes from; I'd work directly with the lists/reactives where your data is stored to retrieve it
  • there is something going on with the filters set in the table; they stay even when you switch datasets, I think you have to put some work into that
  • you have a lot of similar lists (like my_df and df) (and I think you don't use both), which makes your code harder to understand
  • try to use more observeEvent/updateXXInput as it's a bit faster than doing all the renderUI on the server side

filter dataTables in Shiny Dashboad based on selectInput Values

You have to add a filter in your server component with the selection coming from the ui, in this way:

server <- function(input, output) {
  
  output$carBranch <- renderDT(
    salesDF[salesDF$branch==input$Branch,], options = list(searching=F)
  )
}

Branch input could be call from the ui using input$Branch

R + Shiny + DT : download filtered data

Here is a way with a datatables button, not with a download handler:

  output$table <- renderDT({
    datatable(
      df_filter(),
      extensions = "Buttons",
      options = list(
        dom = "Bfrtip",
        buttons = list(
          list(
            extend = "csv",
            exportOptions = list(
              modifier = list(
                search = "applied"
              )
            )
          )
        )
      )
    )
  }, server = FALSE)

Reactive data table in Shiny with optional filtering

The key to your problems are

  1. Create an if statement when your input is NULL (i.e. when you first open the app) that will just spit out the dataset
  2. When selecting multiple inputs, you need to use %in% operator

See code below:

ui <- fluidPage(
  sidebarLayout(
    mainPanel(

      selectInput("pickvalue", label = "Gears", unique(mtcars$gear),
                  selected = NULL, multiple = T)),

    tableOutput("tableOut")

  )
)

server <- function(input, output, session){

  gears <- reactive({

    dat <- mtcars

    if (!is.null(input$pickvalue)){dat <- dat %>% filter(gear %in% input$pickvalue)} 

    dat <- dat %>% select(-gear)

    return(dat)

  })

  output$tableOut<- renderTable({gears()})

}

shinyApp(ui = ui, server=server)

Related Topics

Efficient Apply or Mapply for Multiple Matrix Arguments by Row

Setting Default Number of Decimal Places for Printing

How Does One Aggregate and Summarize Data Quickly

Faster Way to Compare Rows in a Data Frame

Ggplot2: How to Adjust Fill Colour in a Boxplot (And Change Legend Text)

Rcmdr Launch Error in Yosemite (Os X 10.10)

Format Latitude and Longitude Axis Labels in Ggplot

Dplyr Filter() with SQL-Like %Wildcard%

How to Save Interactive Charts from Dygraph

Sorting of Categorical Variables in Ggplot

Importing Wikipedia Tables in R

How to Change Color of Facet Borders When Using Facet_Grid

Convert Begin and End Coordinates into Spatial Lines in R

How to Convert by the Minute Data to Hourly Average Data

Performant 2D Opengl Graphics in R for Fast Display of Raster Image Using Qtpaint (Qt) or Rdyncall (Sdl/Opengl) Packages

Xpath to Extract Text After Br Tags in R

Multiple Colors in a Facet Strip Background

Collapse and Merge Overlapping Time Intervals


Leave a reply



Submit