R Shiny Highchart，单击更改线宽

Question

JS 和 R 的新手。在闪亮的应用程序中，我创建了一个包含以下数据的图表输出：

> dput(all_NoTime3)
structure(list(datetime = c(1574240101000, 1574239987000, 1574239985000, 
1574239845000, 1574239830000, 1574239830000, 1574239438000, 1574239362000, 
1574239339000, 1574239215000, 1574239215000, 1574239215000, 1574238787000, 
1574238745000, 1574238674000, 1574238590000, 1574238590000, 1574238588000, 
1574238144000, 1574238110000, 1574238020000, 1574237979000, 1574237979000, 
1574237960000, 1574237497000, 1574237496000, 1574237378000, 1574237364000, 
1574237364000, 1574237322000, 1574236882000, 1574236840000, 1574236749000, 
1574236749000, 1574236725000, 1574236685000, 1574236266000, 1574236195000, 
1574236134000, 1574236133000, 1574236080000, 1574236057000, 1574235632000, 
1574235550000, 1574235520000, 1574235519000, 1574235426000, 1574235426000, 
1574235017000, 1574234907000, 1574234906000, 1574234905000, 1574234786000, 
1574234770000, 1574234392000, 1574234301000, 1574234301000, 1574234258000, 
1574234159000, 1574234109000, 1574233759000, 1574233686000, 1574233686000, 
1574233609000, 1574233523000, 1574233448000, 1574233143000, 1574233071000, 
1574233070000, 1574232957000, 1574232894000, 1574232787000, 1574232527000, 
1574232455000, 1574232455000, 1574232305000, 1574232257000, 1574232127000, 
1574231911000, 1574231840000, 1574231840000, 1574231662000, 1574231629000, 
1574231465000, 1574231275000, 1574231224000, 1574231224000, 1574231023000, 
1574230992000, 1574230803000, 1574230639000, 1574230608000, 1574230608000, 
1574230381000, 1574230364000), customer = c("digea", "vouli", 
"fraport", "olympiaradio", "maximou", "mitilinaios", "digea", 
"vouli", "fraport", "maximou", "mitilinaios", "olympiaradio", 
"digea", "vouli", "fraport", "maximou", "mitilinaios", "olympiaradio", 
"digea", "vouli", "fraport", "maximou", "mitilinaios", "olympiaradio", 
"vouli", "digea", "fraport", "maximou", "mitilinaios", "olympiaradio", 
"vouli", "digea", "maximou", "mitilinaios", "fraport", "olympiaradio", 
"vouli", "digea", "mitilinaios", "maximou", "fraport", "olympiaradio", 
"vouli", "digea", "mitilinaios", "maximou", "fraport", "olympiaradio", 
"vouli", "mitilinaios", "maximou", "digea", "olympiaradio", "fraport", 
"vouli", "maximou", "mitilinaios", "digea", "olympiaradio", "fraport", 
"vouli", "maximou", "mitilinaios", "digea", "olympiaradio", "fraport", 
"vouli", "mitilinaios", "maximou", "digea", "olympiaradio", "fraport", 
"vouli", "maximou", "mitilinaios", "digea", "olympiaradio", "fraport", 
"vouli", "maximou", "mitilinaios", "digea", "olympiaradio", "fraport", 
"vouli", "maximou", "mitilinaios", "digea", "olympiaradio", "fraport", 
"vouli", "maximou", "mitilinaios", "digea", "olympiaradio"), 
    ping.x = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 
    1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 
    1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 
    1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 
    1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 
    1, 1, 1), n = c(105L, 7L, 44L, 23L, 4L, 5L, 105L, 7L, 44L, 
    4L, 5L, 23L, 105L, 7L, 44L, 4L, 5L, 23L, 105L, 7L, 44L, 4L, 
    5L, 23L, 7L, 104L, 44L, 4L, 5L, 23L, 7L, 105L, 4L, 5L, 44L, 
    23L, 7L, 105L, 5L, 4L, 44L, 23L, 7L, 105L, 5L, 4L, 44L, 23L, 
    7L, 5L, 4L, 105L, 23L, 44L, 7L, 4L, 5L, 105L, 23L, 44L, 7L, 
    4L, 5L, 105L, 23L, 44L, 7L, 5L, 4L, 105L, 23L, 44L, 7L, 4L, 
    5L, 105L, 23L, 44L, 7L, 4L, 5L, 105L, 23L, 44L, 7L, 4L, 5L, 
    105L, 23L, 44L, 6L, 4L, 5L, 105L, 23L), percent = c(100, 
    100, 97.8, 100, 100, 100, 100, 100, 97.8, 100, 100, 100, 
    100, 100, 97.8, 100, 100, 100, 100, 100, 97.8, 100, 100, 
    100, 100, 100, 97.8, 100, 100, 100, 100, 100, 100, 100, 97.8, 
    100, 100, 100, 100, 100, 97.8, 100, 100, 100, 100, 100, 97.8, 
    100, 100, 100, 100, 100, 100, 97.8, 100, 100, 100, 100, 100, 
    97.8, 100, 100, 100, 100, 100, 97.8, 100, 100, 100, 100, 
    100, 97.8, 100, 100, 100, 100, 100, 97.8, 100, 100, 100, 
    100, 100, 97.8, 100, 100, 100, 100, 100, 97.8, 85.7, 100, 
    100, 100, 100), element = c(NA, NA, "n3328-xari9kb-ryanair-airport", 
    NA, NA, NA, NA, NA, "n3328-xari9kb-ryanair-airport", NA, 
    NA, NA, NA, NA, "n3328-xari9kb-ryanair-airport", NA, NA, 
    NA, NA, NA, "n3328-xari9kb-ryanair-airport", NA, NA, NA, 
    NA, NA, "n3328-xari9kb-ryanair-airport", NA, NA, NA, NA, 
    NA, NA, NA, "n3328-xari9kb-ryanair-airport", NA, NA, NA, 
    NA, NA, "n3328-xari9kb-ryanair-airport", NA, NA, NA, NA, 
    NA, "n3328-xari9kb-ryanair-airport", NA, NA, NA, NA, NA, 
    NA, "n3328-xari9kb-ryanair-airport", NA, NA, NA, NA, NA, 
    "n3328-xari9kb-ryanair-airport", NA, NA, NA, NA, NA, "n3328-xari9kb-ryanair-airport", 
    NA, NA, NA, NA, NA, "n3328-xari9kb-ryanair-airport", NA, 
    NA, NA, NA, NA, "n3328-xari9kb-ryanair-airport", NA, NA, 
    NA, NA, NA, "n3328-xari9kb-ryanair-airport", NA, NA, NA, 
    NA, NA, "n3328-xari9kb-ryanair-airport", "n3750-athe9ka-vouli-megarovoulis", 
    NA, NA, NA, NA), ping.y = c(NA, NA, 0, NA, NA, NA, NA, NA, 
    0, NA, NA, NA, NA, NA, 0, NA, NA, NA, NA, NA, 0, NA, NA, 
    NA, NA, NA, 0, NA, NA, NA, NA, NA, NA, NA, 0, NA, NA, NA, 
    NA, NA, 0, NA, NA, NA, NA, NA, 0, NA, NA, NA, NA, NA, NA, 
    0, NA, NA, NA, NA, NA, 0, NA, NA, NA, NA, NA, 0, NA, NA, 
    NA, NA, NA, 0, NA, NA, NA, NA, NA, 0, NA, NA, NA, NA, NA, 
    0, NA, NA, NA, NA, NA, 0, 0, NA, NA, NA, NA)), class = "data.frame", row.names = c(NA, 
-95L))

