The goal of sfdSAR is to make it easy to follow the procedure of calculating swept area ratio of an area of seabed by a fishing gear.
You can install the sfdSAR using
install.packages("sfdSAR", repos = "https://ices-tools-prod.r-universe.dev")For a summary of the package:
library(sfdSAR)
?sfdSARICES 2015. Report of the Working Group on Spatial Fisheries Data (WGSFD), 8-12 June 2015, ICES Headquarters, Copenhagen, Denmark. ICES CM 2015/SSGEPI:18. 150pp
ICES 2016. Interim Report of the Working Group on Spatial Fisheries Data (WGSFD), 17-20 May 2016, Brest, France. ICES CM 2016/SSGEPI:18. 244 pp
Eigaard OR, Bastardie F, Breen M, et al. (2016) Estimating seabed pressure from demersal trawls, seines, and dredges based on gear design and dimensions. ICES Journal of Marine Science, 73:27-43
Church N.J., Carter A.J., Tobin D., Edwards D., Eassom A., Cameron A., Johnson G.E., Robson, L.M. & Webb K.E. (2016) JNCC Recommended Pressure Mapping Methodology 1. Abrasion: Methods paper for creating a geo-data layer for the pressure ‘Physical Damage (Reversible Change) - Penetration and/or disturbance of the substrate below the surface of the seabed, including abrasion’. JNCC report No. 515, JNCC, Peterborough
sfdSAR is developed openly on GitHub.
Feel free to open an issue there if you encounter problems or have suggestions for future versions.
The functions in this package are intended for one purpose: to compute the swept area ratio (SAR) and the subsurface SAR of a fishing gear, which can then be summarised over years and gear groupings.
Swept Area Ratio (SAR) is computed using the algorithm described below. The main steps in the data processing are
- Determine the gear width of the VMS record according to:
- Where average gear widths are supplied these are used.
- For VMS records with missing gear widths but that have supplied average vessel characteristics (i.e. average overall vessel length or average KW engine power): use the model described in (Eigaard et al., 2016) to provide an estimate of gear width
- For VMS records with missing gear widths and missing vessel characteristics use a fill-in value provided by ICES (2015) based on a review by the JNCC or on the BENTHIS survey (Eigaard et al. 2016).
- Estimate swept area based on gear type, fishing hours (hours),
fishing speed (speed) and gear width (width) for each record (ICES,
2016, p 69), note here speed is in knots and requires to be
converted to km per hour:
- Trawl : hours x width x speed x 1.82
- Danish seine : hours / 2.591234 x (width2) / (4 π)
- Scottish seine : hours / 1.9125 x (1.5 x width2) / (4 π)
- Accumulate across gears for each year to produce annual totals of SA by c-square and gear category, and finally average over years within gear category and c-square.
- Calculate SAR values by scaling by the area of the c-squares
The code below shows how the sfdSAR functions can be used to calculate swept area ratio (SAR)
In the following examples the dplyr package is used to simplify the
data processing and a made up vms toy vms dataset (test_vms) will be
used
library(dplyr)
library(sfdSAR)
## load sample vms data
data(test_vms)
The calculation of gear with is done using the data in the benthis model parameters table:
library(icesVMS)
gear_widths <- get_benthis_parameters()
#> GETing ... https://taf.ices.dk/vms/api/gearwidths
#> no token used
#> OK (HTTP 200).
kableExtra::kable(gear_widths)| id | benthisMet | avKw | avLoa | avFspeed | subsurfaceProp | gearWidth | firstFactor | secondFactor | gearModel | gearCoefficient | contactModel |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | OT_SPF | 883.8421 | 34.38526 | 2.9 | 2.8 | 0.1015789 | 0.9652 | 68.3890 | linear | avg_oal | trawl_contact |
| 2 | SDN_DMF | 167.6765 | 18.91915 | 0 | 0 | 6.5366439 | 1948.8347 | 0.2363 | power | avg_kw | danish_seine_contact |
| 3 | OT_DMF | 441.6667 | 19.8 | 3.064286 | 7.8 | 0.1054698 | 9.6054 | 0.4337 | power | avg_kw | trawl_contact |
| 4 | OT_MIX_DMF_BEN | 691.0217 | 24.36896 | 2.911111 | 8.6 | 0.1563055 | 3.2141 | 77.9812 | linear | avg_oal | trawl_contact |
| 5 | SSC_DMF | 481.795 | 23.1175 | 0 | 5 | 6.4542120 | 4461.2700 | 0.1176 | power | avg_oal | scottish_seine_contact |
| 6 | OT_MIX | 400.6089 | 20.13774 | 2.788636 | 14.7 | 0.0613659 | 10.6608 | 0.2921 | power | avg_kw | trawl_contact |
| 7 | OT_MIX_DMF_PEL | 690.3574 | 23.745 | 3.410385 | 22 | 0.0762053 | 6.6371 | 0.7706 | power | avg_oal | trawl_contact |
| 8 | OT_MIX_CRU_DMF | 473.097 | 19.89515 | 2.629 | 22.9 | 0.1139591 | 3.9273 | 35.8254 | linear | avg_oal | trawl_contact |
| 9 | OT_MIX_CRU | 681 | 21.685 | 3.008889 | 29.2 | 0.1051172 | 37.5272 | 0.1490 | power | avg_kw | trawl_contact |
| 10 | OT_CRU | 345.5205 | 18.67739 | 2.47963 | 32.1 | 0.0789228 | 5.1039 | 0.4690 | power | avg_kw | trawl_contact |
| 11 | TBB_CRU | 210.625 | 20.765 | 2.975 | 52.2 | 0.0171507 | 1.4812 | 0.4578 | power | avg_kw | trawl_contact |
| 12 | TBB_DMF | 822.1667 | 33.8866 | 5.230851 | 100 | 0.0202760 | 0.6601 | 0.5078 | power | avg_kw | trawl_contact |
| 13 | TBB_MOL | 107.1773 | 10.14545 | 2.428571 | 100 | 0.0049306 | 0.9530 | 0.7094 | power | avg_oal | trawl_contact |
| 14 | DRB_MOL | 382.4375 | 24.59848 | 2.5 | 100 | 0.0169653 | 0.3142 | 1.2454 | power | avg_oal | trawl_contact |
This table comes from Eigaard et al. (2016), with additions from ICES (2015). And contains, for each benthis gear group, the proportion of the gear contact that also affects the subsurface, the estimated average gear width, and the coeffients and covariates of the surface contact model which relates the gear width, properties of the vessel (kw or overall length) to bottom contact.
In order to use this data a lookup table is required linking Metier
level 6 codes to the benthis gear groupings listed above. The lookup
table is given in the get_metier_lookup() function from the icesVMS
package and contains other gear groupings used in ICES outputs and was
initially developed by ICES (2015).
metier_lookup <- get_metier_lookup()
#> GETing ... https://taf.ices.dk/vms/api/MetierLookup
#> no token used
#> OK (HTTP 200).
kableExtra::kable(head(metier_lookup))| id | leMetLevel6 | fishingHours | benthisMetiers | benthisMetiers2016Wrong | metierLevel5 | metierLevel4 | jnccGrouping | fishingCategory | description | fishingCategoryFo | ecomarClassification |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | FPO_FWS_110-156_0_0 | NA | NA | NA | FPO_FWS | FPO | NA | Static | Pot | Static | NA |
| 2 | FPO_FWS_31-49_0_0 | NA | NA | NA | FPO_FWS | FPO | NA | Static | Pot | Static | NA |
| 3 | FPO_FWS\_\>0_0_0 | NA | NA | NA | FPO_FWS | FPO | NA | Static | Pot | Static | Pots_and_traps |
| 4 | FPO_MCF_0-0_0_0 | NA | NA | NA | FPO_MCF | FPO | NA | Static | Pot | Static | NA |
| 5 | FPO_MOL_0-0_0_0 | NA | NA | NA | FPO_MOL | FPO | NA | Static | Pot | Static | NA |
| 6 | FPO_MOL_0_0_0 | NA | NA | NA | FPO_MOL | FPO | NA | Static | Pot | Static | Pots_and_traps |
Linking the gearwidths and contact model information is done with the following two lines
# join widths and lookup
aux_lookup <-
gear_widths %>%
right_join(metier_lookup, by = c("benthisMet" = "benthisMetiers"))
# add aux data to vms
vms <-
aux_lookup %>%
right_join(test_vms, by = c("leMetLevel6" = "LE_MET_level6"))and the gear width model is applied using the helper function
predict_gear_width
# calculate the gear width model
vms$gearWidth_model <-
predict_gear_width(vms$gearModel, vms$gearCoefficient, vms)In general, if gearwdth is available, it is used. If average overall vessel length (oal) or average vessel power (kW) is available then the gear width model is used. Finally if none of these are avaiable an average gear width is applied. The following code implements this
# do the fillin for gear width:
# select provided average gear width, then modelled gear with, then benthis
# average if no kw or aol supplied
vms$gearWidth_filled <-
with(vms,
ifelse(!is.na(avg_gearWidth), avg_gearWidth / 1000,
ifelse(!is.na(gearWidth_model), gearWidth_model / 1000,
gearWidth)
))finaly, surface contact is computed using the appropriate surface
contact model, given by the contact_model feild, defined as:
sapply(unique(gear_widths$contactModel), function(x) body(get(x)))
#> $trawl_contact
#> {
#> fishing_hours * gear_width * fishing_speed * 1.852
#> }
#>
#> $danish_seine_contact
#> {
#> fishing_hours/2.591234 * gear_width^2/pi/4
#> }
#>
#> $scottish_seine_contact
#> {
#> fishing_hours/1.9125 * gear_width^2/pi/4 * 1.5
#> }The helper function predict_surface_contact computes the surface
contact (usage shown below). The feild subsurface_prop which has come
from the gear_width dataset can be used to compute subsurface contact
from the surface contact.
# calculate surface contact
vms$surface <-
predict_surface_contact(vms$contactModel,
vms$fishingHours,
vms$gearWidth_filled,
vms$ICES_avg_fishing_speed)
# calculate subsurface contact
vms$subsurface <- vms$surface * as.numeric(vms$subsurfaceProp) * .01Normally it is required to summarise the surface quantities, which can be done like this
# compute summaries of swept area over groups
sa <-
vms %>%
mutate(
mw_fishinghours = kw_fishinghours / 1000
) %>%
group_by(year, c_square, fishingCategoryFo) %>%
summarise(
mw_fishinghours = sum(mw_fishinghours, na.rm = TRUE),
subsurface = sum(subsurface, na.rm = TRUE),
surface = sum(surface, na.rm = TRUE)
) %>%
ungroup %>%
mutate(
lat = csquare_lat(c_square),
lon = csquare_lon(c_square)
)
#> `summarise()` has grouped output by 'year', 'c_square'. You can override using the `.groups` argument.sa
#> # A tibble: 3 x 8
#> year c_square fishingCategoryFo mw_fishinghours subsurface surface lat lon
#> <dbl> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1 2020 7400:361:206:4 Otter 15.7 0 0 46.1 -1.68
#> 2 2020 7400:361:206:4 Static 10.8 0 0 46.1 -1.68
#> 3 2020 7400:361:206:4 <NA> 0.903 0 0 46.1 -1.68In the code below, SAR is calculated for each year, then averaged over
years, resulting in a dataset of averarage SAR per c_square. Note that,
because grouping is taking place over c_square the summation in the
first group_by section is equivalent to sum(surface) / area. The
second grouping section computes averages for each c_square over all
years in the dataset.
# compute swept area ratio per year and c_square then average over years
sar <-
sa %>%
mutate(
area = csquare_area(c_square)
) %>%
group_by(c_square, year) %>%
summarise(
surface_sar = sum(surface / area, na.rm = TRUE),
subsurface_sar = sum(subsurface / area, na.rm = TRUE)
) %>%
ungroup() %>%
group_by(c_square) %>%
summarise(
surface_sar = mean(surface_sar, na.rm = TRUE),
subsurface_sar = mean(subsurface_sar, na.rm = TRUE)
)
#> `summarise()` has grouped output by 'c_square'. You can override using the `.groups` argument.
sar
#> # A tibble: 1 x 3
#> c_square surface_sar subsurface_sar
#> <chr> <dbl> <dbl>
#> 1 7400:361:206:4 0 0The steps described above are combined into one code block for convienience. This code can be applied to a larger dataset to covering a range of years, fishing gears and c_squares.
# join widths and lookup
aux_lookup <-
gear_widths %>%
right_join(metier_lookup, by = c("benthisMet" = "benthisMetiers"))
# add aux data to vms
vms <-
aux_lookup %>%
right_join(test_vms, by = c("leMetLevel6" = "LE_MET_level6"))
# calculate the gear width model
vms$gearWidth_model <-
predict_gear_width(vms$gearModel, vms$gearCoefficient, vms)
# do the fillin for gear width:
# select provided average gear width, then modelled gear with, then benthis
# average if no kw or aol supplied
vms$gearWidth_filled <-
with(vms,
ifelse(!is.na(avg_gearWidth), avg_gearWidth / 1000,
ifelse(!is.na(gearWidth_model), gearWidth_model / 1000,
gearWidth)
))
# calculate surface contact
vms$surface <-
predict_surface_contact(vms$contactModel,
vms$fishingHours,
vms$gearWidth_filled,
vms$ICES_avg_fishing_speed)
# calculate subsurface contact
vms$subsurface <- vms$surface * as.numeric(vms$subsurfaceProp) * .01
# compute summaries of swept area over groups
sa <-
vms %>%
mutate(
mw_fishinghours = kw_fishinghours / 1000
) %>%
group_by(year, c_square, fishingCategoryFo) %>%
summarise(
mw_fishinghours = sum(mw_fishinghours, na.rm = TRUE),
subsurface = sum(subsurface, na.rm = TRUE),
surface = sum(surface, na.rm = TRUE)
) %>%
ungroup %>%
mutate(
lat = csquare_lat(c_square),
lon = csquare_lon(c_square)
)
#> `summarise()` has grouped output by 'year', 'c_square'. You can override using the `.groups` argument.
# compute swept area ratio per year and c_square then average over years
sar <-
sa %>%
mutate(
area = csquare_area(c_square)
) %>%
group_by(c_square, year) %>%
summarise(
surface_sar = sum(surface / area, na.rm = TRUE),
subsurface_sar = sum(subsurface / area, na.rm = TRUE)
) %>%
ungroup() %>%
group_by(c_square) %>%
summarise(
surface_sar = mean(surface_sar, na.rm = TRUE),
subsurface_sar = mean(subsurface_sar, na.rm = TRUE)
)
#> `summarise()` has grouped output by 'c_square'. You can override using the `.groups` argument.
sar
#> # A tibble: 1 x 3
#> c_square surface_sar subsurface_sar
#> <chr> <dbl> <dbl>
#> 1 7400:361:206:4 0 0