Shows location of stations, colored by region.
Use to select an area the stations will be highlighted in the trend scatter plot.
Shows the trend per decade of each station (x-axis) versus the station's elevation (y-axis).
Use box select
to select stations
these will be highlighted in the map.
Use the home button
to reset selection.
Shows location of stations, colored by region.
Use to select an area the stations will be highlighted in the trend scatter plot.
Shows the trend per decade of each station (x-axis) versus the station's elevation (y-axis).
Use box select
to select stations
these will be highlighted in the map.
Use the home button
to reset selection.
Shows location of stations, colored by region.
Use to select an area the stations will be highlighted in the trend scatter plot.
Shows the trend per decade of each station (x-axis) versus the station's elevation (y-axis).
Use box select
to select stations
these will be highlighted in the map.
Use the home button
to reset selection.
Shows location of stations, colored by region.
Use to select an area the stations will be highlighted in the trend scatter plot.
Shows the trend per decade of each station (x-axis) versus the station's elevation (y-axis).
Use box select
to select stations
these will be highlighted in the map.
Use the home button
to reset selection.
Shows location of stations, colored by region.
Use to select an area the stations will be highlighted in the trend scatter plot.
Shows the trend per decade of each station (x-axis) versus the station's elevation (y-axis).
Use box select
to select stations
these will be highlighted in the map.
Use the home button
to reset selection.
Shows location of stations, colored by region.
Use to select an area the stations will be highlighted in the trend scatter plot.
Shows the trend per decade of each station (x-axis) versus the station's elevation (y-axis).
Use box select
to select stations
these will be highlighted in the map.
Use the home button
to reset selection.
Shows location of stations, colored by region.
Use to select an area the stations will be highlighted in the trend scatter plot.
Shows the trend per decade of each station (x-axis) versus the station's elevation (y-axis).
Use box select
to select stations
these will be highlighted in the map.
Use the home button
to reset selection.
Shows location of stations, colored by region.
Use to select an area the stations will be highlighted in the trend scatter plot.
Shows the trend per decade of each station (x-axis) versus the station's elevation (y-axis).
Use box select
to select stations
these will be highlighted in the map.
Use the home button
to reset selection.
Shows location of stations, colored by region.
Use to select an area the stations will be highlighted in the trend scatter plot.
Shows the trend per decade of each station (x-axis) versus the station's elevation (y-axis).
Use box select
to select stations
these will be highlighted in the map.
Use the home button
to reset selection.
Shows location of stations, colored by region.
Use to select an area the stations will be highlighted in the trend scatter plot.
Shows the trend per decade of each station (x-axis) versus the station's elevation (y-axis).
Use box select
to select stations
these will be highlighted in the map.
Use the home button
to reset selection.
Shows location of stations, colored by region.
Use to select an area the stations will be highlighted in the trend scatter plot.
Shows the trend per decade of each station (x-axis) versus the station's elevation (y-axis).
Use box select
to select stations
these will be highlighted in the map.
Use the home button
to reset selection.
Shows location of stations, colored by region.
Use to select an area the stations will be highlighted in the trend scatter plot.
Shows the trend per decade of each station (x-axis) versus the station's elevation (y-axis).
Use box select
to select stations
these will be highlighted in the map.
Use the home button
to reset selection.
Shows location of stations, colored by region.
Use to select an area the stations will be highlighted in the trend scatter plot.
Shows the trend per decade of each station (x-axis) versus the station's elevation (y-axis).
Use box select
to select stations
these will be highlighted in the map.
Use the home button
to reset selection.
Shows location of stations, colored by region.
Use to select an area the stations will be highlighted in the trend scatter plot.
Shows the trend per decade of each station (x-axis) versus the station's elevation (y-axis).
Use box select
to select stations
these will be highlighted in the map.
Use the home button
to reset selection.
Clicking on a station will show its name, elevation, coordinates, and links to pre-made time series plots.
Stations whose circles have an outline have full data for the whole period 1971-2019, while the stations without outline contain gaps.
---
title: "Past trends | CliRSnow"
output:
flexdashboard::flex_dashboard:
self_contained: false
lib_dir: libs
theme: bootstrap
orientation: rows
vertical_layout: fill
social: menu
source: embed
logo: other/logo_72x48.png
favicon: other/logo_72x48.png
navbar:
- { icon: "fa-share", title: "Main Dash", href: "./", align: right }
---
```{r setup, include=FALSE}
library(flexdashboard)
library(leaflet)
library(highcharter)
library(crosstalk)
library(plotly)
library(ggplot2)
library(sf)
library(dplyr)
div_text_color <- function(text, color){
paste0("", text, "")
}
```
# Overview 1: HS
```{r overview-data-prep, include=FALSE}
tbl_elev <- readRDS(here::here("data/mountain-background.rds"))
tbl_elev_sub <- tbl_elev[170: 450, ] %>%
dplyr::mutate(elev_scaled = ifelse(elev_rollmean > 1000,
elev_rollmean/max(elev_rollmean)*4500,
elev_rollmean)) %>%
dplyr::mutate(elev_scaled = ifelse(elev_scaled < 4000 & ii < 280,
scales::rescale(elev_scaled, to = c(-100, 4000)),
elev_scaled))
# load(here::here("data/trends_1000m.Rdata"))
load(here::here("data/trends_500m.Rdata"))
# tbl_xy_pos <- tribble(
# ~x, ~y, ~ns_fct, ~elev_range,
# 200, 500, "North", "0-1000m",
# 420, 500, "South", "0-1000m",
# 220, 1500, "North", "1000-2000m",
# 380, 1500, "South", "1000-2000m",
# 240, 2500, "North", "2000-3000m",
# 360, 2500, "South", "2000-3000m",
# 250, 3500, "North", ">3000m",
# 320, 3500, "South", ">3000m"
# )
tbl_xy_pos_500 <- tribble(
~x, ~y, ~ns_fct, ~elev_range,
200, 250, "North", "0-500m",
420, 250, "South", "0-500m",
210, 750, "North", "500-1000m",
410, 750, "South", "500-1000m",
220, 1250, "North", "1000-1500m",
380, 1250, "South", "1000-1500m",
230, 1750, "North", "1500-2000m",
370, 1750, "South", "1500-2000m",
240, 2250, "North", "2000-2500m",
360, 2250, "South", "2000-2500m",
250, 2750, "North", "2500-3000m",
350, 2750, "South", "2500-3000m",
260, 3500, "North", ">3000m",
320, 3500, "South", ">3000m"
)
tbl_3000_2 <- dat_trends_rel %>%
group_by(ns_fct, variable) %>%
summarise(nn_abs = 0, nn_rel = 0, value_abs = 0, value_rel = 0, elev_range = ">3000m")
dat_trends <- left_join(
dat_trends_abs %>% select(elev_fct, ns_fct, variable, value_abs = mean, nn_abs = nn),
dat_trends_rel %>% select(elev_fct, ns_fct, variable, value_rel = mean, nn_rel = nn)
)
tbl_absrel <-
dat_trends %>%
tidyr::separate(elev_fct, c(NA, "elev_min", "elev_max", NA)) %>%
mutate(elev_range = paste0(elev_min, "-", elev_max, "m")) %>%
bind_rows(tbl_3000_2) %>%
# left_join(tbl_xy_pos) %>%
left_join(tbl_xy_pos_500) %>%
mutate(label = if_else(y > 3000,
"?",
if_else(startsWith(variable, "SCD"),
sprintf("%+.0f days (%+.1f%%)", value_abs, value_rel),
sprintf("%+.1f cm (%+.1f%%)", value_abs, value_rel))),
value_size = if_else(y < 3000, abs(value_rel), 0.1),
nn_min = pmin(nn_abs, nn_rel),
label_html = if_else(y > 3000,
div_text_color(label, "#252525"),
if_else(value_rel < 0,
div_text_color(label, "#d7301f"),
div_text_color(label, "#377eb8"))))
x <- c("Elevation", "Change", "Stations")
# y <- sprintf("{point.%s:s}", c("elev_range", "label"))
y <- c("{point.elev_range:s}", "{point.label:s}", "{point.nn_min:f}")
tltip <- tooltip_table(x, y)
cols <- c("#969696", "#1f78b4", "#33a02c")
```
## Row
### HS DJF
```{r}
highchart() %>%
# hc_add_theme(hc_theme_bloom()) %>%
hc_add_theme(hc_theme_hcrt()) %>%
hc_add_series(tbl_elev_sub,
"line",
hcaes(ii, elev_scaled),
name = "Mountain",
enableMouseTracking = F,
showInLegend = F,
states = list(inactive = list(opacity = 1))) %>%
hc_add_series(tbl_absrel %>% filter(variable == "meanHS_DJF"),
"scatter",
hcaes(x, y, group = ns_fct, size = value_size),
dataLabels = list(enabled = T,
align = "left",
x = 20,
useHTML = T,
format = "{point.label_html}")) %>%
hc_colors(cols) %>%
hc_legend(align = "center",
verticalAlign = "top",
x = -30) %>%
hc_tooltip(useHTML = T,
shape = "callout", # or rect
pointFormat = tltip,
headerFormat = "") %>%
hc_yAxis(title = list(text = "Elevation",
rotation = 0,
align = "high",
offset = 10,
y = 10),
# breaks = c(0:3*1000),
labels = list(format = "{value:f} m"),
min = 0, max = 4700,
# tickAmount = 2,
tickInterval = 1000,
endOnTick = F) %>%
hc_xAxis(visible = F) %>%
hc_title(text = "Change in average winter snow depth 1971-2019") %>%
hc_subtitle(text = "December to February") %>%
hc_caption(text = strwrap(width = 1e6,
"Changes are determined from linear regressions over the whole period,
and averaged over all stations in 500 m elevation bands.
Over 2000 m, only few stations were available, so estimates should be
treated with caution.
Over 3000 m, no stations with such long records exist."))
```
### HS MAM
```{r}
highchart() %>%
# hc_add_theme(hc_theme_bloom()) %>%
hc_add_theme(hc_theme_hcrt()) %>%
hc_add_series(tbl_elev_sub,
"line",
hcaes(ii, elev_scaled),
name = "Mountain",
enableMouseTracking = F,
showInLegend = F,
states = list(inactive = list(opacity = 1))) %>%
hc_add_series(tbl_absrel %>% filter(variable == "meanHS_MAM"),
"scatter",
hcaes(x, y, group = ns_fct, size = value_size),
dataLabels = list(enabled = T,
align = "left",
x = 20,
useHTML = T,
format = "{point.label_html}")) %>%
hc_colors(cols) %>%
hc_legend(align = "center",
verticalAlign = "top",
x = -30) %>%
hc_tooltip(useHTML = T,
shape = "callout", # or rect
pointFormat = tltip,
headerFormat = "") %>%
hc_yAxis(title = list(text = "Elevation",
rotation = 0,
align = "high",
offset = 10,
y = 10),
# breaks = c(0:3*1000),
labels = list(format = "{value:f} m"),
min = 0, max = 4700,
# tickAmount = 2,
tickInterval = 1000,
endOnTick = F) %>%
hc_xAxis(visible = F) %>%
hc_title(text = "Change in average spring snow depth 1971-2019") %>%
hc_subtitle(text = "March to May") %>%
hc_caption(text = strwrap(width = 1e6,
"Changes are determined from linear regressions over the whole period,
and averaged over all stations in 500 m elevation bands.
Over 2000 m, only few stations were available, so estimates should be
treated with caution.
Over 3000 m, no stations with such long records exist."))
```
# Overview 2: SCD
## Row
### SCD NDJF
```{r}
highchart() %>%
# hc_add_theme(hc_theme_bloom()) %>%
hc_add_theme(hc_theme_hcrt()) %>%
hc_add_series(tbl_elev_sub,
"line",
hcaes(ii, elev_scaled),
name = "Mountain",
enableMouseTracking = F,
showInLegend = F,
states = list(inactive = list(opacity = 1))) %>%
hc_add_series(tbl_absrel %>% filter(variable == "SCD_NDJF"),
"scatter",
hcaes(x, y, group = ns_fct, size = value_size),
dataLabels = list(enabled = T,
align = "left",
x = 20,
useHTML = T,
format = "{point.label_html}")) %>%
hc_colors(cols) %>%
hc_legend(align = "center",
verticalAlign = "top",
x = -30) %>%
hc_tooltip(useHTML = T,
shape = "callout", # or rect
pointFormat = tltip,
headerFormat = "") %>%
hc_yAxis(title = list(text = "Elevation",
rotation = 0,
align = "high",
offset = 10,
y = 10),
# breaks = c(0:3*1000),
labels = list(format = "{value:f} m"),
min = 0, max = 4700,
# tickAmount = 2,
tickInterval = 1000,
endOnTick = F) %>%
hc_xAxis(visible = F) %>%
hc_title(text = "Change in winter snow cover duration 1971-2019") %>%
hc_subtitle(text = "November to February") %>%
hc_caption(text = strwrap(width = 1e6,
"Snow cover duration is days with snow depth > 1cm. Changes are determined from linear regressions over the whole period,
and averaged over all stations in 500 m elevation bands.
Over 2000 m, only few stations were available, so estimates should be
treated with caution.
Over 3000 m, no stations with such long records exist."))
```
### SCD MAM
```{r}
highchart() %>%
# hc_add_theme(hc_theme_bloom()) %>%
hc_add_theme(hc_theme_hcrt()) %>%
hc_add_series(tbl_elev_sub,
"line",
hcaes(ii, elev_scaled),
name = "Mountain",
enableMouseTracking = F,
showInLegend = F,
states = list(inactive = list(opacity = 1))) %>%
hc_add_series(tbl_absrel %>% filter(variable == "SCD_MAM"),
"scatter",
hcaes(x, y, group = ns_fct, size = value_size),
dataLabels = list(enabled = T,
align = "left",
x = 20,
useHTML = T,
format = "{point.label_html}")) %>%
hc_colors(cols) %>%
hc_legend(align = "center",
verticalAlign = "top",
x = -30) %>%
hc_tooltip(useHTML = T,
shape = "callout", # or rect
pointFormat = tltip,
headerFormat = "") %>%
hc_yAxis(title = list(text = "Elevation",
rotation = 0,
align = "high",
offset = 10,
y = 10),
# breaks = c(0:3*1000),
labels = list(format = "{value:f} m"),
min = 0, max = 4700,
# tickAmount = 2,
tickInterval = 1000,
endOnTick = F) %>%
hc_xAxis(visible = F) %>%
hc_title(text = "Change in spring snow cover duration 1971-2019") %>%
hc_subtitle(text = "March to May") %>%
hc_caption(text = strwrap(width = 1e6,
"Snow cover duration is days with snow depth > 1cm. Changes are determined from linear regressions over the whole period,
and averaged over all stations in 500 m elevation bands.
Over 2000 m, only few stations were available, so estimates should be
treated with caution.
Over 3000 m, no stations with such long records exist."))
```
```{r aux-text, include=FALSE}
library(htmltools)
icon_plotly_box <- tags$svg(viewBox="0 0 1000 1000", class="icon", height="1em", width="1em",
tags$path(d = "m0 850l0-143 143 0 0 143-143 0z m286 0l0-143 143 0 0 143-143 0z m285 0l0-143 143 0 0 143-143 0z m286 0l0-143 143 0 0 143-143 0z m-857-286l0-143 143 0 0 143-143 0z m857 0l0-143 143 0 0 143-143 0z m-857-285l0-143 143 0 0 143-143 0z m857 0l0-143 143 0 0 143-143 0z m-857-286l0-143 143 0 0 143-143 0z m286 0l0-143 143 0 0 143-143 0z m285 0l0-143 143 0 0 143-143 0z m286 0l0-143 143 0 0 143-143 0z",
transform="matrix(1 0 0 -1 0 850)"))
icon_plotly_home <- tags$svg(viewBox="0 0 928.6 1000", class="icon", height="1em", width="1em",
tags$path(d = "m786 296v-267q0-15-11-26t-25-10h-214v214h-143v-214h-214q-15 0-25 10t-11 26v267q0 1 0 2t0 2l321 264 321-264q1-1 1-4z m124 39l-34-41q-5-5-12-6h-2q-7 0-12 3l-386 322-386-322q-7-4-13-4-7 2-12 7l-35 41q-4 5-3 13t6 12l401 334q18 15 42 15t43-15l136-114v109q0 8 5 13t13 5h107q8 0 13-5t5-13v-227l122-102q5-5 6-12t-4-13z",
transform="matrix(1 0 0 -1 0 850)"))
info_map1 <- p("Shows location of stations, colored by region. ")
info_map2 <- p("Use ",
tags$i(class="ion-qr-scanner"),
" to select an area",
# br(),
tags$i(class="fa fa-arrow-alt-circle-right"),
"the stations will be highlighted in the trend scatter plot.")
info_trend1 <- p("Shows the trend per decade of each station (x-axis) versus the station's elevation (y-axis).")
info_trend2 <- p("Use box select ",
icon_plotly_box,
"to select stations ",
# br(),
tags$i(class="fa fa-arrow-alt-circle-right"),
"these will be highlighted in the map.",
br(),
"Use the home button ",
icon_plotly_home, " to reset selection. ")
```
```{r data-funs, include=FALSE}
# meta
dat_meta_cluster <- readRDS(here::here("data/meta-with-cluster-01.rds"))
sf_meta <- st_as_sf(dat_meta_cluster,
coords = c("Longitude", "Latitude"),
crs = 4326)
sf_meta <- sf_meta %>% mutate(Region = cluster_fct)
# colors
cols_cluster <- setNames(scales::brewer_pal(palette = "Set1")(5),
c("NW", "NE", "North & high Alpine",
"South & high Alpine", "SE"))
leaf_col <- colorFactor("Set1", levels = levels(sf_meta$Region))
# stn trends as shared data
load(here::here("data/single-stn-trends.Rdata"))
ylim_common <- range(dat_plot_month$Elevation)
dat_plot_month2 <- dat_plot_month[, .(Name, Region,
Elevation, Latitude, Longitude,
month, Trend)]
dat_plot_season_hs2 <- dat_plot_season_hs[, .(Name, Region,
Elevation, Latitude, Longitude,
variable, Trend)]
dat_plot_season_scd2 <- dat_plot_season_scd[, .(Name, Region,
Elevation, Latitude, Longitude,
variable, Trend)]
## month shared
dat_plot_month2[month == 11] %>%
left_join(sf_meta) %>%
SharedData$new() -> shared_nov
dat_plot_month2[month == 12] %>%
left_join(sf_meta) %>%
SharedData$new() -> shared_dec
dat_plot_month2[month == 1] %>%
left_join(sf_meta) %>%
SharedData$new() -> shared_jan
dat_plot_month2[month == 2] %>%
left_join(sf_meta) %>%
SharedData$new() -> shared_feb
dat_plot_month2[month == 3] %>%
left_join(sf_meta) %>%
SharedData$new() -> shared_mar
dat_plot_month2[month == 4] %>%
left_join(sf_meta) %>%
SharedData$new() -> shared_apr
dat_plot_month2[month == 5] %>%
left_join(sf_meta) %>%
SharedData$new() -> shared_may
## season shared
# maxHS_NDJFMAM meanHS_DJF meanHS_MAM meanHS_NDJFMAM
# SCD_MAM SCD_NDJF SCD_NDJFMAM
dat_plot_season_hs2[variable == "meanHS_NDJFMAM"] %>%
left_join(sf_meta) %>%
SharedData$new() -> shared_meanHS_NDJFMAM
dat_plot_season_hs2[variable == "meanHS_DJF"] %>%
left_join(sf_meta) %>%
SharedData$new() -> shared_meanHS_DJF
dat_plot_season_hs2[variable == "meanHS_MAM"] %>%
left_join(sf_meta) %>%
SharedData$new() -> shared_meanHS_MAM
dat_plot_season_hs2[variable == "maxHS_NDJFMAM"] %>%
left_join(sf_meta) %>%
SharedData$new() -> shared_maxHS_NDJFMAM
dat_plot_season_scd2[variable == "SCD_NDJFMAM"] %>%
left_join(sf_meta) %>%
SharedData$new() -> shared_SCD_NDJFMAM
dat_plot_season_scd2[variable == "SCD_NDJF"] %>%
left_join(sf_meta) %>%
SharedData$new() -> shared_SCD_NDJF
dat_plot_season_scd2[variable == "SCD_MAM"] %>%
left_join(sf_meta) %>%
SharedData$new() -> shared_SCD_MAM
# plot funs
f_plot_month <- function(dat, mo){
gg <- dat %>%
ggplot(aes(Trend, Elevation, colour = Region, label = Name))+
geom_vline(xintercept = 0)+
geom_point()+
theme_bw()+
theme(panel.grid.minor = element_blank())+
scale_color_manual("", values = cols_cluster)+
ylim(ylim_common)+
xlab(paste0("Linear trend in ", month.name[mo], " mean snow depth [cm per decade]"))+
ylab("Elevation [m]")
gg %>%
ggplotly() %>%
highlight(on = "plotly_selected", off = "plotly_relayout")
}
f_plot_season <- function(dat, seas_lab){
gg <- dat %>%
ggplot(aes(Trend, Elevation, colour = Region, label = Name))+
geom_vline(xintercept = 0)+
geom_point()+
theme_bw()+
theme(panel.grid.minor = element_blank())+
scale_color_manual("", values = cols_cluster)+
ylim(ylim_common)+
xlab(paste0("Linear trend in ", seas_lab, " per decade]"))+
ylab("Elevation [m]")
gg %>%
ggplotly() %>%
highlight(on = "plotly_selected", off = "plotly_relayout")
}
f_leaf <- function(dat){
dat %>%
leaflet %>%
addProviderTiles("CartoDB.Positron", group = "CartoDB") %>%
addProviderTiles("Esri.WorldTopoMap", group = "Topomap") %>%
addProviderTiles("Esri.WorldImagery", group = "WorldImagery") %>%
addLayersControl(baseGroups = c("CartoDB", "Topomap", "WorldImagery"),
position = "topright",
options = layersControlOptions(collapsed = FALSE)) %>%
addCircleMarkers(stroke = F,
fillOpacity = 0.8,
radius = 5,
color = ~ leaf_col(Region))
}
```
# Mean snow depth: Seasonal (Nov-May) {data-navmenu="Single station trends"}
## Row {data-height=100}
### Map info
`r info_map1`
`r info_map2`
### Scatter plot info
`r info_trend1`
`r info_trend2`
## Row
### Map
```{r}
shared_meanHS_NDJFMAM %>% f_leaf()
```
### Trend plot
```{r}
f_plot_season(shared_meanHS_NDJFMAM,
"November-May mean HS [cm")
```
# Mean snow depth: Winter (Dec-Feb) {data-navmenu="Single station trends"}
## Row {data-height=100}
### Map info
`r info_map1`
`r info_map2`
### Scatter plot info
`r info_trend1`
`r info_trend2`
## Row
### Map
```{r}
shared_meanHS_DJF %>% f_leaf()
```
### Trend plot
```{r}
f_plot_season(shared_meanHS_DJF,
"December-February mean HS [cm")
```
# Mean snow depth: Spring (Mar-May) {data-navmenu="Single station trends"}
## Row {data-height=100}
### Map info
`r info_map1`
`r info_map2`
### Scatter plot info
`r info_trend1`
`r info_trend2`
## Row
### Map
```{r}
shared_meanHS_MAM %>% f_leaf()
```
### Trend plot
```{r}
f_plot_season(shared_meanHS_MAM,
"March-May mean HS [cm")
```
# Maximum snow depth: Seasonal (Nov-May) {data-navmenu="Single station trends"}
## Row {data-height=100}
### Map info
`r info_map1`
`r info_map2`
### Scatter plot info
`r info_trend1`
`r info_trend2`
## Row
### Map
```{r}
shared_maxHS_NDJFMAM %>% f_leaf()
```
### Trend plot
```{r}
f_plot_season(shared_maxHS_NDJFMAM,
"November-May maximum HS [cm")
```
# Snow cover duration: Seasonal (Nov-May) {data-navmenu="Single station trends"}
## Row {data-height=100}
### Map info
`r info_map1`
`r info_map2`
### Scatter plot info
`r info_trend1`
`r info_trend2`
## Row
### Map
```{r}
shared_SCD_NDJFMAM %>% f_leaf()
```
### Trend plot
```{r}
f_plot_season(shared_SCD_NDJFMAM,
"November-May SCD [days")
```
# Snow cover duration: Winter (Nov-Feb) {data-navmenu="Single station trends"}
## Row {data-height=100}
### Map info
`r info_map1`
`r info_map2`
### Scatter plot info
`r info_trend1`
`r info_trend2`
## Row
### Map
```{r}
shared_SCD_NDJF %>% f_leaf()
```
### Trend plot
```{r}
f_plot_season(shared_SCD_NDJF,
"November-February SCD [days")
```
# Snow cover duration: Spring (Mar-May) {data-navmenu="Single station trends"}
## Row {data-height=100}
### Map info
`r info_map1`
`r info_map2`
### Scatter plot info
`r info_trend1`
`r info_trend2`
## Row
### Map
```{r}
shared_SCD_MAM %>% f_leaf()
```
### Trend plot
```{r}
f_plot_season(shared_SCD_MAM,
"March-May SCD [days")
```
# Mean snow depth: November {data-navmenu="Single station trends"}
## Row {data-height=100}
### Map info
`r info_map1`
`r info_map2`
### Scatter plot info
`r info_trend1`
`r info_trend2`
## Row
### Map
```{r}
shared_nov %>% f_leaf()
```
### Trend plot
```{r}
f_plot_month(shared_nov, 11)
```
# Mean snow depth: December {data-navmenu="Single station trends"}
## Row {data-height=100}
### Map info
`r info_map1`
`r info_map2`
### Scatter plot info
`r info_trend1`
`r info_trend2`
## Row
### Map
```{r}
shared_dec %>% f_leaf()
```
### Trend plot
```{r}
f_plot_month(shared_dec, 12)
```
# Mean snow depth: January {data-navmenu="Single station trends"}
## Row {data-height=100}
### Map info
`r info_map1`
`r info_map2`
### Scatter plot info
`r info_trend1`
`r info_trend2`
## Row
### Map
```{r}
shared_jan %>% f_leaf()
```
### Trend plot
```{r}
f_plot_month(shared_jan, 1)
```
# Mean snow depth: February {data-navmenu="Single station trends"}
## Row {data-height=100}
### Map info
`r info_map1`
`r info_map2`
### Scatter plot info
`r info_trend1`
`r info_trend2`
## Row
### Map
```{r}
shared_feb %>% f_leaf()
```
### Trend plot
```{r}
f_plot_month(shared_feb, 2)
```
# Mean snow depth: March {data-navmenu="Single station trends"}
## Row {data-height=100}
### Map info
`r info_map1`
`r info_map2`
### Scatter plot info
`r info_trend1`
`r info_trend2`
## Row
### Map
```{r}
shared_mar %>% f_leaf()
```
### Trend plot
```{r}
f_plot_month(shared_mar, 3)
```
# Mean snow depth: April {data-navmenu="Single station trends"}
## Row {data-height=100}
### Map info
`r info_map1`
`r info_map2`
### Scatter plot info
`r info_trend1`
`r info_trend2`
## Row
### Map
```{r}
shared_apr %>% f_leaf()
```
### Trend plot
```{r}
f_plot_month(shared_apr, 4)
```
# Mean snow depth: May {data-navmenu="Single station trends"}
## Row {data-height=100}
### Map info
`r info_map1`
`r info_map2`
### Scatter plot info
`r info_trend1`
`r info_trend2`
## Row
### Map
```{r}
shared_may %>% f_leaf()
```
### Trend plot
```{r}
f_plot_month(shared_may, 5)
```
# Station time series
## Row {data-height=150}
### Map info
Clicking on a station will show its name, elevation, coordinates, and links to pre-made time series plots.
Stations whose circles have an outline have full data for the whole period 1971-2019, while the stations without outline contain gaps.
## Row
### Map
```{r}
# addLegendCustom() from: https://stackoverflow.com/questions/52812238/custom-legend-with-r-leaflet-circles-and-squares-in-same-plot-legends
addLegendCustom <- function(map, colors, labels, sizes, shapes, borders, opacity = 0.5){
make_shapes <- function(colors, sizes, borders, shapes) {
shapes <- gsub("circle", "50%", shapes)
shapes <- gsub("square", "0%", shapes)
paste0(colors, "; width:", sizes, "px; height:", sizes, "px; border:3px solid ", borders, "; border-radius:", shapes)
}
make_labels <- function(sizes, labels) {
paste0("", labels, "")
}
legend_colors <- make_shapes(colors, sizes, borders, shapes)
legend_labels <- make_labels(sizes, labels)
return(addLegend(map, colors = legend_colors, labels = legend_labels, opacity = opacity))
}
stn_trend <- sort(unique(c(dat_plot_month$Name,
dat_plot_season_hs$Name,
dat_plot_season_scd$Name)))
dat_meta_ts <- readRDS(here::here("data/meta-with-cluster-01.rds"))
dat_meta_ts[, stn_long := ifelse(Name %in% stn_trend, "trend", "region")]
dat_meta_ts[, leaf_opac := ifelse(Name %in% stn_trend, 0.8, 0.4)]
dat_meta_ts[, leaf_rad := ifelse(Name %in% stn_trend, 6, 4)]
dat_meta_ts[, popup_html := paste0(
Name, "
",
Elevation, "m
",
round(Longitude, 3), "°E ", round(Latitude, 3), "°N
",
'Seasonal snow indices
',
'Monthly mean snow depth
'
)]
sf_meta_ts <- st_as_sf(dat_meta_ts,
coords = c("Longitude", "Latitude"),
crs = 4326)
leaflet() %>%
addProviderTiles("CartoDB.Positron", group = "CartoDB") %>%
addProviderTiles("Esri.WorldTopoMap", group = "Topomap") %>%
addProviderTiles("Esri.WorldImagery", group = "WorldImagery") %>%
addLayersControl(baseGroups = c("CartoDB", "Topomap", "WorldImagery")) %>%
addCircleMarkers(data = sf_meta_ts %>% filter(stn_long == "region"),
color = ~leaf_col(cluster_fct),
stroke = F,
radius = 5,
fillOpacity = 0.4,
popup = ~popup_html) %>%
addCircleMarkers(data = sf_meta_ts %>% filter(stn_long == "trend"),
color = ~leaf_col(cluster_fct),
stroke = T,
weight = 2,
radius = 5,
opacity = 0.8,
fillOpacity = 0.4,
popup = ~popup_html) %>%
addLegendCustom(colors = "gray",
labels = c("Full period 1971-2019 available", "With gaps"),
sizes = 20,
shapes = "circle",
borders = c("black", "white"))
```