---
title: "Combining multiple data sources with simple spatiotemporal matching"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{matching}
  %\VignetteEngine{knitr::rmarkdown}
  %\usepackage[utf8]{inputenc}
---

```{r, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>", 
  warning = FALSE,
  message = FALSE,
  out.width = "100%"
)
library(cubble)
library(dplyr)
library(ggplot2)
```

One common type of task with spatio-temporal data is to match nearby sites. For example, we may want to verify the location of an old list of stations with current stations, or we may want to match the data from different data sources. Some of these matches only concern the spatial dimension, while others require temporal agreement.

This vignette introduces how to spatially and spatio-temporally match sites with the cubble structure with two examples. The first example pairs traditional weather stations with nearby automated stations in New South Wales, Australia. This exercise only concerns the matching based on spherical distance between stations. The next example pairs the river level recorded by the river gauges with the precipitation recorded by the nearby weather station in Victoria, Australia. 

# Spatial matching

Again we will start with `prcp_aus` to look at precipitation and focus on New South Wales stations since that is where most automated stations are implemented. The figure below shows the location of traditional and automated weather station on the map:

```{r}
nsw_map <- ozmaps::abs_ste %>%  
  filter(NAME == "New South Wales") 

nsw <- climate_aus %>%    
  # subset for New South Wales stations
  filter(between(as.numeric(stringr::str_sub(id, 7, 8)), 46, 75)) %>% 
  mutate(automated = stringr::str_detect(name, "aws")) %>%  
  face_temporal(ts) %>% 
  filter(lubridate::month(date) == 1,
         lubridate::year(date) == 2020) %>%  
  face_spatial() %>%  
  filter(!any(is.na(ts$prcp)))
 
ggplot() +
  geom_sf(data = nsw_map, color = "grey", linetype = "dotted") +
  geom_point(data = nsw, aes(x = long, y = lat, color = automated)) +
  theme_bw() +
  theme(legend.position = "bottom") +
  labs(x = "Longitude", y = "Latitude") + 
  scale_color_brewer(palette = "Dark2") + 
  ggtitle("New Sourth Wales") + 
  coord_sf(xlim = c(141, 154))
```

In the map we can see some traditional and automated weather stations are close to each other. This can be useful information to cross validate recordings from different types of weather stations. 

In cubble, `match_sites()` houses `match_spatial()` and `match_temporal()`. For a spatial-only matching, you can use `match_sites(temporal_matching = FALSE)` or simply `match_spatial()`.

Any matching requires two datasets in the cubble and we call them `major` and `minor`. Major and minor dataset differs from how distance is calculated. Spatial matching calculates the spherical distance using the Vincenty formula and this distance is calculated from *each* site in the `major` dataset is to *every* site in the `minor` dataset. 

Once the distance is calculated, three arguments are available to refine the matching results: 

  - `spatial_n_keep`: Number of match each major site receive 
  - `spatial_dist_max`: maximum distance allowed for a pair of matching
  - `spatial_single_match`: Whether each minor site can only be matched to one major site

The order that these three arguments applied will slightly affect the results in `cubble`. `spatial_n_keep`, default to 1,  is first applied to keep `n` site(s) for each major site, `spaital_dist_max`, default to 10, is then applied to filter out the pairs with distance larger than this maximum distance. `spatial_single_match` is lastly applied to resolve the scenario where site `a` (minor) is the closest match for both site `A` and `B` (major) with distance 5km and 8km. If `spatial_single_match = TRUE`, `a` will only be matched to the major site with the smaller distance, that is,  site `A` here.
  
Let's get back to the weather stations.

We first construct the major site `auto` and minor `non_auto` by filtering on whether stations are automated or not. Here we would like to find each station in `auto` a match in `non_auto`. Hence `auto` is the major dataset and `non_auto` is the minor in the `match_sites()`:

```{r}
auto <- nsw %>%  filter(automated)
non_auto <- nsw %>%  filter(!automated)

matched <- match_sites(auto, non_auto, temporal_matching = FALSE) 
```

