让用户在 R Shiny 中编辑数据 table 变量名

Question

我正在构建一个 R Shiny 应用程序，用户可以在其中选择数据 table 中的列，然后该应用程序 returns 所选变量的列表。我希望用户能够在应用程序中更改 variables/columns 的名称。

我用 DT 使这个互动 table。我从 Stéphane Laurent 在 this post.

上的回答中获得了更改列 headers 的代码

虽然列选择和 editable 列名称在 DT table 中工作正常，但问题是更改变量名称只会编辑显示的 table，并且原始数据框仍保留其原始列名。我希望当用户在应用程序中编辑变量名称时，它会更改实际数据框中的变量名称。我该如何实现？

我正在考虑每次用户更改列名时使用 observeEvent() 来更改列名，但由于 Stéphane Laurent 给出的方法使用 JS，我不太确定该怎么做。

(screenshot of the app here;我已经更改了2个选定列的列名，但原始数据框尚未更新。)

library(shiny)
library(DT)

getlist <- function(df, colnums){
  data <- df
  if(length(colnums)==1){
    column_names <- colnames(data)[colnums]
  } else{
    selected_data <- data[,colnums]
    column_names <- colnames(selected_data)
  }
  return(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('change', function(){",
  "    newcolname = $input.val();",
  "    if(newcolname != colname){",
  "      $(table.column(index).header()).text(newcolname);",
  "    }",
  "    $input.remove();",
  "  }).on('blur', function(){",
  "    $(table.column(index).header()).text(newcolname);",
  "    $input.remove();",
  "  });",
  "});"
)


ui <- fluidPage(
  
  DTOutput("table"),
  textOutput('preview'),
  tableOutput('table2')
  
)

server <- function(input, output){
  
  data <- reactiveVal(iris)

  output[["table"]] <- renderDT({
    datatable(data(), selection = list(target = 'column'), options= list(ordering = FALSE, pageLength = 25), callback = JS(callback))
  })  
  
  #selected columns of the tables
  vlist <- reactive(c(getlist(data(),input$table_columns_selected)))
  
  #display list of selected variables
  output$preview <- renderText(paste(c('Selected variables :', vlist()), collapse=' '))
  
  output$table2 <- renderTable({data()})
  
}

shinyApp(ui, server)

Answer 1

您可以使用Shiny.setInputValue()从JS向shiny发送消息并生成输入值。我用它来将 JS 函数中的新旧列名发送到 input$change_colname。然后你可以使用 observeEvent 来更新你的数据。在你的情况下，我会使用不同的对象来呈现 table 和 table2，因为现在 table 在列名更改后重新呈现，因为基础 data() 是更新：

library(shiny)
library(DT)

getlist <- function(df, colnums){
  data <- df
  if(length(colnums)==1){
    column_names <- colnames(data)[colnums]
  } else{
    selected_data <- data[,colnums]
    column_names <- colnames(selected_data)
  }
  return(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('change', function(){",
  "    newcolname = $input.val();",
  "    if(newcolname != colname){",
  "      $(table.column(index).header()).text(newcolname);",
  "      Shiny.setInputValue('change_colname', [colname, newcolname]);",
  "    }",
  "    $input.remove();",
  "  }).on('blur', function(){",
  "    $(table.column(index).header()).text(newcolname);",
  "    $input.remove();",
  "  });",
  "});"
)


ui <- fluidPage(
  
  DTOutput("table"),
  textOutput('preview'),
  tableOutput('table2')
  
)

server <- function(input, output){
  
  data <- reactiveVal(iris)
  vlist <- reactiveVal()
  
  output[["table"]] <- renderDT({
    datatable(data(), selection = list(target = 'column'), options= list(ordering = FALSE, pageLength = 25), callback = JS(callback))
  })  
  
  #selected columns of the tables
  observeEvent(input$table_columns_selected, {
    vlist(getlist(data(),input$table_columns_selected))
  })
  
  # update column names
  observeEvent(input$change_colname, {
    old_colnames <- vlist()
    old_colnames[old_colnames == input$change_colname[1]] <- input$change_colname[2]
    vlist(old_colnames)
    
    # update the data
    old_data <- data()
    colnames(old_data)[colnames(old_data) == input$change_colname[1]] <-
      input$change_colname[2]
    data(old_data)
  })
  
  #display list of selected variables
  output$preview <- renderText(paste(c('Selected variables :', vlist()), collapse=' '))
  
  output$table2 <- renderTable({data()})
  
  output$changed_var <- renderPrint({input$change_colname})
  
}

shinyApp(ui, server)

让用户在 R Shiny 中编辑数据 table 变量名

Let user edit data table variable names in R Shiny

r

shiny

dt