1

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)
  )

0 Answers0