Создайте selectInput (s) для каждой строки и обновите реактивную таблицу, используя выбранные значения - PullRequest
Новая
       8

Создайте selectInput (s) для каждой строки и обновите реактивную таблицу, используя выбранные значения

0 голосов
/ 30 августа 2018

Я пытаюсь реализовать 'selectInput' в каждой строке data.frame с использованием пакета Shiny и DT. Этот пост мне очень помогает в этом.

Следующий код должен принимать входные данные из каждой строки и обновлять столбец Update_Select для каждого нажатия кнопки «Изменить». Проблема в том, что он обновляет столбец один раз и становится бездействующим. 

library(shiny)
library(DT)

ui <- fluidPage(
  fluidRow(
    fluidRow(column(6, actionButton("act", "Change:")),
             column(6, verbatimTextOutput("txt", placeholder = T))),
    fluidRow(column(12, DTOutput("react_tbl")))
  )
)

server <- function(input, output, session) {
  # Helper function for making checkbox
  shinyInput = function(FUN, len, id, ...) { 
    inputs = character(len) 
    for (i in seq_len(len)) { 
      inputs[i] = as.character(FUN(paste0(id, i), label = NULL, ...))
    } 
    inputs 
  } 

  # Helper function for reading checkbox
  shinyValue = function(id, len) { 
    unlist(lapply(seq_len(len), function(i) { 
      value = input[[paste0(id, i)]] 
      if (is.null(value)) NA else value 
    })) 
  }

  alld <- reactiveValues(react_tbl = data.frame(cars, Rating = shinyInput(selectInput,
                                                                          nrow(cars),
                                                                          "selecter_",
                                                                          choices=1:5,
                                                                          width="60px"),
                                                Update_Action = NA,
                                                Update_Select = NA))


  output$react_tbl = DT::renderDataTable(
    alld$react_tbl,
    selection = 'none',
    server = FALSE,
    escape = FALSE,
    options = list(
      dom = "t",
      paging = TRUE,
      pageLength = 20,
      lengthMenu = c(5, 10, 20, 100, 1000, 10000),
      preDrawCallback = JS('function() { 
                           Shiny.unbindAll(this.api().table().node()); }'), 
      drawCallback = JS('function() { 
                        Shiny.bindAll(this.api().table().node()); } '))
      )


  observeEvent(input$act,{
    alld$react_tbl["Update_Action"] <- input$act
    alld$react_tbl["Update_Select"] <- shinyValue("selecter_", nrow(alld$react_tbl))
  })
  output$txt <- renderText(shinyValue("selecter_", nrow(alld$react_tbl)))

  }

shinyApp(ui, server)

1 Ответ

0 голосов
/ 22 июня 2019

Вам нужно отменить привязку при изменении данных. 

ui <- fluidPage(
  tags$head(tags$script(
    HTML(
      "Shiny.addCustomMessageHandler('unbindDT', function(id) {
        var $table = $('#'+id).find('table');
        if($table.length > 0){
          Shiny.unbindAll($table.DataTable().table().node());
        }
      })")
  )),
  fluidRow(......

и в функции сервера: 

  observeEvent(alld$react_tbl, {
    session$sendCustomMessage("unbindDT", "react_tbl")
  })
...