将反应式 table 传递给要通过操作按钮打印的功能

Question

我有一个 R shinydashboard，其中可以编辑 table，然后我希望将新的 table 传递给函数 agree() 以计算统计数据单击操作按钮时打印。我在应用程序的 renderPrint 框中收到以下错误，并假设我的代码中可能存在一些问题：

应用上的 renderPrint 框中的错误消息：

structure(function (...) ,{,    if (length(outputArgs) != 0 && !hasExecuted$get()) {,        warning("Unused argument: outputArgs. The argument outputArgs is only ", ,            "meant to be used when embedding snippets of Shiny code in an ", ,            "R Markdown code chunk (using runtime: shiny). When running a ", ,            "full Shiny app, please set the output arguments directly in ", ,            "the corresponding output function of your UI code."),        hasExecuted$set(TRUE),    },    if (is.null(formals(renderFunc))) ,        renderFunc(),    else renderFunc(...),}, class = "function", outputFunc = function (outputId, placeholder = FALSE) ,{,    pre(id = outputId, class = "shiny-text-output", class = if (!placeholder) ,        "noplaceholder"),}, outputArgs = list(), hasExecuted = <environment>, cacheHint = list(,    label = "renderPrint", origUserExpr = agree(as.data.frame(table1))))

下面是我的代码（我有 3 个 tabItems，但我只是专注于让第一个选项卡：tabName = "2int" 工作。问题在于 output$irr1 的服务器代码。可以使用 baseR cor() 函数替换 irr 包中的 agree() 用于测试目的。只需要将更新后的 table 保存为包含所有数字或矩阵的数据框即可与agree() 函数。

library(shiny)
library(irr)
library(DT)
library(dplyr)
library(shinydashboard)


ui <- dashboardPage(
  dashboardHeader(title = "Interview Reliability"),
  
  dashboardSidebar(
    sidebarMenu(
      menuItem("Two Interviewers",
               tabName = "2int",
               icon = icon("glass-whiskey")),
      menuItem("Three Interviewers",
               tabName = "3int",
               icon = icon("glass-whiskey")),
      menuItem("Four Interviewers",
               tabName = "4int",
               icon = icon("glass-whiskey"))
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName = "2int",
            fluidRow(box(sliderInput("obs1", "Number of Interview Questions:",
                            value = 4,
                            min = 4,
                            max = 12,
                            step = 1))),
            box(dataTableOutput("table1")),
            box(verbatimTextOutput("irr1")),
            box(actionButton("calc1", "Calculate"))
            ),
    
      tabItem(tabName = "3int",
              box(sliderInput("obs2", "Number of Interview Questions:",
                              value = 4,
                              min = 4,
                              max = 12,
                              step = 1))
              
            ),
    
      tabItem(tabName = "4int",
              box(sliderInput("obs3", "Number of Interview Questions:",
                              value = 4,
                              min = 4,
                              max = 12,
                              step = 1)),
      )
            
    )
  )
)

server <- function(input, output) {
  
  tablevalues <- reactiveValues(df = NULL)
  
  observeEvent(input$obs1, {
    tablevalues$df <- matrix(NA, nrow = input$obs1, ncol = 2,
                             dimnames = list(1:input$obs1, c("Interviewer 1", "Interviewer 2")))
  })
  
  output$table1 <- renderDT(tablevalues$df, escape = FALSE, selection = 'none', editable=TRUE) 
  
  
 
  output$irr1 <- eventReactive(input$calc1, {
    renderPrint(agree(as.data.frame(table1)))
  
  })  
}

shinyApp(ui = ui, server = server)

Answer 1

您在这里混淆了内容，因此您的语法不正确。试试这个

server <- function(input, output) {

  tablevalues <- reactiveValues(df = NULL)

  observeEvent(input$obs1, {
    tablevalues$df <- matrix(NA, nrow = input$obs1, ncol = 2,
                             dimnames = list(1:input$obs1, c("Interviewer 1", "Interviewer 2")))
  })

  output$table1 <- renderDT(tablevalues$df, escape = FALSE, selection = 'none', editable=TRUE)
  
  ###  update tablevalues$df with all the edits
  observeEvent(input$table1_cell_edit,{
    info = input$table1_cell_edit
    str(info)
    i = info$row
    j = info$col
    v = as.numeric(info$value)   ###  change it to info$value if your function does not need it to be numeric
    
    tablevalues$df[i, j] <<- DT::coerceValue(v, tablevalues$df[i, j])
  })

  mycor <- eventReactive(input$calc1, {
    cor(tablevalues$df)
  })

  output$irr1 <- renderPrint({mycor()})

}

将反应式 table 传递给要通过操作按钮打印的功能

Pass reactive table to function to be printed via action button

r

shiny

shinydashboard