Edit datatable in Shiny with dropdown selection for factor variables

Question

I am trying to create a Shiny app that allows users to edit a datatable, whereby the edits are saved. Here is a minimal example:

library(shiny)
library(DT)

ui <- fluidPage(
  DT::DTOutput('df')
)

server <- function(session, input, output){
  df <- data.frame(x = factor(c("A", "B", "C"), levels = c("A", "B", "C")))
  output$df <- DT::renderDT(df,
                        editable = T)

  proxy <- dataTableProxy("df")

  observeEvent(input$df_cell_edit, {
    info <- input$df_cell_edit
    str(info)
    i <- info$row
    j <-  info$col
    v <- info$value
    df[i, j] <<- DT:::coerceValue(v, df[i, j])
    replaceData(proxy, df, resetPaging = FALSE)

  })
}

shinyApp(ui, server)

This allows me to edit the values of x in-line, but since x is a factor, I'd like to restrict the values that the user is able to input. Ideally, I would like this to be accomplished using a drop-down menu. Is this functionality possible using DT::datatable and Shiny?

Note: I know of the rhandsontable package, however I would prefer to use DT if possible.

@Dhiraj unfortunately not. I used a combination of reactiveValues and selectInput to get what I want, but it is not a fluid design. — dwhdai, Mar 18 '19 at 14:00
You should take a look at [this app](https://community.rstudio.com/t/shiny-contest-submission-table-editor-shiny-app/23600) from Jiena McLellan. — Alessio, Mar 31 '19 at 20:27
@alessio thanks for sharing. This is similar to my current workaround, but unfortunately does not do what I originally want. What I wanted was the option to change factor variables directly within a datatable using dropdown menus. — dwhdai, Apr 01 '19 at 16:08
You can do that with the JS library **cellEdit**. See [here](https://stackoverflow.com/a/60845695/1100107). — Stéphane Laurent, Jul 01 '20 at 09:53
For future readers: [Here](https://stackoverflow.com/questions/69344974/dt-dynamically-change-column-values-based-on-selectinput-from-another-column-in/69389649#69389649) and [here](https://stackoverflow.com/questions/69959720/edit-datatable-in-shiny-with-dropdown-selection-for-dt-v0-19/69991231#69991231) you can find related answers using a shiny/DT-only approach. — ismirsehregal, Jan 20 '22 at 16:01

Stéphane Laurent · Accepted Answer · 2020-07-09T10:14:09.620

As I said in a comment, you can do that with the JS library cellEdit.

Here is another way, using the JS library contextMenu (a jQuery plugin).

library(shiny)
library(DT)

callback <- c(
  "var id = $(table.table().node()).closest('.datatables').attr('id');",
  "$.contextMenu({",
  "  selector: '#' + id + ' td.factor input[type=text]',", 
  "  trigger: 'hover',",
  "  build: function($trigger, e){",
  "    var colindex = table.cell($trigger.parent()[0]).index().column;",
  "    var coldata = table.column(colindex).data().unique();",
  "    var options = coldata.reduce(function(result, item, index, array){",
  "      result[index] = item;",
  "      return result;",
  "    }, {});",
  "    return {",
  "      autoHide: true,",
  "      items: {",
  "        dropdown: {",
  "          name: 'Edit',", 
  "          type: 'select',", 
  "          options: options,",
  "          selected: 0", 
  "        }",
  "      },",
  "      events: {",
  "        show: function(opts){",
  "          opts.$trigger.off('blur');",
  "        },",
  "        hide: function(opts){",
  "          var $this = this;",
  "          var data = $.contextMenu.getInputValues(opts, $this.data());",
  "          var $input = opts.$trigger;",
  "          $input.val(options[data.dropdown]);",
  "          $input.trigger('change');",
  "        }",
  "      }",
  "    };",
  "  }",
  "});" 
)
ui <- fluidPage(
  tags$head(
    tags$link(
      rel = "stylesheet", 
      href = "https://cdnjs.cloudflare.com/ajax/libs/jquery-contextmenu/2.8.0/jquery.contextMenu.min.css"
    ),
    tags$script(
      src = "https://cdnjs.cloudflare.com/ajax/libs/jquery-contextmenu/2.8.0/jquery.contextMenu.min.js"
    )
  ),
  DTOutput("dtable")
)

server <- function(input, output){
  output[["dtable"]] <- renderDT({
    datatable(
      iris, editable = "cell", callback = JS(callback), 
      options = list(
        columnDefs = list(
          list(
            targets = 5, className = "factor"
          )
        )
      )
    )
  }, server = FALSE)  
}

shinyApp(ui, server)

EDIT

Here is an improvement. In the previous app, the dropdown options are set to the unique values of the column. With the app below, you can set the dropdown options you want.

library(shiny)
library(DT)

callback <- c(
  "var id = $(table.table().node()).closest('.datatables').attr('id');",
  "$.contextMenu({",
  "  selector: '#' + id + ' td.factor input[type=text]',",
  "  trigger: 'hover',",
  "  build: function($trigger, e){",
  "    var levels = $trigger.parent().data('levels');",
  "    if(levels === undefined){",
  "      var colindex = table.cell($trigger.parent()[0]).index().column;",
  "      levels = table.column(colindex).data().unique();",
  "    }",
  "    var options = levels.reduce(function(result, item, index, array){",
  "      result[index] = item;",
  "      return result;",
  "    }, {});",
  "    return {",
  "      autoHide: true,",
  "      items: {",
  "        dropdown: {",
  "          name: 'Edit',",
  "          type: 'select',",
  "          options: options,",
  "          selected: 0",
  "        }",
  "      },",
  "      events: {",
  "        show: function(opts){",
  "          opts.$trigger.off('blur');",
  "        },",
  "        hide: function(opts){",
  "          var $this = this;",
  "          var data = $.contextMenu.getInputValues(opts, $this.data());",
  "          var $input = opts.$trigger;",
  "          $input.val(options[data.dropdown]);",
  "          $input.trigger('change');",
  "        }",
  "      }",
  "    };",
  "  }",
  "});"
)

createdCell <- function(levels){
  if(missing(levels)){
    return("function(td, cellData, rowData, rowIndex, colIndex){}")
  }
  quotedLevels <- toString(sprintf("\"%s\"", levels))
  c(
    "function(td, cellData, rowData, rowIndex, colIndex){",
    sprintf("  $(td).attr('data-levels', '[%s]');", quotedLevels),
    "}"
  )
}

ui <- fluidPage(
  tags$head(
    tags$link(
      rel = "stylesheet",
      href = "https://cdnjs.cloudflare.com/ajax/libs/jquery-contextmenu/2.8.0/jquery.contextMenu.min.css"
    ),
    tags$script(
      src = "https://cdnjs.cloudflare.com/ajax/libs/jquery-contextmenu/2.8.0/jquery.contextMenu.min.js"
    )
  ),
  DTOutput("dtable")
)

server <- function(input, output){
  output[["dtable"]] <- renderDT({
    datatable(
      iris, editable = "cell", callback = JS(callback),
      options = list(
        columnDefs = list(
          list(
            targets = 5,
            className = "factor",
            createdCell = JS(createdCell(c(levels(iris$Species), "another level")))
          )
        )
      )
    )
  }, server = FALSE)
}

shinyApp(ui, server)

If you want to use the unique values of the column, set the option createdCell to JS(createdCell()), or simply don't set this option.

this answer is awesome !!! I was just wondering if you knew how to populate the dropdown menus of every column of the datatable with another dataframe that shares some common columns with the dataframe used in the datatable ? I thought about something like this: `createdCell = JS(createdCell(c(levels(dataframe2[,input$dtable_columns_selected]))))` but it does not work ! — wanderzen, Jan 18 '22 at 12:39

Edit datatable in Shiny with dropdown selection for factor variables

1 Answers1

EDIT

Linked