NOAA Aurora Forecast Map

aurora.R

library(tidyverse)
library(jsonlite)
library(leaflet)
library(raster)
library(terra)
library(htmlwidgets)
library(htmltools)

# https://www.swpc.noaa.gov/products/aurora-30-minute-forecast


# GET DATA ####
url <- "https://services.swpc.noaa.gov/json/ovation_aurora_latest.json"
forecast <- read_json(url)
forecast_date <- forecast$`Forecast Time` |> as_datetime() |> with_tz("Europe/London")

# reshape aurora forecast probability data
df <- forecast$coordinates |> 
  unlist() |> 
  matrix(nrow = 3, dimnames = list(c("long", "lat", "aurora"))) |> 
  t() |> 
  as_tibble() |> 
  # co-ord bodging: shift longitude and remove singularities so terra::rast is happy
  mutate(long = long - 179.5) |> 
  filter(lat != -90, lat != 90)

# quick check data looks sensible (equator is weird but whatever)
df |>
  ggplot(aes(x = long, y = lat)) +
  geom_raster(aes(fill = aurora))

# convert to spatial raster object...
r <- rast(df,
          crs = "+proj=longlat",
          type = "xyz")

#... and then to raster image object for leaflet 
map_raster <- raster(r)


# MAP FAFF ####
# Scotland centred
zoom <- 2
view_long <- -4.15
view_lat <- 57.7

# colour scale
pal <- colorNumeric(
  palette = "plasma",
  domain = values(map_raster),
  na.color = viridisLite::plasma(1))

# map title
tag.map.title <- tags$style(HTML("
  .leaflet-control.map-title { 
    transform: translate(-50%,20%);
    position: fixed !important;
    left: 50%;
    text-align: center;
    padding-left: 8px; 
    padding-right: 8px; 
    background: rgba(255,255,255,0.75);
    font-weight: bold;
    font-size: 20px;
  }
"))

title <- tags$div(
  tag.map.title, HTML(format(forecast_date, "%b %d %Y | %H:%M"))
)  

# draw map
map <- leaflet() |> 
  addTiles() |> # default background map
  # third party map tiles
  # addProviderTiles(providers$Stadia.StamenToner) |>
  # addProviderTiles(providers$CartoDB.Positron) |>
  addTerminator(time = forecast_date) |>
  setView(view_long, view_lat, zoom) |>
  addRasterImage(map_raster, colors = pal, opacity = .7) |> 
  addLegend(pal = pal, 
            values = values(map_raster), 
            title = "aurora prob.", 
            opacity = 1, 
            labFormat = labelFormat(suffix = "%")) |> 
  addControl(title, position = "topleft", className="map-title") |> 
  suppressWarnings()

map

# mapview::mapshot2(map, file="map.png")