r-使用ggplotly将鼠标悬停在多折线图上时，加粗/高亮显示单行

Question

我刚开始学习R，我正在使用ggplot2和plotly创建一个交互式折线图。

当鼠标悬停在多线图上时，有没有办法加粗/高亮显示对应的线？

我的折线图是根据输入绘制的，如果有多个输入，多条线将绘制在单线图中。

这是我在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)

提前感谢您的帮助！

Answer 1

一个有点脏但简单的解决方案是：

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)

我不知道为什么有时悬停事件会连续发生两次。