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.
Related
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))
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,
...
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)
I am currently working with the java script wrapper highcharter in R.
I would like to manually set the Y axis for each of the layer, as well as the title for each layer but have not been able to find a way to do so.
E.g the title for all layers are currently "Basic Drilldown", and i would like to update this for each of the drilldowns. As well as I would like to manually set the y axis.
Thanks in advance.
Current code below.
df <- data_frame(
name = c("Animals", "Fruits", "Cars"),
y = c(5, 2, 4),
drilldown = tolower(name)
)
df
hc <- highchart() %>%
hc_chart(type = "column") %>%
hc_title(text = "Basic drilldown") %>%
hc_xAxis(type = "category") %>%
hc_legend(enabled = FALSE) %>%
hc_plotOptions(
series = list(
boderWidth = 0,
dataLabels = list(enabled = TRUE)
)
) %>%
hc_add_series(
data = df,
name = "Things",
colorByPoint = TRUE
)
dfan <- data_frame(
name = c("Cats", "Dogs", "Cows", "Sheep", "Pigs"),
value = c(4, 3, 1, 2, 1)
)
dffru <- data_frame(
name = c("Apple", "Organes"),
value = c(4, 2)
)
dfcar <- data_frame(
name = c("Toyota", "Opel", "Volkswagen"),
value = c(4, 2, 2)
)
hc <- hc %>%
hc_drilldown(
allowPointDrilldown = TRUE,
series = list(
list(
id = "animals",
data = list_parse2(dfan)
),
list(
id = "fruits",
data = list_parse2(dffru)
),
list(
id = "cars",
data = list_parse2(dfcar)
)
)
)
hc
EDIT* updated with answer to dynamically set yaxis for R highcharts.
drilldown = JS('function(e) {
console.log(e.seriesOptions);
this.setTitle({text: e.seriesOptions.name || e.seriesOptions.id });
this.yAxis[0].update({ min: this.yAxis[0].getExtremes().max * 0.5 })}')
First of all, you need to refactor your code a bit, because it's not correct. For example, try to create new variable with all series names and assign this list of names to drilldown field in your data.frame:
names <- c("Animals", "Fruits", "Cars")
df <- data.frame(
name = names,
y = c(5, 2, 4),
drilldown = names
)
Then, change the drilldown id's in your drilldown object definition, because it's not necessary to make them start from lowercase:
hc_drilldown(
allowPointDrilldown = TRUE,
series = list(
list(
id = "Animals",
data = list_parse2(dfan)
),
list(
id = "Fruits",
data = list_parse2(dffru)
),
list(
id = "Cars",
data = list_parse2(dfcar)
)
)
)
The final step is defining the chart.events.drilldown and chart.events.drillup function handlers, inside of which you will set the chart.title.text using Chart.update() function. In order to define it, you have to use JS() R built-in function, just like below:
hc_chart(type = "column", events = list(
load = JS("function() {console.log(this)}"),
drilldown = JS("function(e) {this.update({title: {text: e.seriesOptions.id}})}"),
drillup = JS("function() {this.update({title: {text: 'Basic drilldown' }})}")
)) %>%
Actually, i don't quite understand this part of the question:
As well as I would like to manually set the y axis.
If you describe it more precisely then I will extend the answer.
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)