闪亮的应用程序：基于条件、日期 x 轴和 valueBoxOutput 的 gpplot 未显示
shiny App: gpplot based on condition, date x-axis, and valueBoxOutput not showing
我的数据框 df:
df<- structure(list(Dead = c(0L, 0L, 0L, 0L, 0L, 1L, 9L, 0L, 0L, 0L
), Case = c(120L, 70L, 50L, 40L, 39L, 20L, 18L, 13L, 9L, 2L), Recovered = c(30L,0L, 18L, 13L, 19L,
10L, 0L,16L, 0L, 1L), Critical = c(0L, 0L, 0L,
0L, 8L, 4L, 0L, 3L, 2L, 0L), Date = c("18/03/2020", "17/03/2020",
"16/03/2020", "15/03/2020", "14/03/2020", "13/03/2020", "12/03/2020",
"11/03/2020", "10/03/2020", "09/03/2020")), class = "data.frame", row.names = c(NA,
10L))
我的 MWE：
library(shiny)
library(plotly)
library(ggplot2)
df$Date = as.Date(df$Date, format = "%d/%m/%Y")
ui <- fluidPage(
title = 'testing',
sidebarLayout(
sidebarPanel(
helpText(),
selectInput("x", "Choose X-axis data", choices = names(df), selected = "Date"),
selectInput("y", "Choose Y-axis data", choices = names(df)),
# Input: Slider for the number of observations to generate ----
sliderInput("n",
"No. of bins:",
value = 5,
min = 1,
max = 15) ,
),
mainPanel(
tabsetPanel(
tabPanel("ggplot", plotlyOutput("regPlot1")),
tabPanel("default plot", plotOutput("regPlot2")),
tabPanel("Histogram", plotOutput("regPlot3"))
),
fluidRow(
shinydashboard::valueBoxOutput("totalCases",width = 2)
)
)
)
)
server <- function(input, output, session) {
#calculation for box values
total.cases <- sum(df$Case)
## Value1: Total cases ##
output$totalCases <- renderValueBox({
shinydashboard::valueBox(
formatC(total.cases, format="d", big.mark=','),
paste('Total Cases:',total.cases),
icon = icon("stats",lib='glyphicon'),
color = "purple")
})
Graphcase <- reactive({
Gchoice<-input$x
})
myData <- reactive({
df[, c(input$x, input$y)]
})
#plot
output$regPlot1 <- renderPlotly({
# comment the if and else(block) to make run the code
if(Graphcase=="Date"){
ggplotly(ggplot(data = myData(),
aes_string(x = input$x, y = input$y)) +
geom_line( color="blue") +
geom_point(shape=21, color="black", fill="gray", size=4) +
theme(axis.text.x = element_text(color="#993333",
size=10, angle=45,hjust = 1),
axis.text.y = element_text(color="#993333",
size=10, angle=45,hjust = 1)))
+scale_x_date(date_labels = "%b/%d")
}else{
ggplotly(ggplot(data = myData(),
aes_string(x = input$x, y = input$y)) +
geom_line( color="blue") +
geom_point(shape=21, color="black", fill="gray", size=4) +
theme(axis.text.x = element_text(color="#993333",
size=10, angle=45,hjust = 1),
axis.text.y = element_text(color="#993333",
size=10, angle=45,hjust = 1)))
}
})
# plot2
output$regPlot2 <- renderPlot({
par(mar = c(4, 4, .1, .1)) # margin lines
plot(myData(), data = df)
})
#plot 3
output$regPlot3 <- renderPlotly({
ggplotly(ggplot(data = myData(), aes_string(x = input$x)) +
geom_histogram(color="black",
fill="blue",
binwidth=input$n)
)
})
}
shinyApp(ui, server)
我的问题分为 3 个部分：
1) 如果您 运行 代码并将鼠标悬停在图表点上，您会注意到 ggplot 没有在 x 轴上显示正确的日期。我输入 +scale_x_date(date_labels = "%b/%d") 解决了这个问题，但是，它破坏了其他数据的图表。换句话说，如果我将 x 轴更改为数据的任何其他变量，它将无法正确显示。经过搜索，我发现使用 if statements 可以解决问题。所以我想设置一个条件：如果 x 轴是 Date，则图形将是 scale_x_date(..)。如果不是，我将在示例中使用相同的代码，如果选择日期，此条件也将应用于 y 轴。我添加了 plot 2 "default plot" 只是为了表明即使有日期，正常的绘图功能也能正常工作。我尝试了代码中的条件，但出现错误。
2) 我正在为显示框而苦苦挣扎，因为您可以看到代码甚至显示了 icom 的值，但没有框。我根据建议使用了名称空间，没有希望。恕我直言，我认为这与软件包有关，因为我注意到警告，一些软件包是屏蔽命令。！
3) 日期作为数据不能用于计算直方图。是否有可能，当打开“直方图”选项卡时，只显示一个输入字段而不是两个输入字段，即 input$x 并且从下拉列表菜单中排除日期？
任何建议。
为了以后参考，不要在同一个问题中问几个问题post。 Whosebug 不仅可以为您提供帮助，还可以帮助其他人在他们的代码中寻找问题的答案。如果一个 post 和它的答案同时提出和回答了很多问题，那么很难看出它们是否有用。
回到你的问题：
- 问题 1：我在 post
中更正了括号问题
- 问题2：
valueBox只能在dashboardPage中显示，不能在fluidPage中显示。这来自 Joe Cheng here 的回答：
Sorry but valueBoxOutput and the other features of shinydashboard, are only available when being used with a dashboardPage.
- 问题3：可以根据选择的tabPanel，使用
observe和updateSelectInput改变selectInput中的选项。为此，您首先需要为 tabsetPanel. 创建 id
这是工作代码：
library(shiny)
library(plotly)
library(ggplot2)
library(shinydashboard)
df <- structure(
list(
Dead = c(0L, 0L, 0L, 0L, 0L, 1L, 9L, 0L, 0L, 0L),
Case = c(120L, 70L, 50L, 40L, 39L, 20L, 18L, 13L, 9L, 2L),
Recovered = c(30L, 0L, 18L, 13L, 19L,
10L, 0L, 16L, 0L, 1L),
Critical = c(0L, 0L, 0L,
0L, 8L, 4L, 0L, 3L, 2L, 0L),
Date = c(
"18/03/2020",
"17/03/2020",
"16/03/2020",
"15/03/2020",
"14/03/2020",
"13/03/2020",
"12/03/2020",
"11/03/2020",
"10/03/2020",
"09/03/2020"
)
),
class = "data.frame",
row.names = c(NA,
10L)
)
df$Date = as.Date(df$Date, format = "%d/%m/%Y")
ui <- fluidPage(
title = 'testing',
sidebarLayout(
sidebarPanel(
helpText(),
selectInput("x", "Choose X-axis data", choices = names(df), selected = "Date"),
uiOutput("second_select"),
# Input: Slider for the number of observations to generate ----
sliderInput("n",
"No. of bins:",
value = 5,
min = 1,
max = 15) ,
),
mainPanel(
tabsetPanel(
id = "tabs",
tabPanel("ggplot", plotlyOutput("regPlot1")),
tabPanel("default plot", plotOutput("regPlot2")),
tabPanel("Histogram", plotlyOutput("regPlot3"))
)
)
)
)
server <- function(input, output, session) {
Graphcase <- reactive({
Gchoice<-input$x
})
myData <- reactive({
df[, c(input$x, input$y)]
})
#plot
output$regPlot1 <- renderPlotly({
req(input$x)
req(input$y)
# comment the if and else(block) to make run the code
if(Graphcase()=="Date"){
ggplotly(ggplot(data = myData(),
aes_string(x = input$x, y = input$y)) +
geom_line( color="blue") +
geom_point(shape=21, color="black", fill="gray", size=4) +
theme(axis.text.x = element_text(color="#993333",
size=10, angle=45,hjust = 1),
axis.text.y = element_text(color="#993333",
size=10, angle=45,hjust = 1)) +
scale_x_date(date_labels = "%b/%d"))
}else{
ggplotly(ggplot(data = myData(),
aes_string(x = input$x, y = input$y)) +
geom_line( color="blue") +
geom_point(shape=21, color="black", fill="gray", size=4) +
theme(axis.text.x = element_text(color="#993333",
size=10, angle=45,hjust = 1),
axis.text.y = element_text(color="#993333",
size=10, angle=45,hjust = 1)))
}
})
# plot2
output$regPlot2 <- renderPlot({
par(mar = c(4, 4, .1, .1)) # margin lines
plot(myData(), data = df)
})
#plot 3
observe({
if(input$tabs == "Histogram"){
updateSelectInput(session = session,
inputId = "x",
choices = names(subset(df, select = -c(Date))))
output$second_select <- renderUI(NULL)
}
else {
updateSelectInput(session = session,
inputId = "x",
choices = names(df),
selected = "Date")
output$second_select <- renderUI({
selectInput("y", "Choose Y-axis data", choices = names(df))
})
}
})
output$regPlot3 <- renderPlotly({
ggplotly(ggplot(data = myData(), aes_string(x = input$x)) +
geom_histogram(color="black",
fill="blue",
binwidth=input$n)
)
})
}
shinyApp(ui, server)
编辑： 如果要在单击选项卡 "Histogram" 时删除第二个 selectInput，则必须使用 uiOutput和 renderUI。此外，为了防止由于前两个图中缺少输入而导致的错误，请在开始计算两个图之前使用 req() 向 Shiny 发出信号，表明您需要这两个输入。结果我修改了上面的代码。
我的数据框 df:
df<- structure(list(Dead = c(0L, 0L, 0L, 0L, 0L, 1L, 9L, 0L, 0L, 0L
), Case = c(120L, 70L, 50L, 40L, 39L, 20L, 18L, 13L, 9L, 2L), Recovered = c(30L,0L, 18L, 13L, 19L,
10L, 0L,16L, 0L, 1L), Critical = c(0L, 0L, 0L,
0L, 8L, 4L, 0L, 3L, 2L, 0L), Date = c("18/03/2020", "17/03/2020",
"16/03/2020", "15/03/2020", "14/03/2020", "13/03/2020", "12/03/2020",
"11/03/2020", "10/03/2020", "09/03/2020")), class = "data.frame", row.names = c(NA,
10L))
我的 MWE：
library(shiny)
library(plotly)
library(ggplot2)
df$Date = as.Date(df$Date, format = "%d/%m/%Y")
ui <- fluidPage(
title = 'testing',
sidebarLayout(
sidebarPanel(
helpText(),
selectInput("x", "Choose X-axis data", choices = names(df), selected = "Date"),
selectInput("y", "Choose Y-axis data", choices = names(df)),
# Input: Slider for the number of observations to generate ----
sliderInput("n",
"No. of bins:",
value = 5,
min = 1,
max = 15) ,
),
mainPanel(
tabsetPanel(
tabPanel("ggplot", plotlyOutput("regPlot1")),
tabPanel("default plot", plotOutput("regPlot2")),
tabPanel("Histogram", plotOutput("regPlot3"))
),
fluidRow(
shinydashboard::valueBoxOutput("totalCases",width = 2)
)
)
)
)
server <- function(input, output, session) {
#calculation for box values
total.cases <- sum(df$Case)
## Value1: Total cases ##
output$totalCases <- renderValueBox({
shinydashboard::valueBox(
formatC(total.cases, format="d", big.mark=','),
paste('Total Cases:',total.cases),
icon = icon("stats",lib='glyphicon'),
color = "purple")
})
Graphcase <- reactive({
Gchoice<-input$x
})
myData <- reactive({
df[, c(input$x, input$y)]
})
#plot
output$regPlot1 <- renderPlotly({
# comment the if and else(block) to make run the code
if(Graphcase=="Date"){
ggplotly(ggplot(data = myData(),
aes_string(x = input$x, y = input$y)) +
geom_line( color="blue") +
geom_point(shape=21, color="black", fill="gray", size=4) +
theme(axis.text.x = element_text(color="#993333",
size=10, angle=45,hjust = 1),
axis.text.y = element_text(color="#993333",
size=10, angle=45,hjust = 1)))
+scale_x_date(date_labels = "%b/%d")
}else{
ggplotly(ggplot(data = myData(),
aes_string(x = input$x, y = input$y)) +
geom_line( color="blue") +
geom_point(shape=21, color="black", fill="gray", size=4) +
theme(axis.text.x = element_text(color="#993333",
size=10, angle=45,hjust = 1),
axis.text.y = element_text(color="#993333",
size=10, angle=45,hjust = 1)))
}
})
# plot2
output$regPlot2 <- renderPlot({
par(mar = c(4, 4, .1, .1)) # margin lines
plot(myData(), data = df)
})
#plot 3
output$regPlot3 <- renderPlotly({
ggplotly(ggplot(data = myData(), aes_string(x = input$x)) +
geom_histogram(color="black",
fill="blue",
binwidth=input$n)
)
})
}
shinyApp(ui, server)
我的问题分为 3 个部分：
1) 如果您 运行 代码并将鼠标悬停在图表点上，您会注意到 ggplot 没有在 x 轴上显示正确的日期。我输入 +scale_x_date(date_labels = "%b/%d") 解决了这个问题，但是，它破坏了其他数据的图表。换句话说，如果我将 x 轴更改为数据的任何其他变量，它将无法正确显示。经过搜索，我发现使用 if statements 可以解决问题。所以我想设置一个条件：如果 x 轴是 Date，则图形将是 scale_x_date(..)。如果不是，我将在示例中使用相同的代码，如果选择日期，此条件也将应用于 y 轴。我添加了 plot 2 "default plot" 只是为了表明即使有日期，正常的绘图功能也能正常工作。我尝试了代码中的条件，但出现错误。
2) 我正在为显示框而苦苦挣扎，因为您可以看到代码甚至显示了 icom 的值，但没有框。我根据建议使用了名称空间，没有希望。恕我直言，我认为这与软件包有关，因为我注意到警告，一些软件包是屏蔽命令。！
3) 日期作为数据不能用于计算直方图。是否有可能，当打开“直方图”选项卡时，只显示一个输入字段而不是两个输入字段，即 input$x 并且从下拉列表菜单中排除日期？
任何建议。
为了以后参考，不要在同一个问题中问几个问题post。 Whosebug 不仅可以为您提供帮助，还可以帮助其他人在他们的代码中寻找问题的答案。如果一个 post 和它的答案同时提出和回答了很多问题，那么很难看出它们是否有用。
回到你的问题：
- 问题 1：我在 post 中更正了括号问题
- 问题2：
valueBox只能在dashboardPage中显示，不能在fluidPage中显示。这来自 Joe Cheng here 的回答：Sorry but valueBoxOutput and the other features of shinydashboard, are only available when being used with a dashboardPage.
- 问题3：可以根据选择的tabPanel，使用
observe和updateSelectInput改变selectInput中的选项。为此，您首先需要为tabsetPanel. 创建
id
这是工作代码：
library(shiny)
library(plotly)
library(ggplot2)
library(shinydashboard)
df <- structure(
list(
Dead = c(0L, 0L, 0L, 0L, 0L, 1L, 9L, 0L, 0L, 0L),
Case = c(120L, 70L, 50L, 40L, 39L, 20L, 18L, 13L, 9L, 2L),
Recovered = c(30L, 0L, 18L, 13L, 19L,
10L, 0L, 16L, 0L, 1L),
Critical = c(0L, 0L, 0L,
0L, 8L, 4L, 0L, 3L, 2L, 0L),
Date = c(
"18/03/2020",
"17/03/2020",
"16/03/2020",
"15/03/2020",
"14/03/2020",
"13/03/2020",
"12/03/2020",
"11/03/2020",
"10/03/2020",
"09/03/2020"
)
),
class = "data.frame",
row.names = c(NA,
10L)
)
df$Date = as.Date(df$Date, format = "%d/%m/%Y")
ui <- fluidPage(
title = 'testing',
sidebarLayout(
sidebarPanel(
helpText(),
selectInput("x", "Choose X-axis data", choices = names(df), selected = "Date"),
uiOutput("second_select"),
# Input: Slider for the number of observations to generate ----
sliderInput("n",
"No. of bins:",
value = 5,
min = 1,
max = 15) ,
),
mainPanel(
tabsetPanel(
id = "tabs",
tabPanel("ggplot", plotlyOutput("regPlot1")),
tabPanel("default plot", plotOutput("regPlot2")),
tabPanel("Histogram", plotlyOutput("regPlot3"))
)
)
)
)
server <- function(input, output, session) {
Graphcase <- reactive({
Gchoice<-input$x
})
myData <- reactive({
df[, c(input$x, input$y)]
})
#plot
output$regPlot1 <- renderPlotly({
req(input$x)
req(input$y)
# comment the if and else(block) to make run the code
if(Graphcase()=="Date"){
ggplotly(ggplot(data = myData(),
aes_string(x = input$x, y = input$y)) +
geom_line( color="blue") +
geom_point(shape=21, color="black", fill="gray", size=4) +
theme(axis.text.x = element_text(color="#993333",
size=10, angle=45,hjust = 1),
axis.text.y = element_text(color="#993333",
size=10, angle=45,hjust = 1)) +
scale_x_date(date_labels = "%b/%d"))
}else{
ggplotly(ggplot(data = myData(),
aes_string(x = input$x, y = input$y)) +
geom_line( color="blue") +
geom_point(shape=21, color="black", fill="gray", size=4) +
theme(axis.text.x = element_text(color="#993333",
size=10, angle=45,hjust = 1),
axis.text.y = element_text(color="#993333",
size=10, angle=45,hjust = 1)))
}
})
# plot2
output$regPlot2 <- renderPlot({
par(mar = c(4, 4, .1, .1)) # margin lines
plot(myData(), data = df)
})
#plot 3
observe({
if(input$tabs == "Histogram"){
updateSelectInput(session = session,
inputId = "x",
choices = names(subset(df, select = -c(Date))))
output$second_select <- renderUI(NULL)
}
else {
updateSelectInput(session = session,
inputId = "x",
choices = names(df),
selected = "Date")
output$second_select <- renderUI({
selectInput("y", "Choose Y-axis data", choices = names(df))
})
}
})
output$regPlot3 <- renderPlotly({
ggplotly(ggplot(data = myData(), aes_string(x = input$x)) +
geom_histogram(color="black",
fill="blue",
binwidth=input$n)
)
})
}
shinyApp(ui, server)
编辑： 如果要在单击选项卡 "Histogram" 时删除第二个 selectInput，则必须使用 uiOutput和 renderUI。此外，为了防止由于前两个图中缺少输入而导致的错误，请在开始计算两个图之前使用 req() 向 Shiny 发出信号，表明您需要这两个输入。结果我修改了上面的代码。