在 R shiny 中，如何为反应式 object 渲染 plot？

Question

I've rendered plenty of plots in Shiny but this one is throwing me. When running the below MWE code, the default data.table is properly rendered in the main panel under the "Liabilities Module" tab. This data.table is the default view when first opening this tab. See first image below to see what this looks like.

However, when I click on the "Vector plots" action button in that same "Liabilities Module" main panel, I get Error: need finite 'ylim' values as shown in the 2nd image below.

The reactive object for rendering the data.table (which works as intended) and the plot (which doesn't work) is the same - vectorsAll .

How do I plot the vectorsAll object? So that when the user clicks the "Vector plots" action button without having first clicked on the "Input Liabilities" action button in the sidebar panel, that same data from the default table is now plotted (value of 0.2 for 60 periods)? Also, when the user clicks on the "Input Liabilities" action button and changes the value in row A of the matrix input grid, both the data.table and plot should update accordingly (the correct updating of the data.table based on the user changing the row A input matrix from 0.2 to 0.23 is shown in the 3rd image below).

I'd like to keep this in native Shiny, no ggplot or other plot package. I'll make this App fancier later as it progresses.

MWE code:

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

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),
        tabPanel("By accounts", value=3), 
        tabPanel("Liabilities module", value=4,
                 fluidRow(h5(strong(helpText("Select model output to view:")))),
                 fluidRow(
                   button2('showVectorValueBtn','Vector values'),
                   button2('showVectorPlotBtn','Vector plots'),
                 ), # close fluid row
                 
                 div(style = "margin-top: 5px"),
                 
                 # Shows outputs on each page of main panel   
                 uiOutput('showResults')), 
        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==4",
        actionButton('showLiabilityGrid','Input Liabilities',style='width:100%;background-color:LightGrey'),
        setShadow(id='showLiabilityGrid'),
        div(style = "margin-bottom: 10px"),
      ), # close conditional panel
      conditionalPanel(condition="input.tabselected==3"),
      conditionalPanel(condition="input.tabselected==4")
    ) # close tagList
  }) # close renderUI
  
  # --- Below defines the vectorsAll object before user clicks on actionButton "Input Liabilities" ---->
  vectorsAll <- reactive({
    if (is.null(input$showLiabilityGrid)){df <- NULL}
    else {
      if(input$showLiabilityGrid < 1){df <- cbind(Period = 1:60,Yld_Rate = pct(0.2))}  # define what you want to display by default
      else {
        req(input$base_input)
        df <- cbind(Period = 1:60,Yld_Rate = pct(yield()[,2]))
      } # close 2nd else
    } # close 1st else
    df
  }) # close reactive
  
  output$table1 <- renderTable({vectorsAll()})
  
  # --- Below produces vector values after clicking "Vector Values" button; see above for pre-click ---->
  observeEvent(input$showVectorValueBtn,
               {showResults$showme <-
                 tagList(tableOutput("table1"))
               },ignoreNULL = FALSE)
  
  # --- Below produces vector plots -------------------------------------------------------------------->   
  output$graph1 <-renderPlot(plot(vectorsAll()))
  observeEvent(input$showVectorPlotBtn,{showResults$showme <- plotOutput("graph1")})
  
  # --- Below sends both vector plots and vector values to UI section above ---------------------------->
  output$showResults <- renderUI({showResults$showme})
  
  # --- Below for modal dialog inputs ------------------------------------------------------------------>
  observeEvent(input$showLiabilityGrid,
               {showModal(modalDialog(
                 matrix1Input("base_input"),
                 div(style = "margin-top: 0px"),
                 useShinyjs(),
               ) # close modalDialog
               ) # close showModal
               } # close showModal function
  ) # close observeEvent
  
}) # close server

shinyApp(ui, server)

Answer 1

Your variable/column Yld_Rate is character with % in it. Once you substitute it to a missing value, it works fine. Try this

output$graph1 <-renderPlot(plot(sapply(vectorsAll(), function(x)gsub("%", "", x))))