R Highcharter: tooltip customization - r

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)

Related

Interactive heatmap in R using apexcharter fails at reactivity

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,
...

How to add Highchart Bar lines and lables?

i would like to build an interactive chart but i'm very new in highcharts, i want to add average line for the data and change the labels of the bars, now per default say "Series 1:" i want to write "Cdays: ", this is my code now
# Load required R packages
library(highcharter)
# Set highcharter options
options(highcharter.theme = hc_theme_smpl(tooltip = list(valueDecimals = 2)))
df <- data.frame(Year=c('2015','2016','2017','2018','2019'),
CD=c(24, 18, 12, 9, 14))
head(df)
hc <- df %>%
hchart('column',
hcaes(x = Year, y = CD),
color = "#702080", borderColor = "#702080",
pointWidth = 80) %>%
hc_title(text = "Critical Days") %>%
hc_xAxis(categories = 'Critical Days') %>%
hc
Thanks !!
To add the mean line, try using plotLines in hc_yAxis and set the value to mean(df$CD). You can also adjust the color, add a label, etc. here.
To change the "Series 1" you see when hovering over the bars, you should set the name inside of hchart - in this case, "Cdays".
Other minor changes below - including use of df$Year for x-axis text labels.
df %>%
hchart('column',
hcaes(x = Year, y = CD),
color = "#702080",
borderColor = "#702080",
pointWidth = 80,
name = "Cdays") %>%
hc_title(text = "Critical Days") %>%
hc_xAxis(categories = df$Year) %>%
hc_yAxis(
title = list(text = "Cdays"),
plotLines = list(
list(
value = mean(df$CD),
color = "#00FF00",
width = 3,
zIndex = 4,
label = list(
text = "mean",
style = list(color = "#00FF00")
)
)
)
)

HighCharter HCAES method not producing any visualization in R Shiny Dashboard

Attempting to build off of Stack Exchange Question:
R Highcharter: tooltip customization
Have a R module (below). That ingests some data and provides the UI including highcharter visualizations.
consolidatedlogModuleUI <- function(id){
ns <- NS(id)
tagList(
fluidRow(
bs4Card(highchartOutput(ns("fundedbydayChart")),
width = 12,
collapsible = TRUE)
),
fluidRow(
bs4TabCard(title = "Consolidated Log",
elevation = 2,
width = 12,
bs4TabPanel(
tabName = "tab1",
active = TRUE,
DT::dataTableOutput(ns("consolidatedlogTable"))
),
bs4TabPanel(
tabName = "tab2",
active = FALSE,
DT::dataTableOutput(ns("daysummaryTable"))
)
)
)
)
}
#######
# Consolidated Log Server Module
#######
consolidatedlogModule <- function(input,output,session,data){
ns <- session$ns
data$HasGap <- ifelse(data$GAPGrossRevenue > 0, 1, 0)
data$HasESC <- ifelse(data$ESCGrossRevenue > 0, 1, 0)
consolidatedLogVariables <- c("AcctID", "FSR", "DocSentDate", "DocsToLenderDate",
"FundedDate", "HasGap", "HasESC", "LoanRevenue")
logSummary <- data %>%
group_by(FundedMonthGroup) %>%
summarise(TotalCount = n()
, TotalAmount = sum(LoanRevenue)
, TotalGAP = sum(HasGap)
, TotalESC = sum(HasESC))
daySummary <- data %>%
group_by(FundedDayGroup) %>%
summarise(TotalCount = n()
,TotalAmount = sum(LoanRevenue))
### Consolidated Log Table
output$consolidatedlogTable = DT::renderDataTable({
data[consolidatedLogVariables]
}, extensions = "Responsive", rownames = FALSE,
caption = "Current Consolidated Log",
filter = "bottom"
)
output$daysummaryTable = DT::renderDataTable({
daySummary
}, extensions = "Responsive", rownames = FALSE,
caption = "Current Consolidated Log",
filter = "bottom"
)
### Charts
#Fundedbyday Chart
output$fundedbydayChart = renderHighchart({
highchart() %>%
hc_add_theme(hc_theme_ffx()) %>%
hc_title(text = "Loans Funded By Day") %>%
hc_add_series(data = daySummary, mapping = hcaes(x=FundedDayGroup, y=TotalAmount), type = "column", name = "Daily Loan Revenue",
tooltip = list(pointFormat = "Daily Revenue ${point.TotalAmount} across {point.TotalCount} deals")) %>%
hc_tooltip(crosshairs = TRUE)
# highchart() %>%
# hc_add_theme(hc_theme_ffx()) %>%
# hc_title(text = "Loans Funded By Day") %>%
# hc_add_series(daySummary$TotalAmount, type = "column", name = "Daily Loan Revenue",
# tooltip = list(pointFormat = "Daily Revenue ${point.TotalAmount} across {point.TotalCount} deals")) %>%
# hc_tooltip()
#hchart(daySummary, "column", hcaes(daySummary$FundedDayGroup, daySummary$TotalAmount))
})
}
The highChart function that is commented out works correctly in displaying the columns wanted. The Axis is incorrect and the tooltips is unformatted but the data displays.
Using the Non-commented highchart with the HCAES call and other items, the plot is displayed without any data.
Below is code to reproduce the test data set for the daySummary, the dataframe in question.
FundedDayGroup <- as.Date(c('2019-02-01', '2019-02-4', '2019-02-05'))
TotalCount <- c(1,13,18)
TotalAmount <- c(0, 13166, 15625)
daySummary <- data.frame(FundedDayGroup, TotalCount, TotalAmount)
The issue ended up being Highcharter not interpreting the POSIXct format of the dates and needing to cast the date variable using as.Date. Additionally added some logic to handle the xAxis and setting the datetime. Code below
highchart() %>%
hc_add_theme(hc_theme_ffx()) %>%
hc_title(text = "Loans Funded By Day") %>%
hc_add_series(data = daySummary, mapping = hcaes(x=as.Date(FundedDayGroup), y=TotalAmount), type = "column", name = "Daily Loan Revenue",
tooltip = list(pointFormat = "Daily Revenue ${point.TotalAmount} across {point.TotalCount} deals")) %>%
hc_xAxis(type = "datetime", labels=list(rotation = -45, y = 40) ) %>%
hc_yAxis(title=list(text = "Revenue")) %>%
hc_tooltip(crosshairs = TRUE)

Setting custom value as label in bar highchart (Rshiny)

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.

R ggvis linked_brush is not reactive

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.

Resources