在 R shiny 中如何呈现一个反应式 data.table？

Question

The below MWE code works as intended, except that the data.table output is not being rendered in the main panel when the "Vector values" action button is clicked in the "By balances" tab (first tab that appears by default).

For now I'd like to render the table in base Shiny without using a table package such as DT.

I don´t think the vectorsAll function below is necessary, I've tried this with yield() function instead and it still doesn't work.

What am I doing wrong? This should be such a simple thing, rendering a 60 row data.table, I'm sure I'm overlooking something very obvious.

vectorPlot function that goes with below MWE:

vectorPlot <- function(w,x,y,z){plot(w,main=x,xlab=y,ylab=z,type="b",col="blue",pch=19,cex=1.25)}

MWE:

library(shiny)
library(shinyMatrix)
library(shinyjs)

button2 <- function(x,y){actionButton(x,y,style="width:90px;margin-bottom:5px;font-size:80%")}

matrix1Input <- function(x){
  matrixInput(x, 
              value = matrix(c(0.2), 4, 1, dimnames = list(c("A","B","C","D"),NULL)),
              rows = list(extend = FALSE,  names = TRUE),
              cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
              class = "numeric")}

vectorBase <- function(x,y){
  a <- rep(y,x)
  b <- seq(1:x)
  c <- data.frame(x = b, y = a)
  return(c)}

ui <- 
  pageWithSidebar(
    headerPanel("Model..."),
    sidebarPanel(
      fluidRow(helpText(h5(strong("Base Input Panel")),align="center",
                        style="margin-top:-15px;margin-bottom:5px")),
    # Panels rendered with uiOuput & renderUI in server to stop flashing at invocation
      uiOutput("Panels") 
    ), # close sidebar panel
    mainPanel(
      tabsetPanel(
        tabPanel("By balances", value=2,
                 fluidRow(h5(strong(helpText("Select model output to view:")))),
                 fluidRow(
                   button2('showVectorPlotBtn','Vector plots'),
                   button2('showVectorValueBtn','Vector values'),
                 ), # close fluid row
                 
                 div(style = "margin-top: 5px"),
                
                 # Shows outputs on each page of main panel   
                 uiOutput('showResults'),
        ),  # close tab panel
        tabPanel("By accounts", value=3), 
        tabPanel("Liabilities module", value=4), 
        id = "tabselected"
      ) # close tabset panel
    ) # close main panel
  ) # close page with sidebar

server <- function(input,output,session)({
  
  base_input  <- reactive(input$base_input)
  showResults <- reactiveValues()

  yield   <- function(){vectorBase(60,input$base_input[1,1])} # Must remain in server section
  
  # --- Conditional panels rendered here rather than in UI to eliminate invocation flashing ---------->
  output$Panels <- renderUI({
    tagList( 
      conditionalPanel(
        condition="input.tabselected==2",
        matrix1Input("base_input"),
        div(style = "margin-top: 0px"), 
        useShinyjs(),
      ), # close conditional panel
      conditionalPanel(condition="input.tabselected==3"),
      conditionalPanel(condition="input.tabselected==4")
    ) # close tagList
  }) # close renderUI
  
  # --- Below produces vector plots as default view when first invoking App ----------------------------->
  output$graph1 <-renderPlot(vectorPlot(yield(),"A Variable","Period","Rate"))
  
  # --- Below produces vector plots after having clicked "Vector Plot" button; see above for pre-click ->
  observeEvent(input$showVectorPlotBtn,
               {showResults$showme <- 
                 tagList(plotOutput("graph1"))
               },ignoreNULL = FALSE)
  
  # --- Below produces vector values table ------------------------------------------------------------->
  vectorsAll <- reactive({cbind(Period = 1:60,Yld_Rate = pct(yield()[,2]))})
  
  output$table1 <- renderTable({vectorsAll()})
  
  observeEvent(input$showVectorValueBtn,{showResults$showme <- show("table1")})

  # --- Below sends both vector plots and vector values to UI section above ---------------------------->
  output$showResults <- renderUI({showResults$showme})

}) # close server

