diff --git a/NAMESPACE b/NAMESPACE index 8e72e97e..cc7b3a5d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,5 @@ # Generated by roxygen2: do not edit by hand -export(apply_filter_predicate) export(calc_animal_pos) export(check_species) export(example_dataset) @@ -19,18 +18,6 @@ export(get_record_table) export(get_scientific_name) export(get_species) export(map_dep) -export(pred) -export(pred_and) -export(pred_gt) -export(pred_gte) -export(pred_in) -export(pred_lt) -export(pred_lte) -export(pred_na) -export(pred_not) -export(pred_notin) -export(pred_notna) -export(pred_or) export(read_camtrap_dp) export(read_camtrapdp) export(read_wi) diff --git a/R/filter_predicates.R b/R/filter_predicates.R deleted file mode 100644 index 7bcf9bb0..00000000 --- a/R/filter_predicates.R +++ /dev/null @@ -1,536 +0,0 @@ -#' Filter predicate -#' -#' @param arg (character) The key for the predicate. -#' See "Keys" below. -#' @param value (various) The value for the predicate. -#' @param ... For `pred_or()` or `pred_and()`: one or more objects of -#' class `filter_predicate`, created by any other `pred*` function. -#' @return A predicate object. -#' An object of class predicate is a list with the following elements: -#' - `arg`: A (list of) character with all arguments in the predicate(s). -#' - `value`: A (list of) character with all values in the predicate(s). -#' - `type`: A (list of) character with all predicate types, see section -#' "predicate methods" here below. -#' - `expr`: A character: body of a filter expression. -#' @family filter functions -#' @rdname filter_predicate -#' @export -#' @section Predicate methods and their equivalent types: -#' `pred*` functions are named for the 'type' of operation they do, inspired by -#' GBIF [occurrence predicates]( -#' https://www.gbif.org/developer/occurrence#predicates) -#' -#' The following functions take one key and one value and are associated to the -#' following types: -#' - `pred`: equals -#' - `pred_not`: notEquals -#' - `pred_lt`: lessThan -#' - `pred_lte`: lessThanOrEquals -#' - `pred_gt`: greaterThan -#' - `pred_gte`: greaterThanOrEquals -#' - `pred_like`: like (NOT IMPLEMENTED YET!) -#' -#' The following function is only for geospatial queries, and only accepts a -#' WKT string: -#' - `pred_within`: within (NOT IMPLEMENTED YET!) -#' -#' The following functions are only for stating that you do (not) want a key to -#' be `NA`, so only accepts one key: -#' - `pred_na`: isNA -#' - `pred_notna`: isNotNA -#' -#' The following two functions accept multiple individual filter predicates, -#' separating them by either "and" or "or": -#' - `pred_and`: and -#' - `pred_or`: or -#' -#' The following function is special in that it accepts a single key but many -#' values, stating that you want to search for all the listed values, e.g. -#' one of the locations in: "B_ML_val 05_molenkreek", "B_ML_val 03_De Val" and -#' "B_ML_val 06_Oostpolderkreek" -#' - `pred_in`: in -#' - `pred_notin`: notIn -#' -#' @section What happens internally: -#' Internally, the input to `pred*` functions turn into a character string, -#' which forms the body of a filter expression. -#' For example: -#' -#' `pred("tags", "boven de stroom")` gives: -#' -#' ``` -#' $arg -#' [1] "tags" -#' -#' $value -#' [1] "boven de stroom" -#' -#' $type -#' [1] "equals" -#' -#' $expr -#' (tags == "boven de stroom") -#' ``` -#' -#' `pred_gt("latitude", 51.27)` gives, (only `expr` element shown): -#' -#' ``` -#' (latitude > 51.27) -#' ``` -#' -#' `pred_or()` gives: -#' -#' ``` -#' ((tags == "boven de stroom") | (latitude > 51.28)) -#' ``` -#' -#' `pred_or()` gives: -#' -#' ``` -#' ((tags == "boven de stroom") & (latitude > 51.28)) -#' ``` -#' -#' @section Keys: -#' Acceptable arguments to the `key` parameter are the column names of the -#' data frame you are applying the filter predicates. -#' -#' @examples -#' # One arg one value predicates -#' pred("scientificName", "Anas platyrhynchos") -#' pred("tags", "boven de stroom") -#' pred_gt("latitude", 51.18) -#' pred_gte("latitude", 51.18) -#' pred_lt("longitude", 3.95) -#' pred_lte("longitude", 3.95) -#' pred_not("locationName", "B_DL_val 3_dikke boom") -#' -#' # and/or predicates -#' pred_and(pred_lt("longitude", 3.59), pred_gt("latitude", 51.28)) -#' pred_or(pred_gte("count", 2), pred("vernacular_name", "Norway Rat")) -#' -#' # Use dates as argument -#' start_date <- as.Date("2020-06-03", format = "%Y-%m-%d") -#' end_date <- as.Date("2020-06-10", format = "%Y-%m-%d") -#' pred_or(pred_gte("start", start_date), pred_lte("end", end_date)) -#' -#' # Use datetimes (POSIXct) as argument -#' start_date <- lubridate::as_datetime("2020-06-03") -#' end_date <- lubridate::as_datetime("2020-06-10") -#' pred_or(pred_gte("start", start_date), pred_lte("end", end_date)) -#' -#' # One arg multiple values predicates -#' locations <- c("B_ML_val 03_De Val", "B_ML_val 05_molenkreek") -#' pred_in("location_name", locations) -#' pred_notin("location_name", locations) -#' start_dates <- lubridate::as_datetime(c("2020-06-03 20:10:18", "2020-06-03 20:04:33")) -#' pred_in("start", start_dates) -#' pred_notin("start", start_dates) -#' -#' # One arg, no value predicates -#' pred_na("scientificName") -#' pred_notna("scientificName") -pred <- function(arg, value) { - pred_primitive(arg, value, symbol = "==", type = "equals") -} - -#' @rdname filter_predicate -#' @export -pred_not <- function(arg, value) { - pred_primitive(arg, value, symbol = "!=", type = "notEquals") -} - -#' @rdname filter_predicate -#' @export -pred_gt <- function(arg, value) { - pred_primitive(arg, value, symbol = ">", type = "greaterThan") -} - -#' @rdname filter_predicate -#' @export -pred_gte <- function(arg, value) { - pred_primitive(arg, value, symbol = ">=", type = "greaterThanOrEquals") -} - -#' @rdname filter_predicate -#' @export -pred_lt <- function(arg, value) { - pred_primitive(arg, value, symbol = "<", type = "lessThan") -} - -#' @rdname filter_predicate -#' @export -pred_lte <- function(arg, value) { - pred_primitive(arg, value, symbol = "<=", type = "lessThanOrEquals") -} - -#' Primitive filter predicate constructor -#' -#' This function is a primitive function to build all basic one arg - one value -#' filter predicates. -#' -#' @param arg Character with the argument of the filter predicate. -#' @param value Value the filter predicate uses to value `arg`. -#' It can be a number, a character, a date object or a POSIXct object. -#' @param symbol Character with the symbol relation of the filter predicate. -#' @param type Character with the type of the filter predicate. -#' @return A filter predicate object. -#' @noRd -#' @examples -#' \dontrun{ -#' pred_primitive(arg = "a", value = 5, symbol = ">", type = "greaterThan") -#' } -pred_primitive <- function(arg, value, symbol, type) { - # checks - check_filter_arg_value(arg, value) - check_filter_value(value) - check_filter_symbol(symbol) - check_filter_type(type) - # build predicate object - predicate <- list(arg = arg, value = value, type = type) - # build expr - if (any(lubridate::is.POSIXct(value), class(value) == "Date")) { - value <- glue::double_quote(value) - predicate$expr <- glue::glue( - "({arg} {symbol} lubridate::as_datetime({value}))" - ) - } else { - if (is.character(value)) { - value <- glue::double_quote(value) - } - predicate$expr <- glue::glue("({arg} {symbol} {value})") - } - return(structure(predicate, class = "filter_predicate")) -} - -#' @rdname filter_predicate -#' @export -pred_in <- function(arg, value) { - # check arg and value - check_filter_arg(arg) - check_filter_value_type(value) - # build predicate object - predicate <- list(arg = arg, value = value, type = "in") - # build expr - if (any(all(lubridate::is.POSIXct(value)), class(value) == "Date")) { - value <- glue::double_quote(value) - if (length(value) > 0) { - predicate$expr <- glue::glue( - "({arg} %in% as_datetime(c(", - glue::glue_collapse(value, sep = ","), - ")))" - ) - } else { - predicate$expr <- glue::glue("({arg} %in% as_datetime(character(0)))") - } - } else { - if (is.character(value)) { - value <- glue::double_quote(value) - } - if (length(value) > 0) { - predicate$expr <- glue::glue( - "({arg} %in% c(", - glue::glue_collapse(value, sep = ","), - "))" - ) - } else { - predicate$expr <- glue::glue("({arg} %in% character(0))") - } - } - return(structure(predicate, class = "filter_predicate")) -} - -#' @rdname filter_predicate -#' @export -pred_notin <- function(arg, value) { - # build predicate object starting from the "in" predicate - predicate <- pred_in(arg, value) - # set right type - predicate$type <- "notIn" - # add negation to expr - predicate$expr <- glue::glue("(!", predicate$expr, ")") - return(structure(predicate, class = "filter_predicate")) -} - -#' @rdname filter_predicate -#' @export -pred_na <- function(arg) { - # check arg - check_filter_arg(arg) - # build predicate object - predicate <- list(arg = arg, value = NA, type = "na") - # build expr - predicate$expr <- glue::glue("(is.na({arg}))") - return(structure(predicate, class = "filter_predicate")) -} - -#' @rdname filter_predicate -#' @export -pred_notna <- function(arg) { - # build predicate object - predicate <- list(arg = arg, value = NA, type = "notNa") - # add negation to expr - predicate$expr <- glue::glue("(!is.na({arg}))") - return(structure(predicate, class = "filter_predicate")) -} - -pred_and_or_primitive <- function(symbol, ...) { - preds <- list(...) - # build predicate object - predicate <- list( - arg = purrr::map(preds, ~ .[["arg"]]), - value = purrr::map(preds, ~ .[["value"]]), - type = purrr::map(preds, ~ .[["type"]]) - ) - # build expr - filter_expr <- purrr::map_chr(preds, ~ .[["expr"]]) - filter_expr <- glue::glue_collapse(filter_expr, sep = symbol) - filter_expr <- glue::glue("(", filter_expr, ")") - # add expr to predicate - predicate$expr <- filter_expr - return(structure(predicate, class = "filter_predicate")) -} - -#' @rdname filter_predicate -#' @export -pred_and <- function(...) { - pred_and_or_primitive(symbol = " & ", ...) -} - -#' @rdname filter_predicate -#' @export -pred_or <- function(...) { - pred_and_or_primitive(symbol = " | ", ...) -} - -#' Intermediate function to apply filter predicates on a data frame -#' -#' This function is used internally by all the `get_*()` functions to filter on -#' deployments. -#' -#' @param df Data frame we want to apply filter(s) expression(s) -#' @param verbose Show (`TRUE`) or not (`FALSE`) the filter predicate -#' expression. -#' @param ... filter predicates to apply to `df` -#' @return A data frame. -#' @family filter functions -#' @export -#' @examples -#' # and -#' apply_filter_predicate( -#' mica$data$deployments, -#' verbose = TRUE, -#' pred_gte("latitude", 51.28), -#' pred_lt("longitude", 3.56) -#' ) -#' # Equivalent of -#' apply_filter_predicate( -#' mica$data$deployments, -#' verbose = TRUE, -#' pred_and( -#' pred_gte("latitude", 51.28), -#' pred_lt("longitude", 3.56) -#' ) -#' ) -#' -#' -#' # or -#' apply_filter_predicate( -#' mica$data$deployments, -#' verbose = TRUE, -#' pred_or( -#' pred_gte("latitude", 51.28), -#' pred_lt("longitude", 3.56) -#' ) -#' ) -apply_filter_predicate <- function(df, verbose, ...) { - assertthat::assert_that(is.data.frame(df), msg = "Predicates must be applied to a df") - preds <- list(...) - if (length(preds) > 0) { - filters <- pred_and(...) - arg <- unlist(filters$arg) - # check that all arg values are valid column names in df - check_value( - arg = arg, - options = names(df), - null_allowed = FALSE, - arg_name = "predicate's arg" - ) - filter_expr <- glue::glue("df %>% dplyr::filter", filters$expr) - if (verbose == TRUE) message(filter_expr) - eval(parse(text = filter_expr)) - } else { - df - } -} - -## helpers - -#' Check filter argument and value -#' -#' This help function checks the argument (`arg`) and the value (`value`) of a -#' basic one argument - one value filter predicate. -#' -#' @param arg Argument of the filter predicate. -#' @param value Value of the filter predicate. -#' @return `TRUE` or an error message. -#' @noRd -#' @examples -#' \dontrun{ -#' check_filter_arg_value("latitude", 5) -#' check_filter_arg_value("locationName", 35) -#' -#' # This returns an error: arg should be always a character -#' check_filter_arg_value(arg = 5, value = 1) -#' -#' # This returns an error: two values instead of one -#' check_filter_arg_value(arg = "location_name", value = c(1, 4)) -#' } -check_filter_arg_value <- function(arg, value) { - check_filter_arg(arg) - check_filter_value(value) -} - -#' Check filter argument -#' -#' Check that the filter argument in a filter predicate is a character and has -#' length one. -#' -#' @param arg Character with the argument name of the filter predicate. -#' @return `TRUE` or an error message. -#' @noRd -#' @examples -#' \dontrun{ -#' check_filter_arg("latitude") -#' check_filter_arg("locationName") -#' -#' # This returns an error -#' check_filter_arg(5) -#' } -check_filter_arg <- function(arg) { - # check arg - assertthat::assert_that(is.character(arg), msg = "'arg' must be a character") - assertthat::assert_that(length(arg) == 1, msg = "'arg' must be length 1") -} - -#' Check filter value type -#' -#' Check that the value argument in a filter predicate is one of the supported -#' types. -#' Required for basic filter predicates. -#' Used in `check_filter_value()`. -#' -#' @param value Character, number, Date or POSIXct object. -#' @return `TRUE` or an error message. -#' @noRd -#' @examples -#' \dontrun{ -#' check_filter_value_type("a") -#' check_filter_value_type(5) -#' -#' # This returns an error -#' check_filter_value_type(list(5)) -#' } -check_filter_value_type <- function(value) { - # check value - assertthat::assert_that( - any( - is.character(value), - is.numeric(value), - class(value) == "Date", - lubridate::is.POSIXct(value) - ), - msg = "'value' must be a character, a number, a date or a datetime(POSIXct)" - ) -} - -#' Check filter value length -#' -#' Check that the value in filter predicates has length one. -#' Required for basic filter predicates. -#' Used in `check_filter_value()`. -#' -#' @param value Value of the filter predicate. -#' @return `TRUE` or an error message. -#' @noRd -#' @examples -#' \dontrun{ -#' check_filter_value_length(5) -#' check_filter_value_length("a") -#' -#' # This returns an error -#' check_filter_value_length(c("a", "aa")) -#' } -check_filter_value_length <- function(value) { - assertthat::assert_that(length(value) == 1, msg = "'value' must be length 1") -} - -#' Check filter value -#' -#' Check that the value argument in a filter predicate has length one and it is -#' one of the supported types. -#' This is required for basic filter predicates. -#' -#' @param value Value of a basic filter predicate. -#' @return `TRUE` or an error message. -#' @noRd -#' @examples -#' \dontrun{ -#' check_filter_value("b") -#' check_filter_value(5) -#' -#' # This returns an error message -#' check_filter_value(list(5)) -#' } -check_filter_value <- function(value) { - check_filter_value_type(value) - check_filter_value_length(value) -} - -#' Check filter symbol -#' -#' Check that the symbol used in a filter predicate is a character and has -#' length one. -#' -#' @param symbol Character with symbol for filter predicate, e.g. "==". -#' @return `TRUE` or an error message. -#' @noRd -#' @examples -#' \dontrun{ -#' check_filter_symbol("==") -#' check_filter_symbol("!=") -#' -#' # Error: not a character -#' check_filter_symbol(5) -#' -#' # Error: length > 1 -#' check_filter_symbol(c("==", "%in%")) -#' } -check_filter_symbol <- function(symbol) { - # check symbol - assertthat::assert_that(is.character(symbol), msg = "'symbol' must be a character") - assertthat::assert_that(length(symbol) == 1, msg = "'symbol' must be length 1") -} - -#' Check filter type -#' -#' Check that the filter predicate type is a character and has length one. -# -#' @param type Character with type for filter predicate, e.g. "equals". -#' @return `TRUE` or an error message. -#' @noRd -#' @examples -#' \dontrun{ -#' check_filter_type("in") -#' check_filter_type("equals") -#' -#' # Error: not a character -#' check_filter_type(5) -#' -#' # Error: length > 1 -#' check_filter_type(c("in", "equals")) -#' } -check_filter_type <- function(type) { - # check type - assertthat::assert_that(is.character(type), msg = "'type' must be a character") - assertthat::assert_that(length(type) == 1, msg = "'type' must be length 1") -} diff --git a/R/get_cam_op.R b/R/get_cam_op.R index a5d17129..ec88e2eb 100644 --- a/R/get_cam_op.R +++ b/R/get_cam_op.R @@ -27,7 +27,6 @@ #' https://jniedballa.github.io/camtrapR/reference/cameraOperation.html). #' Default: `FALSE`. #' @inheritParams get_species -#' @param ... filter predicates for filtering on deployments. #' @return A matrix. Row names always indicate the station ID. Column names are #' dates. #' @family exploration functions @@ -36,9 +35,6 @@ #' library(dplyr) #' get_cam_op(mica) #' -#' # Applying filter(s) on deployments, e.g. deployments with latitude >= 51.18 -#' get_cam_op(mica, pred_gte("latitude", 51.18)) -#' #' # Specify column with station names #' get_cam_op(mica, station_col = "locationID") #' @@ -64,7 +60,6 @@ #' # Use prefix Station as in camtrapR's camera operation matrix #' get_cam_op(mica, use_prefix = TRUE) get_cam_op <- function(package, - ..., station_col = "locationName", camera_col = NULL, session_col = NULL, @@ -158,12 +153,8 @@ get_cam_op <- function(package, msg = "use_prefix must be TRUE or FALSE." ) - # extract and apply filtering on deployments - deploys <- apply_filter_predicate( - df = package$data$deployments, - verbose = TRUE, - ... - ) + # Extract the deployments + deploys <- deployments(package) # very first day among all stations first_day <- min(deploys$start) diff --git a/R/get_custom_effort.R b/R/get_custom_effort.R index 9244867b..dbc8f872 100644 --- a/R/get_custom_effort.R +++ b/R/get_custom_effort.R @@ -1,38 +1,30 @@ #' Get custom effort #' #' Gets the custom effort (deployment duration) for a custom time window and a -#' specific time interval such as day, week, month or year. The custom effort is also -#' calculated over all deployments, although filtering predicates can be applied -#' as well. This function calls `get_cam_op()` internally. +#' specific time interval such as day, week, month or year. The custom effort is +#' also calculated over all deployments. This function calls `get_cam_op()` +#' internally. #' -#' @param ... Filter predicates -#' @param start Start date. -#' Default: `NULL`. -#' If `NULL` the earliest start date among all deployments is used. -#' If `group_by` unit is not `NULL`, the lowest start value allowed is one -#' group by unit before the start date of the earliest deployment. -#' If this condition doesn't hold true, a warning is returned and the earliest -#' start date among all deployments is used. -#' If `group_by` unit is `NULL` the start must be later than or equal to the +#' @param start Start date. Default: `NULL`. If `NULL` the earliest start date +#' among all deployments is used. If `group_by` unit is not `NULL`, the lowest +#' start value allowed is one group by unit before the start date of the +#' earliest deployment. If this condition doesn't hold true, a warning is +#' returned and the earliest start date among all deployments is used. If +#' `group_by` unit is `NULL` the start must be later than or equal to the #' start date among all deployments. -#' @param end End date. -#' Default: `NULL`. -#' If `NULL` the latest end date among all deployments is used. -#' If `group_by` unit is not `NULL`, the latest end value allowed is one group -#' by unit after the end date of the latest deployment. +#' @param end End date. Default: `NULL`. If `NULL` the latest end date among all +#' deployments is used. If `group_by` unit is not `NULL`, the latest end value +#' allowed is one group by unit after the end date of the latest deployment. #' If this condition doesn't hold true, a warning is returned and the latest -#' end date among all deployments is used. -#' If `group_by` unit is `NULL` the end must be earlier than or equal to the -#' end date among all deployments. -#' @param group_by Character, one of `"day"`, `"week"`, `"month"`, `"year"`. -#' The effort is calculated at the interval rate defined in `group_by`. -#' Default: `NULL`: no grouping, i.e. the entire interval from `start` to -#' `end` is taken into account as a whole. Calendar values are used, i.e. -#' grouping by year will calculate the effort from Jan 1st up to Dec 31st for -#' each year. +#' end date among all deployments is used. If `group_by` unit is `NULL` the +#' end must be earlier than or equal to the end date among all deployments. +#' @param group_by Character, one of `"day"`, `"week"`, `"month"`, `"year"`. The +#' effort is calculated at the interval rate defined in `group_by`. Default: +#' `NULL`: no grouping, i.e. the entire interval from `start` to `end` is +#' taken into account as a whole. Calendar values are used, i.e. grouping by +#' year will calculate the effort from Jan 1st up to Dec 31st for each year. #' @param unit Character, the time unit to use while returning custom effort. #' One of: `hour` (default), `day`. -#' @param ... filter predicates #' @inheritParams get_species #' @return A tibble data frame with following columns: #' - `begin`: Begin date of the interval the effort is calculated over. @@ -79,10 +71,7 @@ #' group_by = "year" #' ) #' -#' # Applying filter(s), e.g. deployments with latitude >= 51.18 -#' get_custom_effort(mica, pred_gte("latitude", 51.18)) get_custom_effort <- function(package, - ..., start = NULL, end = NULL, group_by = NULL, @@ -117,7 +106,7 @@ get_custom_effort <- function(package, deployments <- camtrapdp::deployments(package) # Camera operation matrix with filter(s) on deployments - cam_op <- get_cam_op(package, ..., station_col = "deploymentID") + cam_op <- get_cam_op(package, station_col = "deploymentID") # Sum effort over all deployments for each day (in day units) sum_effort <- colSums(cam_op, na.rm = TRUE, dims = 1) diff --git a/R/get_effort.R b/R/get_effort.R index d7398ded..58f77ccb 100644 --- a/R/get_effort.R +++ b/R/get_effort.R @@ -10,7 +10,6 @@ #' - `day` #' - `month` #' - `year` -#' @param ... filter predicates #' @inheritParams get_species #' @return A tibble data frame with following columns: #' - `deploymentID`: Deployment unique identifier. @@ -28,7 +27,6 @@ #' # Effort expressed as days #' get_effort(mica, unit = "day") get_effort <- function(package, - ..., unit = "hour") { # Define possible unit values units <- c("second", "minute", "hour", "day", "month", "year") @@ -38,12 +36,6 @@ get_effort <- function(package, # Check camera trap data package camtrapdp::check_camtrapdp(package) - - # Apply filtering - package$data$deployments <- apply_filter_predicate( - df = package$data$deployments, - verbose = TRUE, ... - ) # Get deployments deployments <- package$data$deployments diff --git a/R/get_n_individuals.R b/R/get_n_individuals.R index 0922074d..fcfa1420 100644 --- a/R/get_n_individuals.R +++ b/R/get_n_individuals.R @@ -16,7 +16,6 @@ #' on, e.g. `"adult"` or `c("subadult", "adult")`. #' If `NULL` (default) all observations of all life stage classes are taken #' into account. -#' @param ... filter predicates for filtering on deployments #' @inheritParams get_species #' @return A tibble data frame with the following columns: #' - `deploymentID`: Deployment unique identifier. @@ -53,11 +52,7 @@ #' #' # Specify both sex and life stage #' get_n_individuals(mica, sex = "unknown", life_stage = "adult") -#' -#' # Apply filter(s), e.g. deployments with latitude >= 51.18 -#' get_n_individuals(mica, pred_gte("latitude", 51.18)) get_n_individuals <- function(package, - ..., species = "all", sex = NULL, life_stage = NULL) { @@ -110,19 +105,9 @@ get_n_individuals <- function(package, observations <- package$data$observations deployments <- package$data$deployments - # apply filtering - deployments <- apply_filter_predicate( - df = deployments, - verbose = TRUE, - ... - ) - deploymentID <- deployments$deploymentID - deployments_no_obs <- get_dep_no_obs( - package, - pred_in("deploymentID", deploymentID) - ) + deployments_no_obs <- get_dep_no_obs(package) # get number of individuals collected by each deployment for each species n_individuals <- diff --git a/R/get_n_obs.R b/R/get_n_obs.R index 83c95d8e..44e7bf6c 100644 --- a/R/get_n_obs.R +++ b/R/get_n_obs.R @@ -16,7 +16,6 @@ #' on, e.g. `"adult"` or `c("subadult", "adult")`. #' If `NULL` (default) all observations of all life stage classes are taken #' into account. -#' @param ... Filter predicates for filtering on deployments #' @inheritParams get_species #' @return A tibble data frame with the following columns: #' - `deploymentID`: Deployment unique identifier. @@ -50,11 +49,8 @@ #' #' # Specify both sex and life stage #' get_n_obs(mica, sex = "unknown", life_stage = "adult") -#' -#' # Applying filter(s), e.g. deployments with latitude >= 51.18 -#' get_n_obs(mica, pred_gte("latitude", 51.18)) + get_n_obs <- function(package, - ..., species = "all", sex = NULL, life_stage = NULL) { @@ -107,19 +103,9 @@ get_n_obs <- function(package, observations <- package$data$observations deployments <- package$data$deployments - # Apply filtering - deployments <- apply_filter_predicate( - df = deployments, - verbose = TRUE, - ... - ) - deploymentID <- deployments$deploymentID - deployments_no_obs <- get_dep_no_obs( - package, - pred_in("deploymentID", deploymentID) - ) + deployments_no_obs <- get_dep_no_obs(package) # get number of observations collected by each deployment for each species n_obs <- diff --git a/R/get_n_species.R b/R/get_n_species.R index 755593fd..862b32ab 100644 --- a/R/get_n_species.R +++ b/R/get_n_species.R @@ -2,7 +2,6 @@ #' #' Gets the number of identified species per deployment. #' -#' @param ... Filter predicates for filtering on deployments. #' @inheritParams get_species #' @return A tibble data frame with the following columns: #' - `deploymentID`: Deployment unique identifier. @@ -12,10 +11,7 @@ #' @examples #' # Get number of species #' get_n_species(mica) -#' -#' # Get number of species for deployments with latitude >= 51.18 -#' get_n_species(mica, pred_gte("latitude", 51.18)) -get_n_species <- function(package, ...) { +get_n_species <- function(package) { # Check camera trap data package camtrapdp::check_camtrapdp(package) @@ -23,20 +19,10 @@ get_n_species <- function(package, ...) { observations <- package$data$observations deployments <- package$data$deployments - # Apply filtering - deployments <- apply_filter_predicate( - df = deployments, - verbose = TRUE, - ... - ) - - # Get deployments without observations among the filtered deployments - deployments_no_obs <- get_dep_no_obs( - package, - pred_in("deploymentID", deployments$deploymentID) - ) + # Get deployments without observations + deployments_no_obs <- get_dep_no_obs(package) - # Get species detected by each deployment after filtering + # Get species detected by each deployment species <- observations %>% dplyr::filter(.data$deploymentID %in% deployments$deploymentID) %>% diff --git a/R/get_rai.R b/R/get_rai.R index 5753cbff..3118a6ab 100644 --- a/R/get_rai.R +++ b/R/get_rai.R @@ -15,7 +15,6 @@ #' @param life_stage Character vector defining the life stage class to filter #' on, e.g. `"adult"` or `c("subadult", "adult")`. If `NULL` (default) all #' observations of all life stage classes are taken into account. -#' @param ... Filter predicates for filtering on deployments. #' @inheritParams get_species #' @return A tibble data frame with the following columns: - `deploymentID`: #' Deployment unique identifier. - `scientificName`: Scientific name. - `rai`: @@ -46,18 +45,14 @@ #' # Specify life stage #' get_rai(mica, life_stage = "adult") #' get_rai(mica, life_stage = c("adult", "subadult")) -#' -#' # Apply filter(s): deployments with latitude >= 51.18 -#' get_rai(mica, pred_gte("latitude", 51.18)) get_rai <- function(package, - ..., species = "all", sex = NULL, life_stage = NULL) { # Check camera trap data package camtrapdp::check_camtrapdp(package) - get_rai_primitive(package, ..., + get_rai_primitive(package, use = "n_obs", species = species, sex = sex, @@ -85,7 +80,6 @@ get_rai <- function(package, #' on, e.g. `"adult"` or `c("subadult", "adult")`. #' If `NULL` (default) all observations of all life stage classes are taken #' into account. -#' @param ... Filter predicates for filtering on deployments. #' @inheritParams get_species #' @return A tibble data frame with the following columns: #' - `deploymentID`: Deployment unique identifier. @@ -120,17 +114,14 @@ get_rai <- function(package, #' get_rai_individuals(mica, life_stage = "adult") #' get_rai_individuals(mica, life_stage = c("adult", "subadult")) #' -#' # Apply filter(s): deployments with latitude >= 51.18 -#' get_rai_individuals(mica, pred_gte("latitude", 51.18)) get_rai_individuals <- function(package, - ..., species = "all", sex = NULL, life_stage = NULL) { # Check camera trap data package camtrapdp::check_camtrapdp(package) - get_rai_primitive(package, ..., + get_rai_primitive(package, use = "n_individuals", species = species, sex = sex, @@ -151,7 +142,7 @@ get_rai_individuals <- function(package, #' @inheritParams get_species #' @return A tibble data frame. #' @noRd -get_rai_primitive <- function(package, use, species, sex, life_stage, ...) { +get_rai_primitive <- function(package, use, species, sex, life_stage) { # define possible feature values uses <- c("n_obs", "n_individuals") @@ -171,14 +162,13 @@ get_rai_primitive <- function(package, use, species, sex, life_stage, ...) { if (use == "n_obs") { # get number of observations - n_df <- get_n_obs(package, species = species, sex = sex, life_stage = life_stage, ...) + n_df <- get_n_obs(package, species = species, sex = sex, life_stage = life_stage) } else { # get number of individuals n_df <- get_n_individuals(package, species = species, sex = sex, - life_stage = life_stage, - ... + life_stage = life_stage ) } @@ -186,7 +176,7 @@ get_rai_primitive <- function(package, use, species, sex, life_stage, ...) { deployments <- package$data$deployments # get deployment duration (effort) in days - dep_effort <- get_effort(package, unit = "day", ...) + dep_effort <- get_effort(package, unit = "day") # calculate RAI n_df %>% diff --git a/R/get_record_table.R b/R/get_record_table.R index a22ae9d1..df83da0c 100644 --- a/R/get_record_table.R +++ b/R/get_record_table.R @@ -28,7 +28,6 @@ #' @param removeDuplicateRecords Logical. #' If there are several records of the same species at the same station at #' exactly the same time, show only one? -#' @param ... Filter predicates for filtering on deployments #' @return A tibble data frame containing species records and additional #' information about stations, date, time and further metadata, such as #' filenames and directories of the images (media) linked to the species @@ -101,11 +100,7 @@ #' #' # duplicate not removed #' get_record_table(mica_dup, removeDuplicateRecords = FALSE) -#' -#' # Applying filter(s) on deployments, e.g. deployments with latitude >= 51.18 -#' get_record_table(mica, pred_gte("latitude", 51.18)) get_record_table <- function(package, - ..., stationCol = "locationName", exclude = NULL, minDeltaTime = 0, @@ -171,12 +166,9 @@ get_record_table <- function(package, obs <- obs %>% dplyr::filter(!.data$scientificName %in% exclude) - # apply filtering on deployments - deployments <- apply_filter_predicate( - df = package$data$deployments, - verbose = TRUE, - ... - ) + # Extract deployments + deployments <- deployments(package) + # remove observations from filtered out deployments obs <- obs %>% dplyr::filter(.data$deploymentID %in% deployments$deploymentID) diff --git a/R/map_dep.R b/R/map_dep.R index 1825c910..31d9d369 100644 --- a/R/map_dep.R +++ b/R/map_dep.R @@ -101,12 +101,9 @@ #' value (`relative_scale` = `TRUE`) or `max_scale` (`relative_scale` #' = `FALSE`). #' Default: `c(10, 50)`. -#' @param ... Filter predicates for subsetting deployments. #' @inheritParams get_species #' @return Leaflet map. #' @family visualization functions -#' @seealso Check documentation about filter predicates: [pred()], [pred_in()], -#' [pred_and()], ... #' @export #' @examples #' \dontrun{ @@ -325,7 +322,6 @@ #' } map_dep <- function(package, feature, - ..., species = NULL, sex = NULL, life_stage = NULL, @@ -490,7 +486,7 @@ map_dep <- function(package, observations <- package$data$observations deployments <- package$data$deployments - # Get average lat lon for empty map without deployments (after filtering) + # Get average lat lon for empty map without deployments avg_lat <- mean(deployments$latitude, na.rm = TRUE) avg_lon <- mean(deployments$longitude, na.rm = TRUE) @@ -568,9 +564,9 @@ map_dep <- function(package, # Calculate and get feature values if (feature == "n_species") { - feat_df <- get_n_species(package, ...) + feat_df <- get_n_species(package) } else if (feature == "n_obs") { - feat_df <- get_n_obs(package, species = species, sex = sex, life_stage = life_stage, ...) + feat_df <- get_n_obs(package, species = species, sex = sex, life_stage = life_stage) } else if (feature == "n_individuals") { feat_df <- get_n_individuals( package, @@ -580,21 +576,21 @@ map_dep <- function(package, ... ) } else if (feature == "rai") { - feat_df <- get_rai(package, species = species, sex = sex, life_stage = life_stage, ...) + feat_df <- get_rai(package, species = species, sex = sex, life_stage = life_stage) feat_df <- feat_df %>% dplyr::rename(n = "rai") } else if (feature == "rai_individuals") { feat_df <- get_rai_individuals( package, species = species, sex = sex, - life_stage = life_stage, ... + life_stage = life_stage ) feat_df <- feat_df %>% dplyr::rename(n = rai) } else if (feature == "effort") { if (is.null(effort_unit)) { effort_unit <- "hour" # Default value of get_effort() } - feat_df <- get_effort(package, unit = effort_unit, ...) + feat_df <- get_effort(package, unit = effort_unit) feat_df <- feat_df %>% dplyr::rename(n = "effort") } diff --git a/R/utils.R b/R/utils.R index 456684de..2b0daf9e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -172,25 +172,21 @@ labelFormat_scale <- function(max_scale = NULL, #' Return subset of deployments without observations. A message is also returned #' to list the ID of such deployments. #' -#' @param ... Filter predicates for filtering on deployments #' @inheritParams get_species #' @return A tibble data frame with deployments not linked to any observations. #' @family exploration functions #' @noRd #' @examples #' get_dep_no_obs(mica) -get_dep_no_obs <- function(package, ...) { +get_dep_no_obs <- function(package) { # Check camera trap data package camtrapdp::check_camtrapdp(package) # Extract observations and deployments - observations <- camtrapdp::observations() - deployments <- camtrapdp::deployments() + observations <- camtrapdp::observations(package) + deployments <- camtrapdp::deployments(package) - # Apply filtering (do not show filtering expression, verbose = FALSE) - deployments <- apply_filter_predicate(df = deployments, verbose = FALSE, ...) - # Deployment with no observations dep_no_obs <- deployments %>% diff --git a/man/apply_filter_predicate.Rd b/man/apply_filter_predicate.Rd deleted file mode 100644 index 0db71918..00000000 --- a/man/apply_filter_predicate.Rd +++ /dev/null @@ -1,58 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/filter_predicates.R -\name{apply_filter_predicate} -\alias{apply_filter_predicate} -\title{Intermediate function to apply filter predicates on a data frame} -\usage{ -apply_filter_predicate(df, verbose, ...) -} -\arguments{ -\item{df}{Data frame we want to apply filter(s) expression(s)} - -\item{verbose}{Show (\code{TRUE}) or not (\code{FALSE}) the filter predicate -expression.} - -\item{...}{filter predicates to apply to \code{df}} -} -\value{ -A data frame. -} -\description{ -This function is used internally by all the \verb{get_*()} functions to filter on -deployments. -} -\examples{ -# and -apply_filter_predicate( - mica$data$deployments, - verbose = TRUE, - pred_gte("latitude", 51.28), - pred_lt("longitude", 3.56) -) -# Equivalent of -apply_filter_predicate( - mica$data$deployments, - verbose = TRUE, - pred_and( - pred_gte("latitude", 51.28), - pred_lt("longitude", 3.56) - ) -) - - -# or -apply_filter_predicate( - mica$data$deployments, - verbose = TRUE, - pred_or( - pred_gte("latitude", 51.28), - pred_lt("longitude", 3.56) - ) -) -} -\seealso{ -Other filter functions: -\code{\link{pred}()}, -\code{\link{reexports}} -} -\concept{filter functions} diff --git a/man/filter_predicate.Rd b/man/filter_predicate.Rd deleted file mode 100644 index 876ae697..00000000 --- a/man/filter_predicate.Rd +++ /dev/null @@ -1,196 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/filter_predicates.R -\name{pred} -\alias{pred} -\alias{pred_not} -\alias{pred_gt} -\alias{pred_gte} -\alias{pred_lt} -\alias{pred_lte} -\alias{pred_in} -\alias{pred_notin} -\alias{pred_na} -\alias{pred_notna} -\alias{pred_and} -\alias{pred_or} -\title{Filter predicate} -\usage{ -pred(arg, value) - -pred_not(arg, value) - -pred_gt(arg, value) - -pred_gte(arg, value) - -pred_lt(arg, value) - -pred_lte(arg, value) - -pred_in(arg, value) - -pred_notin(arg, value) - -pred_na(arg) - -pred_notna(arg) - -pred_and(...) - -pred_or(...) -} -\arguments{ -\item{arg}{(character) The key for the predicate. -See "Keys" below.} - -\item{value}{(various) The value for the predicate.} - -\item{...}{For \code{pred_or()} or \code{pred_and()}: one or more objects of -class \code{filter_predicate}, created by any other \verb{pred*} function.} -} -\value{ -A predicate object. -An object of class predicate is a list with the following elements: -\itemize{ -\item \code{arg}: A (list of) character with all arguments in the predicate(s). -\item \code{value}: A (list of) character with all values in the predicate(s). -\item \code{type}: A (list of) character with all predicate types, see section -"predicate methods" here below. -\item \code{expr}: A character: body of a filter expression. -} -} -\description{ -Filter predicate -} -\section{Predicate methods and their equivalent types}{ - -\verb{pred*} functions are named for the 'type' of operation they do, inspired by -GBIF \href{https://www.gbif.org/developer/occurrence#predicates}{occurrence predicates} - -The following functions take one key and one value and are associated to the -following types: -\itemize{ -\item \code{pred}: equals -\item \code{pred_not}: notEquals -\item \code{pred_lt}: lessThan -\item \code{pred_lte}: lessThanOrEquals -\item \code{pred_gt}: greaterThan -\item \code{pred_gte}: greaterThanOrEquals -\item \code{pred_like}: like (NOT IMPLEMENTED YET!) -} - -The following function is only for geospatial queries, and only accepts a -WKT string: -\itemize{ -\item \code{pred_within}: within (NOT IMPLEMENTED YET!) -} - -The following functions are only for stating that you do (not) want a key to -be \code{NA}, so only accepts one key: -\itemize{ -\item \code{pred_na}: isNA -\item \code{pred_notna}: isNotNA -} - -The following two functions accept multiple individual filter predicates, -separating them by either "and" or "or": -\itemize{ -\item \code{pred_and}: and -\item \code{pred_or}: or -} - -The following function is special in that it accepts a single key but many -values, stating that you want to search for all the listed values, e.g. -one of the locations in: "B_ML_val 05_molenkreek", "B_ML_val 03_De Val" and -"B_ML_val 06_Oostpolderkreek" -\itemize{ -\item \code{pred_in}: in -\item \code{pred_notin}: notIn -} -} - -\section{What happens internally}{ - -Internally, the input to \verb{pred*} functions turn into a character string, -which forms the body of a filter expression. -For example: - -\code{pred("tags", "boven de stroom")} gives: - -\if{html}{\out{