The result from the pairing is also a cubble with two additional columns:  `dist` as the distance between the pair and `group` as the grouping index:

```{r}
matched 
```

Then we can create visualisation to see where these pairs are in the map:

```{r}
ggplot() + 
  geom_sf(data = nsw_map) + 
  geom_point(data = matched, 
             aes(x = long, y = lat, color = automated)) + 
  ggrepel::geom_label_repel(
    data = matched %>%  filter(automated),
    aes(x = long, y = lat, label = group)) + 
  scale_color_brewer(palette = "Dark2") + 
  ggtitle("New South Wales") + 
  theme_minimal() + 
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank()) +
  coord_sf(xlim = c(141, 154))
```

or compare the series within the same pair (as an example here we only look at records in Jan 2020):

```{r echo = FALSE}
ts <- matched %>% 
  switch_key(group) %>%  
  face_temporal(ts) %>% 
  unfold(id, automated) 

ts %>% 
  ggplot(aes(x = date, y = prcp, color = automated, group = id)) +
  geom_line() +
  facet_wrap(vars(group)) +
  scale_color_brewer(palette = "Dark2") + 
  scale_x_date(date_labels = "%d") + 
  theme_bw()
```

We can see that in general the peaks of precipitation recorded by traditional and automated stations from our pairs are matched, while the exact read may need to be further calibrated.

# Spatio-temporal matching

