report.qmd

---
title: "Northern Fur Seal Movement, Dive Behavior, and Oceanography in the Bering Sea and Pacific Ocean"
execute:
  echo: false
  warning: false
  message: false
format: html
search: false

author:
  - id: jml
    name:
      literal: Josh M. London
    email: josh.london@noaa.gov
    orcid: 0000-0002-3647-5046
    attributes:
      corresponding: true
    affiliations: 
      - ref: mml
  - id: skh
    name:
      literal: Stacie M. Koslovsky
    email: stacie.koslovsky@noaa.gov
    affiliations: 
      - ref: mml
  - id: ajo
    name:
      literal: Anthony J. Orr
    email: tony.orr@noaa.gov
    affiliations: 
      - ref: mml
  - id: cek
    name:
      literal: Carey E. Kuhn
    email: carey.kuhn@noaa.gov
    affiliations: 
      - ref: mml
affiliations:
  - id: mml
    name: AFSC Marine Mammal Laboratory, NOAA Fisheries
    address: 7600 Sand Point Way NE
    city: Seattle
    region: Washington
    country: United States
    postal-code: 98115
    url: https://www.fisheries.noaa.gov/about/marine-mammal-laboratory
---

```{r}
#| include: false
library(dplyr)
library(purrr)
library(fs)
library(tidyr)
library(lubridate)
library(stringr)
library(ggplot2)
library(janitor)
library(readr)
library(googlesheets4)
library(wcUtils)
library(scam)
library(sf)
library(googlesheets4)
library(rdeck)
library(downloadthis)
library(aniMotum)
library(rcartocolor)

r_files <- fs::dir_ls(here::here('R'), glob = "*.R")
purrr::map(r_files, source)
deploy_tbl <- read_rds(here::here('data/deploy_tbl.rds'))  |>  
  dplyr::mutate(deploy_end_date_time_gmt = lubridate::as_date('2023-01-01')) |> 
  dplyr::mutate(deploy_end_date_time_gmt = dplyr::case_when(
    deployid == "SM1369SML_19U3077" ~ lubridate::as_date('2022-11-01'),
    deployment_location == "Bogoslof Island" ~ lubridate::as_date('2024-03-01'),
    TRUE ~ deploy_end_date_time_gmt
  ))

```

```{r}
#| include: false
data_list <- get_wc_data(deploy_tbl$deployid)
```

:::{.callout-warning}
The information on this page is automatically updated every hour and without
any significant quality checks. Errors may be present and are likely. We are
providing access to the information in a public forum in the spirit of open
science and to provide easy access to updated information for the authors and
interested researchers. 

**The information provided here should not be cited or
referenced in any form**
:::

::: {.column-margin}
Disclaimer

The scientific results and conclusions, as well as any views or opinions
expressed herein, are those of the author(s) and do not necessarily reflect the
views of NMFS, NOAA, or the Department of Commerce. 
:::

## Predicted Movements

