Linked tooltip between barcharts in {billboarder} https://github.com/dreamRs/billboarder

linked-tooltip-billboarder-bar

# on CRAN now (version 0.2.3)
library(billboarder)

# data
data("prod_par_filiere")


# helper fun
make_bar <- function(year, show_y_axis = TRUE) {
  libs <- list(
    "therm" = "Thermal",
    "hydraulique" = "Hydraulic",
    "bioenergies" = "Bioenergies",
    "eolien" = "Wind", 
    "therm_charbon" = "Thermal / Coal", 
    "solaire" = "Solar", 
    "therm_gaz" = "Thermal / Gaz", 
    "nucleaire" = "Nuclear", 
    "therm_fioul" = "Thermal / Fioul"
  )
  dat <- prod_filiere_long[prod_filiere_long$annee == year & prod_filiere_long$branche != "nucleaire", ]
  dat$branche <- unlist(libs, use.names = FALSE)[match(x = dat$branch, table = names(libs))]
  billboarder() %>%
    bb_barchart(
      data = dat, 
      mapping = bbaes(branche, prod)
    ) %>%
    bb_data(
      names = list(prod = "Production")
    ) %>% 
    bb_legend(show = FALSE) %>% 
    bb_y_grid(show = TRUE) %>%
    bb_grid(front = TRUE) %>% 
    bb_y_axis(
      tick = list(format = suffix("TWh"), values = seq(0, 70, 10)),
      max = max(dat$prod), 
      show = show_y_axis,
      label = list(text = "production (in terawatt-hours)", position = "outer-top")
    ) %>% 
    bb_legend(position = "inset", inset = list(anchor = "top-right")) %>% 
    bb_labs(
      title = year,
      caption = "Data source: RTE (https://opendata.rte-france.com)"
    ) %>% 
    bb_add_style(
      ".bb-tooltip-container" = "right: 10px;",
      ".bb-tooltip th" = "background-color: #FFF; color: #000;"
    ) %>% 
    bb_tooltip(
      linked = list(name = "my-tooltip"),  ### <<<----------------------------------------------------- Id for linking tooltip
      position = htmlwidgets::JS(
        "function(data, width, height, element) {return {top: 10, right: 100};}"
      )
    )
}


# make_bar(2016)
# make_bar(2015)


# app
library(shiny)

ui <- fluidPage(
  
  fluidRow(
    column(
      width = 10, offset = 1,
      tags$h2("Linked tooltip in {billboarder}"),
      fluidRow(
        column(width = 6, billboarderOutput("g1")),
        column(width = 6, billboarderOutput("g2")),
        column(width = 6, billboarderOutput("g3")),
        column(width = 6, billboarderOutput("g4"))
      )
    )
  )
)

server <- function(input, output, session) {
  output$g1 <- renderBillboarder(make_bar(2016))
  output$g2 <- renderBillboarder(make_bar(2015, FALSE))
  output$g3 <- renderBillboarder(make_bar(2014))
  output$g4 <- renderBillboarder(make_bar(2013, FALSE))
}

shinyApp(ui, server)