r - How to save datatable content when a SelectInput in a cell is updated?

I'm looking for a way to display Statut as inputSelect taking c('','yes','no', 'refused') and Commentaires taking c('','b','c','d') and when a person changes it to something different than '', to save the new value on a .csv. It saves a simple input but not for a choice in a list.

library(DT)
library(htmltools)
library(shiny)
library(readr)

save_ref_values <- function(df, name) {
  write.csv(df, name, row.names = FALSE)  
}

missing_values <- structure(list(field_label = c("Date0:", "SR"),
    id = c("link","n"
    ), field = c("date1", "a"), value = c(NA,
    NA), form = c("eval 3", "eval 4"
    ), event = c("5", "5"), label = c("1",
    "1"), field_type = c("text", "radio"), required = c("y",
    "y"), logic = c(NA_character_, NA_character_),
    Commentaires = c(NA, NA), Statut = c(NA, NA)), row.names = 1:2, class = "data.frame")
 

datatableFactory <- function(df) {
  editable_columns <- which(names(df) %in% c("Statut", "Commentaires"))
  df$Statut <-  c(
        as.character(selectInput(
          inputId = "id1",
          label = NULL,
          choices = c('','yes','no', 'refused'),
        ))
      )
  df$Commentaires <-  c(
        as.character(selectInput(
          inputId = "id1",
          label = NULL,
          choices = c('','b','c','d')
        ))
      )
  values_dt_table <- DT::datatable(df,
                                     options = list(pageLength = 5, autoWidth = TRUE),
                                     filter = list(position = 'top', clear = FALSE),
                                     editable = list(target = "cell", disable = list(columns = setdiff(1:dim(df)[2], editable_columns))),
                                     escape = F)
  return(values_dt_table)
}

ui <- fluidPage(
  titlePanel("Génération du Rapport"),
  mainPanel(
  h2("Rapport Preview"),
  DTOutput("missing_values_dt_table"),
  )
)

update_table_data <- function(input, input_id, data_reactif, save_function) {
  observeEvent(input[[input_id]], {
    info <- input[[input_id]]
    i <- info$row 
    j <- info$col 
    value <- info$value 
    new_data <- data_reactif()
    if (colnames(new_data)[j] == "Commentaires") {
      new_data[i, "Commentaires"] <- value
    } else if (colnames(new_data)[j] == "Statut") {
      new_data[i, "Statut"] <- value
    }

    data_reactif(new_data)
    save_function(new_data)
  })
}
 
server <- function(input, output, session) {
missing_values <- read.csv("missing_values.csv")
missing_values_data <- reactiveVal(missing_values)
output$missing_values_dt_table <- renderDT({
datatableFactory(missing_values_data())
})
update_table_data(input
                   , "missing_values_dt_table_cell_edit"
                   , missing_values_data
                   , function(data) save_ref_values(data, "missing_values.csv"))
}

shinyApp(ui, server)

library(DT)
library(htmltools)
library(shiny)
library(readr)

save_ref_values <- function(df, name) {
  write.csv(df, name, row.names = FALSE)  
}

missing_values <- structure(list(field_label = c("Date0:", "SR"),
    id = c("link","n"
    ), field = c("date1", "a"), value = c(NA,
    NA), form = c("eval 3", "eval 4"
    ), event = c("5", "5"), label = c("1",
    "1"), field_type = c("text", "radio"), required = c("y",
    "y"), logic = c(NA_character_, NA_character_),
    Commentaires = c(NA, NA), Statut = c(NA, NA)), row.names = 1:2, class = "data.frame")
 

datatableFactory <- function(df) {
  editable_columns <- which(names(df) %in% c("Statut", "Commentaires"))
  df$Statut <-  c(
        as.character(selectInput(
          inputId = "id1",
          label = NULL,
          choices = c('','yes','no', 'refused'),
        ))
      )
  df$Commentaires <-  c(
        as.character(selectInput(
          inputId = "id1",
          label = NULL,
          choices = c('','b','c','d')
        ))
      )
  values_dt_table <- DT::datatable(df,
                                     options = list(pageLength = 5, autoWidth = TRUE),
                                     filter = list(position = 'top', clear = FALSE),
                                     editable = list(target = "cell", disable = list(columns = setdiff(1:dim(df)[2], editable_columns))),
                                     escape = F)
  return(values_dt_table)
}

ui <- fluidPage(
  titlePanel("Génération du Rapport"),
  mainPanel(
  h2("Rapport Preview"),
  DTOutput("missing_values_dt_table"),
  )
)

update_table_data <- function(input, input_id, data_reactif, save_function) {
  observeEvent(input[[input_id]], {
    info <- input[[input_id]]
    i <- info$row 
    j <- info$col 
    value <- info$value 
    new_data <- data_reactif()
    if (colnames(new_data)[j] == "Commentaires") {
      new_data[i, "Commentaires"] <- value
    } else if (colnames(new_data)[j] == "Statut") {
      new_data[i, "Statut"] <- value
    }

    data_reactif(new_data)
    save_function(new_data)
  })
}
 
server <- function(input, output, session) {
missing_values <- read.csv("missing_values.csv")
missing_values_data <- reactiveVal(missing_values)
output$missing_values_dt_table <- renderDT({
datatableFactory(missing_values_data())
})
update_table_data(input
                   , "missing_values_dt_table_cell_edit"
                   , missing_values_data
                   , function(data) save_ref_values(data, "missing_values.csv"))
}

