Adjust setView() for each group

[aloboa]

Perhaps this feature could be considered as an extension within leafem?
rstudio/leaflet#931

[tim-salabim]

maybe, though is addHomeButton not sufficient?

[aloboa]

I Cannot fully try, as I get:

m <- leaflet() %>%
  addProviderTiles("OpenStreetMap") %>%
  addCircleMarkers(data = breweries91, group = "breweries91") %>%
  addHomeButton(ext = ext(breweries91), group = "Brew")
m
Input to asJSON(keep_vec_names=TRUE) is a named vector. In a future version of jsonlite, this option will not be supported, and named vectors will be translated into arrays instead of objects. If you want JSON object output, please use a named list instead. See ?toJSON.
Input to asJSON(keep_vec_names=TRUE) is a named vector. In a future version of jsonlite, this option will not be supported, and named vectors will be translated into arrays instead of objects. If you want JSON object output, please use a named list instead. See ?toJSON.
Input to asJSON(keep_vec_names=TRUE) is a named vector. In a future version of jsonlite, this option will not be supported, and named vectors will be translated into arrays instead of objects. If you want JSON object output, please use a named list instead. See ?toJSON.
Input to asJSON(keep_vec_names=TRUE) is a named vector. In a future version of jsonlite, this option will not be supported, and named vectors will be translated into arrays instead of objects. If you want JSON object output, please use a named list instead. See ?toJSON.

I can see the button, but there is no response once it is clicked.
Anyway, regarding my request, I have quite busy control panels, thus having the option for automatic "zoom to layer" by group would be better than adding more buttons.

> sessionInfo()
R version 4.4.1 (2024-06-14)
Platform: x86_64-pc-linux-gnu
Running under: Pop!_OS 22.04 LTS

other attached packages:
[1] mapview_2.11.2  leafem_0.2.3    leaflet_2.2.2   terra_1.7-81    RStoolbox_1.0.0

[tim-salabim]

I think your code should be:

library(leaflet)
library(leafem)
library(raster)

m <- leaflet() %>%
    addProviderTiles("OpenStreetMap") %>%
    addCircleMarkers(data = breweries91, group = "breweries91") %>%
    addHomeButton(ext = raster::extent(breweries91), group = "Brew")
m

which works for me

[aloboa]

ok, I see terra objects are still not fully supported.
Anyway, please consider leaving this suggestion open as a feature request.

[aloboa]

See rstudio/leaflet#931

[trafficonese]

Here is a solution:

library(leaflet)
library(sf)

