Shiny - изменить имена столбцов в таблице DT для сохранения как reactiveVal - PullRequest
Новая
       10

Shiny - изменить имена столбцов в таблице DT для сохранения как reactiveVal

0 голосов
/ 17 июня 2020

У меня есть приложение Shiny с таблицей данных DT, в котором я могу изменять имена столбцов с помощью Javascript (благодаря другой записи Stackoverflow). Я хотел бы сохранить измененные имена столбцов в reactiveVal. Однако в настоящее время это не работает.

Вот текущий код, который я использую: 

library(shiny)
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);  ",
  "      Shiny.onInputChange('newColumnValue', newcolname);",
  "      console.log( newcolname);",
  "    }",
  "    $input.remove();",
  "  }).on('blur', function(){",
  "    $(table.column(index).header()).text(newcolname);",
  "    $input.remove();",
  "  });",
  "});"
 )

 ui <- fluidPage(
   textOutput("value"),
   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")
  ),
  DT::dataTableOutput("table")

)

server <- function(input, output){
  val <- reactiveVal(NULL) 

  mydata <- reactive({
    browser()
    data <- datatable(iris[1:3,], callback = JS(callback))
    val(colnames(data$x$data))
    data
  })

  output$table <- DT::renderDataTable({
    mydata()
  }, server = FALSE) 

  output$value <- renderText({
    val()                     
    })
 }

 shinyApp(ui, server)

Однако я не получаю никаких изменений в моей переменной reactiveVal. Что мне нужно изменить?

Ура, Энди

1 Ответ

0 голосов
/ 17 июня 2020 
library(shiny)
library(DT)

callback <- c(
  "var colnames = table.columns().header().to$().map(function(){return this.innerHTML;}).get();",
  "Shiny.onInputChange('colnames', colnames);",
  "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);",
  "      colnames[index] = newcolname;",
  "      Shiny.onInputChange('colnames', colnames);",
  "    }",
  "    $input.remove();",
  "  }).on('blur', function(){",
  "    $(table.column(index).header()).text(newcolname);",
  "    $input.remove();",
  "  });",
  "});"
)

ui <- fluidPage(
  verbatimTextOutput("colnames"),
  DTOutput("table")
)

server <- function(input, output){

  output$table <- renderDT({
    datatable(iris[1:3,], callback = JS(callback), 
              options = list(ordering = FALSE))
  }, server = FALSE) 

  output$colnames <- renderPrint({
    input$colnames                     
  })
}

shinyApp(ui, server)
...