r - 运行 R Shiny 应用程序时如何在数据表函数中编辑列名?
问题描述
我在 R Shiny 中使用 DT 包中的数据表函数,我希望我的应用程序的用户可以编辑列名(变量名)。有什么选择吗?
现在我正在使用文本输入“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"))
是否有任何建议可以实现这一目标或任何我可以使用的数据表选项,然后用户将能够更改他想要的所有变量名称?
解决方案
这是一个带有上下文菜单的解决方案。右键单击列标题以对其进行编辑。完成后按“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)
推荐阅读
- php - 创建一个带有 2 个图标的 png 图像
- c# - 关于代码访问安全性与不可验证代码的混淆
- regex - 如何使用 Beautiful Soup 检查 p 标签中是否存在电子邮件?
- javascript - 用户点击 angular6 后获取所有子对象 ID 的列表
- java - 以编程方式解决和下载依赖关系 - 无需中间常春藤文件
- javascript - 为什么同时具有事件和数据时服务器发送事件不会在前端触发?
- node.js - 我安装了 node.js 并且无法运行“npm start”来处理 react js
- c# - 双多对多关系实体框架
- vb.net - 可执行创建。Win10、Win7和XP哪个路径兼容?
- node.js - 在客户端保存 JWT