Пользовательский ввод в DataTable используется для пересчета и обновления столбца в Shiny - PullRequest
Новая
       23

Пользовательский ввод в DataTable используется для пересчета и обновления столбца в Shiny

0 голосов
/ 10 октября 2018

Я хочу создать веб-приложение, которое позволяет пользователю вводить ввод в объект 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)

1 Ответ

0 голосов
/ 10 октября 2018

Я не мог полностью понять ваш код, поэтому я сам создал другой воспроизводимый пример, основанный на куче других ответов, особенно этот один .

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, который специально предназначен для такого рода целей.

...