是否可以通过单击按钮来更改线宽？例如，每次单击增加按钮时，线宽增加 2 px，而减少按钮则相反。我尝试了很多方法，none 似乎有效。

整个APP代码如下：

library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(dplyr)
library(tidyr)
library(shinyjs)
library(shinycssloaders)
library(shinytoastr)
library (highcharter)
library(pool)

ui <- fluidPage(

    shinyjs::useShinyjs(),

         tags$head(
            tags$link(rel = "stylesheet", type = "text/css", href = "B2B_notifier.css"),
          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'/>")

       ),

    # Main panel for displaying outputs ----
    mainPanel(


         highchartOutput("Plot", height = 600),
         actionButton(inputId = "btn1", label = "increase width", class = "btn-primary"),
         actionButton(inputId = "btn2", label = "decrease width", class = "btn-primary")
    )

)

server <- function(input, output) {

# Click Function JS 
  canvasClickFunction3 <- JS("function (e) {

                        hs.htmlExpand(null, {
                            pageOrigin: {
                                x: e.pageX || e.clientX,
                                y: e.pageY || e.clientY
                            },

                            headingText: 'Nte Information:',
                            maincontentText: '<i>'+ 'Date:' + ' ' + '</i><b>' + Highcharts.dateFormat('%A, %b %e, %Y, %H:%M:%S', this.x) + '</b>'
                              + '<br/><i> ' +
                               'Nte:' + ' ' + '</i><b>' + event.point.element + '</b>' 
                              + '<br/> <i>',
                            width: 330,

                        });
                    }") 

   observeEvent(input$btn1, {
        # Run JS code
        runjs(" function(event){
            chart.series[0].graph.attr({
                'stroke-width': 10
            });
            chart.redraw();
        };"
        )
      })