![](https://images.phylopic.org/images/7ce9ff63-7eec-4fc3-8f37-5f66f9b924a9/thumbnail/192x192.png){style="float: left; padding: 0 10px 0 0;"}
In September 2022 bio-loggers
([SPLASH-F](https://wildlifecomputers.com/our-tags/splash-archiving-tags/splash-f/),
Wildlife Computers[^1], Redmond, Washington) were deployed on adult female northern
fur seals at San Miguel Island, California (n=6) and St. Paul Island, Alaska
(n=6). Then in 2023, additional bio-loggers (n=11) were deployed on adult female
northern fur seals at Bogoslof Island, Alaska. The three maps below provide near real-time predicted
movement paths based on a continuous time correlated random walk model
(via the R package, `aniMotum`). This
movement model uses both Argos and Fastloc GPS derived locations to produce a
predicted path that most-likely represents the actual movement of the fur seal.
Here, the path shown is based on 15 minute predictions. New data
are downloaded, processed, and modeled at least hourly every day.

[^1]: Any reference to specific commercial products, processes, or services by
  service mark, trademark, manufacturer, or otherwise, does not constitute or
  imply their endorsement, recommendation or favoring by the Department of
  Commerce.

The maps below are interactive and can be zoomed in/out using the scroll wheel
on the mouse. The background tiles provide general representation of bathymetric
features but are kept relatively simple so the maps remain responsive and
interactive. Additionally, the solid dots indicate the last known location.
Hovering over a dot will show the deployid and date time associated with that
location.

```{r}
#| include: false

map_proj <- "+proj=lcc +lon_0=-160 +lat_1=33 +lat_2=45 +units=m"


locs <- sf::st_as_sf(data_list$locs,
                     coords = c("longitude","latitude"),
                     crs = 4326) %>% 
  left_join(deploy_tbl) %>% 
  dplyr::filter(between(date_time,
                        deploy_date_time_gmt + lubridate::hours(12),
                        deploy_end_date_time_gmt)) %>% 
  dplyr::rename(datetime=date_time)

locs <- locs %>%
  group_by(deployid) %>%
  arrange(datetime, error_radius) %>%
    mutate(
      rank = 1L,
      rank = case_when(duplicated(datetime, fromLast = FALSE) ~
                         lag(rank) + 1L, TRUE ~ rank)) %>%
    dplyr::filter(rank == 1) %>% 
  arrange(deployid,datetime) %>% 
  ungroup() %>%
  sf::st_transform(map_proj)

locs <- locs |> 
  dplyr::mutate(
    quality = case_when(
      type == 'FastGPS' ~ 'G',
      type == 'User' ~ 'G',
      .default = quality
    )
  )

locs_fit <- fit_ssm(
  x = locs,
  vmax = 5,
  model = "crw",
  time.step = 0.25,
  id = "deployid",
  date = "datetime",
  lc = "quality",
  epar = c(
    "error_semi_major_axis",
    "error_semi_minor_axis",
    "error_ellipse_orientation"
  ),
  tz = "UTC"
)

predict_pts_sf <-
  grab(locs_fit,
       what = "predicted",
       as_sf = TRUE,
       group = TRUE) |> 
  rename(deployid = id,
         datetime = date) |> 
  left_join(deploy_tbl)

predict_lines_sf <- predict_pts_sf %>% 
  group_by(deployid) %>%
  summarise(do_union = FALSE) %>%
  st_cast("LINESTRING") %>%
  left_join(deploy_tbl)
                                 

lines_smi <- filter(predict_lines_sf, deployment_location == "San Miguel Island, CA") %>% 
  sf::st_transform(4326)
lines_stp <- filter(predict_lines_sf, deployment_location == "St. Paul Island, AK") %>% 
  sf::st_transform(4326)
lines_bogo <- filter(predict_lines_sf, deployment_location == "Bogoslof Island") %>% 
  sf::st_transform(4326)

smi_init <- st_bbox(lines_smi) %>% 
  st_as_sfc() %>% 
st_buffer(100000)

stp_init <- st_bbox(lines_stp) %>% 
  st_as_sfc() %>% 
st_buffer(100000)

bogo_init <- st_bbox(lines_bogo) %>% 
  st_as_sfc() %>% 
st_buffer(100000)

locs_smi <- filter(predict_pts_sf, deployment_location == "San Miguel Island, CA") %>% 
  sf::st_transform(4326) %>% 
  group_by(deployid) %>% 
  arrange(deployid,datetime) %>% 
  group_map(~ tail(.x, 1L), .keep=TRUE) %>% 
  bind_rows()

locs_stp <- filter(predict_pts_sf, deployment_location == "St. Paul Island, AK") %>% 
  sf::st_transform(4326) %>% 
  group_by(deployid) %>% 
  arrange(deployid,datetime) %>% 
  group_map(~ tail(.x, 1L), .keep=TRUE) %>% 
  bind_rows()

locs_bogo <- filter(predict_pts_sf, deployment_location == "Bogoslof Island") %>% 
  sf::st_transform(4326) %>% 
  group_by(deployid) %>% 
  arrange(deployid,datetime) %>% 
  group_map(~ tail(.x, 1L), .keep=TRUE) %>% 
  bind_rows()

smi_map <- rdeck(map_style = "mapbox://styles/jmlondon/cl9kktfl2000v16pooqw5p2wz",
                initial_bounds = smi_init,
                controller = TRUE) %>%
  add_path_layer(data = lines_smi,
                    name = "San Miguel",
                    opacity = 0.8,
                    get_color = scale_color_category(
                      col = deployid,
                      palette = rcartocolor::carto_pal(6,"SunsetDark")
                      ),
                    wrap_longitude = TRUE,
                    position_format = "XY",
                    width_min_pixels = 1.5,
                    get_path = geometry) %>%
  add_scatterplot_layer(data = locs_smi,
                    name = "San Miguel",
                    opacity = 1,
                    get_fill_color = scale_color_category(
                      col = deployid,
                      palette = rcartocolor::carto_pal(6,"SunsetDark"),
                      legend = FALSE
                      ),
                    wrap_longitude = TRUE,
                    position_format = "XY",
                    radius_min_pixels = 4,
                    get_position = geometry,
                    pickable = TRUE,
                    tooltip = c(deployid,datetime))

stp_map <- rdeck(map_style = "mapbox://styles/jmlondon/cl9kktfl2000v16pooqw5p2wz",
                initial_bounds = stp_init,
                controller = TRUE) %>%
  add_path_layer(data = lines_stp,
                    name = "St. Paul",
                    opacity = 0.8,
                    get_color = scale_color_category(
                      col = deployid,
                      palette = rcartocolor::carto_pal(6,"BrwnYl")
                      ),
                    wrap_longitude = TRUE,
                    position_format = "XY",
                    width_min_pixels = 1.5,
                    get_path = geometry) %>% 
  
  add_scatterplot_layer(data = locs_stp,
                    name = "St. Paul",
                    opacity = 1,
                    get_fill_color = scale_color_category(
                      col = deployid,
                      palette = rcartocolor::carto_pal(6,"BrwnYl"),
                      legend = FALSE
                      ),
                    wrap_longitude = TRUE,
                    position_format = "XY",
                    radius_min_pixels = 4,
                    get_position = geometry,
                    pickable = TRUE,
                    tooltip = c(deployid,datetime))

bogo_map <- rdeck(map_style = "mapbox://styles/jmlondon/cl9kktfl2000v16pooqw5p2wz",
                initial_bounds = bogo_init,
                controller = TRUE) %>%
  add_path_layer(data = lines_bogo,
                    name = "Bogoslof",
                    opacity = 0.8,
                    get_color = scale_color_category(
                      col = deployid,
                      palette = rcartocolor::carto_pal(11,"Prism")
                      ),
                    wrap_longitude = TRUE,
                    position_format = "XY",
                    width_min_pixels = 1.5,
                    get_path = geometry) %>% 
  
  add_scatterplot_layer(data = locs_bogo,
                    name = "Bogoslof",
                    opacity = 1,
                    get_fill_color = scale_color_category(
                      col = deployid,
                      palette = rcartocolor::carto_pal(11,"Prism"),
                      legend = FALSE
                      ),
                    wrap_longitude = TRUE,
                    position_format = "XY",
                    radius_min_pixels = 4,
                    get_position = geometry,
                    pickable = TRUE,
                    tooltip = c(deployid,datetime))
```

::: {.column-page}

```{r}
bogo_map
```

:::

::: {.column-page}

```{r}
#| layout: [[1,1]]
stp_map
smi_map
```

:::

## Dive Behavior

![](https://images.phylopic.org/images/7ce9ff63-7eec-4fc3-8f37-5f66f9b924a9/thumbnail/192x192.png){style="float: left; padding: 0 10px 0 0;"}
The SPLASH-F bio-loggers were programmed with a new option for summarizing dive
behavior. The Argos satellite network has limited bandwidth available for
transmitting data. This, combined with the inherent nature of a marine mammal to
spend considerable time at sea and under water, restricts the amount of
information that can be transmitted. The Empirical Cumulative Distribution (ECD)
of time at depth provides an efficient and flexible data message for summarizing
the proportion of time spent at varying depths during specified time periods.
Unlike previous dive summary messages (e.g. histograms), the depth bins are not
specified in advance. The ECD adjusts to always include the full range of depths
explored during the summary period.

In this study, the ECD summary period was specified at 1 hour. This is the
finest resolution summary period and aligns well with our movement model
prediction interval. However, such resolution comes at a cost. The transmission
buffer on the SPLASH-F is limited to 100 messages and only 2 summary periods are
encoded in a single message (in this study: 2 hours per message). In addition to
ECD messages, the SPLASH-F is also collecting Fastloc GPS data and oceanographic
depth and temperature profiles. Since approximately 25 messages are generated
per day that means the buffer holds about 4 days worth of messages. Fur seals,
spend relatively little time at the surface when at sea and, thus, not all
messages are successfully transmitted. This is apparent in the plots below
where there are open gaps in the timeline representing hours for which no data
is available.

A key objective of this study is to push the limits of transmission so we can
learn from real-world deployments in challenging environments. With this 
information we can work with Wildlife Computers to improve the capabilities and
make better informed programming decisions in the future.


```{r}

ecd_data <- data_list$ecdf %>% 
  dplyr::rename(deployid = deploy_id) %>% 
  dplyr::arrange(deployid, start) %>% 
  rowwise() %>% 
  dplyr::mutate(spline_interp = list(spline_ecdf(full_ecdf, bin.width=5)),
                depth50pct = x_pct_depth(full_ecdf,pct_tad = 0.5),
                n_dives = if_else(all(is.na(n_dives_shallow),is.na(n_dives_deep)),
                                  NA, mean(c(n_dives_shallow,n_dives_deep), na.rm=TRUE))
  ) %>% 
  dplyr::select(c(deployid,start:percent_dry,shallow_ecdf, 
                  deep_ecdf,full_ecdf,spline_interp,depth50pct, n_dives)) %>% 
  unnest(spline_interp, keep_empty = TRUE) %>% 
  group_by(deployid, start, end, kind, percent_dry) %>% 
  dplyr::arrange(deployid, start, depth_break) %>% 
  dplyr::mutate(propTAD = c(0,diff(ecd_prop)),
                minTAD = 60*(1-0.01*percent_dry) * propTAD) %>% 
  # determine the next depth value
  dplyr::mutate(next_depth = dplyr::lead(depth_break)) %>%
  # determine previous depth for plotting
  dplyr::mutate(prev_depth = dplyr::lag(depth_break)) %>%
  dplyr::select(-next_depth) %>%
  # transform depths to negative values
  dplyr::mutate(depth_break = depth_break * -1,
                prev_depth = prev_depth * -1)

ecd_data <- ecd_data %>% 
  group_by(deployid) %>% 
  arrange(start)

ecd_data <- ecd_data |> 
  dplyr::filter(!(between(start,lubridate::ymd_hms('2023-11-22 10:00:00'), 
                         lubridate::ymd_hms('2023-11-22 13:00:00')) &
                    deployid == '899_19U3097')
                )
```

::: {.column-page}

```{r}
#| fig-asp: 1
#| fig-width: 11.75
ecd_data %>% 
  left_join(deploy_tbl) %>% 
  dplyr::filter(between(end,deploy_date_time_gmt,deploy_end_date_time_gmt)) %>%
  filter(deployment_location == "Bogoslof Island") %>% 
ggplot() +
  geom_rect(aes(xmin = start, xmax = end,
                ymin = 0, ymax = percent_dry/10),
            fill = "seashell3") +
  geom_rect(aes(xmin = start, xmax = end,
                ymin = depth_break, ymax = prev_depth,
                fill = propTAD),
            color = NA) +
  scale_fill_distiller(palette = "Reds",
                   direction = 1, trans = "log10",
                       guide = guide_colorbar(
                         title = 'proportion of time submerged',
                         title.position = 'bottom',
                         title.hjust = 0.5,
                         barwidth = unit(75, units = "mm"),
                         barheight = unit(2, units = "mm"))) +
  facet_grid(deployid ~ .) +
  ylab("depth (meters)") +
  labs(title = "Bogoslof Island",
       subtitle = "each bar represents 1 hour binned at 5m depth increments",
       caption = stringr::str_wrap("data derived from the Emperical Cummulative 
                                   Distribution (ECD) of time at depth 
                                   transmitted via the Argos satellite network")) +
  theme_minimal() +
  theme(legend.position = "bottom")
```

:::

::: {.column-page}

```{r}
#| layout: [[1,1]]
#| fig-asp: 1.85
#| fig-width: 5.75

ecd_data %>% 
  left_join(deploy_tbl) %>% 
  dplyr::filter(between(end,deploy_date_time_gmt,deploy_end_date_time_gmt)) %>%
  filter(deployment_location == "St. Paul Island, AK") %>% 
ggplot() +
  geom_rect(aes(xmin = start, xmax = end,
                ymin = 0, ymax = percent_dry/10),
            fill = "seashell3") +
  geom_rect(aes(xmin = start, xmax = end,
                ymin = depth_break, ymax = prev_depth,
                fill = propTAD),
            color = NA) +
  scale_fill_distiller(palette = "Reds",
                   direction = 1, trans = "log10",
                       guide = guide_colorbar(
                         title = 'proportion of time submerged',
                         title.position = 'bottom',
                         title.hjust = 0.5,
                         barwidth = unit(75, units = "mm"),
                         barheight = unit(2, units = "mm"))) +
  facet_grid(deployid ~ .) +
  ylab("depth (meters)") +
  labs(title = "St Paul Island, AK",
       subtitle = "each bar represents 1 hour binned at 5m depth increments",
       caption = stringr::str_wrap("data derived from the Emperical Cummulative 
                                   Distribution (ECD) of time at depth 
                                   transmitted via the Argos satellite network")) +
  theme_minimal() +
  theme(legend.position = "bottom")

ecd_data %>% 
  left_join(deploy_tbl) %>% 
  dplyr::filter(between(end,deploy_date_time_gmt,deploy_end_date_time_gmt)) %>%
  filter(deployment_location == "San Miguel Island, CA") %>% 
ggplot() +
  geom_rect(aes(xmin = start, xmax = end,
                ymin = 0, ymax = percent_dry/10),
            fill = "seashell3") +
  geom_rect(aes(xmin = start, xmax = end,
                ymin = depth_break, ymax = prev_depth,
                fill = propTAD),
            color = NA) +
  scale_fill_distiller(palette = "Oranges",
                   direction = 1, trans = "log10",
                       guide = guide_colorbar(
                         title = 'proportion of time submerged',
                         title.position = 'bottom',
                         title.hjust = 0.5,
                         barwidth = unit(75, units = "mm"),
                         barheight = unit(2, units = "mm"))) +
  facet_grid(deployid ~ .) +
  theme_minimal() +
  ylab("depth (meters)") +
  labs(title = "San Miguel Island, CA",
       subtitle = " ",
       caption = stringr::str_wrap("data derived from the Emperical 
                                   Cummulative Distribution (ECD) of time at 
                                   depth transmitted via the Argos satellite 
                                   network")) +
  theme_minimal() +
  theme(legend.position = "bottom")

```

:::

## Oceanographic Temperature Profiles

```{r}
pdt_data <- data_list$pdt %>% 
  group_by(deploy_id,date) %>% 
  mutate(data_hr = lubridate::round_date(date,unit="hour"),
         x1 = data_hr - hours(4),
         x2 = data_hr + hours(4)) %>% 
  dplyr::mutate(next_depth = dplyr::lead(depth)) %>%
  # determine previous depth for plotting
  dplyr::mutate(prev_depth = dplyr::lag(depth)) %>%
  dplyr::select(-next_depth) %>%
  # transform depths to negative values
  dplyr::mutate(depth = depth * -1,
                prev_depth = prev_depth * -1) %>% 
  ungroup() %>% 
  left_join(deploy_tbl, by=c("deploy_id" = "deployid")) %>% 
  dplyr::filter(between(data_hr,deploy_date_time_gmt,deploy_end_date_time_gmt))
```

![](https://images.phylopic.org/images/7ce9ff63-7eec-4fc3-8f37-5f66f9b924a9/thumbnail/192x192.png){style="float: left; padding: 0 10px 0 0;"}
The deployed bio-loggers also have the capability of recording temperature at
depth profiles. Temperature and depth values are collected on dive ascents at 1
Hz and are only created on qualifying dives, and when enabled in the
transmission schedule (in this study, just 2 hours per day, 11 hours apart). If
a dive descends 10% deeper than any previous dive in the current summary period,
then all previous data are cleared, and new temperature-depth data are collected
for the remainder of the current dive.

The temperature is saved at the depths specified in the World Ocean Database
2013 (WOD13). Additionally, the entire range of depths cannot be encoded into a
single Argos message. So, depth ranges from 0-80 meters, 85-425 meters, and
450-1200 meters are encoded in separate messages. Therefore, it's possible to
only receive portions of the complete dive profile.

In the figures below, you'll notice large gaps in time between dive profiles.
This is largely due to the limited window during which the tags were programmed
to collect profiles -- just 2 separate hours per day with 11 hours between them.

::: {.column-page}

```{r}
pdt_nest <- pdt_data %>% 
  group_by(deploy_id, deployment_location) %>% 
  nest() %>% 
  rowwise() %>% 
  mutate(temp_interp = list(temp_interp(data)))
```


### Bogoslof Island

```{r}
#| layout: [[1,1]]
#| fig-asp: 1.85
#| fig-width: 5.75
pdt_data %>% 
  filter(depth<0) %>% 
  filter(deployment_location == "Bogoslof Island") %>%
ggplot() +
  geom_rect(aes(xmin = x1, xmax = x2,
                ymin = prev_depth, ymax=depth,
                fill=max_te), colour=NA) +
  scale_fill_distiller(palette = "Spectral",
                   direction = -1,
                       guide = guide_colorbar(
                         title = 'temperature (C)',
                         title.position = 'bottom',
                         title.hjust = 0.5,
                         barwidth = unit(75, units = "mm"),
                         barheight = unit(2, units = "mm"))) +
  facet_grid(deploy_id ~ .) +
  ylab("depth (meters)") +
  labs(title = "Temperature at Depth (transmitted)",
       subtitle = "each bar depicts data from a single upcast as an 8-hour window") +
  theme_minimal() +
  theme(legend.position = "bottom")

pdt_nest %>% 
  filter(deployment_location == "Bogoslof Island") %>% 
  unnest(cols=c(temp_interp)) %>% 
  ungroup() %>% 
  select(deploy_id,doy,depth,max_te) %>% 
ggplot(aes(x = doy, y = depth))+
  geom_raster(aes(fill = max_te), interpolate=TRUE)+
  #geom_contour(aes(z = max_te), binwidth = 1, color = "black")+
  scale_x_continuous(labels = function(x) parse_date_time(x, orders="j") %>% 
                       format("%b %d"),
                     name = NULL) +
  scale_fill_distiller(palette = "Spectral",
                       guide = guide_colorbar(
                         title = 'temperature (C)',
                         title.position = 'bottom',
                         title.hjust = 0.5,
                         barwidth = unit(75, units = "mm"),
                         barheight = unit(2, units = "mm"))) +
  facet_grid(deploy_id ~ .) +
  ylab("depth (meters)") +
  labs(title = "Temperature at Depth (interpreted)",
       subtitle = "temperature values interpreted to regular grid via Akima spline") +
  theme_minimal() +
  theme(legend.position = "bottom")
```

::: {.panel-tabset}

### St. Paul Island

```{r}
#| layout: [[1,1]]
#| fig-asp: 1.75
#| fig-width: 5.75
pdt_data %>% 
  filter(depth<0) %>% 
  filter(deployment_location == "St. Paul Island, AK") %>%
ggplot() +
  geom_rect(aes(xmin = x1, xmax = x2,
                ymin = prev_depth, ymax=depth,
                fill=max_te), colour=NA) +
  scale_fill_distiller(palette = "Spectral",
                   direction = -1,
                       guide = guide_colorbar(
                         title = 'temperature (C)',
                         title.position = 'bottom',
                         title.hjust = 0.5,
                         barwidth = unit(75, units = "mm"),
                         barheight = unit(2, units = "mm"))) +
  facet_grid(deploy_id ~ .) +
  ylab("depth (meters)") +
  labs(title = "Temperature at Depth (transmitted)",
       subtitle = "each bar depicts data from a single upcast as an 8-hour window") +
  theme_minimal() +
  theme(legend.position = "bottom")

pdt_nest %>% 
  filter(deployment_location == "St. Paul Island, AK") %>% 
  unnest(cols=c(temp_interp)) %>% 
  ungroup() %>% 
  select(deploy_id,doy,depth,max_te) %>% 
ggplot(aes(x = doy, y = depth))+
  geom_raster(aes(fill = max_te), interpolate=TRUE)+
  #geom_contour(aes(z = max_te), binwidth = 1, color = "black")+
  scale_x_continuous(labels = function(x) parse_date_time(x, orders="j") %>% 
                       format("%b %d"),
                     name = NULL) +
  scale_fill_distiller(palette = "Spectral",
                       guide = guide_colorbar(
                         title = 'temperature (C)',
                         title.position = 'bottom',
                         title.hjust = 0.5,
                         barwidth = unit(75, units = "mm"),
                         barheight = unit(2, units = "mm"))) +
  facet_grid(deploy_id ~ .) +
  ylab("depth (meters)") +
  labs(title = "Temperature at Depth (interpreted)",
       subtitle = "temperature values interpreted to regular grid via Akima spline") +
  theme_minimal() +
  theme(legend.position = "bottom")
```

### San Miguel Island

```{r}
#| layout: [[1,1]]
#| fig-asp: 1.75
#| fig-width: 5.75
pdt_data %>% 
  filter(depth<0) %>% 
  filter(deployment_location == "San Miguel Island, CA") %>%
ggplot() +
  geom_rect(aes(xmin = x1, xmax = x2,
                ymin = prev_depth, ymax=depth,
                fill=max_te), colour=NA) +
  scale_fill_distiller(palette = "Spectral",
                   direction = -1,
                       guide = guide_colorbar(
                         title = 'temperature (C)',
                         title.position = 'bottom',
                         title.hjust = 0.5,
                         barwidth = unit(75, units = "mm"),
                         barheight = unit(2, units = "mm"))) +
  facet_grid(deploy_id ~ .) +
  ylab("depth (meters)") +
  labs(title = "Temperature at Depth (transmitted)",
       subtitle = "each bar depicts data from a single upcast as an 8-hour window") +
  theme_minimal() +
  theme(legend.position = "bottom")

pdt_nest %>% 
  filter(deployment_location == "San Miguel Island, CA") %>% 
  unnest(cols=c(temp_interp)) %>% 
  ungroup() %>% 
  select(deploy_id,doy,depth,max_te) %>% 
ggplot(aes(x = doy, y = depth))+
  geom_raster(aes(fill = max_te), interpolate=TRUE)+
  #geom_contour(aes(z = max_te), binwidth = 1, color = "black")+
  scale_x_continuous(labels = function(x) parse_date_time(x, orders="j") %>% 
                       format("%b %d"),
                     name = NULL) +
  scale_fill_distiller(palette = "Spectral",
                       guide = guide_colorbar(
                         title = 'temperature (C)',
                         title.position = 'bottom',
                         title.hjust = 0.5,
                         barwidth = unit(75, units = "mm"),
                         barheight = unit(2, units = "mm"))) +
  facet_grid(deploy_id ~ .) +
  ylab("depth (meters)") +
  labs(title = "Temperature at Depth (interpreted)",
       subtitle = "temperature values interpreted to regular grid via Akima spline") +
    theme_minimal() +
  theme(legend.position = "bottom")
```

:::

:::

## Project Summary

In 2018, the AFSC Polar Ecosystems Program and Wildlife Computers began
collaboration on a project to develop a new family of SPLASH bio-loggers
that would provide a small footprint device capable of FastLoc GPS,
ocean temperature profiles, and on-board dive behavior summaries that
provide unbiased data and efficient transmission via Argos. Due to the
COVID-19 pandemic, the intended deployments on ribbon and spotted seals
in 2020 were not possible, and in the spring of 2022, only 2 of the 25
devices available were deployed. Instead of letting these devices sit on
the shelf for 2+ years, we have developed a plan to deploy a portion of
them on northern fur seals at San Miguel Island and northern fur seals
at St. Paul Island and Bogoslof Island in Alaska. These tags were originally 
funded by the US Navy in 2017.

These tags employ two key enhancements that have not been previously
available:

1.  Improved ocean temperature profile capabilities with a dedicated
    external thermistor probe
2.  On-board processing of time-at-depth data to create a more efficient
    dive behavior summary message that relies on empirical cumulative
    distributions instead of the typical histogram bin approach used for
    decades.

Because relatively few devices with these new capabilities have been
deployed (by MML or other researchers), there is a great need to observe
how these new devices perform, to evaluate how efficient the data
transmissions are, and to learn from real-world experience so future
deployments can be optimized for a range of study questions.