Question

我想创建一个Web应用程序，它允许用户在numericInput对象中输入输入，该对象嵌入在DataTable中，并在另一列中重新计算结果（列与某些静态值的乘积和用户输入列）。

我相信，当我设置一个反应性函数来合并数据集和用户输入列，然后我从RenderDataTable调用它时，我以某种方式破坏了反应性，而且我不知道如何将反应性保持在依赖于表的状态根据用户输入（也在表中）。请帮忙。

可卡住的示例：

library(shiny)
library(DT) 

set.seed(21)
db <- data.frame(ent = rep(x = 1,5),
                 group = c("G","M","O","F","L"),
                 val = sample(1:100, 5, replace=TRUE))

ui <- fluidPage(
      titlePanel(paste0("entity - ", unique(db$ent))),
          sidebarLayout(
               sidebarPanel(
                   helpText("Shiny app calculation")
               ),
               mainPanel(
                   DT::dataTableOutput("table")
               ))
      )


numericText <- function(FUN, id_nums, id_base, label, value, ...) {
                        inputs <- 1:length(id_nums)
                        for (i in 1:length(inputs)) {
                        inputs[i] <- as.character(FUN(paste0(id_base, 
                                     id_nums[i]), label, value, ...))
                        }
return(inputs)
}

inputs <- numericText(numericInput,
                  id_nums = as.character(1:5),
                  id_base = "input_", 
                  label = NULL,
                  value = 0)

db <- data.frame(db,
             num = inputs)


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

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

output_table <- reactive({
        data.frame(db, calc = shinyValue("input_", 5))
})

output$table <- renderDataTable({ 
  datatable(output_table(), rownames = FALSE, escape = FALSE, selection 
  = 'none', options = list(paging = FALSE, ordering = FALSE, searching 
  = FALSE, preDrawCallback = JS('function() { 
  Shiny.unbindAll(this.api().table().node()); }'), drawCallback = 
  JS('function() { Shiny.bindAll(this.api().table().node()); } ')))
  })
 }

shinyApp(ui = ui, server = server)

也许也有帮助-如果我从数据帧中删除了反应表达式，并且将结果写入另一种输出类型（但是这不是解决方案，因为我的主要目的是将其写在另一列中，那么我能够做到这一点）在DataTable中）：

library(shiny)
library(DT) 

set.seed(21)
db <- data.frame(ent = rep(x = 1,5),
                 group = c("G","M","O","F","L"),
                 val = sample(1:100, 5, replace=TRUE))

ui <- fluidPage(
      titlePanel(paste0("entity - ", unique(db$ent))),
          sidebarLayout(
               sidebarPanel(
                   helpText("Shiny app calculation")
               ),
               mainPanel(
                   DT::dataTableOutput("table"),
                   verbatimTextOutput("text")
               ))
      )


numericText <- function(FUN, id_nums, id_base, label, value, ...) {
                        inputs <- 1:length(id_nums)
                        for (i in 1:length(inputs)) {
                        inputs[i] <- as.character(FUN(paste0(id_base, 
                                     id_nums[i]), label, value, ...))
                        }
return(inputs)
}

inputs <- numericText(numericInput,
                  id_nums = as.character(1:5),
                  id_base = "input_", 
                  label = NULL,
                  value = 0)

db <- data.frame(db,
             num = inputs)


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

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

output_table <- db

output$table <- renderDataTable({ 
  datatable(output_table, rownames = FALSE, escape = FALSE, selection 
  = 'none', options = list(paging = FALSE, ordering = FALSE, searching 
  = FALSE, preDrawCallback = JS('function() { 
  Shiny.unbindAll(this.api().table().node()); }'), drawCallback = 
  JS('function() { Shiny.bindAll(this.api().table().node()); } ')))
  })
 }

output$text <- reactive({shinyValue("input_", 5) * db$val
})


shinyApp(ui = ui, server = server)

Answer 1

我无法完全理解您的代码，因此我根据其他答案（尤其是one）制作了另一个可重现的示例。

library(shiny)
library(data.table)
library(rhandsontable)

DF = data.frame(num = 1:10, qty = rep(0,10), total = 1:10,
                stringsAsFactors = FALSE)
#DF = rbind(DF, c(0,0,0))

ui = fluidPage(
  titlePanel("Reactive Table "),
  fluidRow(box(rHandsontableOutput("table", height = 400)))  
)
server = function(input, output) {

  data <- reactiveValues(df=DF)



  observe({
    input$recalc
    data$df <- as.data.frame(DF)
  })

  observe({
    if(!is.null(input$table))
      data$df <- hot_to_r(input$table)
  })


  output$table <- renderRHandsontable({
    rhandsontable(data$df)
  })




  output$table <- renderRHandsontable({

      data$df$total       <- data$df$num * data$df$qty
      print(sum(data$df$num*data$df$price) )

    rhandsontable(data$df, selectCallback = TRUE) 
  })


}
shinyApp(ui, server)

第一个想法是使用rhandsontable，它专门用于这种目的。

DataTable中的用户输入用于重新计算和更新Shiny中的列

1 个答案: