When creating a map in R with highcharter, I would like to include a tooltip for missing values. To be sure that nullFormat is recognized I included also a datalabel for missing values and this works.
So nullFormat datalabels is working.
But nullFormat for a tooltip is not working.
require(dplyr)
mapdata <- get_data_from_map(download_map_data("custom/usa-and-canada"))
glimpse(mapdata)
data_fake <- mapdata |>
select(code = `hc-a2`) |>
mutate(value = 1e5 * abs(rt(nrow(mapdata), df = 10)))
# value NT on not available
data_fake$value[data_fake$code == "AZ"] <- NA
glimpse(data_fake)
highchart(type = "map") |>
hc_chart(map = download_map_data("custom/usa-and-canada")) |>
hc_add_series(
data_fake
, joinBy = c("hc-a2", "code")
, name = "Fake data"
, dataLabels = list(enabled = TRUE, format = "{point.name}", nullFormat = "N/A")
) |>
hc_colorAxis(auxpar = NULL) |>
hc_tooltip(valueDecimals = 0, nullFormat = "Missing data")
Related
I am trying to use both hc_motion and hc_drilldown within a highcharter map.
I can manage to get the hc_motion working with the full map, and also a drilldown from a larger area to its smaller ones (UK Region to Local Authority in this instance).
However, after drilling-down and zooming back out again, the hc_motion is now frozen.
Why is this and is there anyway around it? Or are hc_motion and hc_drilldown not compatible?
While in this instance the drilldown is static, if it possible hc_motion within each drilldown would be ideal, although will no even bother trying if even a static can't be incorporated without affecting the hc_motion.
Anyway, example code is below, thanks!
region_lad_lookup = read_csv("https://opendata.arcgis.com/api/v3/datasets/6a41affae7e345a7b2b86602408ea8a2_0/downloads/data?format=csv&spatialRefId=4326") %>%
clean_names() %>%
select(
region_code = rgn21cd,
region_name = rgn21nm,
la_name = lad21nm,
la_code = lad21cd,
value = fid
) %>%
inner_join(
read_sf("https://opendata.arcgis.com/api/v3/datasets/21f7fb2d524b44c8ab9dd0f971c96bba_0/downloads/data?format=geojson&spatialRefId=4326") %>%
clean_names() %>%
filter(grepl("^E", lad21cd)) %>%
select(la_code = lad21cd),
by = "la_code"
)
region_map = read_sf("https://opendata.arcgis.com/api/v3/datasets/bafeb380d7e34f04a3cdf1628752d5c3_0/downloads/data?format=geojson&spatialRefId=4326") %>%
clean_names() %>%
select(
area_code = rgn18cd,
area_name = rgn18nm
) %>%
st_as_sf(crs = 27700) %>%
sf_geojson() %>%
fromJSON(simplifyVector = F)
year_vec = c(2015, 2016, 2017, 2018, 2019)
region_data = region_lad_lookup %>%
select(
area_code = region_code,
area_name = region_name
) %>%
distinct() %>%
crossing(year_vec) %>%
mutate(
value = runif(nrow(.)),
drilldown = tolower(area_name)
)
region_vec = region_data %>%
select(area_name) %>%
distinct() %>%
pull()
get_la_map = function(data, region_val){
data = data %>%
filter(region_name == region_val) %>%
select(
area_code = la_code,
area_name = la_name,
geometry
) %>%
st_as_sf(crs = 27700) %>%
sf_geojson() %>%
fromJSON(simplifyVector = F)
return(data)
}
get_la_data = function(data, region_val){
data = data %>%
filter(region_name == region_val) %>%
select(
area_name = la_name,
area_code = la_code,
value
)
return(data)
}
get_region_map_list = function(region_val){
output = list(
id = tolower(region_val),
data = list_parse(get_la_data(region_lad_lookup, region_val)),
mapData = get_la_map(region_lad_lookup, region_val),
name = region_val,
value = "value",
joinBy = "area_name"
)
return(output)
}
region_ds = region_data %>%
group_by(area_name) %>%
do(
item= list(
area_name = first(.$area_name),
sequence = .$value,
value = first(.$value),
drilldown = first(.$drilldown)
)
) %>%
.$item
highchart(type = "map") %>%
hc_add_series(
data = region_ds,
mapData = region_map,
value = "value",
joinBy = "area_name",
borderWidth = 0
) %>%
hc_colorAxis(
minColor = "lightblue",
maxColor = "red"
) %>%
hc_motion(
enabled = TRUE,
axisLabel = "year",
series = 0,
updateIterval = 200,
magnet = list(
round = "floor",
step = 0.1
)
) %>%
hc_drilldown(
allowPointDrilldown = TRUE,
series = lapply(region_vec, get_region_map_list)
)
Maybe it's duplicated with mapbubble does not work with highcharter highmaps but there was no answer to the question...
From the example taken at https://jkunst.com/highcharter/articles/maps.html with a map of type "mappoint", I try to achieve the same with "mapbubble". I created for this a column z
library(httr)
library(jsonlite)
library(geojsonio)
library(highcharter)
library(dplyr)
ausgeojson <- GET("https://raw.githubusercontent.com/johan/world.geo.json/master/countries/AUS.geo.json") %>%
content() %>%
fromJSON(simplifyVector = FALSE) %>%
as.json()
ausmap <- highchart(type = "map") %>%
hc_add_series(mapData = ausgeojson, showInLegend = FALSE)
ausmap
airports <- read.csv("https://raw.githubusercontent.com/ajdapretnar/datasets/master/data/global_airports.csv")
airports <- airports %>%
filter(country == "Australia", name != "Roma Street Railway Station")
airports <- airports %>%
mutate(z=runif(n=nrow(airports),min=1,max=20))
airp_geojson <- geojson_json(airports, lat = "latitude", lon = "longitude")
# works with mappoint
ausmap %>%
hc_add_series(
data = airp_geojson,
type = "mappoint",
dataLabels = list(enabled = FALSE),
name = "Airports",
tooltip = list(pointFormat = "{point.name}")
)
# doesn't work with mapbubble
ausmap %>%
hc_add_series(
data = airp_geojson,
type = "mapbubble",
value = "z",
dataLabels = list(enabled = FALSE),
name = "Airports",
tooltip = list(pointFormat = "{point.name}")
)
The problem is probably due to the fact that {highcharter} cannot access the other columns of the geojson file.
Example if I add another column to the tooltip argument in the mappoint case :
ausmap %>%
hc_add_series(
data = airp_geojson,
type = "mappoint",
dataLabels = list(enabled = FALSE),
name = "Airports",
tooltip = list(pointFormat = "{point.name} : {point.altitude}")
)
I don't see altitude :
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))
I posted this in the plotly community forum but got absolutely no activity! Hope you can help here:
I have map time-series data, some countries don’t have data and plotly does not plot them at all. I can have them outlined and they look different but it appears nowhere that the data is missing there (i.e. I want a legend entry). How can I achieve this? Here is a reprex:
library(plotly)
library(dplyr)
data = read.csv('https://github.com/lc5415/COVID19/raw/master/data.csv')
l <- list(color = toRGB("grey"), width = 0.5)
g <- list(
scope = 'world',
countrycolor = toRGB('grey'),
showframe = T,
showcoastlines = TRUE,
projection = list(type = 'natural earth')
)
map.time = data %>%
plot_geo() %>%
add_trace(z = ~Confirmed, color = ~Confirmed, frame = ~Date, colors = 'Blues',
text = ~Country, locations = ~Alpha.3.code, marker = list(line = l)) %>%
colorbar(title = 'Confirmed') %>%
layout(
title = 'Number of confirmed cases over time',
geo = g
) %>%
animation_opts(redraw = F) %>%
animation_slider(
currentvalue = list(
prefix = paste0("Days from ",
format(StartDate, "%B %dnd"),": "))) %>%
plotly_build()
map.time
Note that the countries with missing data (e.g. Russia) have as many data points as all other countries, the issue is not that they do not appear in the dtaframe passed to plotly.
The obvious way to handle this is to create a separate labels column for the tooltip that reads "No data" for NA values (with the actual value otherwise), then make your actual NA values 0. This will give a uniform appearance to all the countries but correctly tells you when a country has no data.
map.time = data %>%
mutate_if(is.numeric, function(x) {x[is.na(x)] <- -1; x}) %>%
plot_geo() %>%
add_trace(z = ~Confirmed, color = ~Confirmed, frame = ~Date, colors = 'Blues',
text = ~Country, locations = ~Alpha.3.code,
marker = list(line = l)) %>%
colorbar(title = 'Confirmed') %>%
layout(
title = 'Number of confirmed cases over time',
geo = g
) %>%
animation_opts(redraw = F) %>%
animation_slider(
currentvalue = list(
prefix = paste0("Days from ",
format(StartDate, "%B %dnd"),": "))) %>%
plotly_build()
Which gives:
I am trying to draw line chart using Highchart . I need data format in Million format . Ex for the First point in screenshot 2423175 should be shown as 2.42 Million .How do i change format = "{point.y}" to show in Millions
highchart() %>%
hc_add_series(data, hcaes(x = data$Month, y = data$Total, color = data$Total), type = "line",dataLabels = list(
enabled = TRUE,
format = "{point.y} " )
) %>%
hc_tooltip(cros[![enter image description here][1]][1]shairs = TRUE, borderWidth = 1.5,headerFormat= "",
pointFormat = paste("Year: <b>{point.x:%b-%y}</b> <br> Population: <b>{point.y}</b>")) %>%
hc_title(text = "Population by year") %>%
hc_subtitle(text = "2016-2020") %>%
hc_xAxis(type = "datetime", title = list(text = "Year")) %>%
hc_yAxis(title = list(text = "count per year")) %>%
hc_legend(enabled = FALSE) %>%
hc_add_theme(custom_theme)
Here is a 2 step way of doing it:
First, you need to format your numbers from looking like 2423175 to 2.42 before you create your plot.
data$Total <- format(round(data$Total / 1e6, 1), trim = TRUE)
Next, in order to add 'Million' after your numbers in Highcharter, change format from format = "{point.y} " to format = paste("{point.y} Million") while creating your plot. Your numbers should now be displayed in the format "X.XX Million".
You can use dataLabels.formatter: https://api.highcharts.com/highcharts/series.line.dataLabels.formatter to format your dataLabels. I know how to do it in JavaScript and inject this code inside JS() function in R:
hc_add_series(data, hcaes(x = data$Month, y = data$Total, color = data$Total), type = "line",dataLabels = list(
enabled = TRUE,
formatter = JS("function() {
return (this.y / 1000000).toFixed(2) + 'M'
}") )
) %>%
JS example: https://jsfiddle.net/BlackLabel/o49zcjLv
Let me know if it worked.
Edit: The whole working code with sample data:
library(highcharter)
data <- data.frame(
y = c(54324232,85325324,10424324,44234324,74324234, 44321413))
highchart() %>%
hc_add_series(data, type = "line", hcaes(y = y), dataLabels = list(
enabled = TRUE,
formatter = JS("function() {
return (this.y / 1000000).toFixed(2) + 'M'
}"
)))