Question

这是我上一个问题的延续，我需要将闪亮的输入集成到数据表（Render numericInputs in a datatable row）中。我有一列numericInputs但我无法检索用户输入的值。我已经尝试了输入$ bin_values和shinyValue（输入$ bin_values，ncol（it_matrix）但它没有什么区别。我也尝试合并代码来处理一些JS回调选项（R Shiny selectedInput inside renderDataTable cells）但是在闪亮的输入变量为空的情况下仍然会遇到同样的问题。我缺少什么？

我的最终目标是在interface_table上选择行，并仅对这些列执行计算（行和列索引相同），然后将其输出为新表。这是该代码的简化版本，只是为了找出如何恢复用户在按Apply之前输入的numericInput值列。

library(shiny)
library(DT)

data(mtcars)

if (interactive()) {
  ui <- fluidPage(
    DT::dataTableOutput('interface_table'),
    br(),
    actionButton("do", "Apply"),
    br(),
    hr(),
    tabsetPanel(
      tabPanel("contents", DT::dataTableOutput('contents')),
      tabPanel("it_contents", DT::dataTableOutput('it_contents'))
    ),
    br()

  )

  server <- function(input, output, session) {

    output$contents <- DT::renderDataTable(
      {mtcars}, options = list(autoWidth = TRUE, 
                               scrollX = TRUE, dom = 't', ordering = FALSE),
      rownames = TRUE, selection = 'none')


    # helper function for making input number values
    shinyInput <- function(FUN, len, id, ...) {
      inputs <- numeric(len)
      for (i in seq_len(len)) {
        inputs[i] <- as.character(FUN(paste0(id, i), label = NULL, ...))
      }
      inputs
    }

    # helper function for reading numeric inputs
    shinyValue <- function(id, len) {
      unlist(lapply(seq_len(len), function(i) {
        value <- input[[paste0(id, i)]]
        if (is.null(value)) NA else value
      }))
    }

    it_matrix <- matrix(data = NA, nrow = length(names(mtcars)), ncol = 2)
    rownames(it_matrix) <- names(mtcars)
    colnames(it_matrix) <- c("Ordinality","Number of bins")
    it_matrix[,1] <- lengths(lapply(mtcars, unique))

    it_matrix[,2] <- shinyInput(numericInput, ncol(mtcars),
                                "bin_values", value = NULL,
                                width = '100%', min = 0, max = 12)

    output$interface_table <- DT::renderDataTable(it_matrix,
                                                  rownames = TRUE,
                                                  escape = FALSE,
                                                  options = list(autoWidth = TRUE, scrollX = TRUE,
                                                                 #scrollY = '400px',
                                                                 dom = 't',
                                                                 ordering = FALSE)
    )

    it_data <- reactive({
      if (input$do > 0) {
        rs <- input$interface_table_rows_selected
        bv <- shinyValue(input$bin_values, nrow(it_matrix))
        dat <- matrix(data = NA, nrow = nrow(it_matrix), ncol = 2)
        colnames(dat) <- c("Ordinality","Number of bins")
        dat[,1] <- it_matrix[,1]
        dat[,2] <- input$bin_values
        return(dat)
      }
    })

    output$it_contents <- DT::renderDataTable(
      it_data(), options = list(autoWidth = TRUE, 
                                  scrollX = TRUE, dom = 't', ordering = FALSE),
      rownames = TRUE, selection = 'none')
  }
}

shinyApp(ui, server)

更新：由（MLavoie）建议进行更改，现在我得到一个表输出，但它只包含第一列（常规）。当我cat bv或输入$ bin_values时，它是一个NA值列表，这意味着它没有获取numericInput值。

Answer 1

找出问题 - 好吧，有几个。第一个必须使用data.frame作为列中的闪亮输入，并且它必须是被动的。其次，输入变量由Id访问，这里是＆＃39; bin_values＆＃39;而不是输入$ bin_values。

library(shiny)
library(DT)

data(mtcars)

if (interactive()) {
  ui <- fluidPage(
    DT::dataTableOutput('interface_table'),
    br(),
    actionButton("do", "Apply"),
    br(),
    hr(),
    tabsetPanel(
      tabPanel("contents", DT::dataTableOutput('contents')),
      tabPanel("it_contents", DT::dataTableOutput('it_contents'))
    ),
    br()    
  )

  server <- function(input, output, session) {

    output$contents <- DT::renderDataTable(
      {mtcars}, options = list(autoWidth = TRUE, 
                               scrollX = TRUE, dom = 't', ordering = FALSE),
      rownames = TRUE, selection = 'none')


    # create a character vector of shiny inputs
    shinyInput <- function(FUN, len, id, ...) {
      inputs <- numeric(len)
      for (i in seq_len(len)) {
        inputs[i] <- as.character(FUN(paste0(id, i), label = NULL, ...))
      }
      inputs
    }

    # obtain the values of inputs
    shinyValue <- function(id, len) {
      unlist(lapply(seq_len(len), function(i) {
        value <- input[[paste0(id, i)]]
        if (is.null(value)) NA else value
      }))
    }

    init_ordinality <- lengths(lapply(mtcars, unique))

    it_df <- reactive({
      data.frame(
        Ordinality = init_ordinality,
        Bins = shinyInput(numericInput, ncol(mtcars),
                          'bin_values', value = NULL,
                          width = '100%', min = 0, max = 12),
        stringsAsFactors = FALSE
      )
    })

    output$interface_table <- DT::renderDataTable(
      it_df(), rownames = FALSE, escape = FALSE, options = list(
        autoWidth = TRUE, scrollX = TRUE, #scrollY = '400px',
        dom = 't', ordering = FALSE,
        preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
        drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } '))
    )

    it_data <- reactive({
      if (input$do > 0) {
        dat <- data.frame(
          Ordinality = init_ordinality,
          Bins = shinyValue('bin_values', ncol(mtcars))
        )
        return(dat)
      }
      else { return() }
    })

    output$it_contents <- DT::renderDataTable(
      it_data(),
      options = list(autoWidth = TRUE, scrollX = TRUE, dom = 't', ordering = FALSE),
      rownames = TRUE, selection = 'none')
  }
}

shinyApp(ui, server)

R来自numericInput Datatable列的Shiny提取值

1 个答案: