相关于上一篇文章我提出，我想在 R Shiny 中的一个单独但同步的 Highcharter 图中调用单击事件时，在两个方向上更新一个 Highcharter 图中的点以更改颜色。我能够在 R Shiny 中同步两个 Highcharter 绘图，但是当用户在 UI 中切换输入时，单击事件的 JavaScript 不再起作用（两者都同步）and在任一图表的实际点击事件中）。请参阅这个可重现的示例：
##PACKAGES
library(shiny)
library(shinyWidgets)
library(shinyjs)
library(dplyr)
library(tidyverse)
library(albersusa) ## remotes::install_github("hrbrmstr/albersusa")
library(highcharter)
library(usdata)
library(data.table)
states <- data.frame(
name = rep(state.abb,4),
state = rep(state.name,4),
metric = c(rep("YES",100),rep("NO",100)),
value = sample(100:5000,200)
)
#for synchronizing Highcharts 1 and 2
testJS <- JS("function() {
let currentY = this.name
charts = Highcharts.charts;
charts.forEach(function(chart, index) {
chart.series.forEach(function(series, seriesIndex) {
series.points.forEach(function(point, pointsIndex) {
if (point.name == currentY) {
point.setState('hover');
point.update({color:'red'})
}
})
});
});
}")
ui <- fluidPage(
tags$script(src = "https://code.highcharts.com/mapdata/countries/us/us-all.js"),
fluidRow(
radioButtons(inputId = "toggle",label="toggle it",
choices = c("YES","NO")),
column(width=5,highchartOutput("map1")),
column(width=5,highchartOutput("bar1"))
)
)
server <- function(input, output, session) {
#create rate change
df1_num<- reactive({
states %>%
filter(metric == input$toggle) %>%
group_by(name) %>%
mutate(
first = dplyr::first(value),
last = dplyr::last(value)
) %>%
distinct(metric,state,first,last) %>%
mutate(
#increase/decrease rate change
rate = round(((last-first)/first)*100,1),
)
})
#HIGHCHART 1 (map)
output$map1 <- renderHighchart({
#US map of percent change in population trends
hcmap("countries/us/us-all",
data = df1_num(),
joinBy = c("hc-a2","name"),
value = "rate",
borderColor = "#8d8d8d",
nullColor = "#D3D3D3",
download_map_data = FALSE
) %>%
hc_plotOptions(series = list(
point = list(
events = list(
click = testJS
)
)
)
)
})
#HIGHCHART 2 (barchart)
output$bar1 <- renderHighchart({
test <- df1_num() %>%
arrange(rate) %>%
rowid_to_column("orderrate")
setDT(test)[,testit:=.GRP,by=orderrate]
highchart() %>%
hc_add_series(
data = test,
hcaes(
x = state,
y = rate,
group = orderrate),
showInLegend = FALSE,
type = "bar",
color = "blue",
polar = FALSE
) %>%
hc_plotOptions(series = list(
point = list(
events = list(
click = testJS
)
)
)
)
})
}
shinyApp(ui = ui, server = server)
In my 上一篇文章，我收到了一个很好的答案，它通过保留单击事件功能来修复 R Shiny 用户输入更改，但是此解决方案不会同步图表（替换值testJS with):
JS("function(){
this.update({color:'red'})
}")
我意识到我在这里的主要困难是在令人惊叹的 Highcharter 包装器和原始 Highcharts JS 之间建立和谐，因此任何想法（或我根本不知道的明确方向）都会非常有帮助！
Thanks!
