r - 在 R Shiny 中,如何为反应对象渲染绘图?
问题描述
我已经在 Shiny 中渲染了很多情节,但这个让我很失望。运行以下 MWE 代码时,默认数据表会正确呈现在“负债模块”选项卡下的主面板中。此数据表是首次打开此选项卡时的默认视图。请参阅下面的第一张图片以了解它的外观。
但是,当我单击同一“负债模块”主面板中的“向量图”操作按钮时,出现错误:需要有限的 'ylim' 值,如下图 2 所示。
用于渲染数据表(按预期工作)和绘图(不起作用)的反应对象是相同的 - vectorsAll
。
如何绘制vectorsAll
对象?这样当用户在没有先点击侧边栏面板中的“输入负债”操作按钮的情况下点击“向量图”操作按钮时,现在会绘制来自默认表的相同数据(60 个周期的值为 0.2)?此外,当用户单击“输入负债”操作按钮并更改矩阵输入网格的 A 行中的值时,数据表和绘图都应相应更新(基于用户更改数据表的正确更新行从 0.2 到 0.23 的输入矩阵如下图 3 所示)。
我想把它保存在原生 Shiny 中,没有 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 & 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)
解决方案
推荐阅读
- matlab - 我们如何在 Matlab 中从 csv 导入时间序列数据?
- python - 如何在 Kubernetes 的 Flink 集群上运行 Apache Beam Python 管道?
- azure - 使用 AzureAD 和 Authentication.AzureAD.UI 为失败的登录创建友好的错误页面:AADSTS50105
- python - Pandas 使用两个(或多个值)进行分组聚合
- swift - 使用 CoreData 谓词检查对象
- r - 如何在我的数据框中将某些列的负值变为正值
- css - 如何在不同的组件中动态使用单个ag网格并改变样式
- swift - 错误:线程 1:“*** -[__NSArrayM objectAtIndexedSubscript:]:索引 1 超出范围 [0 .. 0]”
- node.js - node.js 错误 [ERR_HTTP_HEADERS_SENT]:在将标头发送到客户端后无法设置标头
- javascript - 内部 CSS 有效,但外部无效