Add new traces in plotly line chart based on shiny widget

user_9198260 0
Viewed 280

I have this dataframe which contains the Value of each Country per VaccinationWeek and the cumulative Value (EU) for every week.

VaccinationWeek Country Value
1          2020w1      EU     3
2          2020w1     CHE     2
3          2020w1     ITA     1
4          2020w2      EU     5
5          2020w2     CHE     3
6          2020w2     ITA     2

and I have created a shiny app in which when the user have selected (default) no Countries from pickerInput() then only the EU line will be displayed in the line chart like:

enter image description here

For every country then that the user selects (normally more than 2) in the line described above will be added the respective line for this country and the hover text will include data for both EU and the selected Country in all lines like:

enter image description here

library(shiny)
library(plotly)
library(shinyWidgets)

VaccinationWeek<-c("2020w1","2020w1","2020w1","2020w2","2020w2","2020w2")
Country<-c("EU","CHE","ITA","EU","CHE","ITA")
Value<-c(3,2,1,5,3,2)
dat<-data.frame(VaccinationWeek,Country,Value)


ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      pickerInput(
        inputId = "p1",
        label = "",
        choices = c("CHE","ITA"),
        multiple = TRUE,
        selected = c("CHE","ITA"),
        options = pickerOptions(`actions-box` = TRUE)
      )
    ),
    mainPanel(
    plotlyOutput("line")
    )
  )
)

server <- function(input, output) {
  output$line<-renderPlotly({
    dat <- subset(dat, Country %in% input$p1)
    
    plot_ly(dat,
            x = ~VaccinationWeek, 
            y = ~Value,
            text = ~Value) %>%
      add_trace(
        type = 'scatter',
        mode = 'lines+markers+text',
        fill = 'tozeroy',
        fillcolor = 'lightgreen',
        marker = list(color = 'green'),
        line = list(color = 'green'),
        textposition = "top center",
        hovertemplate = paste0("<b>%{x}</b>
                           Value: %{y} 
                          <extra></extra>"),
        hoveron = 'points') 
    
  })
}

shinyApp(ui = ui, server = server)
shiny plotly r
1 Answers

Here is an idea with just lines (see your second image).

library(shiny)
library(plotly)
library(shinyWidgets)

VaccinationWeek<-c("2020w1","2020w1","2020w1","2020w2","2020w2","2020w2")
Country<-c("EU","CHE","ITA","EU","CHE","ITA")
Value<-c(3,2,1,5,3,2)
dat<-data.frame(VaccinationWeek,Country,Value)


ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      pickerInput(
        inputId = "p1",
        label = "",
        choices = c("CHE","ITA"),
        multiple = TRUE,
        selected = c("CHE","ITA"),
        options = pickerOptions(`actions-box` = TRUE)
      )
    ),
    mainPanel(
      plotlyOutput("line")
    )
  )
)

server <- function(input, output) {
  output$line<-renderPlotly({
    
    dat <- subset(dat, Country %in% c("EU",input$p1))

    plot_ly(dat,
            x = ~VaccinationWeek, 
            y = ~Value,
            text = ~Value,
            color = ~Country,
            customdata = dat$Country) %>%
      add_trace(
        type = 'scatter',
        mode = 'lines+markers',
        hovertemplate = paste("Country: %{customdata}",
                              "Uptake first dose (%): %{y}", 
                              "<extra></extra>",
                              sep = "\n"),
        hoveron = 'points') %>%
      add_text(    
        textposition = "top center",
        showlegend = F,
        hoverinfo = "skip") %>% 
      layout(hovermode = "x unified",
             hoverlabel = "none",
             legend = list(itemclick = F, itemdoubleclick = F))
    
  })
}

shinyApp(ui = ui, server = server)

enter image description here

Or a line plot with filled area and single lines for each country (your first image with added lines).

# Just the plot, needs to be copied into the shiny app 
    plot_ly(x = ~VaccinationWeek, 
            y = ~Value,
            text = ~Value,
            color = ~Country) %>%
      add_trace(
        data = subset(dat, Country == "EU"),
        customdata = subset(dat, Country == "EU")$Country,
        type = 'scatter',
        mode = 'lines+markers',
        fill = 'tozeroy',
        fillcolor = 'lightgreen',
        marker = list(color = 'green'),
        line = list(color = 'green'),
        hovertemplate = paste("Country: %{customdata}",
                              "Uptake first dose (%): %{y}", 
                              "<extra></extra>",
                              sep = "\n"),
        hoveron = 'points') %>%
      add_text(        
        data = subset(dat, Country == "EU"),
        textposition = "top center",
        showlegend = F,
        hoverinfo = "skip") %>%
      add_trace(
        data = subset(dat, Country != "EU"),
        customdata = subset(dat, Country != "EU")$Country,
        type = 'scatter',
        mode = 'lines+markers',
        hovertemplate = paste("Country: %{customdata}",
                              "Uptake first dose (%): %{y}", 
                              "<extra></extra>",
                              sep = "\n"),
        hoveron = 'points')  %>% 
      add_text(        
        data = subset(dat, Country != "EU"),
        textposition = "top center",
        showlegend = F,
        hoverinfo = "skip") %>%
      layout(hovermode = "x unified",
             hoverlabel = "none",
             legend = list(itemclick = F, itemdoubleclick = F))

enter image description here

user_141700970
Related