使用Shinydashboard侧栏上的输入未绘制的情节 [英] Plot not rendering with inputs on the sidebar of shinydashboard
本文介绍了使用Shinydashboard侧栏上的输入未绘制的情节的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
几天来，我一直在使用 shiny 库开发应用程序，现在我想使用 shinydashboard 包测试新的改编版本.问题在于，当我在侧边栏中设置输入时，我的绘图不会出现在我希望其显示的选项卡中(显示).
仅使用闪亮包，我设置了以下代码，没有菜单侧边栏(如闪亮仪表板中的内容):
库(发光)库(ggplot2)图书馆(dplyr)rm(list = ls());GC()#functions订购条形图reorder_within<-function(x，by，inside，fun = mean，sep ="___"，...){new_x<-paste(x，inside，sep = sep)stats :: reorder(new_x，by，FUN = fun)}scale_x_reordered<-function(...，sep ="___"){reg<-paste0(sep，.+ $")ggplot2 :: scale_x_discrete(labels = function(x)gsub(reg，"，x)，...)}#设置示例数据sample_data = data.frame(Company_Name = c("Company 1"，"Company 2"，"Company 3"，公司1"，公司2"，公司3"，公司1"，公司2"，公司3")，Profits_MM = c(20,100,80，45,120,70，50,110,130)，Sales_MM = c(200,800,520，300,1000,630，410,1150,1200)，年份= c(2016,2016,2016，2017,2017,2017，2018,2018,2018))#UIui<-fluidPage(sidebarLayout(#个输入sidebarPanel(checkboxGroupInput(inputId ="sel_com"，标签=公司选择:"，选择= c(公司1"，公司2"，公司3")，选择=公司1")，selectInput(inputId ="y"，标签=性能变量"，选择= c(利润(以百万为单位)=" Profits_MM，"Sales(in Millions)" ="Sales_MM")，selected ="Profits_MM")，SliderInput("year"，"Year Selection:"，min = 2016，最大值= 2018，值= c(2017,2018)，步骤= 1))，#个输出mainPanel(plotOutput(outputId ="barplot"))))# 服务器服务器<-功能(输入，输出，会话){companies_sel<-反应性({req(input $ sel_com)sample_data_gg =过滤器(sample_data，Company_Name％in％input $ sel_com)#打印(sample_data_gg)sample_data_gg})year_sample<-反应性({需求(输入$年)sample_data_gg = sample_dataif((input $ year [2]-input $ year [1])> 1){年= seq(input $ year [1]，input $ year [2])sample_data_gg = filter(companies_sel()，年份％in％年)}if((input $ year [2]-input $ year [1])== 1){sample_data_gg = filter(companies_sel()，年份％in％输入$ year)}#打印(sample_data_gg)sample_data_gg})输出$ barplot = renderPlot({sample_data_gg = year_sample()y<-输入$ yggplot(data = sample_data_gg，aes(x = reorder_within(Company_Name，get(y)，Year)，y = get(y)))+geom_col(position ="dodge"，fill ="darkred")+facet_wrap(Year〜.，scales ="free")+scale_x_reordered()+主题(axis.text.x = element_text(角度= 60，高度= 1))})}ShinyApp(ui = ui，服务器=服务器) 此代码可在闪亮的程序包中工作，并显示我想在应用程序中显示的情节类型.
但是，如果我更改 shinydashboard 包的编码-在边栏中设置输入时-不会显示该图，并且我试图找出原因.这是代码:
库(发光)库(ggplot2)图书馆(dplyr)图书馆(shinydashboard)reorder_within<-function(x，by，inside，fun = mean，sep ="___"，...){new_x<-paste(x，inside，sep = sep)stats :: reorder(new_x，by，FUN = fun)}scale_x_reordered<-function(...，sep ="___"){reg<-paste0(sep，.+ $")ggplot2 :: scale_x_discrete(labels = function(x)gsub(reg，"，x)，...)}rm(list = ls());GC()sample_data = data.frame(Company_Name = c("Company 1"，"Company 2"，"Company 3"，公司1"，公司2"，公司3"，公司1"，公司2"，公司3")，Profits_MM = c(20,100,80，45,120,70，50,110,130)，Sales_MM = c(200,800,520，300,1000,630，410,1150,1200)，年份= c(2016,2016,2016，2017,2017,2017，2018,2018,2018))#UIui< -dashboardPage(panelHeader(title ="Dashboard Test")，仪表板侧栏(sidebarMenu(id ="tab"，menuItem(数据选择"，tabName ="dc"，icon = icon(仪表板")，checkboxGroupInput(inputId ="sel_com"，标签=公司选择:"，选择= c(公司1"，公司2"，公司3")，选择=公司1")，selectInput(inputId ="y"，标签=性能变量"，选择= c(利润(以百万为单位)=" Profits_MM，"Sales(in Millions)" ="Sales_MM")，selected ="Profits_MM")，SliderInput("year"，"Year Selection:"，min = 2016，最大值= 2018，值= c(2017,2018)，step = 1))))，dashboardBody(tabItems(#第一个标签内容tabItem(tabName ="dc"，fluidRow(column(width = 12，box(plotOutput("plot1")))))))))# 服务器服务器<-功能(输入，输出，会话){companies_sel<-反应性({req(input $ sel_com)sample_data_gg =过滤器(sample_data，Company_Name％in％input $ sel_com)#打印(sample_data_gg)sample_data_gg})year_sample<-反应性({需求(输入$年)sample_data_gg = sample_dataif((input $ year [2]-input $ year [1])> 1){年= seq(input $ year [1]，input $ year [2])sample_data_gg = filter(companies_sel()，年份％in％年)}if((input $ year [2]-input $ year [1])== 1){sample_data_gg = filter(companies_sel()，年份％in％输入$ year)}#打印(sample_data_gg)sample_data_gg})输出$ barplot = renderPlot({sample_data_gg = year_sample()y<-输入$ yggplot(data = sample_data_gg，aes(x = reorder_within(Company_Name，get(y)，Year)，y = get(y)))+geom_col(position ="dodge"，fill ="darkred")+facet_wrap(Year〜.，scales ="free")+scale_x_reordered()+主题(axis.text.x = element_text(角度= 60，高度= 1))})}ShinyApp(ui = ui，服务器=服务器) 我相信我可能会丢失小工具栏和侧边栏中的输入选择之间的某些交互，但是我无法确切地找出问题所在.
解决方案
您的代码中实际上存在一些共同导致该问题的问题:
第一个:第一个在注释中标识-您使用 rm(list = ls())删除了以后需要的功能.
第二:您的 plotOutput()使用的ID为"plot1" ，而renderPlot引用的是"barplot" .我认为这是从您切换到 shinydashboard 以来的一个简单翻译错误.使它们相同，这将有所帮助.
第三:这是三个中比较严重的一个. shinydashboard 有一个已知问题，描述得很好
For a few days I've been working on an app with the shiny library and now I would like to test the new adaptations with the shinydashboard package. The problem is that my plot does not show up (render) in the tab that I would like it to appear when I set the inputs in the sidebar.
Using only the shiny package, I've set the following code, with no menu sidebar (as in shinydashboard):
library(shiny)
library(ggplot2)
library(dplyr)
rm(list=ls()); gc()
#functions to order the bar graph
reorder_within <- function(x, by, within, fun = mean, sep = "___", ...) {
new_x <- paste(x, within, sep = sep)
stats::reorder(new_x, by, FUN = fun)
}
scale_x_reordered <- function(..., sep = "___") {
reg <- paste0(sep, ".+$")
ggplot2::scale_x_discrete(labels = function(x) gsub(reg, "", x), ...)
}
#setting example data
sample_data = data.frame(Company_Name=c("Company 1","Company 2","Company 3",
"Company 1","Company 2","Company 3",
"Company 1","Company 2","Company 3"),
Profits_MM = c(20,100,80,
45,120,70,
50,110,130),
Sales_MM = c(200,800,520,
300,1000,630,
410,1150,1200),
Year=c(2016,2016,2016,
2017,2017,2017,
2018,2018,2018))
# UI
ui <- fluidPage(
sidebarLayout(
# Input(s)
sidebarPanel(
checkboxGroupInput(inputId = "sel_com",
label = "Company Selection:",
choices = c("Company 1","Company 2","Company 3"),
selected = "Company 1"),
selectInput(inputId = "y",
label = "Performance Variable",
choices = c("Profits (in Millions)" = "Profits_MM",
"Sales (in Millions)" = "Sales_MM"),
selected = "Profits_MM"),
sliderInput("year","Year Selection:",
min=2016,
max=2018,
value=c(2017,2018),
step=1)
),
# Output(s)
mainPanel(
plotOutput(outputId = "barplot")
)
)
)
# Server
server <- function(input, output, session) {
companies_sel <- reactive({
req(input$sel_com)
sample_data_gg = filter(sample_data, Company_Name %in% input$sel_com)
# print(sample_data_gg)
sample_data_gg
})
year_sample <- reactive({
req(input$year)
sample_data_gg = sample_data
if((input$year[2] - input$year[1])>1){
Years = seq(input$year[1],input$year[2])
sample_data_gg = filter(companies_sel(), Year %in% Years)
}
if((input$year[2] - input$year[1])==1){
sample_data_gg = filter(companies_sel(), Year %in% input$year)
}
# print(sample_data_gg)
sample_data_gg
})
output$barplot = renderPlot({
sample_data_gg = year_sample()
y <- input$y
ggplot(data = sample_data_gg, aes(x=reorder_within(Company_Name, get( y ), Year), y = get( y ))) +
geom_col(position="dodge", fill="darkred") +
facet_wrap(Year~., scales = "free") +
scale_x_reordered() +
theme(axis.text.x = element_text(angle = 60, hjust = 1))
})
}
shinyApp(ui = ui, server = server)
This code works within the shiny package and shows the type of plot that I would like to show up in the app.
But if I change this coding for the shinydashboard package -- while setting the inputs inside the sidebar -- the plot does not show up and I'm trying to figure out why. Here it is the code:
library(shiny)
library(ggplot2)
library(dplyr)
library(shinydashboard)
reorder_within <- function(x, by, within, fun = mean, sep = "___", ...) {
new_x <- paste(x, within, sep = sep)
stats::reorder(new_x, by, FUN = fun)
}
scale_x_reordered <- function(..., sep = "___") {
reg <- paste0(sep, ".+$")
ggplot2::scale_x_discrete(labels = function(x) gsub(reg, "", x), ...)
}
rm(list=ls()); gc()
sample_data = data.frame(Company_Name=c("Company 1","Company 2","Company 3",
"Company 1","Company 2","Company 3",
"Company 1","Company 2","Company 3"),
Profits_MM = c(20,100,80,
45,120,70,
50,110,130),
Sales_MM = c(200,800,520,
300,1000,630,
410,1150,1200),
Year=c(2016,2016,2016,
2017,2017,2017,
2018,2018,2018))
# UI
ui <- dashboardPage(
dashboardHeader(title = "Dashboard Test"),
dashboardSidebar(
sidebarMenu(id="tab",
menuItem("Data Selection", tabName = "dc", icon = icon("dashboard"),
checkboxGroupInput(inputId = "sel_com",
label = "Company Selection:",
choices = c("Company 1","Company 2","Company 3"),
selected = "Company 1"),
selectInput(inputId = "y",
label = "Performance Variable",
choices = c("Profits (in Millions)" = "Profits_MM",
"Sales (in Millions)" = "Sales_MM"),
selected = "Profits_MM"),
sliderInput("year","Year Selection:",
min=2016,
max=2018,
value=c(2017,2018),
step=1)))),
dashboardBody(
tabItems(
# First tab content
tabItem(tabName = "dc",
fluidRow(column(width=12,box(plotOutput("plot1")))
)
)
)
)
)
# Server
server <- function(input, output, session) {
companies_sel <- reactive({
req(input$sel_com)
sample_data_gg = filter(sample_data, Company_Name %in% input$sel_com)
# print(sample_data_gg)
sample_data_gg
})
year_sample <- reactive({
req(input$year)
sample_data_gg = sample_data
if((input$year[2] - input$year[1])>1){
Years = seq(input$year[1],input$year[2])
sample_data_gg = filter(companies_sel(), Year %in% Years)
}
if((input$year[2] - input$year[1])==1){
sample_data_gg = filter(companies_sel(), Year %in% input$year)
}
# print(sample_data_gg)
sample_data_gg
})
output$barplot = renderPlot({
sample_data_gg = year_sample()
y <- input$y
ggplot(data = sample_data_gg, aes(x=reorder_within(Company_Name, get( y ), Year), y = get( y ))) +
geom_col(position="dodge", fill="darkred") +
facet_wrap(Year~., scales = "free") +
scale_x_reordered() +
theme(axis.text.x = element_text(angle = 60, hjust = 1))
})
}
shinyApp(ui = ui, server = server)
I believe I might be missing some interaction between the barplot and the input selection in the sidebar, but I cannot figure exactly what is wrong.
解决方案
You actually had a few issues in your code that were collectively causing the issue:
First: The first was identified in the comments - your use of rm(list=ls()) was deleting functions that you needed later.
Second: Your plotOutput() was using the id "plot1" while your renderPlot was referring to "barplot". I assume that was a simple translation error from when you were switching over to shinydashboard. Make them the same and that will help.
Third: This was the more serious of the three. shinydashboard has a known issue, described very well here, where multiple elements within menuItem cause the loss of the attributes that link the content to tabItems. You can overcome that with a custom function that sets those values manually, and then wrap your menuItem calls in that function, taking care to specify the tabName in the function.
convertMenuItem <- function(mi,tabName) {
mi$children[[1]]$attribs['data-toggle']="tab"
mi$children[[1]]$attribs['data-value'] = tabName
mi
}
Updated UI for your situation would look like this:
ui <- dashboardPage(
... #Other elements remain unchanged
dashboardSidebar(
sidebarMenu(
convertMenuItem(menuItem("Data Selection", tabName = "dc", icon = icon("dashboard"),
checkboxGroupInput(inputId = "sel_com",
label = "Company Selection:",
choices = c("Company 1","Company 2","Company 3"),
selected = "Company 1"),
selectInput(inputId = "y",
label = "Performance Variable",
choices = c("Profits (in Millions)" = "Profits_MM",
"Sales (in Millions)" = "Sales_MM"),
selected = "Profits_MM"),
sliderInput("year","Year Selection:",
min=2016,
max=2018,
value=c(2017,2018),
step=1)), tabName="dc")
)
),
... #Other elements remain unchanged
)
这篇关于使用Shinydashboard侧栏上的输入未绘制的情节的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
