Skip to content

Instantly share code, notes, and snippets.

@natemiller
Last active July 30, 2018 04:56
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save natemiller/10e8105e87647bfa6a706ab033a4b49a to your computer and use it in GitHub Desktop.
Save natemiller/10e8105e87647bfa6a706ab033a4b49a to your computer and use it in GitHub Desktop.
GFW/ICCAT Observer Data Comparison

ICCAT Observer Data Comparison

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.

Distinct vessels in the dataset. Some vessels have multiple trips

Carrier Vessels
Ibuki
Taisei Maru 24
Futagami
Genta Maru
Chitose
Taisei Maru 15
Shota Maru
Chikuma
Lady Tuna
Victoria 2

Relationship between Transshipment Duration and Amount of Fish Transshipped.

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). unnamed-chunk-8-1

Relationship is relatively linear adj. R at 0.79

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

Most of the events are short (1.5 - 2.5 hours).

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.

unnamed-chunk-10-1

Locations of the Events within the ICCAT

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.

unnamed-chunk-12-1

MAPS CARRIER VESSEL VOYAGES

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.

IBUKI 370599000, Panama

3ELC8

03/09/2016 to 21/10/2016

VOYAGE 1

unnamed-chunk-25-1

Voyage 1, ZOOM

unnamed-chunk-26-1

Voyage 2

2017-05-16 to 2017-06-26

unnamed-chunk-33-1

TAISEI MARU 24, 431678000

Japan



Voyage 1

2016-09-15 to 2016-11-08

unnamed-chunk-42-1

Voyage 2

2017-03-28 to 2017-05-10


unnamed-chunk-48-1

Voyage 2, Zoom 1

unnamed-chunk-50-1

Voyage 2, Zoom 2

unnamed-chunk-52-1

Voyage 2, Zoom 3

unnamed-chunk-54-1

FUTAGAMI VESSEL, 636017301

Liberia
13/10/2016 to 12/12/2016
28/04/2017 to 29/06/2017


Voyage 1

unnamed-chunk-62-1

Voyage 1, Zoom

unnamed-chunk-64-1

Voyage 2

28/04/2017 to 29/06/2017

unnamed-chunk-70-1

GENTA MARU, 636017162, Liberia

31/10/2016 TO 19/12/2016
D5JO9

Voyage 1

unnamed-chunk-78-1

Voyage 1, Zoom 1

unnamed-chunk-80-1

Voyage 1, Zoom 2

unnamed-chunk-82-1



CHITOSE VESSEL 636017162, Singapore

06/12/2016 to 21/02/2017
9V6110

Voyage 1

unnamed-chunk-90-1

Voyage 1, Zoom 1

unnamed-chunk-92-1

Voyage 1, Zoom 2

unnamed-chunk-94-1



TAISEI MARU 15, 431201000, Japan

25/11/2016 to 27/01/2017
and 30/05/2017 to 24/08/2017
7JTK


Voyage 1

unnamed-chunk-102-1

Voyage 1, Zoom

unnamed-chunk-104-1

Voyage 2

30/05/2017 to 24/08/2017

unnamed-chunk-110-1



SHOTA MARU, 636017359, Liberia

01/01/2017 to 26/02/2017
D5KN7

Voyage 1

unnamed-chunk-119-1

SHOTA MARU Voyage 1, Zoom

unnamed-chunk-121-1

CHIKUMA 636017108

D5JI4 Liberia

18/02/2017 to 24/04/2017

Voyage 1

unnamed-chunk-129-1

Voyage 1, Zoom 1

unnamed-chunk-131-1

Voyage 1, Zoom 2

unnamed-chunk-133-1

LADY TUNA, 374762000, Panama

3EQX2

05-03-2017 to 23-04-2017

Voyage 1

unnamed-chunk-141-1

Voyage 1, Zoom

unnamed-chunk-143-1

VICTORIA 2, 636017275, Liberia

D5KD3

01/03/2017 to 25/05/2017

Voyage 1

unnamed-chunk-151-1

Voyage 1, Zoom 1

unnamed-chunk-153-1

Voyage 1, Zoom 2

unnamed-chunk-155-1

How well do we identify real events?

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.

Matching encounters and loitering to observed fish transshipments

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
}

Matching observed fish transshipments to encounters

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)
}

Matching observed fish transshipments to loitering

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)

Run the matching functions

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

Match by Vessel Voyage

Encounters Matched by Observered Transshipment

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

Loitering Matched by Observered Transshipment

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

Observed Transshipment Matched by Encounter

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

Observed Transshipment Matched by Loitering

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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment