Julian Gabriel Fita
Julian Gabriel Fita

Reputation: 63

How to add mouseOver event?

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.

Upvotes: 1

Views: 223

Answers (0)

Related Questions