Início / coding / Perguntas / 79544054
Accepted
ranell
Asked: 2025-03-30 08:12:17 +0800 CST

Como salvar o conteúdo da tabela de dados quando um SelectInput em uma célula é atualizado?

  • 772

Estou procurando uma maneira de exibir Statutcomo inputSelect pegando c('','yes','no', 'refused')e Commentairespegando c('','b','c','d')e quando uma pessoa muda para algo diferente de '', para salvar o novo valor em um .csv. Ele salva uma entrada simples, mas não para uma escolha em uma lista.

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)

1 respostas

  1. Best Answer

    No seu aplicativo, você já tem uma lógica que dispara um observeEventquando os dados da tabela são alterados ( "missing_values_dt_table_cell_edit") e, em seguida, grava os dados no .csv. Então, o que podemos tentar é disparar o _cell_editevento se um valor de um dos selectInputdentro do datatablefor alterado.

    Pode ser feito assim: Instale observeEvents em todos os selectInputs e colete a linha, coluna e valor correspondentes onde a entrada mudou. Use session$sendCustomMessage()e envie isso infopara JS, e lá acione o evento já existente usando Shiny.setInputValue('missing_values_dt_table_cell_edit', info);. E então fazemos apenas um pós-processamento menor em R e escrevemos o .csv.

    insira a descrição da imagem aqui

    insira a descrição da imagem aqui

    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)
    • 2

relate perguntas