Pass reactive table to function to be printed via action button-CodePudding

I have a R shinydashboard where a table can be edited and then I'd like the new table to be passed to the function agree() to calculate a statistic to be printed upon clicking an action button. I'm getting the following error in my renderPrint box on the app and assume a few things may be off in my code:

Error message in renderPrint box on app:

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

Below is my code (I have 3 tabItems but am just focusing on getting the first tab: tabName = "2int" to work. Issue lies in the sever code of output$irr1. Can use the baseR cor() function in replace of agree() from the irr package for testing purposes. Just need the updated table to be saved as a dataframe with all numbers or matrix to function correctly with the agree() function.

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)

CodePudding user response：

You are mixing things here, and therefore your syntax is incorrect. Try this

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

}