简体   繁体   中英

Is it possible to make a plot title reactive in R Shiny?

I have made a simple Shiny App and within the app I have a plotly drilldown chart.

Is it possible to make the plot/chart title reactive?

In this example it would be great if the title of the first plot said "GDP Level of (state you choose)"

Then, when you go to the drilldown, the title will say "GDP Level of (city you choose)"

Below is my attempt to do this. As always any and all help is appreciated.

library(tidyverse)
library(plotly)
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(shinyjs)


full_data <- tibble(
  State = c("IL", "IL", "IL", "IL", "IL", "IL", "IN", "IN", "IN", "IN", "IN", "IN"),
  City = c("Chicago", "Rockford", "Naperville", "Chicago", "Rockford", "Naperville","Fort Wayne", 
           "Indianapolis", "Bloomington", "Fort Wayne", "Indianapolis", "Bloomington"),
  Year = c("2008", "2008", "2008", "2009", "2009", "2009", "2008", "2008", "2008", "2009", "2009", "2009"),
  GDP = c(200, 300, 350, 400, 450, 250, 600, 400, 300, 800, 520, 375)
)


ui <- fluidPage(useShinyjs(),
                selectInput(inputId = "year",
                            label = "Year",
                            multiple = TRUE,
                            choices = unique(full_data$Year),
                            selected = unique(full_data$Year)),
                selectInput(inputId = "state",
                            label = "State",
                            choices = unique(full_data$State)),
                plotlyOutput("gdp_level", height = 200),
                shinyjs::hidden(actionButton("clear", "Return to State"))
)


server <- function(input, output, session) {
  
  
  drills <- reactiveValues(
    category = NULL,
    sub_category = NULL
  )
  
  
  gdp_reactive <- reactive({
    full_data %>%
      filter(Year %in% input$year) %>%
      filter(State %in% input$state)  
  })
  
  
  gdp_reactive_2 <- reactive({
    full_data %>%
      filter(Year %in% input$year) %>%
      filter(State %in% input$state) %>%
      filter(City %in% drills$category) 
  })
  
  
  
  gdp_data <- reactive({
    
    if (!length(drills$category)) {
      
      return(gdp_reactive())
      
    }
    
    else {
      
      return(gdp_reactive_2())
      
    }
    
  })
  
  
  output$gdp_level <- renderPlotly({
    
    if(!length(drills$category))
      plot_title <- "GDP Level of State"
    else
      plot_title <- "GDP Level of City"
    
    
    gdp_data() %>% 
      plot_ly(
        x = ~Year,
        y = ~GDP,
        color = ~City,
        key = ~City,
        source = "gdp_level",
        type = "bar"
      ) %>% 
      layout(barmode = "stack", 
             showlegend = T,
             xaxis = list(title = "Year"),
             yaxis = list(title = "GDP"),
             title = plot_title)
    
  })
  
  
  
  observeEvent(event_data("plotly_click", source = "gdp_level"), {
    
    x <- event_data("plotly_click", source = "gdp_level")$key
    
    if (!length(x))
      
      return()
    
    if (!length(drills$category)) {
      
      drills$category <- x
      
    }  else {
      
      drills$sub_category <- NULL
      
    }
    
  })
  
  
  observe({
    
    if(length(drills$category))  shinyjs::show("clear")  
    
  })
  
  observeEvent(input$clear, {
    
    drills$category <- NULL
    
    shinyjs::hide("clear")
    
  })
  
}

shinyApp(ui, server)

You just need to pass plotly's event_data to the title. The following also resets the plot after a new state was selected:

library(tidyverse)
library(plotly)
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(shinyjs)

full_data <- tibble(
  State = c("IL", "IL", "IL", "IL", "IL", "IL", "IN", "IN", "IN", "IN", "IN", "IN"),
  City = c("Chicago", "Rockford", "Naperville", "Chicago", "Rockford", "Naperville","Fort Wayne", 
           "Indianapolis", "Bloomington", "Fort Wayne", "Indianapolis", "Bloomington"),
  Year = c("2008", "2008", "2008", "2009", "2009", "2009", "2008", "2008", "2008", "2009", "2009", "2009"),
  GDP = c(200, 300, 350, 400, 450, 250, 600, 400, 300, 800, 520, 375)
)

ui <- fluidPage(
  useShinyjs(),
  selectInput(
    inputId = "year",
    label = "Year",
    multiple = TRUE,
    choices = unique(full_data$Year),
    selected = unique(full_data$Year)
  ),
  selectInput(
    inputId = "state",
    label = "State",
    choices = unique(full_data$State)
  ),
  plotlyOutput("gdp_level", height = 400),
  shinyjs::hidden(actionButton("clear", "Return to State"))
)

server <- function(input, output, session) {
  drills <- reactiveValues(category = NULL,
                           sub_category = NULL)
  
  gdp_reactive <- reactive({
    full_data %>%
      filter(Year %in% input$year) %>%
      filter(State %in% input$state)
  })
  
  gdp_reactive_2 <- reactive({
    full_data %>%
      filter(Year %in% input$year) %>%
      filter(State %in% input$state) %>%
      filter(City %in% drills$category)
  })
  
  gdp_data <- reactive({
    if (is.null(drills$category)) {
      return(gdp_reactive())
    }
    else {
      return(gdp_reactive_2())
    }
  })
  
  output$gdp_level <- renderPlotly({
    if (is.null(drills$category)) {
      plot_title <- paste0("GDP Level of ",  input$state)
    } else {
      plot_title <- paste0("GDP Level of ",  drills$category)
    }
    
    gdp_data() %>%
      plot_ly(
        x = ~ Year,
        y = ~ GDP,
        color = ~ City,
        key = ~ City,
        source = "gdp_level",
        type = "bar"
      ) %>%
      layout(
        barmode = "stack",
        showlegend = T,
        xaxis = list(title = "Year"),
        yaxis = list(title = "GDP"),
        title = plot_title
      )
  })
  
  observeEvent(event_data("plotly_click", source = "gdp_level"), {
    x <- event_data("plotly_click", source = "gdp_level")$key
    if (is.null(x))
      return(NULL)
    if (is.null(drills$category)) {
      drills$category <- unlist(x)
    }  else {
      drills$sub_category <- NULL
    }
  })
  
  observe({
    if (!is.null(drills$category)) {
      shinyjs::show("clear")
    }
  })
  
  observeEvent(c(input$clear, input$state), {
    drills$category <- NULL
    shinyjs::hide("clear")
  })
}

shinyApp(ui, server)

结果

Using eg paste0 you could eg do plot_title <- paste0("GDP Level of ", input$state) .

output$gdp_level <- renderPlotly({
  if (!length(drills$category)) {
    plot_title <- paste0("GDP Level of ",  input$state)
  } else {
    plot_title <- paste0("GDP Level of ",  input$city)
  }
  
  gdp_data() %>%
    plot_ly(
      x = ~Year,
      y = ~GDP,
      color = ~City,
      key = ~City,
      source = "gdp_level",
      type = "bar"
    ) %>%
    layout(
      barmode = "stack",
      showlegend = T,
      xaxis = list(title = "Year"),
      yaxis = list(title = "GDP"),
      title = plot_title
    )
})

在此处输入图像描述

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM