# 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)