I'm still trying to modify my code from adding/removing traces in plotly per onclick event.
I want to add a hover effect to the slices of my pie chart. I thought of doing it with writing a css modificator on hover. As far as I understood the slices of my chart are class .slice:
jshover <- "
$(document).ready(function(){
$(.slice).hover(function(){
$(this).css('background-color', 'yellow');
}, function(){
$(this).css('background-color', 'pink');
})
Sadly this doesn't seem to work. Below you can find my whole piece of code:
require(shiny)
require(shinydashboard)
require(shinyjs)
require(shinythemes)
require(shinyWidgets)
library(data.table)
library(plotly)
require(htmltools)
js <- "
$(document).ready(function(){
$(document).on('click', function(){
Shiny.setInputValue('click_on_doc', true, {priority: 'event'});
Shiny.setInputValue('.clientValue-plotly_click-A', 'null');
})
})"
jshover <- "
$(document).ready(function(){
$(.slice).hover(function(){
$(this).css('background-color', 'yellow');
}, function(){
$(this).css('background-color', 'pink');
})
});"
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", icon = icon("th"), tabName = "widgets",
badgeLabel = "new", badgeColor = "green")
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
h2("Dashboard tab content"),
tags$head(tags$script(HTML(js))),
tags$head(tags$script(src="https://d3js.org/d3.v5.min.js")),
tags$script(HTML(jshover)),
fluidRow(column(12, plotly::plotlyOutput("myplot", height = "800px")))
),
tabItem(tabName = "widgets",
h2("Widgets tab content")
)
)
)
# Define UI
ui <- dashboardPage(
dashboardHeader(title = "Simple tabs"),
sidebar,
body
)
# Server logic
server <- function(input, output, session) {
testdata <- data.frame("Orga" = c("Li", "La", "Le", "Lu", "De", "Va", "Xul", "Jin"),
"Dachorga" = c("Bla", "Bla", "Blu", "Blu", "Blub", "Blub", "Lol", "Lol"),
"Umsatz.Orga" = c(20000, 10000, 12000, 3000, 100, 2400, 205000, 95000))
testdata <- data.table(testdata)
testdata_agg <- testdata[, sum(Umsatz.Orga), by=Dachorga]
plot <- testdata_agg %>%
group_by(Dachorga) %>%
plot_ly(labels = ~Dachorga, values = ~V1, hoverinfo = 'label+percent+value') %>%
add_pie(hole = 0.6) %>%
layout(title = "Donut charts using Plotly", showlegend = F,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
click <- reactiveVal(FALSE)
myline <- reactiveVal(0)
observe({
event <- !is.null(event_data("plotly_click"))
click(event)
myline(event_data("plotly_click")$pointNumber)
})
observeEvent(input$click_on_doc, {
click(FALSE)
})
output$myplot <- renderPlotly({
if (click()) {
p <- add_pie(plot, data = testdata[Dachorga == testdata_agg$Dachorga[myline()+1]], labels = ~Orga,
values = ~Umsatz.Orga, hole = 0.5,
hoverinfo = 'label+percent+value', domain = list(
x = c(0.1, 0.9),
y = c(0.1, 0.9)),
marker = list(hover = list(color = "white")))
}else{
p <- plot
}
p
})
}
# Complete app with UI and server components
shinyApp(ui, server)
Any suggestions on how to modify the code so i can get a hover effect? Right now I just tried to change the background color. I would like to zoom a slice on hover too. Maybe you have suggestions for that too.
Thanks in advance.