# Function to add onRender event for leaflet map
addLayerViewControl <- function(map, view_settings, verbose = TRUE) {
  # Create JavaScript logic for each layer and corresponding view/bounds with options
  view_js <- lapply(names(view_settings), function(layer) {
    setting <- view_settings[[layer]]
    
    # Handle setView or fitBounds case ##########
    if (length(setting$coords) == 2) {
      zoom <- setting$zoom
      options <- setting$options
      
      action <- "setView"
      if (!is.null(setting[["fly"]]) && setting[["fly"]]) {
        action <- "flyTo"
      }
      
      if (!is.null(options)) {
        sprintf("
          if (e.name === '%s') {
            this.%s([%s, %s], %s, %s);
          }", 
                layer
                , action
                , as.numeric(setting$coords[2])
                , as.numeric(setting$coords[1])
                , zoom
                , jsonlite::toJSON(options, auto_unbox = TRUE))
      } else {
        sprintf("
          if (e.name === '%s') {
            this.%s([%s, %s], %s);
          }", 
                layer
                , action
                , as.numeric(setting$coords[2])
                , as.numeric(setting$coords[1])
                , zoom)
      }
    } 
    else if (length(setting$coords) == 4) {
      options <- setting$options
      
      action <- "fitBounds"
      if (!is.null(setting[["fly"]]) && setting[["fly"]]) {
        action <- "flyToBounds"
      }
      
      if (!is.null(options)) {
        sprintf("
          if (e.name === '%s') {
            this.%s([[%s, %s], [%s, %s]], %s);
          }", 
                layer
                , action
                , as.numeric(setting$coords[2])
                , as.numeric(setting$coords[1])
                , as.numeric(setting$coords[4])
                , as.numeric(setting$coords[3])
                , jsonlite::toJSON(options, auto_unbox = TRUE))
      } else {
        sprintf("
          if (e.name === '%s') {
            this.%s([[%s, %s], [%s, %s]]);
          }",
                layer
                , action
                , as.numeric(setting$coords[2])
                , as.numeric(setting$coords[1])
                , as.numeric(setting$coords[4])
                , as.numeric(setting$coords[3])
                )
      }
    }
  })
  
  # Combine all JavaScript conditions into one string ##########
  view_js_combined <- paste(view_js, collapse = "\n")
  js <- sprintf("
      function(el, x) {
        this.on('baselayerchange', function(e) {
          %s
        });
      }
    ", view_js_combined)
  
  if (verbose) {
    cat("addLayerViewControl JavaScript:\n", js)
  }
  
  # Add the onRender logic to the leaflet map ##########
  map %>%
    htmlwidgets::onRender(js)
}


# Example use case
breweries91 <- st_as_sf(breweries91)
lines <- st_as_sf(atlStorms2005)
polys <- st_as_sf(leaflet::gadmCHE)

n = 300
df1 = data.frame(id = 1:n,
                 x = rnorm(n, 20, 3),
                 y = rnorm(n, -49, 1.8))
pts = st_as_sf(df1, coords = c("x", "y"), crs = 4326)

# View settings: Each entry is a list with 'coords', 'zoom', and optional 'options' (e.g., padding)
view_settings <- list(
  "breweries91" = list(
    coords = as.numeric(st_coordinates(st_centroid(st_union(breweries91))))
    , zoom = 8
    , options = NULL
  ),
  "atlStorms2005" = list(
    coords = as.numeric(st_bbox(lines))
    # , options = list(padding = c(10, 10), maxZoom = 6)
  ),
  "gadmCHE" = list(
    coords = as.numeric(st_bbox(polys))
    , options = list(padding = c(10, 10))
    , fly = TRUE
  ),
  "random_points" = list(
    coords = as.numeric(st_coordinates(st_centroid(st_union(pts))))
    , zoom = 7
    , fly = TRUE
  )
)

# Create leaflet map and apply the layer control function
leaflet() %>%
  addTiles() %>%
  addLayerViewControl(view_settings) %>% 
  addCircleMarkers(data = breweries91, group = "breweries91") %>%
  addCircleMarkers(data = pts, group = "random_points", color = "red", weight = 1) %>%
  addPolylines(data = lines, group = "atlStorms2005") %>%
  addPolygons(data = polys, group = "gadmCHE") %>%
  addLayersControl(
    baseGroups = c("breweries91", "random_points", "atlStorms2005", "gadmCHE"),
    options = layersControlOptions(collapsed = FALSE, autoZIndex = TRUE)
  )

@tim-salabim How do you feel about integrating this into leafem?

[tim-salabim]

@tim-salabim How do you feel about integrating this into leafem?

@trafficonese I like this a lot!
A few thoughts:

• can we add functionality to link legends to baseGroup layers? addLegend group not working when group is in addLayersControl baseGroups rstudio/leaflet#477 (comment)
• Can we maybe include functionality to optionally add a 'home button' next to the layer names in the layerControl (for both overlay and base groups) so we can get a better/cleaner, less cluttered version of addHomeButton?
• can we make this a proper htmlDependency rather than using onRender?

[trafficonese]

hm, I am not sure about the first. Of course we could include it, but this should actually get fixed in leaflet or?

I will check if we can easily insert some HTML in the LayersControl for overlay and basegroups.
One thing about overlays - only the view of the last selected overlay will be used.

And yes we can make a htmlDependency

[trafficonese]

homebuttons work :)

