Combined stations and predators

Sightings and stations

Visual description of line transect and point station aggregation, for supplemental.

Code
points_to_line <- function(pts) {
  pts %>% 
    group_by(segmentid) %>% 
    summarize(begin = paste0(first(processID), first(interval)),
              end = paste0(last(processID), last(interval)),
              lbl = format(first(UTC_start), "%b %d %Y"),
              do_union = FALSE) %>% 
    mutate(segmentid = factor(segmentid, labels = lbl)) %>% 
    st_cast("LINESTRING")
}

tow_origin <- as.POSIXct("1899-12-31", tz = "UTC")
station_prj <- slice(zoop_sf, 25) %>% 
  st_transform(ant_proj()) %>% 
  mutate(tow.UTC = date.tow + (start.time.UTC - tow_origin),
         lbl = format(tow.UTC, "%b %d"))
station_buffer <- st_buffer(station_prj, 15e3)
station_bbox <- st_bbox(station_buffer) %>% 
  expand_bbox(1.5)
transect_prj <- effort_sf %>% 
  filter(between(UTC_start, 
                 station_prj$tow.UTC - days(3),
                 station_prj$tow.UTC + days(3))) %>% 
  st_transform(ant_proj()) %>% 
  st_intersection(station_buffer) %>% 
  mutate(lag = UTC_start - lag(UTC_start, default = UTC_start[1]),
         segmentid = factor(cumsum(lag > hours(6))))
transect_line <- transect_prj %>% 
  points_to_line()
transect_prj2 <- effort_sf %>% 
  filter(year == station_prj$Year) %>% 
  st_transform(ant_proj()) %>% 
  st_crop(station_bbox) %>% 
  mutate(lag = UTC_start - lag(UTC_start, default = UTC_start[1]),
         segmentid = factor(cumsum(lag > hours(6))))
transect_line2 <- transect_prj2 %>% 
  points_to_line()

transect_endpoints <- transect_prj2 %>% 
  filter(paste0(processID, interval) %in% c(transect_line2$begin, 
                                            transect_line2$end))

ant_basemap() +
  geom_sf(data = station_buffer,
          fill = "grey50",
          alpha = 0.1,
          linetype = "dashed") +
  geom_sf(aes(color = segmentid),
          transect_line2,
          linetype = "dotted",
          linewidth = 1) +
  geom_sf(aes(color = segmentid),
          transect_line,
          linewidth = 1) +
  geom_sf(data = station_prj,
          shape = 23,
          size = 4,
          fill = "gold") +
  scale_color_manual(values = c("firebrick", "cornflowerblue")) +
  coord_ant(station_bbox) +
  theme(legend.position = c(0.03, 0.98),
        legend.justification = c(0, 1),
        legend.title = element_blank())

Figure 1: Biophysical observations (e.g., macrozooplankton net tows and CTD casts) collected at stations (yellow point) were associated with visual surveys for predators collected along line transects. All visual surveys conducted within 15 km (shaded circle) and 3 days were aggregated with station observations to form sites. In this example, the station was sampled on August 15, 2016 and visual surveys were condected within 15 km of the station twice: on August 15 (red) and on August 23 (blue). Only the visual surveys collected on August 15 were associated with this site.

Station locations on predator (five most abundant) count maps. Spatially restricted to station transects.

Code
top_five <- predators_agg %>% 
  group_by(species) %>% 
  summarize(total_count = sum(count)) %>% 
  arrange(desc(total_count)) %>%
  slice(1:5)

topfive_sf <- predators_agg %>% 
  semi_join(top_five, by = "species") %>% 
  latlon_to_sf(coords = c("lon_mean", "lat_mean"))

topfive_stars <- rasterize_counts(topfive_sf, res = 2.5e4)

zoop_sf <- latlon_to_sf(zoop, 
                        coords = c("dec.longitude", "dec.latitude")) %>% 
  st_transform(ant_proj()) %>% 
  rename(year = Year)
zoop_buffers_20k <- st_buffer(zoop_sf, 20e3)

map_lim <- st_bbox(zoop_sf) %>% 
  project_bbox() %>% 
  expand_bbox(factor = 1.2)

