crosstalk icon indicating copy to clipboard operation
crosstalk copied to clipboard

Linked-brushing not working on Polar map projections

Open gerlis22 opened this issue 6 years ago • 0 comments

There an issue with the map brushing tool on a polar map projection. The brushing box is distorted and does not select map markers. Is there a way to change brushing projection or correct this?

Below is a reproducible example of the issue

library(leaflet)
library(DT)
library(crosstalk)

extent <- 11000000 + 9036842.762 + 667
origin = c(-extent, extent)
maxResolution <- ((extent - -extent) / 256)
defZoom <- 3
bounds <- list(c(-extent, extent),c(extent, -extent))
minZoom <- 0
maxZoom <- 18
resolutions <- purrr::map_dbl(minZoom:maxZoom,function(x) maxResolution/(2^x))

# 6 Projection EPSG Codes
projections <- c('3571', '3572', '3573', '3574', '3575', '3576')
# Corresponding proj4defs codes for each projection
proj4defs <- list(
  '3571' = '+proj=laea +lat_0=90 +lon_0=180 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs',
  '3572' = '+proj=laea +lat_0=90 +lon_0=-150 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs',
  '3573' = '+proj=laea +lat_0=90 +lon_0=-100 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs',
  '3574' = '+proj=laea +lat_0=90 +lon_0=-40 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs',
  '3575' = '+proj=laea +lat_0=90 +lon_0=10 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs',
  '3576' = '+proj=laea +lat_0=90 +lon_0=90 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs'
)

# create a CRS instance for each projection
crses <- purrr::map(projections, function(code) {
  leafletCRS(
    crsClass = 'L.Proj.CRS',
    code = sprintf("EPSG:%s",code),
    proj4def = proj4defs[[code]],
    origin = origin,
    resolutions = resolutions,
    bounds = bounds
  )
})

# Tile URL Template for each projection
tileURLtemplates <- purrr::map(projections, function(code) {
  sprintf('http://{s}.tiles.arcticconnect.org/osm_%s/{z}/{x}/{y}.png',
          code)
})


# Create data points for map
dat <- data.frame(latitude = c(80, 80), longitude = c(-143, 143))

# Wrap data frame in SharedData
sd <- SharedData$new(dat)


# We can't add all 6 tiles to our leaflet map,
# because each one is in a different projection,
# and you can have only one projection per map in Leaflet.
# So we create 6 maps.
polarmaps <- purrr::map2(crses, tileURLtemplates,
                         function(crs, tileURLTemplate) {
                           leaflet(sd, options= leafletOptions(
                             crs=crs, minZoom = minZoom, maxZoom = maxZoom)) %>%
                             setView(0, 90, defZoom) %>%
                             addTiles(urlTemplate = tileURLTemplate,
                                      attribution = "Map © ArcticConnect. Data © OpenStreetMap contributors",
                                      options = tileOptions(subdomains = "abc", noWrap = TRUE,
                                                            continuousWorld = FALSE))
                         })


# Use SharedData like a dataframe with Crosstalk-enabled widgets
bscols(
polarmaps[[1]] %>%
  addGraticule() %>%
  addCircleMarkers(data = sd, lat = ~latitude, lng = ~longitude),
datatable(sd, extensions="Scroller", style="bootstrap", class="compact", width="100%",
          options=list(deferRender=TRUE, scrollY=300, scroller=TRUE))
)

gerlis22 avatar Jul 17 '18 16:07 gerlis22