r - 如何在 R 中被动更改 ShinyDashboard 框的标题?
问题描述
我的代码如下所示,用户可以从中选择位置,sidebarpanel
并且基于用户选择数据显示在mainpanel
. 接下来,我想title
根据用户选择动态更改绘图的。例如,如果用户选择 location1,那么 Plot 的图块应该显示“Loc1”(下图突出显示的地方,我需要更改我的标题)。我不知道如何实现这一点ShinyDashboard
请提供代码解释。
代码:
library(shiny)
library(shinydashboard)
resetForm<-function(session){
updateSelectInput(session,"slct1",selected = ' ')
}
ui<-dashboardPage(
dashboardHeader(title="System Tracker"),
dashboardSidebar(
selectInput('slct1',"Select Location",choices = c(" ",d$Locations)),
actionButton('clear',"Reset Form"),
h4("Powered by:"),
tags$img(src='baka.png',height=50,width=50)
),
dashboardBody(
#fluidRow(
# box( DT::dataTableOutput("mytable")),
# box(plotlyOutput('out'))
conditionalPanel(
#Uses a Javascript formatted condition
condition="input.slct1 !== ' '",
box( DT::dataTableOutput("mytable")),
box(plotlyOutput('out'),status = 'warning',solidHeader = T)
)
)
)
server<-function(input, output,session) {
output$mytable = DT::renderDataTable({
req(input$slct1)
d %>%
filter(Locations==input$slct1)
})
output$out<-renderPlotly({
req(input$slct1)
data_filter<-dd %>%
filter(Locations==input$slct1)
req(nrow(data_filter)>0) #https://stackoverflow.com/questions/51427189/facet-grid-in-shiny-flexdashboard-giving-error-faceting-variables-must-have-at
ggplotly(ggplot(data_filter, aes(Systems,frequency,fill=year)) +
geom_col(position = 'stack')+geom_text(aes(label=label), position = position_stack(vjust = .5)))#+
#facet_grid(.~Locations, space= "free_x", scales = "free_x"))
})
observeEvent(input$clear,{
req(input$slct1)
resetForm(session)
})
}
shinyApp(ui, server)
数据:
structure(list(Systems = c("Sys1", "Sys1", "Sys2", "Sys3", "Sys4",
"Sys6", "Sys7"), Locations = c("loc1", "loc1", "loc1", "loc2",
"loc2", "loc3", "loc1"), year = structure(c(2L, 1L, 1L, 1L, 1L,
3L, 3L), .Label = c("2019", "2018", "0"), class = "factor"),
frequency = c(1L, 2L, 1L, 1L, 1L, 0L, 0L), freq_cal = c(33.33,
66.67, 100, 100, 100, 0, 0), label = c("33.33%", "66.67%",
"100.00%", "100.00%", "100.00%", "0.00%", "0.00%")), row.names = c(NA,
-7L), class = "data.frame")
解决方案
uiOutput
您可以使用和的组合来实现此目的renderUI
,方法是将box()
功能从 UI 移动到服务器,如下所示,
library(shiny)
library(plotly)
library(shinydashboard)
d = structure(list(Systems = c("Sys1", "Sys1", "Sys2", "Sys3", "Sys4",
"Sys6", "Sys7"), Locations = c("loc1", "loc1", "loc1", "loc2",
"loc2", "loc3", "loc1"), year = structure(c(2L, 1L, 1L, 1L, 1L,
3L, 3L), .Label = c("2019", "2018", "0"), class = "factor"),
frequency = c(1L, 2L, 1L, 1L, 1L, 0L, 0L), freq_cal = c(33.33,
66.67, 100, 100, 100, 0, 0), label = c("33.33%", "66.67%",
"100.00%", "100.00%", "100.00%", "0.00%", "0.00%")), row.names = c(NA,
-7L), class = "data.frame")
ui<-dashboardPage(
dashboardHeader(title="System Tracker"),
dashboardSidebar(
selectInput('slct1',"Select Location",choices = c(" ",d$Locations)),
actionButton('clear',"Reset Form"),
h4("Powered by:"),
tags$img(src='baka.png',height=50,width=50)
),
dashboardBody(
#fluidRow(
# box( DT::dataTableOutput("mytable")),
# box(plotlyOutput('out'))
conditionalPanel(
#Uses a Javascript formatted condition
condition="input.slct1 !== ' '",
box(DT::dataTableOutput("mytable")),
uiOutput("placeholder")
)
)
)
server<-function(input, output,session) {
output$placeholder = renderUI({
req(input$slct1)
box(title = input$slct1,plotlyOutput('out'),status = 'warning',solidHeader = T)
})
output$mytable = DT::renderDataTable({
req(input$slct1)
d %>%
filter(Locations==input$slct1)
})
output$out<-renderPlotly({
req(input$slct1)
data_filter<-d %>%
filter(Locations==input$slct1)
req(nrow(data_filter)>0)
ggplotly(ggplot(data_filter, aes(Systems,frequency,fill=year)) +
geom_col(position = 'stack')+geom_text(aes(label=label), position = position_stack(vjust = .5)))#+
#facet_grid(.~Locations, space= "free_x", scales = "free_x"))
})
observeEvent(input$clear,{
req(input$slct1)
updateSelectInput(session,"slct1",selected = ' ')
})
}
shinyApp(ui, server)
推荐阅读
- java - 如何使用 apache nifi 连接到远程 postgresql
- javascript - 使用带有 json 文件的 select2 ajax 远程数据
- c# - 如何避免计数 - Crystal Report 中的最后一个空白页码
- javascript - 在 ES6 中使用 Gulp 4 - Babel 问题
- python - 为什么我的模型在进行正则化和批量标准化后会过拟合
- linux - 如何在 Raspberry Pi 上重新激活终端?
- android - 触摸问题总是在最前面
- javascript - 为什么App.js中这部分代码不起作用?(我做了一个搜索过滤器)
- javascript - JavaScript 中 setInterval 与 setTimeout 的混淆
- javascript - “状态”类型的参数不能分配给“从不”类型的参数