使用增量计算在闪亮的应用程序中编辑数据表

Posted 2023-02-14

【中文标题】使用增量计算在闪亮的应用程序中编辑数据表

【英文标题】：Editing data table in shiny app with incremental calculation

【发布时间】：2022-01-19 16:56:19

【问题描述】：

我目前正在开发一个闪亮的应用程序，我希望用户进入其中并对显示的表格上的特定列进行一些更改，然后触发要完成的计算并更新显示的表格。例如，取如下数据框：

input_data <- data.frame(ITEM_NO = c("1000001", "1000001","1000001", "20001", '20001', '20001'),
                     AVAILABLE_QTY = c(1000, 1000, 1000, 500,500,500),
                     DEMAND = c(0, 0, 0, 0, 0, 0),
                     FORECAST = c(0,0,0, 0 ,0, 0),
                     stringsAsFactors = FALSE)

我希望能够以触发简单增量计算的方式更改预测列，以从可用数量中减去输入的预测。诀窍是我希望能够让应用程序对每个单独的项目进行单独的计算。我编写了一些适用于单个项目的代码，所以如果我只为 1000001 做它，它会起作用，或者如果我只为 20001 做它，它会起作用，但是当我尝试同时对两者进行编辑时它因以下错误而崩溃：“警告：[.data.table:j 中的错误（[...] 中的第二个参数）是单个符号，但未找到列名 'j'。也许您打算使用 DT[, . .j]. 这种与 data.frame 的差异是经过深思熟虑的，并在 FAQ 1.1 中进行了解释。 "。谁能帮我调整这段代码，让它在那种情况下工作？

这是完整的代码：

library(shiny)
library(dplyr)
library(DT)
input_data <- data.frame(ITEM_NO = c("1000001", "1000001","1000001", "20001", '20001', '20001'),
                         AVAILABLE_QTY = c(1000, 1000, 1000, 500,500,500),
                         DEMAND = c(0, 0, 0, 0, 0, 0),
                         FORECAST = c(0,0,0, 0 ,0, 0),
                         stringsAsFactors = FALSE)
#=================================================================
modFunction <- function(input, output, session, data,reset) 
  
  v <- reactiveValues(data = data)
  
  proxy = dataTableProxy("mod_table")
  
  #need to change this function so that the data gets group split
  observeEvent(input$mod_table_cell_edit, 
    print(names(v$data))
    info = input$mod_table_cell_edit
    str(info)
    i = info$row
    j = info$col
    k = info$value
    str(info)
    print(i)
    print(j)
    print(k)
    isolate(
      #try putting the list stuff out here instead and see if it gets rid of the e
      if (j %in% match(c("FORECAST"), names(v$data))) 
        print(match(c("FORECAST"), names(v$data)))
        v$data[i, j] <<- DT::coerceValue(k, v$data[i, j])
        print(v$data)
        
        if(j %in% match('FORECAST', names(v$data)))
          #convert to a list
          test_stuff<- v$data
          start_list<- test_stuff %>% group_split(ITEM_NO)
          end_list<- list()
          for(t in 1:length(start_list))
            start<- start_list[[t]]
            for(n in 2:nrow(start))
              start$AVAILABLE_QTY[n] <- start$AVAILABLE_QTY[n-1]-start$DEMAND[n]-start$FORECAST[n]
            
            end_list[[t]]<- start
            
          
          final<-  data.table::rbindlist(end_list)
          v$data<<- final
            
        
       else 
        stop("You cannot change this column.") # check to stop the user from editing only few columns
      
    )
    replaceData(proxy, v$data, resetPaging = FALSE)  # replaces data displayed by the updated table
  )
  ### Reset Table
  observeEvent(reset(), 
    v$data <- data # your default data
  )
  
  print(isolate(colnames(v$data)))
  output$mod_table <- DT::renderDataTable(
    DT::datatable(v$data, editable = TRUE)
    
  )


modFunctionUI <- function(id) 
  ns <- NS(id)
  DT::dataTableOutput(ns("mod_table"))
  

#===================================================
shinyApp(
  ui = basicPage(
    mainPanel(
      actionButton("reset", "Reset"),
      tags$hr(),
      modFunctionUI("editable")
    )
  ),
  server = function(input, output) 
    demodata<-input_data
    callModule(modFunction,"editable", demodata,
               reset = reactive(input$reset))
  
)

【参考方案1】：

您的问题是因为 final 是一个 data.table 并且您将其分配给 v$data。只要v$data 是一个数据框，它就可以正常工作。试试这个

library(shiny)
library(dplyr)
library(DT)

input_data <- data.frame(ITEM_NO = c("1000001", "1000001","1000001", "20001", '20001', '20001'),
                         AVAILABLE_QTY = c(1000, 1000, 1000, 500,500,500),
                         DEMAND = c(0, 0, 0, 0, 0, 0),
                         FORECAST = c(0,0,0, 0 ,0, 0),
                         stringsAsFactors = FALSE)
#=================================================================
#modFunction <- function(input, output, session, data,reset,globalSession) 
modFunction <- function(id, data, reset) 
  moduleServer(id, function(input, output, session) 
  v <- reactiveValues(data = NULL)
  observe(v$data <- data())
  
  output$mod_table <- renderDT(
    DT::datatable(v$data, editable = TRUE, rownames = FALSE)
  )
  
  proxy = dataTableProxy("mod_table" ) #, session = globalSession)
  
  #need to change this function so that the data gets group split
  observeEvent(input$mod_table_cell_edit, 
    
    print(names(v$data))
    info = input$mod_table_cell_edit
    str(info)
    i = info$row
    j = info$col + 1
    k = info$value
    # str(info)
    print(i)
    print(j)
    print(k)
    myvar <- match(c("FORECAST"), names(v$data))
    isolate(
      #try putting the list stuff out here instead and see if it gets rid of the e
      if (j == myvar) 
        print(myvar)
        v$data[i, j] <<- DT::coerceValue(k, v$data[i, j])
        print(v$data)
        
        #if(j %in% match('FORECAST', names(v$data)))
          #convert to a list
          test_stuff<- v$data
          start_list<- test_stuff %>% group_split(ITEM_NO)
          end_list<- list()
          lapply(1:length(start_list), function(t)
          #for(t in 1:length(start_list))
            start<- start_list[[t]]
            for(n in 2:nrow(start))
                start$AVAILABLE_QTY[n] <- start$AVAILABLE_QTY[n-1]-start$DEMAND[n]-start$FORECAST[n]
            
            end_list[[t]]<<- start
            
          #
          )
          final <-  data.table::rbindlist(end_list)
          v$data<<- as.data.frame(final)
          
          #
          
       else 
        stop("You cannot change this column.") # check to stop the user from editing only few columns
      
    )
    
    replaceData(proxy, v$data, resetPaging = FALSE, rownames = FALSE)  # replaces data displayed by the updated table
  )
  ### Reset Table
  observeEvent(reset(), 
    v$data <- data() # your default data
  )
  
  print(isolate(colnames(v$data)))

  )


modFunctionUI <- function(id) 
  ns <- NS(id)
  DTOutput(ns("mod_table"))
  


#===================================================
shinyApp(
  ui = basicPage(
    mainPanel(
      actionButton("reset", "Reset"),
      tags$hr(),
      modFunctionUI("editable")
    )
  ),
  server = function(input, output, session) 
    demodata <- reactive(input_data)
    modFunction("editable", demodata, reset = reactive(input$reset))
    #callModule(modFunction,"editable", demodata,reset = reactive(input$reset),globalSession = session)
  
)

【讨论】：

哇，我很感激！我认为这将是一件简单的事情，当它弄清楚时我会打自己的头 - 我是对的！再次感谢！