ant_basemap() +
  stars::geom_stars(aes(fill = count), data = topfive_stars) +
  geom_sf(aes(color = time.of.day), zoop_sf, size = 0.2) +
  scale_x_continuous(breaks = c(-65, -60, -55)) +
  scale_y_continuous(breaks = c(-66, -64, -62, -60)) +
  scale_fill_gradient(low = "lightblue", high = "darkred",
                      trans = scales::pseudo_log_trans(),
                      breaks = c(0, 25, 100, 400, 1000, 4000),
                      na.value = NA) +
  scale_color_manual(values = tod_pal()) +
  guides(color = guide_legend(override.aes = list(size = 2))) +
  coord_ant(map_lim) +
  facet_grid(species ~ year) +
  expand_limits(fill = 0) +
  theme(axis.text.x = element_text(size = 7),
        legend.position = "bottom",
        legend.title = element_blank())

As above, but for species of interest (Gentoo Penguins, Blue Petrels, Antarctic Terns, Leopard Seals, and Killer Whales).

Code
soi <- c("GEPN", "BLPT", "ANTE", "LESE", "KIWH")

soi_sf <- predators_agg %>% 
  filter(species %in% soi) %>% 
  latlon_to_sf(coords = c("lon_mean", "lat_mean"))

soi_stars <- rasterize_counts(soi_sf, res = 2.5e4)

ant_basemap() +
  stars::geom_stars(aes(fill = count), data = soi_stars) +
  geom_sf(aes(color = time.of.day), zoop_sf, size = 0.2) +
  scale_x_continuous(breaks = c(-65, -60, -55)) +
  scale_y_continuous(breaks = c(-66, -64, -62, -60)) +
  scale_fill_gradient(low = "lightblue", high = "darkred",
                      trans = scales::pseudo_log_trans(),
                      breaks = c(0, 25, 100, 400, 1000, 4000),
                      na.value = NA) +
  scale_color_manual(values = tod_pal()) +
  guides(color = guide_legend(override.aes = list(size = 2))) +
  coord_ant(map_lim) +
  facet_grid(species ~ year) +
  expand_limits(fill = 0) +
  theme(axis.text.x = element_text(size = 7),
        legend.position = "bottom",
        legend.title = element_blank())

Aggregated ice observations

Code
ice_qa <- zoop_sf %>% 
  right_join(stations_ice, by = "amlr.station") %>%
  distinct(amlr.station, ice_type, ice_intervals, ice_type_freq) %>%
  mutate(n_obs = ice_intervals,
         n_mode = round(ice_type_freq, digits = 0))

Each station was associated with the modal ice type (multi-year, first-year, thin, or open) from the underway observations. This figure shows how frequent the modal ice type was at each station. The two grey lines represent 1:1 and 2:1. Stations falling on the upper line had uniform ice category observations i.e., every interval within 15 km had the same ice category. Stations falling below the lower line had highly mixed ice category observations i.e., the most frequent ice category was observed at less than half the intervals within 15 km of the station.

The frequency of the modal ice type was 90% or greater for 57.8% of stations. The modal ice type was <50% frequency at just 10 stations (<5% of total stations).

Code
ggplot(ice_qa, aes(n_obs, n_mode)) +
  geom_abline(slope = c(1, 0.5), intercept = 0, color = "grey50") +
  geom_point(alpha = 0.5) +
  labs(x = "Count of intervals with ice category observation",
       y = "Count of intervals with most frequent ice category") +
  coord_fixed() +
  facet_wrap(~ ice_type, ncol = 2) +
  theme_classic()

Code
ice_sf <- station_effort %>% 
  select(amlr.station, year) %>% 
  right_join(stations_ice, by = "amlr.station")

ant_basemap() +
  geom_sf(aes(color = ice_type), 
          ice_sf,
          size = 0.5) +
  scale_color_brewer("Ice category", palette = "YlGnBu") +
  guides(color = guide_legend(override.aes = list(size = 5))) +
  facet_wrap(~ year) +
  theme(legend.position = "left")

Code
ice_type_grand_total_row <- stations_ice %>% 
  mutate(YEAR = str_extract(amlr.station, "AMLR([0-9]{4}).*", 1)) %>% 
  count(ice_type) %>% 
  pivot_wider(names_from = "ice_type", 
              values_from = "n", 
              values_fill = 0) %>% 
  mutate(TOTAL = OPEN + THIN + FY + MY,
         across(-TOTAL, \(x) x / TOTAL),
         YEAR = "Total")

