Customize hoverinfo of ggplotly() in a bupaR:: activity frequency plot

Question

How can you set the hoverinfo of ggplotly() in a activity frequency plot of bupaR to Activity: and Absolute Activity Frequency: ?

## app.R ##
library(shiny)
library(shinydashboard)
library(bupaR)
library(processmapR)
library(eventdataR)
library(plotly)
ui <- dashboardPage(
  dashboardHeader(title = "decio"),
  dashboardSidebar(
    collapsed = TRUE
    
  ),
  dashboardBody(
    
    plotlyOutput("activity_frequency"),

    )
    
)
  


server <- function(input, output,session) {
  sip<-bupaR::simple_eventlog(eventlog = eventdataR::sepsis,
                              case_id = "case_id",
                              activity_id = "activity",
                              #activity_instance_id = "activity_instance_id",
                              timestamp = "timestamp",
                              #lifecycle_id = "lifecycle",
                              resource_id = "resource"
  )
  output$activity_frequency <- renderPlotly({
    
    ggplotly(sip %>% activity_frequency("activity") %>% plot())
  })
  
  
  
}

shinyApp(ui, server)

Answer 1

I don't know what you want in your tooltips, so I'm just going to show you a way you could change them.

When I realized you were using a function called activity_frequency and you named the Plotly output the same thing, I made a change. I changed the call in ui and server from activity_frequency to act_freq.

I created a function that modifies the tooltips. Inside server, after calling ggplotly, you'll run the plot through that function.

This function will make your tooltips look like this.

It's not particularly informative (since that information is already there). However, it's still a big change from the default, which looks like this.

I put this function before the call to create ui.

hoverFix <- function(plt) {
  dat <- invisible(lapply(
    1:length(plt$x$data),
    function(i) {
      txt <- plt$x$data[[i]]$text
      # original pattern: "reorder(activity, absolute): Release E<br />
      #                    absolute:    6<br />
      #                    absolute:    6"
      plt$x$data[[i]]$text <- gsub(pattern = "^.*(\\:.*)<.*(\\:.*)<.*",
                                    "Activity\\1 <br />Frequency\\2",
                                    txt)
      plt$x$data[[i]]
    } # end inner function
  ) # end lapply
  ) # end invisible
  plt$x$data <- dat
  plt # return entire plot
} # end outer function

Then I modified the call to create output$act_freq <- renderPlotly({ so that the function was called. You've already used the ({ instead of (, so you can list multiple steps in the call.

Here is the entire server.

server <- function(input, output, session) {
  sip <- simple_eventlog(eventlog = sepsis,
                         case_id = "case_id",
                         activity_id = "activity",
                         timestamp = "timestamp",
                         resource_id = "resource")
  output$act_freq <- renderPlotly({
    plt <- ggplotly(sip %>% activity_frequency('activity') %>% plot())
    plt <- hoverFix(plt)
    plt
  })
}

Just so we're totally clear, here is all the code together.

library(shiny)
library(shinydashboard)
library(bupaR)
library(processmapR)
library(eventdataR)
library(plotly)
library(edeaR)

hoverFix <- function(plt) {
  dat <- invisible(lapply(
    1:length(plt$x$data),
    function(i) {
      txt <- plt$x$data[[i]]$text
      # original pattern: "reorder(activity, absolute): Release E<br />
      #                    absolute:    6<br />
      #                    absolute:    6"
      plt$x$data[[i]]$text <- gsub(pattern = "^.*(\\:.*)<.*(\\:.*)<.*",
                                    "Activity\\1 <br />Frequency\\2",
                                    txt)
      plt$x$data[[i]]
    } # end inner function
  ) # end lapply
  ) # end invisible
  plt$x$data <- dat
  plt # return entire plot
} # end outer function

data(sepsis, package = "eventdataR")

ui <- dashboardPage(
  dashboardHeader(title = "decio"),
  dashboardSidebar(collapsed = TRUE),
  dashboardBody(plotlyOutput("act_freq"))
)

server <- function(input, output,session) {
  sip <- simple_eventlog(eventlog = sepsis,
                         case_id = "case_id",
                         activity_id = "activity",
                         timestamp = "timestamp",
                         resource_id = "resource")
  output$act_freq <- renderPlotly({
    plt <- ggplotly(sip %>% activity_frequency('activity') %>% plot())
    plt <- hoverFix(plt)
    plt
  })
}

shinyApp(ui, server)