'select列'中的列名如何在编辑后自动更新？

Question

我正在创建一个 R shiny 应用程序，它接受一个 csv 文件作为输入并取决于我可以使用按钮 'split columns' 'delete Rows' 等的结果...

但是，我添加了javascript(回调)用于编辑列名，并在服务器函数中调用了'callback'变量；它工作正常，但是当我编辑列名时，select 列的字段不会自动更新，但是，当我对 'split column' 等其他功能这样做时，'select column' 字段会更新。

有人可以帮我解决这个问题吗？

我已经添加了更改列名的服务器方法。:

  #Server functionf for editing the column names, javascript callback
  output[["table1"]] <- renderDT({
    
    datatable(rv$data, callback = JS(callback))
    
  }, server = FALSE)

csv 数据

ID  Type   Range
21  A1 B1   100
22  C1 D1   200
23  E1 F1   300

app.R 已编辑：

library(shiny)
library(reshape2)
library(DT)
library(tibble)

#Javascript callback for editing the column names
callback <- c(
  "table.on('dblclick.dt', 'thead th', function(e) {",
  "  var $th = $(this);",
  "  var index = $th.index();",
  "  var colname = $th.text(), newcolname = colname;",
  "  var $input = $('<input type=\"text\">')",
  "  $input.val(colname);",
  "  $th.empty().append($input);",
  "  $input.on('blur', function(){",
  "    newcolname = $input.val();",
  "    Shiny.setInputValue('newcol', {i: index, name: newcolname});",
  "    $(table.column(index).header()).text(newcolname);",
  "    $input.remove();",
  "  });",
  "});"
)


###function for deleting the rows
splitColumn <- function(data, column_name) {
  newColNames <- c("Unmerged_type1", "Unmerged_type2")
  newCols <- colsplit(data[[column_name]], " ", newColNames)
  after_merge <- cbind(data, newCols)
  after_merge[[column_name]] <- NULL
  after_merge
}
###_______________________________________________
### function for inserting a new column

fillvalues <- function(data, values, columName){
  df_fill <- data
  vec <- strsplit(values, ",")[[1]]
  df_fill <- tibble::add_column(df_fill, newcolumn = vec, .after = columName)
  df_fill
}

##function for removing the colum

removecolumn <- function(df, nameofthecolumn){
  df[ , -which(names(df) %in% nameofthecolumn)]
}

### use a_splitme.csv for testing this program

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      fileInput("file1", "Choose CSV File", accept = ".csv"),
      checkboxInput("header", "Header", TRUE),
      actionButton("Splitcolumn", "SplitColumn", class = "btn-warning" ),
      uiOutput("selectUI"),
      
      
      actionButton("replacevalues", label = 'Replace values', class= "btn-Secondary"),
      actionButton("removecolumn", "Remove Column"),
      actionButton("Undo", 'Undo', style="color: #fff; background-color: #337ab7; border-color: #2e6da4"),
      actionButton("deleteRows", "Delete Rows"),
      textInput("textbox", label="Input the value to replace:"),
      actionButton('downloadbtn', label= 'Download'),
    ),
    mainPanel(
      DTOutput("table1")
    )
  )
)

server <- function(session, input, output) {
  rv <- reactiveValues(data = NULL, orig=NULL)
  
  observeEvent(input$file1, {
    file <- input$file1
    ext <- tools::file_ext(file$datapath)
    
    req(file)
    
    validate(need(ext == "csv", "Please upload a csv file"))
    
    rv$orig <- read.csv(file$datapath, header = input$header)
    rv$data <- rv$orig
  })
  
  output$selectUI<-renderUI({
    req(rv$data)
    selectInput(inputId='selectcolumn', label='select column', choices = names(rv$data))
  })
  
  
  observeEvent(input$Splitcolumn, {
    rv$data <- splitColumn(rv$data, input$selectcolumn)
  })
  
  observeEvent(input$deleteRows,{
    if (!is.null(input$table1_rows_selected)) {
      rv$data <- rv$data[-as.numeric(input$table1_rows_selected),]
    }
  })
  
  output$table1 <- renderDT(
    rv$data, server = F, editable = T
  )
  #includes extra column after the 'select column' and replaces the values specified 'Input the value to replace:'
  observeEvent(input$replacevalues, {
    rv$data <- fillvalues(rv$data, input$textbox, input$selectcolumn)
  })
  #Removing the specifield column through select column
  observeEvent(input$removecolumn, {
    rv$data <- removecolumn(rv$data,input$selectcolumn)
  })
  observeEvent(input$Undo, {
    rv$data <- rv$orig
  })
  #Storing the csv file through download button
  observeEvent(input$downloadbtn,{
    write.csv(rv$data,'test.csv')
    print ('file has been downloaded')
  })
  observeEvent(input$downloadbtn, {
    showModal(modalDialog(
      title = "Download Status.",
      paste0("csv file has been downloaded",input$downloadbtn,'.'),
      easyClose = TRUE,
      footer = NULL
    ))
    
  })
  #Server functionf for editing the column names, javascript callback
  output[["table1"]] <- renderDT({
    
    datatable(rv$data, callback = JS(callback))
    
  }, server = FALSE)
  
  #datatable(rv$data,options = list(searching=FALSE, pageLength=100))
}

shinyApp(ui, server)

Answer 1

您可以使用 Shiny.setInputValue:

将更改后的 header 的索引及其名称发送到 blur 侦听器中的 Shiny

  "  }).on('blur', function(){",
  "    $(table.column(index).header()).text(newcolname);",
  "    $input.remove();",
  "    Shiny.setInputValue('newcol', {i: index+1, name: newcolname});",
  "  });",

这样，在 server 中你会得到 input[["newcol]]"，一个带有索引 i 和新名称 name 的列表。然后观察此输入并更改 rv$data:

的列名称

observeEvent(input[["newcol"]], {
  i <- input[["newcol"]][["i"]]
  names(rv$data)[i] <- input[["newcol"]][["name"]]
})

编辑

其实change监听器是没用的。您可以使用此回调：

callback <- c(
  "table.on('dblclick.dt', 'thead th', function(e) {",
  "  var $th = $(this);",
  "  var index = $th.index();",
  "  var colname = $th.text(), newcolname = colname;",
  "  var $input = $('<input type=\"text\">')",
  "  $input.val(colname);",
  "  $th.empty().append($input);",
  "  $input.on('blur', function(){",
  "    newcolname = $input.val();",
  "    Shiny.setInputValue('newcol', {i: index, name: newcolname});",
  "    $(table.column(index).header()).text(newcolname);",
  "    $input.remove();",
  "  });",
  "});"
)

'select列'中的列名如何在编辑后自动更新？

How can the column name in'select column' be automatically updated after it has been edited?

r

shiny

rscript

编辑