Как редактировать имена столбцов в функции данных при запуске приложения Riny?

Question

Я использую функцию данных из пакета DT в R Shiny и хочу, чтобы пользователь моего приложения мог редактировать имена столбцов (имена переменных).Есть ли возможность сделать это?

Пока я использую текстовый ввод "old_var_name", текстовый ввод "new_var_name" и кнопку действия "update_variable_name".Но на данный момент я могу изменить только имя переменной в данный момент.Я хочу, чтобы пользователь мог изменять столько имен переменных, сколько он хочет.

Сервер:

tab <- eventReactive(input$import,{
inFile <- input$file1
if (is.null(inFile))
  return(NULL)

tabledata <- read.xlsx(inFile$datapath,startRow=1,sheet = 1)
})

name_temp <- eventReactive(input$var_name,{
if (input$old_name == ""){
  colnames(tab())
} else {
    c(colnames(tab())[1:(which(colnames(tab()) == input$old_name)-1)],input$new_name,
    colnames(tab())[(which(colnames(tab()) == input$old_name)+1):length(colnames(tab()))])
}
})

final_rename <- reactive({
d <- tab()
colnames(d) <- name_temp()
d
})

output$tabledata <- DT::renderDataTable({
if (input$var_name == 0) {
  DT::datatable(tab(),editable = T)
} else {
  DT::datatable(final_rename(),editable = T)
}
})

Пользовательский интерфейс:

tabPanel("Table",h1("Table",align="center") ,
actionButton(inputId = "import", label = "Import data"),br(),br(),                           
splitLayout(textInput(inputId = "old_name", label = "Old variable name"),                           
textInput(inputId = "new_name", label = "New variable Name")),
actionButton(inputId = "var_name", label = "Update Variable name"),br(),br(),
DT::dataTableOutput("tabledata"))

Есть ли какие-либо предложения длядостичь этого или любого другого параметра с помощью datatable, который я могу использовать, и тогда пользователь сможет изменять все имена переменных, которые он хочет?

Answer 1

Вот решение с контекстным меню.Щелкните правой кнопкой мыши заголовок столбца, чтобы изменить его.Нажмите «Escape», когда закончите, или просто переместите мышь за пределы поля ввода текста.Это решение не мешает сортировке.

library(shiny)
library(DT)

callback <- c(
  "$.contextMenu({",
  "  selector: '#table th',", 
  "  trigger: 'right',",
  "  autoHide: true,",
  "  items: {",
  "    text: {",
  "      name: 'Enter column header:',", 
  "      type: 'text',", 
  "      value: ''", 
  "    }",
  "  },",
  "  events: {",
  "    show: function(opt){",
  "      $.contextMenu.setInputValues(opt, {text: opt.$trigger.text()});",
  "    },",
  "    hide: function(opt){",
  "      var $this = this;",
  "      var text = $.contextMenu.getInputValues(opt, $this.data()).text;",
  "      var $th = opt.$trigger;",
  "      $th.text(text);",
  "    }",
  "  }",
  "});" 
)

ui <- fluidPage(
  tags$head(
    tags$link(rel = "stylesheet", href = "https://cdnjs.cloudflare.com/ajax/libs/jquery-contextmenu/2.8.0/jquery.contextMenu.min.css"),
    tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/jquery-contextmenu/2.8.0/jquery.contextMenu.min.js")
  ),
  DTOutput("table")
)

server <- function(input, output){
  output[["table"]] <- renderDT({
    datatable(iris[1:3,], callback = JS(callback))
  }, server = FALSE)  
}

shinyApp(ui, server)

Answer 2

Это дружественный способ, за исключением того, что он мешает сортировке.Так что приятно, только если сортировка отключена.Дважды щелкните заголовок столбца, чтобы отредактировать его, и нажмите клавишу Tab, чтобы выйти.

library(DT)

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();",
  "  });",
  "});"
)

datatable(iris[1:3,], callback = JS(callback))