Reputation: 2720
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)
Upvotes: 0
Views: 1169
Reputation: 21297
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))))
Upvotes: 1