在 r Shiny 中的两个 renderDT 之间切换

Question

我正在构建一个闪亮的应用程序，用户需要添加一个数字项向量（我为此使用了 renderDT），该向量应该用于计算另一个 renderDT 中的列值。有没有办法使用 arates1[i,2] 来计算 arates2[i,1]。下面的代码不允许这样做。有什么想法可以解决这个问题？

    ui <- navbarPage("Calculator",
                 
                 tabPanel("allocate",
                          fluidRow(
                            
                            column(2, wellPanel(
                              
                              
                              numericInput(inputId = "nsamp",
                                          label = "Total sample size",
                                          min = 10, max = 1000000, value = 100),
                              
                              numericInput(inputId = "Nstrata",
                                          label = "Number of Strata",
                                          min = 1, max = 500, value = 10)
                            ))
                            ,
                            
                            # Output:
                            column(2, 
                              DTOutput("tbl")
                            ),
                            column(5,
                              DTOutput("tb2")
                            )
                          )
                 ))

    server <- function(input, output, session) 
    {
output$tbl <- renderDT({
    
    Nstrata <- as.numeric(input$Nstrata)
    RSE_ <- rep(0,Nstrata)    
    
    arates1 <- matrix(0, nrow = Nstrata, ncol = 2)
    dimnames(arates1) <- list(NULL, c("ID","population"))
    
    for (i in seq_along(RSE_)) {
      
      arates1[i,1] <- i
      arates1[i,2] <- 0

    }
    
    datatable(arates1, class = 'cell-border stripe',
              options = list(dom = 't', pageLength = Nstrata, initComplete = JS(
                "function(settings, json) {",
                "$(this.api().table().header()).css({'background-color': '#000', 'color': '#fff'});",
                "}")),editable = TRUE)
  })
  
  output$tb2 <- renderDT({
    
    Nstrata <- as.numeric(input$Nstrata)
    RSE_ <- rep(0,Nstrata) 
    arates2 <- matrix(0, nrow = Nstrata, ncol = 1)
    dimnames(arates2) <- list(NULL, c("allocation"))
    
    for (i in seq_along(RSE_)) {
      
      arates2[i,1] <- input$nsamp*arates1[i,2]

    }
    
    datatable(arates2, class = 'cell-border stripe',
              options = list(dom = 't', pageLength = Nstrata, initComplete = JS(
                "function(settings, json) {",
                "$(this.api().table().header()).css({'background-color': '#000', 'color': '#fff'});",
                "}")))
    
  })
}

Answer 1

如果您将第一个数据帧设为响应式，则可以使用它。请试试这个。

library(data.table)

  ui <- navbarPage("Calculator",

                   tabPanel("allocate",
                            fluidRow(
                              column(2, wellPanel(
                                numericInput(inputId = "nsamp",
                                             label = "Total sample size",
                                             min = 10, max = 1000000, value = 100),

                                numericInput(inputId = "Nstrata",
                                             label = "Number of Strata",
                                             min = 1, max = 500, value = 10)
                              )),

                              # Output:
                              column(2,
                                     DTOutput("tb1")
                              ),
                              column(3,
                                     DTOutput("tb2")
                              )
                            )
                   ))

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

    Nstrata <- reactiveVal(0)
    arates <- reactiveValues(data=NULL)
    observe({
      req(input$Nstrata)
      Nstrata(input$Nstrata)
      arates1 <- matrix(0, nrow = req(input$Nstrata), ncol = 2)
      dimnames(arates1) <- list(NULL, c("ID","population"))

      for (i in (1:Nstrata())) {

        arates1[i,1] <- i
        arates1[i,2] <- i*i

      }

      arates$data <- arates1

    })

    output$tb1 <- renderDT({
      req(Nstrata())
      #Nstrata <- as.numeric(input$Nstrata)
      datatable(arates$data, class = 'cell-border stripe',
                options = list(dom = 't', pageLength = Nstrata(), initComplete = JS(
                  "function(settings, json) {",
                  "$(this.api().table().header()).css({'background-color': '#000', 'color': '#fff'});",
                  "}")),editable = TRUE)
    })


    observeEvent(input$tb1_cell_edit, {
      info = input$tb1_cell_edit
      str(info)
      i = info$row
      j = info$col + 1  # column index offset by 1
      v = info$value
      
      arates$data[i, j] <<- DT::coerceValue(v, arates$data[i, j])
    }) 
    
    output$tb2 <- renderDT({
      arates2 <- matrix(0, nrow = Nstrata(), ncol = 1)
      dimnames(arates2) <- list(NULL, c("allocation"))
      arates2[,1] <- arates$data[,2]*input$nsamp
      datatable(arates2, class = 'cell-border stripe',
                options = list(dom = 't', pageLength = Nstrata(), initComplete = JS(
                  "function(settings, json) {",
                  "$(this.api().table().header()).css({'background-color': '#000', 'color': '#fff'});",
                  "}")))
      
    })
    
  }

  shinyApp(ui = ui, server = server)