How to left-justify legend text in leaflet with reactive rasters?
I’ve created a shiny app with raster layers plotted over a leaflet map. The user selects which raster to show with two drop down menus: one to select the type of data (mean or SD) the other to select a particular threshold (e.g., mean with 50-deg threshold, mean with 100-deg threshold). I’m having problems with the alignment of labels in the legend. The labels are right justified (see image), but I would like all the labels to be left justified.
Legend with incorrect formatting:
This answer that was just posted to a previous question works perfectly if I dont't have reactive rasters. However, when I try the same thing in code used to display reactive rasters nothing happens. Will this work if I'm using leafletProxy()with clearControls()? Here is all the code used the run the app (with fake data):
library(lubridate)
library(raster)
library(shiny)
library(leaflet)
library(leafem)
# Create example csv
params <- data.frame(summary = c("Mean", "Mean", "SD" , "SD"),
threshold = c(1, 2, 1, 2))
# Create raster brick (example)
raster_list <- list()
for (i in 1:4) {
raster_list[[i]] <- raster(xmn=-90, xmx=-75, ymn=40, ymx=47,
crs = "+proj=longlat +datum=NAD83 +no_defs ",
resolution = 0.0416667)
}
raster_list[[1]] <- setValues(raster_list[[1]],
sample(30:50, ncell(raster_list[[1]]), replace = TRUE))
raster_list[[2]] <- setValues(raster_list[[1]],
sample(50:80, ncell(raster_list[[2]]), replace = TRUE))
raster_list[[3]] <- setValues(raster_list[[3]],
sample(1:20, ncell(raster_list[[3]]), replace = TRUE))
raster_list[[4]] <- setValues(raster_list[[4]],
sample(1:20, ncell(raster_list[[4]]), replace = TRUE))
all_rast <- stack(raster_list)
names(all_rast) <- paste0(tolower(params$summary), "_", params$threshold)
all_rast <- brick(all_rast)
all_rast <- projectRaster(all_rast, raster::projectExtent(all_rast, crs = "epsg:3857"))
# Modify function used to format legend labels so we can add dates
myLabelFormat <- function(..., dates = FALSE){
if (dates) {
function(type = "numeric", cuts) {
dd <- parse_date_time(paste("2019", cuts), orders = "%Y %j")
dd <- format(dd, "%d %B")
paste0(cuts, " (", dd, ")")
}
} else {
labelFormat(...)
}
}
# ui --------------------------------------------------------------------------#
ui <- fluidPage(
titlePanel("Title"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = "threshold",
label = "Threshold",
choices = unique(params$threshold)),
selectInput(inputId = "summary",
label = "Summary",
choices = unique(params$summary))
), # end sidebarPanel
mainPanel(
leafletOutput("map", height = "80vh")
) # end mainPanel
) # end sidebarLayout
) # end fluidPage
# server ----------------------------------------------------------------------#
server <- shinyServer(function(input, output) {
reacRaster <- reactive({all_rast[[paste0(tolower(input$summary),
"_", input$threshold)]]})
legend_title <- reactive({ifelse(input$summary == "SD",
"SD (days)", "Day of year")})
legend_labels <- reactive({ifelse(input$summary == "SD",
myLabelFormat(dates = FALSE),
myLabelFormat(dates = TRUE))})
output$map <- renderLeaflet({
leaflet() %>%
fitBounds(lng1 = -88, lat1 = 35, lng2 = -65, lat2 = 47) %>%
addTiles()
})
observe({
pal <- colorNumeric(palette = "viridis",
domain = values(reacRaster()),
na.color = "transparent",
reverse = TRUE)
leafletProxy("map") %>%
clearImages() %>%
clearControls() %>%
addRasterImage(reacRaster(),
colors = pal,
group = "Value",
layerId = "Value",
opacity = 0.8,
project = FALSE) %>%
addLegend("bottomright",
pal = pal,
values = values(reacRaster()),
labFormat = legend_labels(),
title = legend_title(),
opacity = 0.8) %>%
addImageQuery(reacRaster(),
digits = 2,
type = "click",
position = "bottomleft",
prefix = "",
layerId = "Value",
project = TRUE)
}) # end observe
}) # end server
# run app ---------------------------------------------------------------------#
shinyApp(ui = ui, server = server)
Solution
You can follow up map with htmlwidgets::onRender() -> query the document for all text elements below info.legend 1 and then change their text-anchor attribute 2 each time the mutationObserver observes any change on the map object (= a layer is changed) 3. This is a slight variation of my previous answer but the principle stays the same, just this method is more robust to map-changes!
library(lubridate)
library(raster)
library(shiny)
library(leaflet)
library(leafem)
# Create example csv
params <- data.frame(summary = c("Mean", "Mean", "SD" , "SD"),
threshold = c(1, 2, 1, 2))
# Create raster brick (example)
raster_list <- list()
for (i in 1:4) {
raster_list[[i]] <- raster(xmn=-90, xmx=-75, ymn=40, ymx=47,
crs = "+proj=longlat +datum=NAD83 +no_defs ",
resolution = 0.0416667)
}
raster_list[[1]] <- setValues(raster_list[[1]],
sample(30:50, ncell(raster_list[[1]]), replace = TRUE))
raster_list[[2]] <- setValues(raster_list[[1]],
sample(50:80, ncell(raster_list[[2]]), replace = TRUE))
raster_list[[3]] <- setValues(raster_list[[3]],
sample(1:20, ncell(raster_list[[3]]), replace = TRUE))
raster_list[[4]] <- setValues(raster_list[[4]],
sample(1:20, ncell(raster_list[[4]]), replace = TRUE))
all_rast <- stack(raster_list)
names(all_rast) <- paste0(tolower(params$summary), "_", params$threshold)
all_rast <- brick(all_rast)
all_rast <- projectRaster(all_rast, raster::projectExtent(all_rast, crs = "epsg:3857"))
# Modify function used to format legend labels so we can add dates
myLabelFormat <- function(..., dates = FALSE){
if (dates) {
function(type = "numeric", cuts) {
dd <- parse_date_time(paste("2019", cuts), orders = "%Y %j")
dd <- format(dd, "%d %B")
paste0(cuts, " (", dd, ")")
}
} else {
labelFormat(...)
}
}
# ui --------------------------------------------------------------------------#
ui <- fluidPage(
titlePanel("Title"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = "threshold",
label = "Threshold",
choices = unique(params$threshold)),
selectInput(inputId = "summary",
label = "Summary",
choices = unique(params$summary))
), # end sidebarPanel
mainPanel(
leafletOutput("map", height = "80vh")
) # end mainPanel
) # end sidebarLayout
) # end fluidPage
# server ----------------------------------------------------------------------#
server <- shinyServer(function(input, output) {
reacRaster <- reactive({all_rast[[paste0(tolower(input$summary),
"_", input$threshold)]]})
legend_title <- reactive({ifelse(input$summary == "SD",
"SD (days)", "Day of year")})
legend_labels <- reactive({ifelse(input$summary == "SD",
myLabelFormat(dates = FALSE),
myLabelFormat(dates = TRUE))})
output$map <- renderLeaflet({
leaflet() %>%
fitBounds(lng1 = -88, lat1 = 35, lng2 = -65, lat2 = 47) %>%
addTiles() %>%
htmlwidgets::onRender("
function(el, x) {
const observer = new MutationObserver(function(mutations) {
mutations.forEach(function(mutation) {
if (mutation.addedNodes.length > 0) {
var labels = el.querySelectorAll('.info.legend text'); // 1 Find all legend text elements as before
if (labels.length > 0) {
//console.log('Applying text alignment to', labels.length, 'legend labels');
labels.forEach(function(label) {
label.setAttribute('text-anchor', 'start'); // 2
label.setAttribute('dx', '5');
});
}
}
});
});
// 3 observing the entire map container el for changes
observer.observe(el, { childList: true, subtree: true });
}
")
})
observe({
pal <- colorNumeric(palette = "viridis",
domain = values(reacRaster()),
na.color = "transparent",
reverse = TRUE)
leafletProxy("map") %>%
clearImages() %>%
clearControls() %>%
addRasterImage(reacRaster(),
colors = pal,
group = "Value",
layerId = "Value",
opacity = 0.8,
project = FALSE) %>%
addLegend("bottomright",
pal = pal,
values = values(reacRaster()),
labFormat = legend_labels(),
title = legend_title(),
opacity = 0.8) %>%
addImageQuery(reacRaster(),
digits = 2,
type = "click",
position = "bottomleft",
prefix = "",
layerId = "Value",
project = TRUE)
}) # end observe
}) # end server
# run app ---------------------------------------------------------------------#
shinyApp(ui = ui, server = server)
- How to maximize the space between characters/letters in a div (like with space-between in CSS flexbox)?
- havung a issue with full width img with css
- How to use peer pseudo-class to detect existence of peers?
- How can you set the height of an outer div to always be equal to a particular inner div?
- Material UI - Autocomplete default margin?
- css - parent :before pseudoelement with child alt attribute as content
- Border-radius property not working in outlook
- Removing bullets from unordered list
- focus:outline-none not working Tailwind CSS with Laravel
- How to fully override styles of Select component from Angular Material?
- How to set size of SVG image in :before pseudo-class?
- Adding JavaScript to my Plotly Dash app (Python)
- CSS: How to let the user know that not all content fits in a flex container
- Subpixel rendering artefact on Chrome when using position: sticky
- Check the kind of unit in Sass/SCSS to optimise CSS
- How to style a specific word in textarea
- How to prevent line overlapping and make media query work for large screens
- What is the correct way to get the color of a font from a site?
- Why Codemirror editor does NOT scroll horizontally with long line?
- Angular grid layout behaviour
- Are "div > p" & "div p" same?
- Hiding Google Translate bar
- How to convert background-position: % in Tailwind
- Unknown at rule @tailwind css(unknownAtRules)
- How do I know the IntersectionObserver scroll direction?
- Display a card on hover
- How does this <td> overflow the <table>?
- Why doesn't the left sticky position work when the scroll container is the body?
- Programmatically import a CSS file by its relative file path
- Angular: Styles from primeng not working even they are listed in styles.scss