通过动作按钮将反应表传递给要打印的功能 [英] Pass reactive table to function to be printed via action button

问题描述

我有一个R shinyashboard，其中可以编辑表，然后我希望将新表传递给函数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个表项，但我只专注于让第一个表项工作：tabName = "2int")。问题出在output$irr1的服务器代码中。可以使用BASERcor()函数代替agree()包中的irr进行测试。只需将更新后的表保存为包含所有数字或矩阵的数据帧，即可使用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)

推荐答案

您在这里混在一起，因此您的语法不正确。试试这个

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()})

}

这篇关于通过动作按钮将反应表传递给要打印的功能的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！