Bureau of Meteorology collects [water data](http://www.bom.gov.au/metadata/catalogue/19115/ANZCW0503900528?template=full) from river gauges and this includes variables: electrical conductivity, turbidity, water course discharge, water course level, and water temperature. In particular, water level will interactive with precipitation from the climate data since rainfall will raise the water level in the river. Here is the location of available weather station and water gauges in Victoria:

```{r echo = FALSE}
river <- river %>%  mutate(type = "river")

vic <- climate_aus %>%  
  # subset for Victoria stations
  filter(between(as.numeric(stringr::str_sub(id, 7, 8)), 76, 90)) %>%  
  face_temporal() %>%  
  filter(lubridate::year(date) == 2020) %>%  
  face_spatial() %>%  
  mutate(type = "climate")

vic_map <- ozmaps::abs_ste %>%  filter(NAME == "Victoria")

ggplot() + 
  geom_sf(data = vic_map) + 
  geom_point(data = dplyr::bind_rows(river, vic), 
             aes(x = long, y = lat, color = type)) + 
  theme_bw() +
  theme(legend.position = "bottom") +
  labs(x = "Longitude", y = "Latitude") + 
  scale_color_brewer(palette = "Dark2")
```

Here we provide more details on how temporal matching works in `cubble`. Suppose two locations have been matched spatially and temproal matching will be conducted on variable `A` and `a` in the plot below: . 

```{r echo = FALSE}
set.seed(123)
dt <- tibble(
  id = factor(c(rep("A", 31), rep("a", 31)), levels = c("A", "a")),
  date = rep(1:31, 2),
  val = c(
    c(rnorm(5), 10, rnorm(7), 5, rnorm(8), 7, rnorm(8)),
    c(
      rnorm(6, sd = 0.5), 7, rnorm(7, sd = 0.5), rnorm(6, sd = 0.5),
      4, rnorm(5, sd = 0.5), 6, rnorm(4, sd = 0.5)
    )
  )
) %>%  mutate(val = ifelse(val < 0, 0, val))

circle <- tibble(
  x = c(6, 14, 23, 7, 21, 27),
  y = c(10, 5, 7, 7, 4, 6),
  id = factor(c(rep("A", 3), rep("a", 3)), levels = c("A", "a")),
  xend = x + 5,
  match = factor(c("yes", "no", rep("yes", 2), "no", "yes"), levels = c("yes", "no"))
) 

errorbar <- bind_rows(
  circle %>%  filter(id == "A"),
  circle %>%  filter(id == "A") %>%  mutate(id = "a")
) %>% 
  mutate(id = factor(id, c("A", "a")))

ggplot() +
  geom_rect(data = errorbar, aes(xmin = x, xmax = xend, ymin = 0, ymax = 10), fill = "grey90") +
  geom_line(data = dt, aes(x = date, y = val, group = id), color = "black") +
  geom_vline(data = circle %>%  filter(id == "A"), 
             aes(xintercept = x), linetype = "longdash", color = "grey10", lwd = 0.2) +
  geom_point(data = circle, aes(x = x, y = y, color = match), size = 3) +
  facet_wrap(vars(id), nrow = 2) +
  scale_y_continuous(breaks = seq(0, 10, 2)) +
  scale_x_continuous(breaks = seq(1, 31, 1)) +
  scale_color_brewer(palette = "Dark2") + 
  theme_bw() +
  theme(panel.grid = element_blank(),
        legend.position = "bottom") +
  labs(x = "Time", y = "Value")

```

We first find the `n` peaks in each series (3 peaks here). A variable needs to be specified in `temporal_independent` for construct an interval. Here we pick variable `A` and construct an interval with a default length of 5. The peaks in variable `a` are then tested against whether they fall into the any of the intervals constructed from `A`. In this illustration, there are 2 matches for these two variable The available tuning parameter in temporal matches are: 

 - `temporal_n_highest`: the number of peak used - 3 in the example above
 - `temporal_window`: the length of the interval - 5 in the example above
 - `temporal_min_match`: the minimum number of matched peak for a valid matched pair. To return all the pairs of the match, set this parameter to 0.

In the river level and precipitation example, `Water_course_level` in `river` will be matched to `prcp` in `climate`. This can be specified in `temporal_by`, an analogue to  the `by` syntax in `join`. The goal in this example is to see if precipitation will be reflected by the water level in the river and this puts precipitation `prcp`, as the independent. Given there is one year worth of data, the number of peak (`temporal_n_highest`) to consider is slightly raised from a default 20 to 30 and `temporal_min_match` is raised accordingly. 

```{r}
res <- match_sites(river, vic,
                   temporal_by = c("Water_course_level" = "prcp"),
                   temporal_independent = "prcp",
                   temporal_n_highest = 30,
                   temporal_min_match = 15)
```

The output from temporal matching is also a cubble with `n_match` for the number of matched temporal peaks (on top of the `dist` and `group` from spatial matching)： 

```{r}
res
```

We can look at the matched pair on the map:

```{r}
ggplot() + 
  geom_sf(data = vic_map) + 
  geom_point(data = res, 
             aes(x = long, y = lat, color = type)) + 
  ggrepel::geom_label_repel(data = res %>%  filter(type == "river"),
                            aes(x = long, y = lat, label = group)) + 
  scale_color_brewer(palette = "Dark2") + 
  ggplot2::theme_bw() +
  ggplot2::theme(legend.position = "bottom") +
  ggplot2::labs(x = "Longitude", y = "Latitude") + 
  ggtitle("Victoria") 
```

or to look at the series: 

```{r}
res_long <- res %>%  
  face_temporal(ts) %>%  
  unfold(group, type) %>%  
  rename(prcp = matched_var) %>%  
  mutate(prcp = (prcp - min(prcp, na.rm = TRUE))/ (max(prcp, na.rm = TRUE) - min(prcp, na.rm = TRUE))) 

res_long %>%  
  ggplot(aes(x = date, y = prcp, group = type,color = type)) + 
  geom_line() + 
  facet_wrap(vars(group)) + 
  scale_color_brewer(palette = "Dark2", guide = "none") + 
  theme_bw() + 
  labs(x=  "date") + 
  scale_x_date(date_labels = "%b") + 
  labs(x = "Week", y = "Precipitation/ water level")
```

There are four pairs of matches - all locates in the middle Victoria and we can observe concurrent increase of precipitation and water level (precipitation and water level have been standardised between 0 and 1 to be displayed on the same scale).
