CODEWITHSUNDEEP
rggplot2shinyplotly
sok09
sok09

Reputation: 117

Bold/highlight single line in multiple line chart when hover over using ggplotly

I just started learning R and I am creating an interactive line chart using ggplot2 and plotly.

Is there a way to bold/highlight the corresponding line in a multiple line graph when the mouse hovers over?

The line chart that I have is plotted according to the inputs and multiple lines will be plotted in a single line chart if there are multiple inputs.

This is the code I have in R Shiny.

data_sales <- structure(list(town = c("ANG MO KIO", "ANG MO KIO", "ANG MO KIO", 
                                "BEDOK", "BEDOK", "BEDOK"), Date = structure(c(17167, 17198, 
                                 17226, 17167, 17198, 17226), class = "Date"), median_sales = c(336500, 
                                 355000, 375000, 359000, 361500, 360000), percentage_change_sales = c(NA, 
                                 5.49777117384844, 5.6338028169014, NA, 0.696378830083555, -0.414937759336098
                                 ), transaction_vol = c(56L, 41L, 89L, 70L, 70L, 101L), percentage_change_vol = c(NA, 
                                 -26.7857142857143, 117.073170731707, NA, 0, 44.2857142857143)), row.names = c(1L, 
                                 2L, 3L, 32L, 33L, 34L), class = "data.frame")

ui <- fluidPage(
    titlePanel("Change in Sales by Town"),
    verticalLayout(
            pickerInput(inputId = "town",
                               label = "Town",
                               choices = c("Ang Mo Kio" = "ANG MO KIO",
                                           "Bedok" = "BEDOK"),

            options = list('actions-box' = TRUE),multiple = T, 
            selected = "ANG MO KIO"),

        mainPanel("Trend in sales",
                  fluidRow( plotlyOutput("sales_percentage_plot") 
                  )
            )
        )
)
server <- function(input, output){ 
    #For Resale Price

    output$sales_percentage_plot <-renderPlotly({
        data<-data_sales[data_sales$town %in% input$town, ]
        p<-ggplot(data, (aes(Date,percentage_change_sales,colour = town))) + 
            geom_line() +
            geom_point()
        p<-ggplotly(p)
        p
    })
}


shinyApp (ui=ui, server=server)

Thanks in advance for the help given!

Upvotes: 0

Views: 1215

Answers (1)

tasasaki
tasasaki

Reputation: 694

A little bit dirty but simple solution is:

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

data_sales <-
    structure(
        list(
            town = c("ANG MO KIO", "ANG MO KIO", "ANG MO KIO",
                     "BEDOK", "BEDOK", "BEDOK"),
            Date = structure(c(17167, 17198,
                               17226, 17167, 17198, 17226), class = "Date"),
            median_sales = c(336500,
                             355000, 375000, 359000, 361500, 360000),
            percentage_change_sales = c(
                NA,
                5.49777117384844,
                5.6338028169014,
                NA,
                0.696378830083555,
                -0.414937759336098
            ),
            transaction_vol = c(56L, 41L, 89L, 70L, 70L, 101L),
            percentage_change_vol = c(
                NA,
                -26.7857142857143,
                117.073170731707,
                NA,
                0,
                44.2857142857143
            )
        ),
        row.names = c(1L,
                      2L, 3L, 32L, 33L, 34L),
        class = "data.frame"
    )

normal_size <- 0.5
bold_size <- 1.0

ui <- fluidPage(titlePanel("Change in Sales by Town"),
                verticalLayout(
                    pickerInput(
                        inputId = "town",
                        label = "Town",
                        choices = c("Ang Mo Kio" = "ANG MO KIO",
                                    "Bedok" = "BEDOK"),

                        options = list('actions-box' = TRUE),
                        multiple = T,
                        selected = "ANG MO KIO"
                    ),

                    mainPanel("Trend in sales",
                              fluidRow(plotlyOutput(
                                  "sales_percentage_plot"
                              )))
                ))

server <- function(input, output) {
    #For Resale Price

    output$sales_percentage_plot <- renderPlotly({
        data <- data_sales[data_sales$town %in% input$town,]

        # default size vector
        sizes <- rep(normal_size, length(unique(data$town)))

        # capture plotly event
        eventdata <- event_data("plotly_hover")

        p <-
            ggplot(data, (
                aes(
                    Date,
                    percentage_change_sales,
                    colour = town,
                    size = town
                )
            )) +
            geom_line() +
            geom_point()

        if (!is.null(eventdata)) {
            # search selected row in data
            x <- data %>%
                filter(Date == eventdata$x &
                           percentage_change_sales == eventdata$y)

            # change size vector
            sizes[which(unique(data$town) == x$town)] <- bold_size

        }

        # change line and point size manually
        p <- p +
            scale_size_manual(values = sizes)

        # without tooltip settings, "town" appears twice...
        p <- ggplotly(p, tooltip = c("x", "y", "colour"))
        p
    })
}

shinyApp (ui = ui, server = server)

I don't know why sometimes hover event occurs twice in a row.

Upvotes: 1

Related Questions