########### Plot1 ##########

   output$Plot <- renderHighchart ({

        highchart() %>%
             hc_chart(type = "container",
                      zoomType= "x"
             ) %>%
             #axis
             hc_xAxis(type='datetime',
                      # categories=c(min2$datetime),
                      labels = list(rotation = 90,
                                    format = '{value:%e-%b %H:%M}'),
                      showLastLabel = TRUE
             ) %>% 
             hc_yAxis(opposite = FALSE, 
                      title = list(text = "Call Success"),
                      labels = list(format = "{value}%", style=list(fontSize='13px')), max = 100) %>% 
             hc_add_series(all_NoTime3, "spline", hcaes(x=datetime, y=percent, group=customer)
             )%>%
             hc_tooltip(valueDecimals = 1,
                        borderWidth=2,
                        xDateFormat= '<b> %y/%m/%d %H:%M:%S <b/>',
                        crosshairs = TRUE,
                        backgroundColor=' #eaecee ',
                        pointFormat = "Customer: <b> {series.name} <br> Success: <b> {point.y} %",
                        style=list(fontSize='14px')
             )%>%
             hc_plotOptions(spline =list(lineWidth=2,
                                         allowPointSelect= TRUE,
                                         turboThreshold=100,
                                         cursor= 'pointer',
                                         states=list(hover=list(lineWidth=4)),
                                         marker=list(enabled = F,
                                                     radius=1, 
                                                     symbol="circle")),
                              series = list(stacking = FALSE,
                                        point =list(
                                        events = list(click =  canvasClickFunction3)))
             ) %>%
             hc_credits(enabled = TRUE,
                        text = "CX & SE Center",
                        style = list(fontSize = "10px")
             ) %>%
             hc_exporting(enabled = TRUE)
   }) 

}

shinyApp(ui, server)

Answer 1

我想你可以坚持闪亮的逻辑及其反应值。检查这是否满足您的需求：

library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(dplyr)
library(tidyr)
library(shinyjs)
library(shinycssloaders)
library(shinytoastr)
library(highcharter)
library(pool)

ui <- fluidPage(
  shinyjs::useShinyjs(),
  # Main panel for displaying outputs ----
  mainPanel(
    highchartOutput("Plot", height = 600),
    actionButton(inputId = "btn1", label = "increase width", class = "btn-primary"),
    actionButton(inputId = "btn2", label = "decrease width", class = "btn-primary")
  )
)

server <- function(input, output) {

  size <- reactiveVal(1)

  observeEvent(input$btn1, {
    size(size() + 1)
  })

  observeEvent(input$btn2, {
    # do not allow negative values
    if(size() > 0){
      size(size() - 1)
    } 
  })

  ########### Plot1 ##########

  output$Plot <- renderHighchart ({

    highchart() %>%
      hc_chart(type = "container",
               zoomType= "x"
      ) %>%
      #axis
      hc_xAxis(type='datetime',
               # categories=c(min2$datetime),
               labels = list(rotation = 90,
                             format = '{value:%e-%b %H:%M}'),
               showLastLabel = TRUE
      ) %>% 
      hc_yAxis(opposite = FALSE, 
               title = list(text = "Call Success"),
               labels = list(format = "{value}%", style=list(fontSize='13px')), max = 100) %>% 
      hc_add_series(all_NoTime3, "spline", hcaes(x=datetime, y=percent, group=customer)
      )%>%
      hc_tooltip(valueDecimals = 1,
                 borderWidth=2,
                 xDateFormat= '<b> %y/%m/%d %H:%M:%S <b/>',
                 crosshairs = TRUE,
                 backgroundColor=' #eaecee ',
                 pointFormat = "Customer: <b> {series.name} <br> Success: <b> {point.y} %",
                 style=list(fontSize='14px')
      )%>%
      hc_plotOptions(spline =list(lineWidth = size(),
                                  allowPointSelect = TRUE,
                                  turboThreshold = 100,
                                  cursor = 'pointer',
                                  states = list(hover = list(lineWidth = 4)),
                                  marker = list(enabled = F,
                                              radius=1, 
                                              symbol="circle"))
      ) %>%
      hc_credits(enabled = TRUE,
                 text = "CX & SE Center",
                 style = list(fontSize = "10px")
      ) %>%
      hc_exporting(enabled = TRUE)
  }) 

}

shinyApp(ui, server)

R Shiny Highchart，单击更改线宽

R Shiny Highchart, change line width on click

r

highcharts

shiny

r-highcharter