R/calc_effort.R
In ChrKo1/fecR2.0: Fishing Effort Calculator in R
Defines functions
calc_days_at_sea_trip
Documented in
calc_days_at_sea_trip
# Author: Christoph Konrad (EC JRC), Finlay Scott (EC JRC) <iago.mosqueira@jrc.ec.europa.eu>, Nuno Prista (SLU) and Thomas Reilly (Marine Scotland)
# Distributed under the terms of the European Union Public Licence (EUPL) V.1.1.
#' Calculate days at sea for a fishing trip.
#'
#' Calculate days at sea for a single fishing trip using data in the format
#' described in the package vignette \emph{checking_data}.
#'
#' The input is a single fishing trip. The format of the data should be
#' checked by \code{\link{check_format}} before calling this function
#' (see the package vignette \emph{checking_data} for more details).
#' Days at sea is reported at the gear (type and mesh size), fishing area and
#' economic zone level. The total number of days at sea is the number of
#' commenced 24 hour periods.
#' The total number of days at sea of a trip is split equally over dates on
#' which fishing occurs. The effort for each fishing date is split equally over
#' the fishing activity on that date. Active and passive gears are treated
#' equally.
#' See the vignette \emph{calculating_fishing_effort} for more details.
#' This function is called by \code{\link{calc_fishing_effort}}.
#'
#' @param trip Data.frame of the trip data
#' @return A \code{data.frame} with the days at sea by gear, fishing area
#' and economic zone.
#' @export
#' @seealso See \code{\link{calc_fishing_effort}}.
#' See the package vignette \emph{checking_data} for data preparation
#' and the vignette \emph{calculating_fishing_effort} for the calculation
#' details.
#' @examples
#' trip1 <- data.frame(
#' eunr_id = "my_boat", loa = 2000, gt = 70, kw = 400,
#' trip_id = "trip1",
#' # 4 day trip
#' depdate = "20140718", deptime = "0615", retdate = "20140721", rettime = "1615",
#' # Only fish on 2 of those
#' fishdate = c("20140719", "20140719", "20140719", "20140719", "20140720",
#' "20140720", "20140720"),
#' gear = c("OTB","OTB","OTB","GN","OTB","GN","FPO"), gear_mesh_size = c(80,80,80,50,80,50,0),
#' fishing_area = "27.4.B",
#' economic_zone = "EU",
#' rectangle = c("39F0","40F0","41F0","41F0","41F0","41F0","41F0"),
#' stringsAsFactors = FALSE
#' )
#' das <- calc_days_at_sea_trip(trip1)
calc_days_at_sea_trip <- function(trip, .int = FALSE){
if(!data.table::is.data.table(trip)) trip <- data.table::data.table(trip)
# Check that this is just 1 trip
if(.int){
# Calculate total days at sea
# Number of commenced 24 hour periods - use lubridate interval class
trip_start <- lubridate::ymd_hm(paste(trip$depdate[1],trip$deptime[1],sep=""))
trip_end <- lubridate::ymd_hm(paste(trip$retdate[1],trip$rettime[1],sep=""))
total_das <- ceiling(lubridate::int_length(lubridate::interval(trip_start, trip_end)) / (24*60*60))
# Within each unique fish date, the days effort is split equally between fishing activity
no_fishdates <- length(unique(trip$fishdate))
# Add a column of the proportion of daily effort attributed to each activity
fishdate <- NULL # Just to get rid of NOTE about visible binding when running check - seems annoying
t2 <- data.table(trip)
t2[,activity_prop := 1/length(fishdate), by = fishdate]
t2[,days_at_sea := activity_prop * (total_das/no_fishdates)]
# Collapse date and rectangle
days_at_sea <- NULL # Just to get rid of NOTE about visible binding when running check - seems annoying
return(t2[, .(days_at_sea = sum(days_at_sea)), by =
list(
eunr_id,
loa,
gt,
kw,
depdate,
deptime,
retdate,
rettime,
gear,
gear_mesh_size,
fishing_area,
economic_zone) ])
} else {
if(length(unique(trip$trip_id)) != 1){
stop("More than one trip found in data. This function only processes one trip at a time,")
}
if(!data.table::is.data.table(trip)) trip <- data.table::data.table(trip)
# Calculate total days at sea
# Number of commenced 24 hour periods - use lubridate interval class
trip_start <- lubridate::ymd_hm(paste(trip$depdate[1],trip$deptime[1],sep=""))
trip_end <- lubridate::ymd_hm(paste(trip$retdate[1],trip$rettime[1],sep=""))
total_das <- ceiling(lubridate::int_length(lubridate::interval(trip_start, trip_end)) / (24*60*60))
# Within each unique fish date, the days effort is split equally between fishing activity
no_fishdates <- length(unique(trip$fishdate))
# Add a column of the proportion of daily effort attributed to each activity
fishdate <- NULL # Just to get rid of NOTE about visible binding when running check - seems annoying
trip[,activity_prop := 1/length(fishdate), by = fishdate]
trip[,days_at_sea := activity_prop * (total_das/no_fishdates)]
# Collapse date and rectangle
days_at_sea <- NULL # Just to get rid of NOTE about visible binding when running check - seems annoying
return(trip[, .(days_at_sea = sum(days_at_sea)), by =
list(
eunr_id,
loa,
gt,
kw,
trip_id,
depdate,
deptime,
retdate,
rettime,
gear,
gear_mesh_size,
fishing_area,
economic_zone) ])
}
}
#' Calculate fishing days for a fishing trip.
#'
#' Calculate fishing days for a single fishing trip using data in the format
#' described in the package vignette \emph{checking_data}.
#'
#' The input is a single fishing trip. The format of the data should be
#' checked by \code{\link{check_format}} before calling this function
#' (see the package vignette \emph{checking_data} for more details).
#' Fishing days is reported at the gear (type and mesh size), fishing area, economic zone and rectangle level.
#' Passive and active gears are treated separately.
#' For active gears, each fishing date has 1 fishing day that is spread equally over the active gears.
#' For passive gears, each use of a passive gear is one fishing day, i.e. on fishing date can have several passive fishing days simultaneously.
#' See the vignette \emph{calculating_fishing_effort} for more details.
#' This function is called by \code{\link{calc_fishing_effort}}.
#'
#' @param trip Data.frame of the trip data
#' @return A data.frame with the fishing days by gear, fishing area, economic zone and rectangle.
#' @export
#' @seealso See \code{\link{calc_fishing_effort}}.
#' See the package vignette \emph{checking_data} for data preparation
#' and the vignette \emph{calculating_fishing_effort} for the calculation
#' details.
#' @examples
#' trip1 <- data.frame(
#' eunr_id = "my_boat", loa = 2000, gt = 70, kw = 400,
#' trip_id = "trip1",
#' # 4 day trip
#' depdate = "20140718", deptime = "0615", retdate = "20140721", rettime = "1615",
#' # Only fish on 2 of those
#' fishdate = c("20140719", "20140719", "20140719", "20140719", "20140720",
#' "20140720", "20140720"),
#' gear = c("OTB","OTB","OTB","GN","OTB","GN","FPO"), gear_mesh_size = c(80,80,80,50,80,50,0),
#' fishing_area = "27.4.B",
#' economic_zone = "EU",
#' rectangle = c("39F0","40F0","41F0","41F0","41F0","41F0","41F0"),
#' stringsAsFactors = FALSE
#' )
#' fd <- calc_fishing_days_trip(trip1)
calc_fishing_days_trip <- function(trip, .int = FALSE ){
if(!data.table::is.data.table(trip)) trip <- data.table::data.table(trip)
if (.int){
# Separate passive and active gears - gear_codes is a data set included in the package - lazy loading
gear_codes <- fecR2.0::gear_codes
passive_gears <- gear_codes[gear_codes$passive,"gear_code"]
active_gears <- gear_codes[!gear_codes$passive,"gear_code"]
active <- data.table(trip[trip$gear %in% active_gears,])
passive <- data.table(trip[trip$gear %in% passive_gears,])
# Process active gears - date which has some fishing is given 1 fishing day. This is spread equally over all active fishing activities on that date.
# Add a column of the fishing day attributed to each activity
fishdate <- NULL # Just to get rid of NOTE about visible binding when running check - seems annoying
if (nrow(active)>0) active[, `:=` (fishing_days = 1/length(fishdate), passive_gear = FALSE), by = fishdate]
# Process passive gears - each entry is a passive gear used on a day so gets 1 fishing day
if (nrow(passive)>0) passive[, `:=` (fishing_days = 1, passive_gear = TRUE)]
# Stick the results together
t1 <- merge(active, passive, all = TRUE)
# Collapse date
fishing_days <- NULL # Just to get rid of NOTE about visible binding when running check - seems annoying
return(t1[, .(fishing_days = sum(fishing_days)), by =
list(eunr_id,
loa,
gt,
kw,
depdate,
deptime,
retdate,
rettime,
gear,
gear_mesh_size,
rectangle,
fishing_area,
economic_zone) ])
} else{
# Check that this is just 1 trip
if(length(unique(trip$trip_id)) != 1){
stop("More than one trip found in data. This function only processes one trip at a time,")
}
# Separate passive and active gears - gear_codes is a data set included in the package - lazy loading
gear_codes <- fecR2.0::gear_codes
passive_gears <- gear_codes[gear_codes$passive,"gear_code"]
active_gears <- gear_codes[!gear_codes$passive,"gear_code"]
active <- data.table(trip[trip$gear %in% active_gears,])
passive <- data.table(trip[trip$gear %in% passive_gears,])
# Process active gears - date which has some fishing is given 1 fishing day. This is spread equally over all active fishing activities on that date.
# Add a column of the fishing day attributed to each activity
fishdate <- NULL # Just to get rid of NOTE about visible binding when running check - seems annoying
if (nrow(active)>0) active[, `:=` (fishing_days = 1/length(fishdate), passive_gear = FALSE), by = fishdate]
# Process passive gears - each entry is a passive gear used on a day so gets 1 fishing day
if (nrow(passive)>0) passive[, `:=` (fishing_days = 1, passive_gear = TRUE)]
# Stick the results together
t1 <- merge(active, passive, all = TRUE)
# Collapse date
fishing_days <- NULL # Just to get rid of NOTE about visible binding when running check - seems annoying
return(t1[, .(fishing_days = sum(fishing_days)), by =
list(eunr_id,
loa,
gt,
kw,
trip_id,
depdate,
deptime,
retdate,
rettime,
gear,
gear_mesh_size,
rectangle,
fishing_area,
economic_zone) ])
}
}
#' Calculate days at sea and fishing days for a full trip data set.
#'
#' Calculates the days at sea and the fishing days for each trip in a data set.
#'
#' The input is a \code{data.frame} that contains details of fishing trips.
#' The format of the data should be checked by \code{\link{check_format}} before calling this function
#' (see the package vignette \emph{checking_data} for more details on the data format).
#' See the documentation of \code{\link{calc_fishing_days_trip}} and \code{\link{calc_days_at_sea_trip}}
#' and the vignette \emph{calculating_fishing_effort} for more details
#' of how the different effort measures are calculated.
#' This function has the additional option of calling \code{\link{check_format}} before
#' the calculations are performed.
#'
#' @param dat data.frame with the details of all the fishing trips.
#' @param check_data Should the \code{\link{check_format}} function be called on the data first (default is TRUE).
#' It is not possible to run \code{\link{check_format}} with automatic corrections here. Do this yourself first.
#' @return A list with two data.frames: one with the fishing days by gear, fishing area, economic zone and rectangle,
#' the other with the days at sea by gear, fishing area and economic zone.
#' @export
#' @seealso See \code{\link{check_format}}.
#' See the package vignette \emph{checking_data} for data preparation
#' and the vignette \emph{calculating_fishing_effort} for the calculation
#' details.
#' @examples
#' trip1 <- data.frame(
#' eunr_id = "my_boat", loa = 2000, gt = 70, kw = 400,
#' trip_id = "trip1",
#' # 4 day trip
#' depdate = "20140718", deptime = "0615", retdate = "20140721", rettime = "1615",
#' # Only fish on 2 of those
#' fishdate = c("20140719", "20140719", "20140719", "20140719", "20140720",
#' "20140720", "20140720"),
#' gear = c("OTB","OTB","OTB","GN","OTB","GN","FPO"), gear_mesh_size = c(80,80,80,50,80,50,0),
#' fishing_area = "27.4.B",
#' economic_zone = "EU",
#' rectangle = c("39F0","40F0","41F0","41F0","41F0","41F0","41F0"),
#' stringsAsFactors = FALSE
#' )
#' trip2 <- data.frame(
#' eunr_id = "my_boat", loa = 2000, gt = 70, kw = 400,
#' trip_id = "trip2",
#' # 2 day trip
#' depdate = "20140718", deptime = "0615", retdate = "20140719", rettime = "0600",
#' # Only fish on 2 of those
#' fishdate = c("20140718", "20140719", "20140719", "20140719"),
#' gear = c("OTB","OTB","GN","FPO"), gear_mesh_size = c(80,80,50,0),
#' fishing_area = "27.4.B",
#' economic_zone = "EU",
#' rectangle = c("39F0","39F0"),
#' stringsAsFactors = FALSE
#' )
#' dat <- rbind(trip1, trip2)
#' effort <- calc_fishing_effort(dat)
calc_fishing_effort <- function(dat, check_data = TRUE){
# Check data first of all
if(check_data){
print("Running check on data before calculating effort")
dat <- tryCatch(check_format(dat),error=function(e) e, warning=function(w) w)
if(methods::is(dat, "warning")){
stop("Checking the input data generated a warning. Stopping here")
}
print("Data looks OK. Continuing")
}
# Get days at sea
# dat[,calc_fishing_days_trip(.SD), by = trip_id]
fd <- dat[,calc_fishing_days_trip(.SD, .int = T), by = trip_id]
das <- dat[,calc_days_at_sea_trip(.SD, .int = T), by = trip_id]
# das <- plyr::ddply(dat, "trip_id", calc_days_at_sea_trip)
# fd <- plyr::ddply(dat, "trip_id", calc_fishing_days_trip)
return(list(days_at_sea = das, fishing_days = fd))
}
ChrKo1/fecR2.0 documentation built on July 30, 2020, 9:53 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions calc_days_at_sea_trip
Documented in calc_days_at_sea_trip
# Author: Christoph Konrad (EC JRC), Finlay Scott (EC JRC) <iago.mosqueira@jrc.ec.europa.eu>, Nuno Prista (SLU) and Thomas Reilly (Marine Scotland)
# Distributed under the terms of the European Union Public Licence (EUPL) V.1.1.
#' Calculate days at sea for a fishing trip.
#'
#' Calculate days at sea for a single fishing trip using data in the format
#' described in the package vignette \emph{checking_data}.
#'
#' The input is a single fishing trip. The format of the data should be
#' checked by \code{\link{check_format}} before calling this function
#' (see the package vignette \emph{checking_data} for more details).
#' Days at sea is reported at the gear (type and mesh size), fishing area and
#' economic zone level. The total number of days at sea is the number of
#' commenced 24 hour periods.
#' The total number of days at sea of a trip is split equally over dates on
#' which fishing occurs. The effort for each fishing date is split equally over
#' the fishing activity on that date. Active and passive gears are treated
#' equally.
#' See the vignette \emph{calculating_fishing_effort} for more details.
#' This function is called by \code{\link{calc_fishing_effort}}.
#'
#' @param trip Data.frame of the trip data
#' @return A \code{data.frame} with the days at sea by gear, fishing area
#' and economic zone.
#' @export
#' @seealso See \code{\link{calc_fishing_effort}}.
#' See the package vignette \emph{checking_data} for data preparation
#' and the vignette \emph{calculating_fishing_effort} for the calculation
#' details.
#' @examples
#' trip1 <- data.frame(
#' eunr_id = "my_boat", loa = 2000, gt = 70, kw = 400,
#' trip_id = "trip1",
#' # 4 day trip
#' depdate = "20140718", deptime = "0615", retdate = "20140721", rettime = "1615",
#' # Only fish on 2 of those
#' fishdate = c("20140719", "20140719", "20140719", "20140719", "20140720",
#' "20140720", "20140720"),
#' gear = c("OTB","OTB","OTB","GN","OTB","GN","FPO"), gear_mesh_size = c(80,80,80,50,80,50,0),
#' fishing_area = "27.4.B",
#' economic_zone = "EU",
#' rectangle = c("39F0","40F0","41F0","41F0","41F0","41F0","41F0"),
#' stringsAsFactors = FALSE
#' )
#' das <- calc_days_at_sea_trip(trip1)
calc_days_at_sea_trip <- function(trip, .int = FALSE){
if(!data.table::is.data.table(trip)) trip <- data.table::data.table(trip)
# Check that this is just 1 trip
if(.int){
# Calculate total days at sea
# Number of commenced 24 hour periods - use lubridate interval class
trip_start <- lubridate::ymd_hm(paste(trip$depdate[1],trip$deptime[1],sep=""))
trip_end <- lubridate::ymd_hm(paste(trip$retdate[1],trip$rettime[1],sep=""))
total_das <- ceiling(lubridate::int_length(lubridate::interval(trip_start, trip_end)) / (24*60*60))
# Within each unique fish date, the days effort is split equally between fishing activity
no_fishdates <- length(unique(trip$fishdate))
# Add a column of the proportion of daily effort attributed to each activity
fishdate <- NULL # Just to get rid of NOTE about visible binding when running check - seems annoying
t2 <- data.table(trip)
t2[,activity_prop := 1/length(fishdate), by = fishdate]
t2[,days_at_sea := activity_prop * (total_das/no_fishdates)]
# Collapse date and rectangle
days_at_sea <- NULL # Just to get rid of NOTE about visible binding when running check - seems annoying
return(t2[, .(days_at_sea = sum(days_at_sea)), by =
list(
eunr_id,
loa,
gt,
kw,
depdate,
deptime,
retdate,
rettime,
gear,
gear_mesh_size,
fishing_area,
economic_zone) ])
} else {
if(length(unique(trip$trip_id)) != 1){
stop("More than one trip found in data. This function only processes one trip at a time,")
}
if(!data.table::is.data.table(trip)) trip <- data.table::data.table(trip)
# Calculate total days at sea
# Number of commenced 24 hour periods - use lubridate interval class
trip_start <- lubridate::ymd_hm(paste(trip$depdate[1],trip$deptime[1],sep=""))
trip_end <- lubridate::ymd_hm(paste(trip$retdate[1],trip$rettime[1],sep=""))
total_das <- ceiling(lubridate::int_length(lubridate::interval(trip_start, trip_end)) / (24*60*60))
# Within each unique fish date, the days effort is split equally between fishing activity
no_fishdates <- length(unique(trip$fishdate))
# Add a column of the proportion of daily effort attributed to each activity
fishdate <- NULL # Just to get rid of NOTE about visible binding when running check - seems annoying
trip[,activity_prop := 1/length(fishdate), by = fishdate]
trip[,days_at_sea := activity_prop * (total_das/no_fishdates)]
# Collapse date and rectangle
days_at_sea <- NULL # Just to get rid of NOTE about visible binding when running check - seems annoying
return(trip[, .(days_at_sea = sum(days_at_sea)), by =
list(
eunr_id,
loa,
gt,
kw,
trip_id,
depdate,
deptime,
retdate,
rettime,
gear,
gear_mesh_size,
fishing_area,
economic_zone) ])
}
}
#' Calculate fishing days for a fishing trip.
#'
#' Calculate fishing days for a single fishing trip using data in the format
#' described in the package vignette \emph{checking_data}.
#'
#' The input is a single fishing trip. The format of the data should be
#' checked by \code{\link{check_format}} before calling this function
#' (see the package vignette \emph{checking_data} for more details).
#' Fishing days is reported at the gear (type and mesh size), fishing area, economic zone and rectangle level.
#' Passive and active gears are treated separately.
#' For active gears, each fishing date has 1 fishing day that is spread equally over the active gears.
#' For passive gears, each use of a passive gear is one fishing day, i.e. on fishing date can have several passive fishing days simultaneously.
#' See the vignette \emph{calculating_fishing_effort} for more details.
#' This function is called by \code{\link{calc_fishing_effort}}.
#'
#' @param trip Data.frame of the trip data
#' @return A data.frame with the fishing days by gear, fishing area, economic zone and rectangle.
#' @export
#' @seealso See \code{\link{calc_fishing_effort}}.
#' See the package vignette \emph{checking_data} for data preparation
#' and the vignette \emph{calculating_fishing_effort} for the calculation
#' details.
#' @examples
#' trip1 <- data.frame(
#' eunr_id = "my_boat", loa = 2000, gt = 70, kw = 400,
#' trip_id = "trip1",
#' # 4 day trip
#' depdate = "20140718", deptime = "0615", retdate = "20140721", rettime = "1615",
#' # Only fish on 2 of those
#' fishdate = c("20140719", "20140719", "20140719", "20140719", "20140720",
#' "20140720", "20140720"),
#' gear = c("OTB","OTB","OTB","GN","OTB","GN","FPO"), gear_mesh_size = c(80,80,80,50,80,50,0),
#' fishing_area = "27.4.B",
#' economic_zone = "EU",
#' rectangle = c("39F0","40F0","41F0","41F0","41F0","41F0","41F0"),
#' stringsAsFactors = FALSE
#' )
#' fd <- calc_fishing_days_trip(trip1)
calc_fishing_days_trip <- function(trip, .int = FALSE ){
if(!data.table::is.data.table(trip)) trip <- data.table::data.table(trip)
if (.int){
# Separate passive and active gears - gear_codes is a data set included in the package - lazy loading
gear_codes <- fecR2.0::gear_codes
passive_gears <- gear_codes[gear_codes$passive,"gear_code"]
active_gears <- gear_codes[!gear_codes$passive,"gear_code"]
active <- data.table(trip[trip$gear %in% active_gears,])
passive <- data.table(trip[trip$gear %in% passive_gears,])
# Process active gears - date which has some fishing is given 1 fishing day. This is spread equally over all active fishing activities on that date.
# Add a column of the fishing day attributed to each activity
fishdate <- NULL # Just to get rid of NOTE about visible binding when running check - seems annoying
if (nrow(active)>0) active[, `:=` (fishing_days = 1/length(fishdate), passive_gear = FALSE), by = fishdate]
# Process passive gears - each entry is a passive gear used on a day so gets 1 fishing day
if (nrow(passive)>0) passive[, `:=` (fishing_days = 1, passive_gear = TRUE)]
# Stick the results together
t1 <- merge(active, passive, all = TRUE)
# Collapse date
fishing_days <- NULL # Just to get rid of NOTE about visible binding when running check - seems annoying
return(t1[, .(fishing_days = sum(fishing_days)), by =
list(eunr_id,
loa,
gt,
kw,
depdate,
deptime,
retdate,
rettime,
gear,
gear_mesh_size,
rectangle,
fishing_area,
economic_zone) ])
} else{
# Check that this is just 1 trip
if(length(unique(trip$trip_id)) != 1){
stop("More than one trip found in data. This function only processes one trip at a time,")
}
# Separate passive and active gears - gear_codes is a data set included in the package - lazy loading
gear_codes <- fecR2.0::gear_codes
passive_gears <- gear_codes[gear_codes$passive,"gear_code"]
active_gears <- gear_codes[!gear_codes$passive,"gear_code"]
active <- data.table(trip[trip$gear %in% active_gears,])
passive <- data.table(trip[trip$gear %in% passive_gears,])
# Process active gears - date which has some fishing is given 1 fishing day. This is spread equally over all active fishing activities on that date.
# Add a column of the fishing day attributed to each activity
fishdate <- NULL # Just to get rid of NOTE about visible binding when running check - seems annoying
if (nrow(active)>0) active[, `:=` (fishing_days = 1/length(fishdate), passive_gear = FALSE), by = fishdate]
# Process passive gears - each entry is a passive gear used on a day so gets 1 fishing day
if (nrow(passive)>0) passive[, `:=` (fishing_days = 1, passive_gear = TRUE)]
# Stick the results together
t1 <- merge(active, passive, all = TRUE)
# Collapse date
fishing_days <- NULL # Just to get rid of NOTE about visible binding when running check - seems annoying
return(t1[, .(fishing_days = sum(fishing_days)), by =
list(eunr_id,
loa,
gt,
kw,
trip_id,
depdate,
deptime,
retdate,
rettime,
gear,
gear_mesh_size,
rectangle,
fishing_area,
economic_zone) ])
}
}
#' Calculate days at sea and fishing days for a full trip data set.
#'
#' Calculates the days at sea and the fishing days for each trip in a data set.
#'
#' The input is a \code{data.frame} that contains details of fishing trips.
#' The format of the data should be checked by \code{\link{check_format}} before calling this function
#' (see the package vignette \emph{checking_data} for more details on the data format).
#' See the documentation of \code{\link{calc_fishing_days_trip}} and \code{\link{calc_days_at_sea_trip}}
#' and the vignette \emph{calculating_fishing_effort} for more details
#' of how the different effort measures are calculated.
#' This function has the additional option of calling \code{\link{check_format}} before
#' the calculations are performed.
#'
#' @param dat data.frame with the details of all the fishing trips.
#' @param check_data Should the \code{\link{check_format}} function be called on the data first (default is TRUE).
#' It is not possible to run \code{\link{check_format}} with automatic corrections here. Do this yourself first.
#' @return A list with two data.frames: one with the fishing days by gear, fishing area, economic zone and rectangle,
#' the other with the days at sea by gear, fishing area and economic zone.
#' @export
#' @seealso See \code{\link{check_format}}.
#' See the package vignette \emph{checking_data} for data preparation
#' and the vignette \emph{calculating_fishing_effort} for the calculation
#' details.
#' @examples
#' trip1 <- data.frame(
#' eunr_id = "my_boat", loa = 2000, gt = 70, kw = 400,
#' trip_id = "trip1",
#' # 4 day trip
#' depdate = "20140718", deptime = "0615", retdate = "20140721", rettime = "1615",
#' # Only fish on 2 of those
#' fishdate = c("20140719", "20140719", "20140719", "20140719", "20140720",
#' "20140720", "20140720"),
#' gear = c("OTB","OTB","OTB","GN","OTB","GN","FPO"), gear_mesh_size = c(80,80,80,50,80,50,0),
#' fishing_area = "27.4.B",
#' economic_zone = "EU",
#' rectangle = c("39F0","40F0","41F0","41F0","41F0","41F0","41F0"),
#' stringsAsFactors = FALSE
#' )
#' trip2 <- data.frame(
#' eunr_id = "my_boat", loa = 2000, gt = 70, kw = 400,
#' trip_id = "trip2",
#' # 2 day trip
#' depdate = "20140718", deptime = "0615", retdate = "20140719", rettime = "0600",
#' # Only fish on 2 of those
#' fishdate = c("20140718", "20140719", "20140719", "20140719"),
#' gear = c("OTB","OTB","GN","FPO"), gear_mesh_size = c(80,80,50,0),
#' fishing_area = "27.4.B",
#' economic_zone = "EU",
#' rectangle = c("39F0","39F0"),
#' stringsAsFactors = FALSE
#' )
#' dat <- rbind(trip1, trip2)
#' effort <- calc_fishing_effort(dat)
calc_fishing_effort <- function(dat, check_data = TRUE){
# Check data first of all
if(check_data){
print("Running check on data before calculating effort")
dat <- tryCatch(check_format(dat),error=function(e) e, warning=function(w) w)
if(methods::is(dat, "warning")){
stop("Checking the input data generated a warning. Stopping here")
}
print("Data looks OK. Continuing")
}
# Get days at sea
# dat[,calc_fishing_days_trip(.SD), by = trip_id]
fd <- dat[,calc_fishing_days_trip(.SD, .int = T), by = trip_id]
das <- dat[,calc_days_at_sea_trip(.SD, .int = T), by = trip_id]
# das <- plyr::ddply(dat, "trip_id", calc_days_at_sea_trip)
# fd <- plyr::ddply(dat, "trip_id", calc_fishing_days_trip)
return(list(days_at_sea = das, fishing_days = fd))
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.