Блог

Я изобразил множество сюжетов в Блестящем, но этот меня бросает. При выполнении приведенного ниже кода MWE таблица данных по умолчанию правильно отображается на главной панели на вкладке «Модуль обязательств». Эта таблица данных отображается по умолчанию при первом открытии этой вкладки. См.Первое изображение ниже, чтобы увидеть, как это выглядит.

Однако, когда я нажимаю на кнопку действия «Векторные графики» на той же главной панели «Модуль данных», я получаю сообщение об ошибке: нужны конечные значения «ylim», как показано на 2-м изображении ниже.

Реактивный объект для визуализации таблицы данных (которая работает по назначению) и графика (который не работает) один и тот же — vectorsAll .

Как мне построить vectorsAll объект? Таким образом, когда пользователь нажимает кнопку действия «Векторные графики», не нажимая сначала кнопку действия «Ввод обязательств» на боковой панели, теперь отображаются те же данные из таблицы по умолчанию (значение 0,2 для 60 периодов)? Кроме того, когда пользователь нажимает на кнопку действия «Входные обязательства» и изменяет значение в строке A таблицы ввода матрицы, как таблица данных, так и график должны обновляться соответствующим образом (правильное обновление таблицы данных на основе изменения пользователем входной матрицы строки A с 0,2 до 0,23 показано на 3-м изображении ниже).

Я бы хотел сохранить это в родном блестящем, без ggplot или другого сюжетного пакета. Я сделаю это приложение более привлекательным позже, по мере его развития.

Код 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")}

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

Ваша переменная/столбец Yld_Rate -это символ, с % которым в нем. Как только вы замените его отсутствующим значением, он будет работать нормально. Попробуйте это

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