shinyApp(ui, server)

Share Improve this question edited Mar 30 at 20:00 Jan 9,8506 gold badges20 silver badges33 bronze badges asked Mar 30 at 0:12 ranell 71513 silver badges29 bronze badges

1) There are several answers on SO which explain how to embed inputs in a DT::datatable(). I suggest that you edit your question and include at least the inputs or explain in more detail what your issue is, otherwise the question may get closed as a duplicate. 2) Your code is not running currently, e.g. in id = c("link") there is something missing, also the backtick at the end, shinyApp() missing and so on. 3) Provide a minimal example. For your question it is e.g. not necessary that missing_values has so many columns. – Jan Commented Mar 30 at 7:36
thanks for this reminder. Now my code is working, and i've added some choices to my fields Statut and Commentaires. – ranell Commented Mar 30 at 9:26
This should help with obtaining the dropdown values on input change. I would suggest using a save-button. – Tim G Commented Mar 30 at 10:27

Add a comment |

1 Answer 1

Sorted by: Reset to default 2

In your app you already have a logic which triggers an observeEvent when the table data is changed ("missing_values_dt_table_cell_edit") and then writes the data to the .csv. So what we can try is to trigger the _cell_edit event if a value of one of the selectInput inside the datatable is changed.

It can be done like so: Install observeEvents on all of the selectInputs and collect the corresponding row, column and value where the input has changed. Usesession$sendCustomMessage() and send this info to JS, and there trigger the already existing event by using Shiny.setInputValue('missing_values_dt_table_cell_edit', info);. And then we just do some smaller post-processing in R and write the .csv.

library(DT)
library(htmltools)
library(shiny)
library(readr)

save_ref_values <- function(df, name) {
  write.csv(df, name, row.names = FALSE)  
}

missing_values <- structure(
  list(
    id = c("link", "n"), 
    Commentaires = sapply(1:2, function(i) as.character(selectInput(inputId = paste0("comm_", i), label=NULL, choices=c('','b','c', 'd')))),
    Statut = sapply(1:2, function(i) as.character(selectInput(inputId = paste0("statut_", i), label=NULL, choices=c('','yes','no', 'refused'))))
  ), row.names = 1:2, class = "data.frame"
)


datatableFactory <- function(df) {
  editable_columns <- which(names(df) %in% c("Statut", "Commentaires"))
  values_dt_table <- DT::datatable(df,
                                   rownames = FALSE,
                                   options = list(pageLength = 5, autoWidth = TRUE,
                                                  preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                                                  drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')),
                                   filter = list(position = 'top', clear = FALSE),
                                   editable = list(target = "cell", disable = list(columns = setdiff(1:dim(df)[2], editable_columns))),
                                   escape = F)
  return(values_dt_table)
}

ui <- fluidPage(
  tags$head(
    tags$script("
         Shiny.addCustomMessageHandler('triggerCellEdit', function(info) {
          Shiny.setInputValue('missing_values_dt_table_cell_edit', info);
        });       
    ")
  ),
  findDependencies(selectizeInput("dummy", label = NULL, choices = NULL)),
  titlePanel("Génération du Rapport"),
  mainPanel(
    h2("Rapport Preview"),
    DTOutput("missing_values_dt_table"),
  )
)

update_table_data <- function(input, input_id, data_reactif, save_function) {
  observeEvent(input[[input_id]], {
    info <- input[[input_id]]
    info <- list(row = info[[1]], col = info[[2]], value = info[[3]])
    i <- as.integer(info$row)
    j <- as.integer(info$col)
    value <- info$value
    req(value != "")
    new_data <- data_reactif()
    data_reactif(new_data)
    # special processing because we don't want to write the HTML
    save_data <- subset(new_data, select = -c(Statut, Commentaires))
    save_data$Commentaires <- sapply(1:nrow(missing_values), function(i) input[[paste0("comm_", i)]])
    save_data$Statut <- sapply(1:nrow(missing_values), function(i) input[[paste0("statut_", i)]])
    save_function(save_data)
  })
}

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

  missing_values_data <- reactiveVal(missing_values)

  output$missing_values_dt_table <- renderDT({
    datatableFactory(missing_values_data())
  })
  
  sapply(1:nrow(missing_values), function(x) {
    sapply(c("statut_", "comm_"), function(colPre) {
      observeEvent(input[[paste0(colPre, x)]], {
        row <- x
        col <- grep(if (colPre == "statut_") "Statut" else "Commentaires", colnames(missing_values_data()))
        value <- input[[paste0(colPre, x)]]
        session$sendCustomMessage("triggerCellEdit", list(row, col, value))
      }, ignoreInit = TRUE)
    })
  })

  update_table_data(input
                    , "missing_values_dt_table_cell_edit"
                    , missing_values_data
                    , function(data) save_ref_values(data, "missing_values.csv"))

}

shinyApp(ui, server)

科技改变生活-雨落星辰 - 所有的伟大,都源于一个勇敢的开始

r - How to save datatable content when a SelectInput in a cell is updated? - Stack Overflow

1 Answer 1

与本文相关的文章

评论列表(0)