R + Highcharter + ShinyDashboard: How to add mouseOver event? - r

Question

I am trying to make it so that when the client puts the mouse cursor over a value in the line graph, a text is created indicating the information of a column.
This is my code:
DataSource
library(tidyverse)
library(janitor)
library(lubridate)
library(highcharter)
library(shiny)
library(shinydashboard)
massShooting2018 <- read.csv('shootings_2018.csv')
massShooting2019 <- read.csv('shootings_2019.csv')
massShooting2020 <- read.csv('shootings_2020.csv')
massShooting2021 <- read.csv('shootings_2021.csv')
massShooting2022 <- read.csv('shootings_2022.csv')
# Merge datasets
massShootings <- rbind(massShooting2018,
massShooting2019,
massShooting2020,
massShooting2021,
massShooting2022)
# Clean
massShootings.clean <- massShootings %>%
clean_names() %>%
mutate(date = dmy(date))
massShootings.order <- massShootings.clean %>%
group_by(date, state) %>%
summarise(dead = sum(dead),
injured = sum(injured),
total = sum(total),
description, .groups = 'drop')
years <- massShootings.order %>%
sample_frac(1) %>%
select(date) %>%
mutate(date = year(date)) %>%
arrange(date)
hc_my_theme <- hc_theme_merge(hc_theme_flatdark(),
hc_theme(chart = list(backgroundColor = '#242f39'),
subtitle = list(style = list(color = '#a7a5a5'))))
header <- dashboardHeader(title = 'Mass Shootings')
sideBar <- dashboardSidebar(sidebarMenu(menuItem('Description', tabName = 'info', icon = icon('info')),
menuItem('Charts', tabName = 'charts', icon = icon('chart-line')),
menuItem('Contact', tabName = 'contact', icon = icon('address-card'))))
body <- dashboardBody(fluidPage(valueBoxOutput('totals'),
valueBoxOutput('dead'),
valueBoxOutput('injured')),
fluidPage(column(width = 4,
offset = 4,
selectInput('year',
label = 'Year',
choices = unique(years),
selected = 2018,
width = "100%"))),
box(title = "USA-States Map",
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
highchartOutput('mapPlot')),
box(title = 'Mass shootings in every state over time',
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
highchartOutput('linePlot')))
ui <- dashboardPage(header,
sideBar,
body)
server <- function(input,
output,
session)
{
df <- reactive({df <- massShootings.order %>%
filter(year(date) == input$year) %>%
group_by(state) %>%
summarise(dead = sum(dead),
injured = sum(injured),
total = sum(total),
description, .groups = 'drop')})
# Map Chart
output$mapPlot <- renderHighchart({
fn <- "function(){
console.log(this.name);
Shiny.onInputChange('mapPlotinput', this.name)
}"
hcmap(map = 'countries/us/custom/us-all-mainland.js',
data = df(),
joinBy = c('name', 'state'),
value = 'total',
borderWidth = 0.05,
nullColor = "#d3d3d3") %>%
hc_title(text = 'Mass Shooting') %>%
hc_colorAxis(stops = color_stops(colors = viridisLite::viridis(10,
begin = 0.1)),
type = "logarithmic") %>%
hc_tooltip(formatter= JS("function () { return this.point.name.bold() +
' <br />' +
' <br /> <b>Dead:</b> ' + this.point.dead +
' <br /> <b>Injured:</b> ' + this.point.injured ;}")) %>%
hc_add_theme(hc_my_theme) %>%
hc_mapNavigation(enabled = TRUE) %>%
hc_credits(enabled = FALSE) %>%
hc_exporting(enabled = TRUE) %>%
hc_plotOptions(series = list(cursor = "pointer",
point = list(events = list(click = JS(fn)))))})
# Stock chart
output$linePlot <- renderHighchart({
nme <- ifelse(is.null(input$mapPlotinput),
"United States of America",
input$mapPlotinput)
dfClick <- massShootings.order %>%
filter(state %in% nme) %>%
filter(year(date) == input$year) %>%
group_by(date) %>%
summarise(dead = sum(dead),
injured = sum(injured),
total = sum(total),
.groups = 'drop')
highchart(type = "stock") %>%
hc_chart("line",
name = "base",
hcaes(x = date)) %>%
hc_add_series(dfClick,
name = "Total",
type = "line",
hcaes(
x = date,
y = total)) %>%
hc_add_series(dfClick,
name = "Dead",
type = "line",
hcaes(
x = date,
y = dead)) %>%
hc_add_series(dfClick,
name = "Injured",
type = "line",
hcaes(
x = date,
y = injured)) %>%
hc_add_theme(hc_theme_538()) %>%
hc_tooltip(
crosshairs = TRUE,
shared = TRUE,
borderWidth = 2,
table = TRUE)})
# valueBox - Total
output$totals <- renderValueBox({dfTotals <- massShootings.order%>%
filter(year(date) == input$year) %>%
group_by(date) %>%
summarise(total = sum(dead, injured))
valueBox(sum(dfTotals$total), 'Total', icon = icon('calculator') ,color = 'light-blue')})
# valueBox - Deads
output$dead <- renderValueBox({dfDeads <- massShootings.order %>%
filter(year(date) == input$year) %>%
group_by(date) %>%
summarise(dead = sum(dead))
valueBox(sum(dfDeads$dead), 'Deads', icon = icon('skull') ,color = 'red')})
# valueBox - Injureds
output$injured <- renderValueBox({dfInjureds <- massShootings.order %>%
filter(year(date) == input$year) %>%
group_by(date) %>%
summarise(injured = sum(injured))
valueBox(sum(dfInjureds$injured), 'Injureds', icon = icon('user-injured') ,color = 'yellow')})
}
shinyApp(ui, server)
So far you can interact with the map which, when clicking on each state, creates a line graph next to it showing the values per day throughout the selected year.
What I am trying to achieve is that when the client places the cursor on the values of the graph line, text is created where the description of what happened on that date is shown, but the truth is that I do not know how to achieve it.
Thank you very much for reading my question and I would appreciate any kind of help to solve this problem