rhighchartsshinyr-highcharter
R Shiny Highchart, change line width on click
New to JS and R. In a shiny App, I've created a highchart output with the following data:
> 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))
Is it possible to change the line width by the click of a button? e.g each time the increase button is clicked, to increase line width by 2 px and the opposite with the decrease button. I've tried many approaches, none seems to work.
The whole APP code is the following:
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)
Solution
I guess you can just stick to the shiny logic and its reactive values. Check if this meets your needs:
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)
- Turn dataframe with frequency into a frequency table for chi-square test
- Print result of a function in R
- dplyr is turning dates to doubles when mutating dataframe
- How to require user authentication in R Shiny before users see any part of the app using shinyauthr?
- Determine foreground / background colour in bslib app with dark/light mode
- R quanteda kwic not matching negative look behind pattern
- make ggplot legend correspond to geom type
- Preserve xy coordinates while using terra::extract with vector data
- Grepl with logical operator AND across multiple alphanumeric columns
- Newey-West error for multiple linear regressions
- Looping over variables in ggplot
- data.frame rows to a list
- Calculate svymean for variable within user-defined function called by mutate(), across(), with variable name as function parameter
- Dual axis graph, keep original scale
- creating a Instrument variable formula form formula object
- Create a straight edge between nodes if there is another node branching from the midpoint of the edge in DiagrammeR?
- Compose long character string in R across multiple lines but without functions or line breaks
- Using R Quarto to create PDF documents, how can I center code chunk output and add a background color?
- Create a gif from a series of Leaflet maps in R
- How to reduce vertical margin between rows in ggplot legend
- Importing a scatter plot from PDF into R
- How to remove background of images with the magick package?
- saveGIF() returns empty GIF
- Writing multiple images using Magick on R
- How to repair obscured blocks in a QR code image
- Join multiple rasters at specific locations, when the number of rasters is variable
- Creating animation (.gif) in R using .png files
- Forest plot images cut off on all sides
- R - select last 2 columns
- Why is step_cut from R's recipes package complaining about a factor in my data frame?