shinyApp(ui, server)

Answer 1

Mistake was to use show("table1") instead of tableOutput("table1") in the last observeEvent in the original MWE code posted above. Also two custom functions in the original MWE were erroneously omitted: "pct" and "vectorPlot". Revised MWE code below now uses the correct table output syntax and includes all required functions. Now it runs as intended. Thanks to YBS comment for pointing out the error.

library(shiny)
library(shinyMatrix)
library(shinyjs)

button2 <- function(x,y){actionButton(x,y,style="width:90px;margin-bottom:5px;font-size:80%")}

matrix1Input <- function(x){
  matrixInput(x, 
              value = matrix(c(0.2), 4, 1, dimnames = list(c("A","B","C","D"),NULL)),
              rows = list(extend = FALSE,  names = TRUE),
              cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
              class = "numeric")}

pct <- function(x){paste(format(round(x*100,digits=1),nsmall=1),"%",sep="")} # convert to percentage

vectorBase <- function(x,y){
  a <- rep(y,x)
  b <- seq(1:x)
  c <- data.frame(x = b, y = a)
  return(c)}

vectorPlot <- function(w,x,y,z){plot(w,main=x,xlab=y,ylab=z,type="b",col="blue",pch=19,cex=1.25)}

ui <- 
  pageWithSidebar(
    headerPanel("Model..."),
    sidebarPanel(
      fluidRow(helpText(h5(strong("Base Input Panel")),align="center",
                        style="margin-top:-15px;margin-bottom:5px")),
    # Panels rendered with uiOuput & renderUI in server to stop flashing at invocation
      uiOutput("Panels") 
    ), # close sidebar panel
    mainPanel(
      tabsetPanel(
        tabPanel("By balances", value=2,
                 fluidRow(h5(strong(helpText("Select model output to view:")))),
                 fluidRow(
                   button2('showVectorPlotBtn','Vector plots'),
                   button2('showVectorValueBtn','Vector values'),
                 ), # close fluid row
                 
                 div(style = "margin-top: 5px"),
                
                 # Shows outputs on each page of main panel   
                 uiOutput('showResults'),
        ),  # close tab panel
        tabPanel("By accounts", value=3), 
        tabPanel("Liabilities module", value=4), 
        id = "tabselected"
      ) # close tabset panel
    ) # close main panel
  ) # close page with sidebar

server <- function(input,output,session)({
  
  base_input  <- reactive(input$base_input)
  showResults <- reactiveValues()

  yield   <- function(){vectorBase(60,input$base_input[1,1])} # Must remain in server section
  
  # --- Conditional panels rendered here rather than in UI to eliminate invocation flashing ---------->
  output$Panels <- renderUI({
    tagList( 
      conditionalPanel(
        condition="input.tabselected==2",
        matrix1Input("base_input"),
        div(style = "margin-top: 0px"), 
        useShinyjs(),
      ), # close conditional panel
      conditionalPanel(condition="input.tabselected==3"),
      conditionalPanel(condition="input.tabselected==4")
    ) # close tagList
  }) # close renderUI
  
  # --- Below produces vector plots as default view when first invoking App ----------------------------->
  output$graph1 <-renderPlot(vectorPlot(yield(),"A Variable","Period","Rate"))
  
  # --- Below produces vector plots after having clicked "Vector Plot" button; see above for pre-click ->
  observeEvent(input$showVectorPlotBtn,
               {showResults$showme <- 
                 tagList(plotOutput("graph1"))
               },ignoreNULL = FALSE)
  
  # --- Below produces vector values table ------------------------------------------------------------->
  vectorsAll <- reactive({cbind(Period = 1:60,Yld_Rate = pct(yield()[,2]))})
  
  output$table1 <- renderTable({vectorsAll()})
  
  observeEvent(input$showVectorValueBtn,{showResults$showme <- tableOutput("table1")})
  
  # --- Below sends both vector plots and vector values to UI section above ---------------------------->
  output$showResults <- renderUI({showResults$showme})

}) # close server

shinyApp(ui, server)