ggplotly 图表不显示反应式 df

问题描述 投票:0回答:1

我希望制作一个在其上显示交互式绘图的 Flexdashboard,这将根据 selectInput 更改显示的内容。

相关.Rmd数据

---
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")
    
})

我错过了什么?

r shiny flexdashboard
1个回答
0
投票

正如用户在上述帖子下面评论的那样,解决方案是使用

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")
    
})
© www.soinside.com 2019 - 2024. All rights reserved.