如何讓Datatable在R shiny中可以編輯

Question

我正在開發一個應用程序，該應用程序將多個 Xpt 文件作為輸入並允許用戶根據列字段“STUDYID”、“DOMAIN”和“VALUE”進行過濾。 到目前為止，一切都運行良好。

我正在尋找的是，我想讓這個 data.table 可以編輯。 如何做到這一點？

數據

XPT1

STUDYID   DOMAIN    CR_VALUE
1           CR        1.5
2           CR        1.5
3           CR        1.5

XPT2

STUDYID   DOMAIN    CM_VALUE
1           CM        1.5
2           CM        1.8
3           CR        1.9

預計 Output

STUDYID   DOMAIN    CR_VALUE STATUS  COMMANDS
1           CR        1.5
2           CR        1.5
3           CR        1.5
STUDYID   DOMAIN    CM_VALUE STATUS COMMANDS
1           CM        1.5
2           CM        1.8
3           CR        1.9

代碼

library(shiny)
library(haven)
library(stringr)
library(shinyWidgets)
library(tidyverse)
library(DT)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      fileInput("file1", "Choose CSV File",
                multiple = TRUE,
                accept = c(
                  "text/csv",
                  "text/comma-separated-values,text/plain",
                  ".csv", ".xpt"
                )
      ),
      tags$hr(),
      checkboxInput("header", "Header", TRUE),
      uiOutput("files_available"),
      uiOutput("filters")
    ),
    mainPanel(
      uiOutput("tables")
    )
  )
)

server <- function(input, output) {
  nms <- reactiveVal(NULL)
  
  suffixes <- c("STUDYID", "DOMAIN", "VALUE")
  
  df <- reactive({
    req(input$file1)
    input$file1$datapath %>%
      map(~ read_xpt(.x))
  })
  
  # for debugging
  observe({
    print(df())
    # print(nms())
    # print(map(names(input), ~input[[.x]]))
  })
  
  
  observeEvent(df(), {
    nms(map(df(), names))
  })
  
  output$filters <- renderUI({
    req(df())
    inpts <- tagList(
      numericInput("STUDYID", "STUDYID", value = NA),
      textInput("DOMAIN", "DOMAIN", value = ""),
      numericInput("VALUE", "VALUE", value = NA)
    )
  })
  
  output$tables <- renderUI({
    req(df())
    map(1:length(df()), ~ tableOutput(str_c("table", .x)))
  })
  
  observeEvent(c(input$STUDYID, input$DOMAIN, input$VALUE), {
    df <- df()
   
  
    # df contains multiple dataframes so we need to loop through each of them to create the render functions
    walk(1:length(df), ~ {
      output[[str_c("table", .x)]] <<- renderTable({
        cur_df <- df[[.x]]
        nms <- nms()[[.x]]
        nms <- map(suffixes, ~ str_subset(nms, .)) # to order the correct column names with the required input. Warning, if more than one name matches the suffix is not tested
        # first we look if the input is character type and force a NA value on it, if it's not we just look for NA.
        # If the input is not NA (meaning that is has a value inserted by the user), then filter the table by that value.
       
        walk2(nms, suffixes, ~ {
          if (class(input[[.y]]) == "character") {
            if (input[[.y]] == "") {
              input_value <- NA
            } else {
              input_value <- input[[.y]]
            }
          } else {
            input_value <- input[[.y]]
          } # empty textInput's show has an empty string value instead of NA
          print(input_value)
          
         
          if (!is.na(input_value)) {
            cur_df <<- cur_df %>% filter(.data[[.x]] == input[[.y]])
            
          }
        })
        cur_df
        print(typeof(cur_df))
        cur_df$STATUS <- " "
        cur_df$COMMANDS <- " "
        cur_df
      })
   
    })
  })
}

shinyApp(ui, server)

Answer 1

DT提供開箱即用的表格編輯功能。 你只需要做DT::datatable(X, editable = 'cell') 。 請在此處查看帶有幾個示例的手冊

你的代碼：

library(shiny)
library(haven)
library(stringr)
library(shinyWidgets)
library(tidyverse)
library(DT)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      fileInput("file1", "Choose CSV File",
                multiple = TRUE,
                accept = c(
                  "text/csv",
                  "text/comma-separated-values,text/plain",
                  ".csv", ".xpt"
                )
      ),
      tags$hr(),
      checkboxInput("header", "Header", TRUE),
      uiOutput("files_available"),
      uiOutput("filters")
    ),
    mainPanel(
      uiOutput("tables")
    )
  )
)

server <- function(input, output) {
  nms <- reactiveVal(NULL)
  
  suffixes <- c("STUDYID", "DOMAIN", "VALUE")
  
  df <- reactive({
    req(input$file1)
    input$file1$datapath %>%
      map(~ read.table(.x, sep = "\t", header = TRUE))
  })
  
  # for debugging
  observe({
    print(df())
    # print(nms())
    # print(map(names(input), ~input[[.x]]))
  })
  
  
  observeEvent(df(), {
    nms(map(df(), names))
  })
  
  output$filters <- renderUI({
    req(df())
    inpts <- tagList(
      numericInput("STUDYID", "STUDYID", value = NA),
      textInput("DOMAIN", "DOMAIN", value = ""),
      numericInput("VALUE", "VALUE", value = NA)
    )
  })
  
  output$tables <- renderUI({
    req(df())
    map(1:length(df()), ~ DT::DTOutput(str_c("table", .x)))
  })
  
  observeEvent(c(input$STUDYID, input$DOMAIN, input$VALUE), {
    df <- df()
    
    
    # df contains multiple dataframes so we need to loop through each of them to create the render functions
    walk(1:length(df), ~ {
      output[[str_c("table", .x)]] <<- DT::renderDT({
        cur_df <- df[[.x]]
        nms <- nms()[[.x]]
        nms <- map(suffixes, ~ str_subset(nms, .)) # to order the correct column names with the required input. Warning, if more than one name matches the suffix is not tested
        # first we look if the input is character type and force a NA value on it, if it's not we just look for NA.
        # If the input is not NA (meaning that is has a value inserted by the user), then filter the table by that value.
        
        walk2(nms, suffixes, ~ {
          if (class(input[[.y]]) == "character") {
            if (input[[.y]] == "") {
              input_value <- NA
            } else {
              input_value <- input[[.y]]
            }
          } else {
            input_value <- input[[.y]]
          } # empty textInput's show has an empty string value instead of NA
          print(input_value)
          
          
          if (!is.na(input_value)) {
            cur_df <<- cur_df %>% filter(.data[[.x]] == input[[.y]])
            
          }
        })
        cur_df
        print(typeof(cur_df))
        cur_df$STATUS <- " "
        cur_df$COMMANDS <- " "
        DT::datatable(cur_df, editable = 'cell')
      })
      
    })
  })
}

shinyApp(ui, server)

結果：

請注意，您可以進一步自定義對特定列、行甚至一組單元格的編輯！

Answer 2

如果您有數據，您可以將其定義為：

df$STATUS <- vector1
df$COMMANDS <- vector2

其中vector1和vector2是包含所需信息的向量。