I have multiple highcharts in my shiny app and the structure is similar in all of them, so I'm trying to use a function to generalise:
In my data file:
Edit
set.seed(5)
data <- data.frame(id=1:10,
period=seq(2011,2020, 1),
program=rep(LETTERS[1:2], 5),
total=rnorm(10))
gral <- function(df,x,y,group,theme){
highchart() %>%
hc_xAxis(type = "category") %>%
hc_add_series(df, "line",
hcaes(x = x, y = y
,group = group),
dataLabels = list(enabled = TRUE,
style = list(fontSize = '13px'))
) %>%
hc_legend(enabled = TRUE) %>%
hc_tooltip(shared = TRUE, crosshairs = TRUE
,style = list(fontSize = "18px")
) %>%
hc_add_theme(theme) }
In my server file (for each highchart)
output$usuariosgral <- renderHighchart({ gral(df = data, x = period, y = total,
group = program, theme = hc_theme_elementary()) })
But it is not working, anyone knows why?
Finally, I found the answer here, in case it is useful to anyone --> https://stackoverflow.com/a/64392483/13529820
Just need to use the function ensym from library rlang. So in my code jus changed the hcaes line to this:
hcaes(x = !!rlang::ensym(x), y = !!rlang::ensym(y), group = !!rlang::ensym(group))
This is a common issue: hcaes is based on ggplot2::aes and acts similarly, luckily, you can access it as a string, ggplot2 has aes_string and highcharter has hcaes_string
library(shiny)
library(highcharter)
gral <- function(df,x,y,group,theme){
highchart() %>%
hc_xAxis(type = "category") %>%
hc_add_series(df, "line",
hcaes_string(x = x, y = y, group = group),
dataLabels = list(enabled = TRUE,
style = list(fontSize = '13px'))) %>%
hc_legend(enabled = TRUE) %>%
hc_tooltip(shared = TRUE, crosshairs = TRUE,style = list(fontSize = "18px")) %>%
hc_add_theme(theme)
}
ui <- basicPage(
column(12,
highchartOutput('usuariosgral')
)
)
server <- function(input, output, session) {
output$usuariosgral <- renderHighchart({
gral(df = mtcars,x ='mpg',y = 'disp',group ='cyl',theme = hc_theme_elementary())
})
}
shinyApp(ui, server)
I found the answer here in case it is useful to anyone.
Just need to use the function ensym from library rlang. So in my code jus changed the hcaes line to this:
hcaes(x = !!rlang::ensym(x), y = !!rlang::ensym(y), group = !!rlang::ensym(group))
Related
at the moment I try to create an interactive heatmap in R with apexcharter. This works fine at manual chart creation but fails on interactive use within shiny.
library(shiny)
library(tidyverse)
library(apexcharter)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Test Heatmap"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectInput(
inputId = "heatmap_filter",
label = "heatmap filter",
choices = c(1999, 2008),
selected = 2008
)
),
mainPanel(
apexchartOutput("heatmap")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$heatmap <- renderApexchart({
df <- mpg %>% filter(year == input$heatmap_filter) %>% mutate_if(is.character, as.factor) %>% group_by(manufacturer, class) %>% summarise(cnt = n()) %>% tidyr::complete(class, fill = list(cnt = 0))
q20 <- round(as.numeric(quantile(df %>% filter(cnt>0) %>% pull(cnt), probs = seq(0,1,0.2), na.rm = TRUE))[2],0)
q40 <- round(as.numeric(quantile(df %>% filter(cnt>0) %>% pull(cnt), probs = seq(0,1,0.2), na.rm = TRUE))[3],0)
q60 <- round(as.numeric(quantile(df %>% filter(cnt>0) %>% pull(cnt), probs = seq(0,1,0.2), na.rm = TRUE))[4],0)
q80 <- round(as.numeric(quantile(df %>% filter(cnt>0) %>% pull(cnt), probs = seq(0,1,0.2), na.rm = TRUE))[5],0)
apex(
data = df,
type = "heatmap",
mapping = aes(x = manufacturer, y = class, fill = cnt)
) %>%
ax_dataLabels(enabled = TRUE) %>%
ax_plotOptions(
heatmap = heatmap_opts(
enableShades = FALSE,
colorScale = list(
ranges = list(
list(from = 0, to = q20, color = "#106e45"), #grün
list(from = q20, to = q40, color = "#90dbba"), #leichtes grün
list(from = q40, to = q60, color = "#fff33b"), #gelb
list(from = q60, to = q80, color = "#f3903f"), # orange
list(from = q80, to = 20, color = "#e93e3a") #rot
)
)
)
) %>%
ax_title(
text = paste("Test interactive heatmap",
input$heatmap_filter
), align = "center"
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
With the manual approach everthing works as expected. But when I change the input select only the values changes but not the heatmap quantil ranges and not the title input. Its seems like the input value is not pushing the changes to already calculated variables. I already tried to use an reactive df or reactive variables but so far nothing works.
I added a minimal example where you could change the year input and this should change the title and the color ranges.
Can you help me?
Thanks in advance.
Try setting auto_update to FALSE in the call to apex
apex(
data = df,
type = "heatmap",
auto_update = FALSE,
...
I created a chart using highcharter in a shiny dashboard and I am trying to customize the tooltip. The chart is combined line and scatter plot. I would like it to do the following:
1) Have a single box for hover information (it currently has one for the line and one for scatter)
2) Be able to use different column of information that is not used in the series x or y values
I would like the tooltip to display the following information (whether I hover over the scatter point or line) for each particular x-axis value.
Overall
Mean: 2 [Mean: data$avghours]
Dog: 1 [data$animal: data$hours]
Below is the example code I've written that demonstrates my problem:
library (shiny)
library (shinydashboard)
library (highcharter)
header <- dashboardHeader(title = "Example")
body <- dashboardBody(
fluidRow(
box(title = "example", status = "primary", solidHeader = TRUE,
highchartOutput("chart")
)
)
)
sidebar <- dashboardSidebar()
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output) {
date <- c(1,2,3,4,5,6,7,8,9,10)
hours <- c(1,5,4,1,6,5,7,5,4,3)
avghours <- c(2,2,2,3,3,3,2,2,2,2)
animal <- c("dog","cat","cat","cat","cat","cat","cat","cat","dog","dog")
data <- data.frame(date,hours,avghours,animal)
output$chart <- renderHighchart({
highchart() %>%
hc_add_series(name = "Shipments", data=data$hours, type = "scatter", color = "#2670FF", marker = list(radius = 2), alpha = 0.5) %>%
hc_add_series(name = "Rolling Mean", data=data$avghours, color = "#FF7900") %>%
hc_yAxis(min = 0, title = list(text = "Hours")) %>%
hc_tooltip(crosshairs = TRUE)
})
}
shinyApp(ui, server)
Firt of all, you need to add all the data instead give only the vector (the vector DON´T have all the information to the tooltip you want).
To do this you need change the data argument using the data.frame with the hcaes helper function in the mapping argument to define which variable use in every axis:
highchart() %>%
hc_add_series(data = data, mapping = hcaes(x=date, y=hours), name = "Shipments", type = "scatter", color = "#2670FF", marker = list(radius = 2), alpha = 0.5) %>%
hc_add_series(data = data, hcaes(date, avghours), name = "Rolling Mean", type = "line", color = "#FF7900") %>%
hc_yAxis(min = 0, title = list(text = "Hours")) %>%
hc_tooltip(crosshairs = TRUE)
Then you can use the tooltip argument in every hc_add_series to define the tooltip in each series:
highchart() %>%
hc_add_series(data = data, hcaes(date, hours), name = "Shipments", type = "scatter",
tooltip = list(pointFormat = "tooltip with 2 values {point.animal}: {point.hours}")) %>%
hc_add_series(data = data, hcaes(date, avghours), name = "Rolling Mean", type = "line",
tooltip = list(pointFormat = "Avg hour text! {point.avghours}")) %>%
hc_yAxis(min = 0, title = list(text = "Hours")) %>%
hc_tooltip(crosshairs = TRUE)
I have a dataframe with several columns. I draw a bar plot with the values of one of the columns (Ex Count) and I would like to show a label which is not the value of the 'Count' column but the value of the 'Rank' column.
I do not know how to replace the 'point.y' in the dataLabels.
Here is a reproducible example :
library("shiny")
library("highcharter")
data <- data.frame(Name = c("A", "B", "C", "D", "E"),Count=c(38,44,23,29,26), Rank=10:14)
ui <- fluidPage(
fluidRow(
column(width = 8,
highchartOutput("hcontainer",height = "500px")
)
)
)
server <- function(input, output) {
output$hcontainer <- renderHighchart({
chart <- highchart() %>%
hc_chart(type = "bar") %>%
hc_yAxis(title = list(text = "Count"))
chart <- chart %>%
hc_add_series(name="",data = data$Count, dataLabels = list(enabled = TRUE, format='{point.y}'))
return(chart)
})
}
shinyApp(ui = ui, server = server)
Does anyone have an idea ?
Thanks a lot
Sam
Sam,
The easiest way is use hchart function.
hchart(data, "bar", hcaes(x = Name, y = Count),
dataLabels = list(enabled = TRUE, format='{point.Rank}'))
This send all the data to the highchart object so you can extract the info of each point/row (in highcharts /R language) via point.Rank.
The other way is:
highchart() %>%
hc_yAxis(title = list(text = "Count")) %>%
hc_xAxis(categories = data$Name) %>%
hc_add_series(data = data, type = "bar", hcaes(x = Name, y = Count),
dataLabels = list(enabled = TRUE, format='{point.Rank}'))
Here you send all the data again: hc_add_series(data = data, ...) and not only the count values as you did. When you use hc_add_series function with data frames (is a generic function!) you need to use hcaes(x = Name, y = Count) in the mapping argument to specify how to use each variable in the chart.
I'm trying to create a scatter plot in highcharts shiny R but I need to give a different color to points, individually. Consider for instance the following example:
library("MASS")
dscars <- round(mvrnorm(n = 20, mu = c(1, 1), Sigma = matrix(c(1,0,0,1),2)), 2)
highchart() %>%
hc_chart(type = "scatter", zoomType = "xy") %>%
hc_tooltip(
useHTML = TRUE,
pointFormat = paste0("<span style=\"color:{series.color};\">{series.options.icon}</span>",
"{series.name}: <b>[{point.x}, {point.y}]</b><br/>")
) %>%
hc_add_series(data = list.parse2(as.data.frame(dscars)),
marker = list(symbol = fa_icon_mark("car")),
icon = fa_icon("car"), name = "car")
My objective is to give to this 20 points, an unique color.
I tried to set the "fillColor" inside marker list as also as to define the color of the series, both with a vector of 20 colors but I had no success.
Can any one give me a hint?
Thank you
In highcharts (the highcharter) the point can be given as other parameter, same as x and y. So first
library("MASS")
dscars <- round(mvrnorm(n = 20, mu = c(1, 1), Sigma = matrix(c(1,0,0,1),2)), 2)
dscars <- as.data.frame(dscars)
names(dscars) <- c("x", "y") # it's better give a named list IMHO
dscars$color <- colorize(1:nrow(dscars))
colorizeis a function to create a color vector given other vector. In this case the input vector is a sequence (no repeated) so the output will be differents colors. But if you want yo can use your own colors.
highchart() %>%
hc_chart(type = "scatter", zoomType = "xy") %>%
hc_tooltip(
useHTML = TRUE,
pointFormat = paste0("<span style=\"color:{point.color};\">{series.options.icon}</span>",
"{series.name}: <b>[{point.x}, {point.y}]</b><br/>")
) %>%
hc_add_series(data = list_parse(dscars),
marker = list(symbol = fa_icon_mark("car")),
icon = fa_icon("car"), name = "car")
Note we used:
color:{point.color}; in the poinFormat, beacuse every point has its own color in the color accesor.
I used list_parse which parse the data frame in a named list instead of unnamed list so highcharts understand how to use the data. list_parse is the same list.parse3 for old version of highcharts.
Hope it helps.
Is this what you want?
rm(list = ls())
library(highcharter)
library(MASS)
dscars <- data.frame(round(mvrnorm(n = 20, mu = c(1, 1), Sigma = matrix(c(1,0,0,1),2)), 2))
highchart() %>%
hc_chart(type = "scatter", zoomType = "xy") %>%
hc_tooltip(
useHTML = TRUE,
pointFormat = paste0("<span style=\"color:{colorByPoint:true};\">{series.options.icon}</span>",
"{series.name}: <b>[{point.x}, {point.y}]</b><br/>")
) %>%
hc_add_series(data = list.parse2(as.data.frame(dscars)),colorByPoint = TRUE,
marker = list(symbol = fa_icon_mark("car")),
icon = fa_icon("car"), name = "car")
I have the following code on my Server. R
data_agg_plot1<- reactive({
brush1 <- linked_brush(keys = data_agg()$id, "navy" )
data_agg <- data_agg()
plot1<-data_agg%>%
ggvis(x = ~dates_all) %>%
group_by(factor(dates_all.1)) %>%
layer_points(y = ~ value, fill =~dates_all.1, shape =~dates_all.1) %>%
layer_paths(y = ~ value, stroke = ~dates_all.1 , strokeOpacity := 0.5) %>%
scale_ordinal("fill", range = c("green", "red", "blue"))%>%
scale_ordinal("shape", range = c("triangle-up","triangle-down","circle")) %>%
scale_ordinal("stroke",range=c("green","red","blue")) %>%
brush1$input() %>%
hide_legend(c('stroke','fill'))%>%
add_legend(c('shape','fill'),
title = "Symbol", orient = "left",
values = c("New hires", "Attrition" , "Net Growth"),
properties = legend_props(
title = list(fontSize = 16))) %>%
add_axis("x",properties= axis_props(labels = list(angle=60,align = "left")),
tick_padding =0,
title = "") %>%
add_axis("y", title = "Total Count") %>%
set_options(width = "auto",height = 400) %>%
scale_numeric('y',clamp = TRUE)
return(list(plot1,brush1))
})
so this is a reactive function that returns me a list of 2 functions, a plot and my brush object.
the purpose of doing so is so that I can make my keys reactive - this is so that I can make an additional plot based on my user's selection. think of it as the second plot depends on what the first user highlights in the first plot.
this is my following code:
plot1_data<-reactive({
data_agg_plot1()[[1]]
})
plot1_data%>%bind_shiny("plot1")
selected_plot1 <- reactive({
data_agg_plot1()[[2]]
})
output$test <- renderPrint({
temp <- selected_plot1()$selected()
print(temp)
})
however, when I print out the selection, it is all false,
please refer to the image below:
can anybody explain to me how to overcome this?
I highly suspect I have to re-write my linkedbrush function,
I have tried both solutions from:
linked_brush in ggvis cannot work in Shiny when data change
but it does not work.