stations_ice %>% 
  mutate(YEAR = str_extract(amlr.station, "AMLR([0-9]{4}).*", 1)) %>% 
  count(YEAR, ice_type) %>% 
  pivot_wider(names_from = "ice_type", 
              values_from = "n", 
              values_fill = 0) %>% 
  mutate(TOTAL = OPEN + THIN + FY + MY,
         across(c(OPEN, THIN, FY, MY), \(x) x / TOTAL)) %>% 
  rbind(ice_type_grand_total_row) %>% 
  mutate(across(-c(TOTAL, YEAR), scales::percent)) %>% 
  knitr::kable()
YEAR OPEN THIN FY MY TOTAL
2012 93.3% 6.7% 0.0% 0.00% 15
2013 6.7% 48.9% 44.4% 0.00% 45
2014 13.4% 14.9% 71.6% 0.00% 67
2015 21.7% 61.7% 16.7% 0.00% 60
2016 15.4% 59.6% 23.1% 1.92% 52
Total 19.7% 42.3% 37.7% 0.42% 239
Code
stations_ice %>% 
  mutate(year = str_extract(amlr.station, "AMLR([0-9]{4}).*", 1)) %>% 
  count(year, ice_type) %>% 
  group_by(year) %>% 
  mutate(frac = n / sum(n)) %>% 
  ungroup() %>% 
  mutate(ice_type = fct_rev(ice_type)) %>% 
  ggplot(aes(year, frac, fill = ice_type)) +
  geom_col() +
  scale_fill_brewer(palette = "Blues") +
  scale_y_continuous("Sea ice composition", labels = scales::percent) +
  theme_minimal() +
  theme(axis.title.x = element_blank(),
        legend.position = "bottom",
        legend.title = element_blank())

Code
stations_ice %>% 
  mutate(year = str_extract(amlr.station, "AMLR([0-9]{4}).*", 1)) %>% 
  group_by(year, ice_type) %>% 
  summarize(mean_cov = mean(ice_coverage) / 10,
            n = n(),
            .groups = "drop_last") %>% 
  mutate(n = sum(n),
         se_cov = sqrt(mean_cov * (1 - mean_cov) / n)) %>% 
  ungroup() %>% 
  mutate(ice_type = fct_rev(ice_type)) %>% 
  ggplot(aes(year, mean_cov, fill = ice_type)) +
  geom_errorbar(aes(ymin = mean_cov - se_cov, ymax = mean_cov + se_cov),
                width = 0.2,
                color = "grey50",
                position = "dodge") +
  geom_point(size = 2, 
             shape = 21, 
             color = "grey50", 
             position = position_dodge(width = 0.2)) +
  scale_fill_brewer(palette = "Blues") +
  scale_y_continuous(limits = c(NA, 1),
                     labels = scales::percent) +
  theme_minimal() +
  theme()

Code
stations_ice %>% 
  mutate(year = str_extract(amlr.station, "AMLR([0-9]{4}).*", 1)) %>% 
  group_by(year) %>% 
  summarize(mean = mean(ice_coverage),
            sd = sd(ice_coverage),
            .groups = "drop") %>% 
  mutate(mean_sd = str_glue("{format(mean, digits = 2)} \U00B1 {format(sd, digits = 2)}")) %>% 
  knitr::kable()
year mean sd mean_sd
2012 0.2931909 0.4293444 0.29 ± 0.43
2013 5.5876881 2.1224223 5.59 ± 2.12
2014 4.1721131 2.5027168 4.17 ± 2.50
2015 4.8113233 3.1830837 4.81 ± 3.18
2016 5.4245213 2.9414936 5.42 ± 2.94

Effort

Number of stations

Total of 245 stations. Breakdown by year:

Code
predators_stations %>% 
  distinct(amlr.station) %>% 
  mutate(year = str_extract(amlr.station, "AMLR([0-9]{4}).*", 1)) %>% 
  count(year)
# A tibble: 5 × 2
  year      n
  <chr> <int>
1 2012     19
2 2013     47
3 2014     68
4 2015     60
5 2016     51

Line transects

Code
survey_km <- predators_stations %>% 
  distinct(amlr.station, survey_km) %>% 
  pull(survey_km)
mean_km <- format(mean(survey_km), digits = 3) 
sd_km <- format(sd(survey_km), digits = 3) 

