The ICCAT tuna RFMO provides some high resolution observer data in the 2016 report (obtained from https://www.iccat.int/Documents/Comply/transhipmentreports_current.pdf). The data contained in this report was extracted and processed to determine how well GFW encounters and loitering events match to actual reported fish transshipments. While the maps below show the patterns for supply transshipments as well the current analysis did not consider the matching of encounters or loitering to these events, though it is apparent (from the maps) that in some cases, and for some vessels, supply transshipments also align.
What follows are some basic analysese of the dataset and then a series of maps for each transshipment/carrier vessels for each voayage documented within the ICCAT observer report. On each map I have shown the location of reported/observed transshipments of catch and observed transshipments of supplies. Along side these reported data, I have provided those events that GFW has detected as encounter and loitering events.
Finally I provide a basic analysis of how well observed transshipments are matched to encounter or loitering events, showing that while the encounters only approximate a small percentage of actual events (a not surprising result given that we have made these events rather stringent) overall ~70% loitering events may correspond to actual transshipment of catch.
Carrier Vessels |
---|
Ibuki |
Taisei Maru 24 |
Futagami |
Genta Maru |
Chitose |
Taisei Maru 15 |
Shota Maru |
Chikuma |
Lady Tuna |
Victoria 2 |
The observer data includes estimates of the amount of catch transshipped during the encounter as well as the duration of the encounters. We see that the relationship is elatively linear, but that most events are quite short. The first (lowest) vertical line shows the time cut-off for encounters (> 2 hours), while the upper line shows the time cut-off for loitering events (> 8 hours).
FALSE r.squared adj.r.squared sigma statistic p.value df logLik
FALSE 1 0.789675 0.7892501 13.67858 1858.501 1.049411e-169 2 -2004.278
FALSE AIC BIC deviance df.residual
FALSE 1 4014.557 4027.183 92616.23 495
While most events are short, this is likely only identifies the time period when fish is actually being moved from one vessel to the other. "Transshipment behavior", such as positioning of the vessels, slow speed manuevers, etc. likely occur both before and after this event. Thus event with time-cutoffs for encounters of > 2 hours and loitering events > 8 hours, we can likely detect these events.
The events occur within the ICCAT convention region and all but one within the high seas. Mapping of the vessel tracks suggests that the single event within Brazilian waters is actually an error and the location of the event was recorded improperly.
For clarity some 'zoom' maps have been provided in areas where the vessel track or the events were close together. Some vessels had two voyages, separated in time, in the dataset and both voyages are shown. Green points are locations where GFW has identified a likely transshipment or encounters. Orang points represent locations where GFW identified an loitering event (the dot is at the start of the event, the orange line extends to the end of the event). The red circles are locations where ICCAT observers report a transshipment of fish. Blue points are ICCAT reported transshipments of crew, supplies, or bait. The transshipment of supplies is reported at a lower resolution so it is less likely to fall perfectly along the vessel track. There are some cases where it appears the observer recorded the latitude or longitude incorrectly and a transshipment is offset slightly from the vessel's actual position.
Current matching first looks 12 hours forward and backward from the encounters datetime. This datetime is converted to a date and matched to any observed transshipment that occured on a date within that window. If not observed transshipment occured within this window the mismatch is identified by NAs. The distance between each encounter and each observed event is then calculated and for each encounter we calculate the minimum distance. This represents the closest match. To determine if it is actually a match we use an adjustable distance cut-off rule. For encounters (which are only identified by a mean location), we use a distance rule of 10km. Thus the encounter and its closest match have to be within 10km of one another to be considered a match.
Loitering events are identified by a start location, a mean location, and an end location, each of these is used to calculate the minimum distance between a loitering event and an observered event. Given that we have compared at the beginning, mean, and end of the event, the distance cut-off rule is more stringent, at 5km.
calc_dist_km <- function(mean_longitude, mean_latitude, lon, lat) {
p1 = c(mean_longitude, mean_latitude)
p2 = c(lon, lat)
r = 6378.137
distance = geosphere::distHaversine(p1, p2, r)
distance
}
# result <- distm(ibuki_1[ , c(3, 2)],ibuki_encounters_1[ , c(4, 3)], fun = distHaversine)
# apply(result,2,min)
#
# result <- distm(ibuki_1[ , c(3, 2)],ibuki_loitering_1[ , c(2, 1)], fun = distHaversine)
# apply(result,2,min)
#encounters
encounters_matches <- function(obs_transshipments, encounters_data, match_distance = 10) {
matches <- encounters_data %>%
mutate(start_range1 = as.Date(start_time - lubridate::hours(12)),
end_range1 = as.Date(end_time + lubridate::hours(12))) %>%
fuzzyjoin::fuzzy_left_join(obs_transshipments, by = c("start_range1" = "date",
"end_range1" = "date"), match_fun = list(`<=`, `>=`) ) %>%
mutate(distance = purrr::pmap_dbl(.l = list(mean_longitude, mean_latitude, lon, lat), .f = calc_dist_km)) %>%
group_by(start_time, end_time,mean_latitude, mean_longitude,duration_hr) %>%
mutate(min_dist = min(distance)) %>%
filter(distance == min_dist | is.na(date)) %>%
select(start_time, end_time, mean_latitude, mean_longitude,
duration_hr, date, lat, lon, vessel, transshipped_fish,
total_tonnage_obs_transshipped, min_dist) %>%
rename( enc_start = start_time, enc_end = end_time,
enc_latitude = mean_latitude,
enc_longitude = mean_longitude, enc_duration_hr = duration_hr,
trans_date = date, trans_lat = lat, trans_lon = lon,
trans_fish = transshipped_fish, tot_ton_trans = total_tonnage_obs_transshipped,
min_dist = min_dist) %>%
mutate(match = ifelse(min_dist > match_distance | is.na(min_dist), FALSE, TRUE)) %>%
select(match, everything())
fraction_matched = sum(matches$match)/nrow(matches)
results <- list(match_df = matches, frac_match = fraction_matched)
results
}
# loitering
loitering_matches <- function(obs_transshipments, loitering_data, match_distance = 5) {
mean_two_col <- function(start, end) {
mean_val = mean(c(start, end))
mean_val
}
matches <- loitering_data %>%
mutate(start_range1 = as.Date(start_timestamp - lubridate::hours(12)),
end_range1 = as.Date(end_timestamp + lubridate::hours(12))) %>%
fuzzyjoin::fuzzy_left_join(obs_transshipments, by = c("start_range1" = "date",
"end_range1" = "date"), match_fun = list(`<=`, `>=`) ) %>%
mutate(mean_lat = purrr::pmap_dbl(.l = list(start_lat,end_lat), .f = mean_two_col),
mean_lon = purrr::pmap_dbl(.l = list(start_lon,end_lon), .f = mean_two_col),
distance_to_start = purrr::pmap_dbl(.l = list(start_lon, start_lat, lon, lat), .f = calc_dist_km),
distance_to_end = purrr::pmap_dbl(.l = list(end_lon, end_lat, lon, lat), .f = calc_dist_km),
distance_to_mean = purrr::pmap_dbl(.l = list(mean_lon, mean_lat, lon, lat), .f = calc_dist_km)) %>%
group_by(start_timestamp, end_timestamp, start_lat, start_lon, tot_hours) %>%
mutate(min_dist = min(distance_to_start, distance_to_end, distance_to_mean)) %>%
filter(distance_to_start == min_dist |
distance_to_end == min_dist |
distance_to_mean == min_dist) %>%
select(start_timestamp, end_timestamp, start_lat,
start_lon, end_lat, end_lon, tot_hours, date,
lat, lon, vessel, total_tonnage_obs_transshipped,
min_dist) %>%
rename( loit_start = start_timestamp, loit_end = end_timestamp,
loit_start_latitude = start_lat, loit_start_longitude = start_lon,
loit_end_latitude = end_lat, loit_end_longitude = end_lon,
loit_duration_hr = tot_hours, trans_date = date,
trans_lat = lat, trans_lon = lon,
tot_ton_trans = total_tonnage_obs_transshipped, min_dist = min_dist) %>%
mutate(match = ifelse(min_dist > match_distance | is.na(min_dist), FALSE, TRUE)) %>%
select(match, everything())
fraction_matched = sum(matches$match)/nrow(matches)
results <- list(match_df = matches, frac_match = fraction_matched)
results
}
The alternative means of looking at matching approximates recall, identifying how many of the observed events we are able to identify using encounters and loitering events.
Here we look at that patterns as well.
match_obs_encounters <- function(obs_transshipments, encounters_data, match_distance = 10) {
encounters_data <- encounters_data %>%
mutate(start_range1 = as.Date(start_time - lubridate::hours(12)),
end_range1 = as.Date(end_time + lubridate::hours(12)))
matches <- obs_transshipments %>%
mutate(event_num = c(seq(1, nrow(obs_transshipments)))) %>%
fuzzyjoin::fuzzy_left_join(encounters_data,
by = c("date" = "start_range1",
"date" = "end_range1"),
match_fun = list(`>=`, `<=`) ) %>%
mutate(distance = purrr::pmap_dbl(.l = list(mean_longitude, mean_latitude, lon, lat),
.f = calc_dist_km)) %>%
group_by(event_num) %>%
mutate(min_dist = min(distance)) %>%
filter(distance == min_dist | is.na(min_dist)) %>%
select(event_num, start_time, end_time, mean_latitude, mean_longitude,
duration_hr, date, lat, lon, vessel, transshipped_fish,
total_tonnage_obs_transshipped, min_dist) %>%
rename( enc_start = start_time, enc_end = end_time,
enc_latitude = mean_latitude, enc_longitude = mean_longitude,
enc_duration_hr = duration_hr, trans_date = date,
trans_lat = lat, trans_lon = lon,trans_fish = transshipped_fish,
tot_ton_trans = total_tonnage_obs_transshipped, min_dist = min_dist) %>%
mutate(match = ifelse(min_dist > 10 | is.na(min_dist), FALSE, TRUE)) %>%
select(match, everything())
frac_match <- sum(matches$match)/nrow(matches)
results <- list(match_df = matches, fraction_matched = frac_match)
}
match_obs_loitering <- function(obs_transshipments, loitering_data, match_distance = 10) {
mean_two_col <- function(start, end) {
mean_val = mean(c(start, end))
mean_val
}
loitering_data <- loitering_data %>%
mutate(start_range1 = as.Date(start_timestamp - lubridate::hours(12)),
end_range1 = as.Date(end_timestamp + lubridate::hours(12)))
matches <- obs_transshipments %>%
mutate(event_num = c(seq(1, nrow(obs_transshipments)))) %>%
fuzzyjoin::fuzzy_left_join(loitering_data,
by = c("date" = "start_range1",
"date" = "end_range1"),
match_fun = list(`>=`, `<=`) ) %>%
mutate(mean_lat = purrr::pmap_dbl(.l = list(start_lat,end_lat), .f = mean_two_col),
mean_lon = purrr::pmap_dbl(.l = list(start_lon,end_lon), .f = mean_two_col),
distance_to_start = purrr::pmap_dbl(.l = list(start_lon, start_lat, lon, lat), .f = calc_dist_km),
distance_to_end = purrr::pmap_dbl(.l = list(end_lon, end_lat, lon, lat), .f = calc_dist_km),
distance_to_mean = purrr::pmap_dbl(.l = list(mean_lon, mean_lat, lon, lat), .f = calc_dist_km)) %>%
group_by(event_num) %>%
mutate(min_dist = min(distance_to_start, distance_to_end, distance_to_mean)) %>%
filter(distance_to_start == min_dist |
distance_to_end == min_dist |
distance_to_mean == min_dist |
is.na(min_dist)) %>%
select(start_timestamp, end_timestamp, start_lat, start_lon,
end_lat, end_lon, tot_hours, date, lat, lon, vessel,
total_tonnage_obs_transshipped, min_dist) %>%
rename( loit_start = start_timestamp, loit_end = end_timestamp,
loit_start_latitude = start_lat, loit_start_longitude = start_lon,
loit_end_latitude = end_lat, loit_end_longitude = end_lon,
loit_duration_hr = tot_hours, trans_date = date,
trans_lat = lat, trans_lon = lon,
tot_ton_trans = total_tonnage_obs_transshipped,min_dist = min_dist) %>%
mutate(match = ifelse(min_dist > 5 | is.na(min_dist), FALSE, TRUE)) %>%
select(match, everything())
frac_match <- sum(matches$match)/nrow(matches)
results <- list(match_df = matches, fraction_matched = frac_match)
results
}
obs_transshipment <- list(ibuki_1 = ibuki_1, ibuki_2 = ibuki_2,
taisei_maru_24_1 = taisei_maru_24_1,
taisei_maru_24_2 = taisei_maru_24_2,
futagami_transship_1 = futagami_transship_1,
futagami_transship_2 = futagami_transship_2,
genta_maru_transship_1 = genta_maru_transship_1,
chitose_transship_1 = chitose_transship_1,
taisei_maru_15_transship_1 = taisei_maru_15_transship_1,
taisei_maru_15_transship_2 = taisei_maru_15_transship_2,
shota_maru_transship_1 = shota_maru_transship_1,
chikuma_transship_1 = chikuma_transship_1,
ladytuna_transship_1 = ladytuna_transship_1,
victoria2_transship_1 = victoria2_transship_1)
encounter_events <- list(ibuki_encounters_1, ibuki_encounters_2, taisei_maru_24_encounters_1,
taisei_maru_24_encounters_2, futagami_encounters_1, futagami_encounters_2,
genta_maru_encounters_1, chitose_encounters_1, taisei_maru_15_encounters_1,
taisei_maru_15_encounters_2, shota_maru_encounters_1, chikuma_encounters_1,
ladytuna_encounters_1, victoria2_encounters_1)
loitering_events <- list(ibuki_loitering_1, ibuki_loitering_2, taisei_maru_24_loitering_1,
taisei_maru_24_loitering_2, futagami_loitering_1, futagami_loitering_2,
genta_maru_loitering_1, chitose_loitering_1,taisei_maru_15_loitering_1,
taisei_maru_15_loitering_2,shota_maru_loitering_1,chikuma_loitering_1,
ladytuna_loitering_1, victoria2_loitering_1)
encounters_match_list <- list()
loitering_match_list <- list()
transshipment_encounters_match <- list()
transshipment_loiter_match <- list()
for(i in seq_len(length(obs_transshipment))) {
encounters_match_list[names(obs_transshipment[i])] <- encounters_matches(obs_transshipment[[i]], encounter_events[[i]])
loitering_match_list[names(obs_transshipment[i])] <- match_obs_loitering(obs_transshipment[[i]], loitering_events[[i]])
transshipment_encounters_match[names(obs_transshipment[i])] <- match_obs_encounters(obs_transshipment[[i]], encounter_events[[i]])
transshipment_loiter_match[names(obs_transshipment[i])] <- match_obs_loitering(obs_transshipment[[i]], loitering_events[[i]])
}
encounters_match_tot <- dplyr::bind_rows(encounters_match_list, .id = "column_label")
loiter_match_tot <- dplyr::bind_rows(loitering_match_list, .id = "column_label")
transshipment_encounters_match_tot <- dplyr::bind_rows(transshipment_encounters_match, .id = "column_label")
transshipment_loiter_match_tot <- dplyr::bind_rows(transshipment_loiter_match, .id = "column_label")
ICCAT_observer_report_matching <-tibble::tibble(enc_match_obs = sum(encounters_match_tot$match)/nrow(encounters_match_tot),
loit_match_obs = sum(loiter_match_tot$match)/nrow(loiter_match_tot),
obs_match_enc = sum(transshipment_encounters_match_tot$match)/nrow(transshipment_encounters_match_tot),
obs_match_loit = sum(transshipment_loiter_match_tot$match)/nrow(transshipment_loiter_match_tot))
names(ICCAT_observer_report_matching) <- c('Encounters Matched\nby Observered Transshipment',
'Loitering Matched\nby Observered Transshipment',
'Observed Transshipment\nMatched by Encounter',
'Observed Transshipment\nMatched by Loitering')
#overall results
ICCAT_observer_report_matching
The results for all of the encounters and loitering data for all the vessels and voyages together. We see that roughly 2/3 of the encounters have a matched observed transshipment and over 70% of the loitering events. Alternatively, less than a quarter of the observed transshipments were matched to an encounter, though again many of these events were matched by loitering. In many cases, looking at the maps above, encounters and loitering events were associated.
Encounters Matched by Observered Transshipment | Loitering Matched by Observered Transshipment | Observed Transshipment Matched by Encounter | Observed Transshipment Matched by Loitering |
---|---|---|---|
0.674 | 0.706 | 0.236 | 0.706 |
The same analysis can be done by vessel/voyage to see that some vessels are much better matched than others. This may be due to the location where they operate, the time period when they were operating, or the vessels that they were meeting. Perhaps some transshipment vessels are more likely to meet with fishing vessels that do not operate AIS or who disable or turn off their AIS device.
Vessel/Voyage | Fraction Matched |
---|---|
Chikuma 1 | 0.909 |
Chitose 1 | 1.00 |
Futagami 1 | 0.0 |
Futagami 2 | 0.833 |
Genta Maru 1 | 0.0 |
Ibuki 1 | 0.833 |
Ibuki 2 | 1.00 |
Lady Tuna 1 | 1.00 |
Shota Maru 1 | 0.750 |
Taisei Maru 15 1 | 0.625 |
Taisei Maru 15 2 | 0.556 |
Taisei Maru 24 1 | 0.375 |
Taisei Maru 24 2 | 0.571 |
Victoria II 1 | 0.667 |
Vessel/Voyage | Fraction Matched |
---|---|
Chikuma 1 | 0.698 |
Chitose 1 | 0.833 |
Futagami 1 | 0.750 |
Futagami 2 | 0.857 |
Genta Maru 1 | 0.700 |
Ibuki 1 | 0.771 |
Ibuki 2 | 0.840 |
Lady Tuna 1 | 0.839 |
Shota Maru 1 | 0.839 |
Taisei Maru 15 1 | 0.721 |
Taisei Maru 15 2 | 0.417 |
Taisei Maru 24 1 | 0.286 |
Taisei Maru 24 2 | 0.605 |
Victoria II 1 | 0.762 |
Vessel/Voyage | Fraction Matched |
---|---|
Chikuma 1 | 0.326 |
Chitose 1 | 0.288 |
Futagami 1 | 0. |
Futagami 2 | 0.393 |
Genta Maru 1 | 0. |
Ibuki 1 | 0.229 |
Ibuki 2 | 0.200 |
Lady Tuna 1 | 0.0645 |
Shota Maru 1 | 0.355 |
Taisei Maru 15 1 | 0.302 |
Taisei Maru 15 2 | 0.278 |
Taisei Maru 24 1 | 0.143 |
Taisei Maru 24 2 | 0.132 |
Victoria II 1 | 0.381 |
Vessel/Voyage | Fraction Matched |
---|---|
Chikuma 1 | 0.698 |
Chitose 1 | 0.833 |
Futagami 1 | 0.750 |
Futagami 2 | 0.857 |
Genta Maru 1 | 0.700 |
Ibuki 1 | 0.771 |
Ibuki 2 | 0.840 |
Lady Tuna 1 | 0.839 |
Shota Maru 1 | 0.839 |
Taisei Maru 15 1 | 0.721 |
Taisei Maru 15 2 | 0.417 |
Taisei Maru 24 1 | 0.286 |
Taisei Maru 24 2 | 0.605 |
Victoria II 1 | 0.762 |