我希望制作一个在其上显示交互式绘图的 Flexdashboard,这将根据 selectInput 更改显示的内容。
---
title: "Test Dashboard"
output:
flexdashboard::flex_dashboard:
orientation: columns
runtime: shiny
---
{r setup, include=FALSE}
library(flexdashboard)
library(tidyverse)
library(plotly)
library(reshape2)
library(shiny)
我有我在这里寻找的内容的比较图,其中有一个堆积条形图,它有一个交互式绘图叠加层,用户可以将鼠标悬停在条形图上,并查看与该特定堆栈相关的信息。
date <- as.Date(c("28/09/2024", "28/09/2024", "28/09/2024", "28/09/2024"),
format = "%d/%m/%Y")
name <- c("Joe", "Dave", "Steve", "John")
a <- c(5, 9, 16, 17)
b <- c(3, 3, 3, 2)
c <- c(2, 3, 1, 0)
dat <- data.frame(date, name, a, b, c)
dat <- dat %>%
mutate(total = a + b + c)
dat <- gather(dat, key, value, -date, -name, -total)
stacked_plot <- ggplot(dat, aes(x = name, y = value, fill = key,
# details for when staff hover over bar
text = paste("Name:", name,
"<br>Total:", total, "m<br>",
case_when(
key == "a" ~ paste("A:", value),
key == "b" ~ paste("B:", value, "m"),
key == "c" ~ paste("C:", value, "m"))))) +
# adding border around bars
geom_bar(stat = "identity", colour = "black", linewidth = 0.1) +
# adding colour scale
scale_fill_brewer(palette = "Greens", direction = -1,
name = "Letters") +
# rename y-axis
ylab("Total") +
# edit theme, removing grey area, adjusting x-axis ticks, and removing x-axis title
theme_minimal() +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1),
axis.title.x = element_blank(),
axis.title.y = element_text(size = 8))
stacked_plot %>%
ggplotly(tooltip = "text")
我可以创建图表(如果删除“ind_plot <-" prior to ggplot, and the final 2 lines applying it with ggplotly in the renderPlot fn, it'll create a reactive plot as I would like it to look), However, when I apply the ggplotly function, to add this box, the graph will not render at all on my flexdashboard, let alone with the plotly additions I require and there aren't any errors in the Render console.
# reading in all data, rather than just the 1 day's information
date <- as.Date(c("28/09/2024", "28/09/2024", "28/09/2024", "28/09/2024",
"29/09/2024", "29/09/2024", "29/09/2024", "29/09/2024",
"30/09/2024", "30/09/2024", "30/09/2024", "30/09/2024",
"1/10/2024", "1/10/2024", "1/10/2024", "1/10/2024",
"2/10/2024", "2/10/2024", "2/10/2024", "2/10/2024"), format = "%d/%m/%Y")
name <- c("Joe", "Dave", "Steve", "John", "Joe", "Dave", "Steve", "John", "Joe", "Dave", "Steve", "John", "Joe", "Dave", "Steve", "John", "Joe", "Dave", "Steve", "John")
a <- c(5, 9, 16, 17, 15, 45, 28, 45, 19, 80, 30, 15, 30, 20, 14, 8, 9, 6, 30, 9)
b <- c(3, 3, 3, 2, 8, 15, 1, 20, 6, 8, 9, 10, 10, 8, 5, 2, 1, 3, 10, 5)
c <- c(2, 3, 1, 0, 7, 10, 1, 5, 2, 2, 6, 5, 10, 2, 1, 0, 0, 0, 5, 2)
dat2 <- data.frame(date, name, a, b, c)
dat2 <- dat2 %>%
mutate(total = a + b + c)
dat2 <- gather(dat2, key, value, -date, -name, -total)
# creating dropbox options
selectInput('Name', 'Select a person:', sort(unique(dat2$name)))
# reactive dropdown input filtered
selected_data <- reactive(
dat2 %>%
filter(name == input$Name))
# plot
renderPlot({
ind_dat <- req(selected_data())
ind_plot <- ggplot(ind_dat, aes(x = factor(date), y = value, fill = key,
text = paste("Name:", name,
"<br>Total:", total, "m<br>",
case_when(
key == "a" ~ paste("A:", value),
key == "b" ~ paste("B:", value),
key == "c" ~ paste("C:", value))))) +
# adding border around bars
geom_bar(stat = "identity", colour = "black", linewidth = 0.3) +
# adding same colour scale
scale_fill_brewer(palette = "Greens", direction = -1,
name = "Speed Zones") +
# rename y-axis
ylab("Total") +
# edit theme, removing grey area, adjusting x-axis ticks, and removing x-axis title
theme_minimal() +
theme(axis.title.x = element_blank(),
axis.title.y = element_text(size = 14))
ind_plot %>%
ggplotly(tooltip = "text")
})
我错过了什么?
正如用户在上述帖子下面评论的那样,解决方案是使用
renderPlotly
而不是 renderPlot
。固定代码如下:
# plot
renderPlotly({
ind_dat <- req(selected_data())
ind_plot <- ggplot(ind_dat, aes(x = factor(date), y = value, fill = key,
text = paste("Name:", name,
"<br>Total:", total, "m<br>",
case_when(
key == "a" ~ paste("A:", value),
key == "b" ~ paste("B:", value),
key == "c" ~ paste("C:", value))))) +
# adding border around bars
geom_bar(stat = "identity", colour = "black", linewidth = 0.3) +
# adding same colour scale
scale_fill_brewer(palette = "Greens", direction = -1,
name = "Speed Zones") +
# rename y-axis
ylab("Total") +
# edit theme, removing grey area, adjusting x-axis ticks, and removing x-axis title
theme_minimal() +
theme(axis.title.x = element_blank(),
axis.title.y = element_text(size = 14))
ind_plot %>%
ggplotly(tooltip = "text")
})