Leaflet Shiny and polygons across the dateline

I have a Shiny app which maps country characteristics to their SF polygons (from rnaturalearth) using Leaflet. But I'm having trouble displaying the polygons around the dateline (antemeridian) in the pacific ocean; Fiji in particular is cut off on the east side as the geometry data 'circles' back to -180... I think.

My current work around is to set leafletOptions(worldCopyJump = T) and providerTileOptions(noWrap = F) but the polygons on the other side of the dateline only displays once you drag the map past the 180th.

Is there a way to display all polygons at once?

Toy code below

#### Libraries ####
library(sf)
library(shiny)
library(RColorBrewer)
library(leaflet)

#### Load data ####
sf_data <- st_read(dsn = "natural_earth_vector.gpkg", layer = "ne_50m_admin_0_countries", stringsAsFactors = FALSE)
sf_data <- subset(sf_data, ISO_N3 %in% PacificIslandscodes, select = c("NAME_LONG", "ISO_A3", "ISO_N3"))

#### Define UI ####
ui <- navbarPage("PACER+ Map"
                 , id="nav"
                 , tabPanel("Map"
                            , div(class="outer"
                                  , tags$style(type = "text/css"
                                               , "#map {height: calc(100vh - 80px) !important;}"
                                               )
                                  , leafletOutput("map"
                                                  , height="100%"
                                                  , width="100%"
                                                  ))))

#### Define server logic ####
server <- function(input, output, session) {

    output$map <- renderLeaflet({
        leaflet(options = leafletOptions(worldCopyJump = T)) %>% 
            addProviderTiles(
                providers$Stamen.TonerLite
                , options = providerTileOptions(noWrap = F, minZoom = 2)
                ) %>%
            setView(lng = 175, lat = -22, zoom = 4)
        })

observe({
       #some code here to set the pal and color data based on input selections

        leafletProxy("map", data = sf_data ) %>%
            clearShapes() %>% 
            addPolygons(
                fillColor = pal(colorData)
                , stroke = T
                , opacity = 0.9
                , color = "black"
                , fillOpacity = 1
                , weight = 3
                , highlight = highlightOptions(
                    weight = 4,
                    color = "#666",
                    dashArray = NULL,
                    fillOpacity = 0.5,
                    bringToFront = TRUE)
                , label = sprintf( 
# some code to display relevant selection data on hover 
                ) %>% lapply(htmltools::HTML)
                , labelOptions = labelOptions(
                    style = list("font-weight" = "normal", padding = "3px 8px"),
                    textsize = "15px",
                    direction = "auto")
                , group = "PACER Info"
            ) %>% 
            addLegend("bottomleft", pal = pal, values = colorData, title = colorBy,
                      layerId = "colorLegend")
    })

Good news! I found a solution in the sf Vignette.

Adjust the sf geometry values as follow:
sf_data$geom <- (st_geometry(sf_data) + c(360,90)) %% c(360) - c(0,90)
This offsets the geometry values that are on the other side of the dateline to "wrap around" to become 180+ values.
Then you also want to set leafletOptions(worldCopyJump = F) and providerTileOptions(noWrap = T)

1 Like

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.