8000 GitHub - roimartins/sfdSAR: Functions to calculate Swept area ratio and Surface and subsurface abrasion from VMS data developed at WGSFD
[go: up one dir, main page]
More Web Proxy on the site http://driver.im/
Skip to content

Functions to calculate Swept area ratio and Surface and subsurface abrasion from VMS data developed at WGSFD

License

Notifications You must be signed in to change notification settings

roimartins/sfdSAR

 
 

Folders and files

NameName
Last commit message
Last commit date

Latest commit

 

History

30 Commits
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 

Repository files navigation

Build Status

ICES Logo

sfdSAR

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.

Installation

You can install the sfdSAR from GitHub using

devtools::install_github("ices-tools-dev/sfdSAR")

Usage

For a summary of the package:

library(sfdSAR)
?sfdSAR

References

ICES 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

Development

sfdSAR is developed openly on GitHub.

Feel free to open an issue there if you encounter problems or have suggestions for future versions.

Example

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

  1. 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).
  2. 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 π)
  3. 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.
  4. 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)

1. Determine gear widths

The calculation of gear with is done using the data in the gear_widths table:

data(gear_widths)
kableExtra::kable(gear_widths)

benthis_met

subsurface_prop

gearWidth

a

b

gear_model

gear_coefficient

contact_model

OT_CRU

32.1

0.0789228

5.1039

0.4690

power

avg_kw

trawl_contact

OT_DMF

7.8

0.1054698

9.6054

0.4337

power

avg_kw

trawl_contact

OT_MIX

14.7

0.0613659

10.6608

0.2921

power

avg_kw

trawl_contact

OT_MIX_CRU

29.2

0.1051172

37.5272

0.1490

power

avg_kw

trawl_contact

TBB_CRU

52.2

0.0171507

1.4812

0.4578

power

avg_kw

trawl_contact

TBB_DMF

100.0

0.0202760

0.6601

0.5078

power

avg_kw

trawl_contact

OT_MIX_DMF_PEL

22.0

0.0762053

6.6371

0.7706

power

avg_oal

trawl_contact

TBB_MOL

100.0

0.0049306

0.9530

0.7094

power

avg_oal

trawl_contact

DRB_MOL

100.0

0.0169653

0.3142

1.2454

power

avg_oal

trawl_contact

OT_MIX_DMF_BEN

8.6

0.1563055

3.2141

77.9812

linear

avg_oal

trawl_contact

OT_MIX_CRU_DMF

22.9

0.1139591

3.9273

35.8254

linear

avg_oal

trawl_contact

OT_SPF

2.8

0.1015789

0.9652

68.3890

linear

avg_oal

trawl_contact

SDN_DMF

0.0

6.5366439

1948.8347

0.2363

power

avg_kw

danish_seine_contact

SSC_DMF

5.0

6.4542120

4461.2700

0.1176

power

avg_oal

scottish_seine_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 metier_lookup dataset and contains other gear groupings used in ICES outputs and was initially developed by ICES (2015).

data(metier_lookup)
kableExtra::kable(head(metier_lookup))

LE_MET_level6

Benthis_metiers

Metier_level5

Metier_level4

JNCC_grouping

Fishing_category

Fishing_category_FO

Description

FPO_FWS_110-156_0_0

NA

FPO_FWS

FPO

NA

Static

Static

Pot

FPO_FWS_31-49_0_0

NA

FPO_FWS

FPO

NA

Static

Static

Pot

FPO_FWS_>0_0_0

NA

FPO_FWS

FPO

NA

Static

Static

Pot

FPO_MCF_0-0_0_0

NA

FPO_MCF

FPO

NA

Static

Static

Pot

FPO_MOL_0-0_0_0

NA

FPO_MOL

FPO

NA

Static

Static

Pot

FPO_MOL_0_0_0

NA

FPO_MOL

FPO

NA

Static

Static

Pot

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("benthis_met" = "Benthis_metiers"))

# add aux data to vms
vms <-
  aux_lookup %>%
  right_join(test_vms, by = c("LE_MET_level6", "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$gear_model, vms$gear_coefficient, 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)
    ))

Predicting surface contact

finaly, surface contact is computed using the appropriate surface contact model, given by the contact_model feild, defined as:

sapply(unique(gear_widths$contact_model), 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$contact_model,
                          vms$fishing_hours,
                          vms$gearWidth_filled,
                          vms$ICES_avg_fishing_speed)
# calculate subsurface contact
vms$subsurface <- vms$surface * vms$subsurface_prop * .01

Summarising accross months etc.

Normally 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, Fishing_category_FO) %>%
    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)
  )
sa
#> # A tibble: 3 x 8
#>    year c_square Fishing_categor~ mw_fishinghours subsurface surface   lat
#>   <dbl> <chr>    <chr>                      <dbl>      <dbl>   <dbl> <dbl>
#> 1  2020 7400:36~ <NA>                       0.903       0        0    46.1
#> 2  2020 7400:36~ Otter                     15.7         2.00    15.5  46.1
#> 3  2020 7400:36~ Static                    10.8         0        0    46.1
#> # ... with 1 more variable: lon <dbl>

Computing Swept Area Ratio (SAR)

In 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)
    )
sar
#> # A tibble: 1 x 3
#>   c_square       surface_sar subsurface_sar
#>   <chr>                <dbl>          <dbl>
#> 1 7400:361:206:4       0.721         0.0934

All in one

The 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("benthis_met" = "Benthis_metiers"))

# add aux data to vms
vms <-
  aux_lookup %>%
  right_join(test_vms, by = c("LE_MET_level6", "LE_MET_level6"))

# calculate the gear width model
vms$gearWidth_model <-
  predict_gear_width(vms$gear_model, vms$gear_coefficient, 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$contact_model,
                          vms$fishing_hours,
                          vms$gearWidth_filled,
                          vms$ICES_avg_fishing_speed)
# calculate subsurface contact
vms$subsurface <- vms$surface * vms$subsurface_prop * .01

# compute summaries of swept area over groups
sa <-
  vms %>%
    mutate(
      mw_fishinghours = kw_fishinghours / 1000
    ) %>%
    group_by(year, c_square, Fishing_category_FO) %>%
    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)
  )

# 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)
    )
sar
#> # A tibble: 1 x 3
#>   c_square       surface_sar subsurface_sar
#>   <chr>                <dbl>          <dbl>
#> 1 7400:361:206:4       0.721         0.0934

About

Functions to calculate Swept area ratio and Surface and subsurface abrasion from VMS data developed at WGSFD

Resources

License

Stars

Watchers

Forks

312D

Releases

No releases published

Packages

No packages published

Languages

  • R 100.0%
0