30.2 \(\pm\) 10.3 km of survey effort associated with each station.

Ice and effort combined

Code
percent <- partial(scales::percent, accuracy = 0.1)

ice_type_lookup = c(
  OPEN = "Open water",
  THIN = "Thin ice",
  FY = "First-year ice",
  MY = "Multi-year ice"
)

ice_table <- stations_ice %>% 
  mutate(year = str_extract(amlr.station, "AMLR([0-9]{4}).*", 1)) %>% 
  group_by(year, ice_type) %>% 
  summarize(n_year_type = n(),
            ice_mean = mean(ice_coverage / 10),
            .groups = "drop_last") %>% 
  mutate(n_year = sum(n_year_type),
         ice_se = sqrt(ice_mean * (1 - ice_mean) / n_year)) %>% 
  ungroup() %>% 
  transmute(year,
            ice_type = ice_type_lookup[ice_type],
            ice_val = str_glue("{n_year_type} ({percent(ice_mean)} \U00B1 {percent(ice_se)})")) %>% 
  pivot_wider(names_from = ice_type, 
              values_from = ice_val, 
              values_fill = "0") %>% 
  rbind(
    stations_ice %>% 
      mutate(year = str_extract(amlr.station, "AMLR([0-9]{4}).*", 1)) %>% 
      group_by(ice_type) %>% 
      summarize(n_type = n(),
                ice_mean = mean(ice_coverage / 10)) %>% 
      mutate(ice_se = sqrt(ice_mean * (1 - ice_mean) / sum(n_type)),
             ice_val = str_glue("{n_type} ({percent(ice_mean)} \U00B1 {percent(ice_se)})")) %>% 
      transmute(year = "Total", ice_type = ice_type_lookup[ice_type], ice_val = str_glue("{n_type} ({percent(ice_mean)} \U00B1 {percent(ice_se)})")) %>% 
      pivot_wider(names_from = ice_type, 
              values_from = ice_val)
  )

effort_table <- predators_stations %>%
  distinct(amlr.station, survey_km) %>% 
  mutate(year = str_extract(amlr.station, "AMLR([0-9]{4}).*", 1)) %>% 
  group_by(year) %>% 
  summarize(`Stations sampled` = n(),
            mean_km = mean(survey_km),
            sd_km = sd(survey_km),
            `Effort per station (km)` = str_glue("{sprintf('%0.1f', mean_km)} \U00B1 {sprintf('%0.1f', sd_km)}")) %>% 
  select(year, `Stations sampled`, `Effort per station (km)`) %>% 
  rbind(
    predators_stations %>% 
      distinct(amlr.station, survey_km) %>% 
      mutate(year = str_extract(amlr.station, "AMLR([0-9]{4}).*", 1)) %>% 
      summarize(
        year = "Total",
        `Stations sampled` = n(),
        `Effort per station (km)` = str_glue("{sprintf('%0.1f', mean(survey_km))} \U00B1 {sprintf('%0.1f', sd(survey_km))}")
      )
  )

effort_table %>% 
  left_join(ice_table, by = "year") %>% 
  knitr::kable() %>% 
  kableExtra::add_header_above(c(" ", "Survey effort" = 2, "Ice conditions" = 4))
Survey effort
Ice conditions
year Stations sampled Effort per station (km) Open water Thin ice First-year ice Multi-year ice
2012 19 34.9 ± 8.8 14 (2.4% ± 4.0%) 1 (10.0% ± 7.7%) 0 0
2013 47 38.5 ± 13.5 3 (16.3% ± 5.5%) 22 (51.2% ± 7.5%) 20 (67.0% ± 7.0%) 0
2014 68 26.6 ± 7.0 9 (10.5% ± 3.7%) 10 (55.2% ± 6.1%) 48 (44.8% ± 6.1%) 0
2015 60 27.8 ± 8.5 13 (4.6% ± 2.7%) 37 (56.7% ± 6.4%) 10 (73.1% ± 5.7%) 0
2016 51 28.4 ± 8.3 8 (7.8% ± 3.7%) 31 (59.2% ± 6.8%) 12 (75.8% ± 5.9%) 1 (13.0% ± 4.7%)
Total 245 30.2 ± 10.3 47 (6.4% ± 1.6%) 101 (55.6% ± 3.2%) 90 (57.0% ± 3.2%) 1 (13.0% ± 2.2%)