addLayerViewControl <- function(map, view_settings, home_btns = FALSE, verbose = TRUE) {

  # Initialize JavaScript strings
  view_actions_js <- ""
  home_buttons_js <- ""

  # Loop over each layer to generate JavaScript
  for (layer in names(view_settings)) {
    setting <- view_settings[[layer]]

    # Handle setView or fitBounds case
    if (length(setting$coords) == 2) {
      zoom <- setting$zoom
      options <- setting$options

      action <- "setView"
      if (!is.null(setting[["fly"]]) && setting[["fly"]]) {
        action <- "flyTo"
      }

      view_action <- if (!is.null(options)) {
        sprintf("map.%s([%s, %s], %s, %s);",
                action, as.numeric(setting$coords[2]), as.numeric(setting$coords[1]), zoom, jsonlite::toJSON(options, auto_unbox = TRUE))
      } else {
        sprintf("map.%s([%s, %s], %s);",
                action, as.numeric(setting$coords[2]), as.numeric(setting$coords[1]), zoom)
      }

    } else if (length(setting$coords) == 4) {
      options <- setting$options

      action <- "fitBounds"
      if (!is.null(setting[["fly"]]) && setting[["fly"]]) {
        action <- "flyToBounds"
      }

      view_action <- if (!is.null(options)) {
        sprintf("map.%s([[%s, %s], [%s, %s]], %s);",
                action, as.numeric(setting$coords[2]), as.numeric(setting$coords[1]),
                as.numeric(setting$coords[4]), as.numeric(setting$coords[3]),
                jsonlite::toJSON(options, auto_unbox = TRUE))
      } else {
        sprintf("map.%s([[%s, %s], [%s, %s]]);",
                action, as.numeric(setting$coords[2]), as.numeric(setting$coords[1]),
                as.numeric(setting$coords[4]), as.numeric(setting$coords[3]))
      }
    }

    # Accumulate JavaScript for view actions
    view_actions_js <- paste0(view_actions_js, sprintf("
      if (e.name === '%s') {
        %s
      }
    ", layer, view_action))

    # Accumulate JavaScript for home buttons if enabled
    if (isTRUE(home_btns)) {
      home_buttons_js <- paste0(home_buttons_js, sprintf("
        var homeButton = document.createElement('span');
        homeButton.innerHTML = '🏠';
        homeButton.style.cursor = 'pointer';
        homeButton.className = 'leaflet-home-btn';
        homeButton.dataset.layer = '%s';

        // Find the corresponding label for the layer
        var labels = document.querySelectorAll('.leaflet-control-layers label');
        labels.forEach(function(label) {
          if (label.textContent.trim() === '%s') {
            $(label).find('div')[0].appendChild(homeButton);
          }
        });

        homeButton.addEventListener('click', function(event) {
          event.preventDefault();
          event.stopPropagation();
          %s
        });
      ", layer, layer, view_action))
    }
  }

  # Combine all JavaScript into one block
  js <- sprintf("
    function(el, x) {
      var map = this;

      // Add view settings for each layer on 'overlayadd' or 'baselayerchange'
      map.on('overlayadd baselayerchange', function(e) {
        %s
      });

      // Add home buttons after the map has rendered
      setTimeout(function() {
        %s
      }, 1000);
    }
  ", view_actions_js, home_buttons_js)

  if (verbose) {
    cat("addLayerViewControl JavaScript:\n", js)
  }

  # Add the onRender logic to the leaflet map
  map %>%
    htmlwidgets::onRender(js)
}
# Example use case
breweries91 <- st_as_sf(breweries91)
lines <- st_as_sf(atlStorms2005)
polys <- st_as_sf(leaflet::gadmCHE)

n = 300
df1 = data.frame(id = 1:n,
                 x = rnorm(n, 20, 3),
                 y = rnorm(n, -49, 1.8))
pts = st_as_sf(df1, coords = c("x", "y"), crs = 4326)

# View settings: Each entry is a list with 'coords', 'zoom', and optional 'options' (e.g., padding) ##########
view_settings <- list(
  "baselayer1" = list(
    coords = c(20, 50)
    , zoom = 3
  ),
  "baselayer2" = list(
    coords = c(-110, 50)
    , zoom = 5
  ),
  "breweries91" = list(
    coords = as.numeric(st_coordinates(st_centroid(st_union(breweries91))))
    , zoom = 8
    , options = NULL
  ),
  "atlStorms2005" = list(
    coords = as.numeric(st_bbox(lines))
    # , options = list(padding = c(10, 10), maxZoom = 6)
  ),
  "gadmCHE" = list(
    coords = as.numeric(st_bbox(polys))
    , options = list(padding = c(10, 10))
    , fly = TRUE
  ),
  "random_points" = list(
    coords = as.numeric(st_coordinates(st_centroid(st_union(pts))))
    , zoom = 7
    , fly = TRUE
  )
)

# Create leaflet map and apply the layer control function  #########
home_view <- list(lat = 51.1657, lng = 10.4515, zoom = 6)

leaflet() %>%
  addTiles(group = "baselayer1") %>%
  addProviderTiles("CartoDB", group = "baselayer2") %>%
  addCircleMarkers(data = breweries91, group = "breweries91") %>%
  addCircleMarkers(data = pts, group = "random_points", color = "red", weight = 1) %>%
  addPolylines(data = lines, group = "atlStorms2005") %>%
  addPolygons(data = polys, group = "gadmCHE") %>%
  addLayerViewControl(view_settings, TRUE) %>%
  addLayersControl(
    baseGroups = c("baselayer1", "baselayer2"),
    overlayGroups = c("breweries91", "random_points", "atlStorms2005", "gadmCHE"),
    options = layersControlOptions(collapsed = FALSE, autoZIndex = TRUE)
  )