Highcharter R Shiny中的Clickable Points弹出窗口

Question

Here is my question. Is it possible to replicate the following example from Highcharts in R Highchart? The idea is to introduce various text inside a popup which appears when a point is selected.

Example here: https://jsfiddle.net/jnupf62x/

This is what I have tried so far:

data <- data.frame(x = c(1,2,3,4,5,6),
               y = c(2,4,1,5,2,6))

highchart() %>% 
  hc_add_series(data, "line") %>% 
  hc_tooltip(shared = T,
             crosshairs = T) %>% 
  hc_plotOptions(
    series = list(
      cursor = "pointer",
      point = list(
        events = list(click = JS("function () {
                                          hs.htmlExpand(null, {
                                          pageOrigin: {
                                          x: this.pageX,
                                          y: this.pageY
                                          },
                                          headingText: 'testing1',
                                          maincontentText: 'testing2',
                                          width: 310,
                                          height: 500
                                          });
                                          }")))
    ))

If we can crack this nut then maybe we can do something like this: http://jsfiddle.net/y4JV5/4/

Thanks

Answer 1

For all those interested, here is the solution to the problem above. I am still working on a solution to display a chart using "htmlExpand" function. http://jsfiddle.net/y4JV5/4/

library(shiny)
library(highcharter)

data <- data.frame(x = c(1,2,3,4),
                   y = c(2,1,5,1))



js_func <- JS("function (event) {
                 hs.htmlExpand(null, {
                    pageOrigin: {
                      x: event.pageX || event.clientX,
                      y: event.pageY || event.clientY
                 },
                 headingText: event.point.series.name,
                 maincontentText:  'This point has coordinates: (' + event.point.x + ', ' + event.point.y + ')' , 
                 height: 100,
                 width: 250
             }); 
            }")

ui <- fluidPage(
   tags$head(HTML("\n<script src='https://www.highcharts.com/media/com_demo/js/highslide-full.min.js'></script>
             \n<script src='https://www.highcharts.com/media/com_demo/js/highslide.config.js' charset='utf-8'></script>
            \n<link rel='stylesheet' type='text/css' href='https://www.highcharts.com/media/com_demo/css/highslide.css'/>")),

   highchartOutput("a1")
)

server <- function(input, output){

  output$a1 <- renderHighchart({

   highchart() %>% 
     hc_add_series(data, "line", hcaes(x,y), name = "Sample Series") %>% 
     hc_plotOptions(series = list(
        cursor = "pointer",
        events = list(click = js_func)
     ))

 })

}

shinyApp(ui, server)

Hardest part is to link the data to the "hs.htmlExpand" part. This is done only using event.point .

Hopefully this is helpful.