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{
}}\preformatted{$arg -[1] "tags" - -$value -[1] "boven de stroom" - -$type -[1] "equals" - -$expr -(tags == "boven de stroom") -}\if{html}{\out{
}} - -\code{pred_gt("latitude", 51.27)} gives, (only \code{expr} element shown): - -\if{html}{\out{
}}\preformatted{(latitude > 51.27) -}\if{html}{\out{
}} - -\code{pred_or()} gives: - -\if{html}{\out{
}}\preformatted{((tags == "boven de stroom") | (latitude > 51.28)) -}\if{html}{\out{
}} - -\code{pred_or()} gives: - -\if{html}{\out{
}}\preformatted{((tags == "boven de stroom") & (latitude > 51.28)) -}\if{html}{\out{
}} -} - -\section{Keys}{ - -Acceptable arguments to the \code{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") -} -\seealso{ -Other filter functions: -\code{\link{apply_filter_predicate}()}, -\code{\link{reexports}} -} -\concept{filter functions} diff --git a/man/get_cam_op.Rd b/man/get_cam_op.Rd index 50c1b11a..bfb48f31 100644 --- a/man/get_cam_op.Rd +++ b/man/get_cam_op.Rd @@ -6,7 +6,6 @@ \usage{ get_cam_op( package, - ..., station_col = "locationName", camera_col = NULL, session_col = NULL, @@ -17,8 +16,6 @@ get_cam_op( \item{package}{Camera trap data package object, as returned by \code{\link[camtrapdp:read_camtrapdp]{camtrapdp::read_camtrapdp()}}.} -\item{...}{filter predicates for filtering on deployments.} - \item{station_col}{Column name to use for identifying the stations. Default: \code{"locationName"}.} @@ -55,9 +52,6 @@ in decimal effort values as in \href{https://jniedballa.github.io/camtrapR/refer 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") diff --git a/man/get_custom_effort.Rd b/man/get_custom_effort.Rd index 0ddd48f8..87e5fd50 100644 --- a/man/get_custom_effort.Rd +++ b/man/get_custom_effort.Rd @@ -6,7 +6,6 @@ \usage{ get_custom_effort( package, - ..., start = NULL, end = NULL, group_by = NULL, @@ -17,34 +16,26 @@ get_custom_effort( \item{package}{Camera trap data package object, as returned by \code{\link[camtrapdp:read_camtrapdp]{camtrapdp::read_camtrapdp()}}.} -\item{...}{filter predicates} - -\item{start}{Start date. -Default: \code{NULL}. -If \code{NULL} the earliest start date among all deployments is used. -If \code{group_by} unit is not \code{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 \code{group_by} unit is \code{NULL} the start must be later than or equal to the +\item{start}{Start date. Default: \code{NULL}. If \code{NULL} the earliest start date +among all deployments is used. If \code{group_by} unit is not \code{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 +\code{group_by} unit is \code{NULL} the start must be later than or equal to the start date among all deployments.} -\item{end}{End date. -Default: \code{NULL}. -If \code{NULL} the latest end date among all deployments is used. -If \code{group_by} unit is not \code{NULL}, the latest end value allowed is one group -by unit after the end date of the latest deployment. +\item{end}{End date. Default: \code{NULL}. If \code{NULL} the latest end date among all +deployments is used. If \code{group_by} unit is not \code{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 \code{group_by} unit is \code{NULL} the end must be earlier than or equal to the -end date among all deployments.} +end date among all deployments is used. If \code{group_by} unit is \code{NULL} the +end must be earlier than or equal to the end date among all deployments.} -\item{group_by}{Character, one of \code{"day"}, \code{"week"}, \code{"month"}, \code{"year"}. -The effort is calculated at the interval rate defined in \code{group_by}. -Default: \code{NULL}: no grouping, i.e. the entire interval from \code{start} to -\code{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.} +\item{group_by}{Character, one of \code{"day"}, \code{"week"}, \code{"month"}, \code{"year"}. The +effort is calculated at the interval rate defined in \code{group_by}. Default: +\code{NULL}: no grouping, i.e. the entire interval from \code{start} to \code{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.} \item{unit}{Character, the time unit to use while returning custom effort. One of: \code{hour} (default), \code{day}.} @@ -59,9 +50,9 @@ A tibble data frame with following columns: } \description{ 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 \code{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 \code{get_cam_op()} +internally. } \examples{ # A global effort over the entire duration of the project (Camera Trap Data @@ -102,8 +93,6 @@ get_custom_effort( group_by = "year" ) -# Applying filter(s), e.g. deployments with latitude >= 51.18 -get_custom_effort(mica, pred_gte("latitude", 51.18)) } \seealso{ Other exploration functions: diff --git a/man/get_effort.Rd b/man/get_effort.Rd index 52087989..728afc6b 100644 --- a/man/get_effort.Rd +++ b/man/get_effort.Rd @@ -4,14 +4,12 @@ \alias{get_effort} \title{Get effort} \usage{ -get_effort(package, ..., unit = "hour") +get_effort(package, unit = "hour") } \arguments{ \item{package}{Camera trap data package object, as returned by \code{\link[camtrapdp:read_camtrapdp]{camtrapdp::read_camtrapdp()}}.} -\item{...}{filter predicates} - \item{unit}{Time unit to use while returning deployment effort (duration). One of: \itemize{ diff --git a/man/get_n_individuals.Rd b/man/get_n_individuals.Rd index bc1d35e3..4d0719fc 100644 --- a/man/get_n_individuals.Rd +++ b/man/get_n_individuals.Rd @@ -4,14 +4,12 @@ \alias{get_n_individuals} \title{Get number of individuals for each deployment} \usage{ -get_n_individuals(package, ..., species = "all", sex = NULL, life_stage = NULL) +get_n_individuals(package, species = "all", sex = NULL, life_stage = NULL) } \arguments{ \item{package}{Camera trap data package object, as returned by \code{\link[camtrapdp:read_camtrapdp]{camtrapdp::read_camtrapdp()}}.} -\item{...}{filter predicates for filtering on deployments} - \item{species}{Character with scientific names or common names (case insensitive). If \code{"all"} (default) all scientific names are automatically selected. @@ -69,9 +67,6 @@ get_n_individuals(mica, sex = "female") # 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)) } \seealso{ Other exploration functions: diff --git a/man/get_n_obs.Rd b/man/get_n_obs.Rd index 28fd4d10..b38112f2 100644 --- a/man/get_n_obs.Rd +++ b/man/get_n_obs.Rd @@ -4,14 +4,12 @@ \alias{get_n_obs} \title{Get number of observations for each deployment} \usage{ -get_n_obs(package, ..., species = "all", sex = NULL, life_stage = NULL) +get_n_obs(package, species = "all", sex = NULL, life_stage = NULL) } \arguments{ \item{package}{Camera trap data package object, as returned by \code{\link[camtrapdp:read_camtrapdp]{camtrapdp::read_camtrapdp()}}.} -\item{...}{Filter predicates for filtering on deployments} - \item{species}{Character with scientific names or common names (case insensitive). If \code{"all"} (default) all scientific names are automatically selected. @@ -66,9 +64,6 @@ get_n_obs(mica, sex = "female") # 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)) } \seealso{ Other exploration functions: diff --git a/man/get_n_species.Rd b/man/get_n_species.Rd index d4feffe7..47086368 100644 --- a/man/get_n_species.Rd +++ b/man/get_n_species.Rd @@ -4,13 +4,11 @@ \alias{get_n_species} \title{Get number of identified species for each deployment} \usage{ -get_n_species(package, ...) +get_n_species(package) } \arguments{ \item{package}{Camera trap data package object, as returned by \code{\link[camtrapdp:read_camtrapdp]{camtrapdp::read_camtrapdp()}}.} - -\item{...}{Filter predicates for filtering on deployments.} } \value{ A tibble data frame with the following columns: @@ -25,9 +23,6 @@ Gets the number of identified species per deployment. \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)) } \seealso{ Other exploration functions: diff --git a/man/get_rai.Rd b/man/get_rai.Rd index f59a2232..2079d8d5 100644 --- a/man/get_rai.Rd +++ b/man/get_rai.Rd @@ -4,14 +4,12 @@ \alias{get_rai} \title{Get Relative Abundance Index (RAI)} \usage{ -get_rai(package, ..., species = "all", sex = NULL, life_stage = NULL) +get_rai(package, species = "all", sex = NULL, life_stage = NULL) } \arguments{ \item{package}{Camera trap data package object, as returned by \code{\link[camtrapdp:read_camtrapdp]{camtrapdp::read_camtrapdp()}}.} -\item{...}{Filter predicates for filtering on deployments.} - \item{species}{Character with scientific names or common names (case insensitive). If \code{"all"} (default) all scientific names are automatically selected.} @@ -60,9 +58,6 @@ get_rai(mica, sex = c("female", "unknown")) # 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)) } \seealso{ Other exploration functions: diff --git a/man/get_rai_individuals.Rd b/man/get_rai_individuals.Rd index 193c358b..5b61f83c 100644 --- a/man/get_rai_individuals.Rd +++ b/man/get_rai_individuals.Rd @@ -4,20 +4,12 @@ \alias{get_rai_individuals} \title{Get Relative Abundance Index (RAI) based on number of individuals} \usage{ -get_rai_individuals( - package, - ..., - species = "all", - sex = NULL, - life_stage = NULL -) +get_rai_individuals(package, species = "all", sex = NULL, life_stage = NULL) } \arguments{ \item{package}{Camera trap data package object, as returned by \code{\link[camtrapdp:read_camtrapdp]{camtrapdp::read_camtrapdp()}}.} -\item{...}{Filter predicates for filtering on deployments.} - \item{species}{Character with scientific names or common names (case insensitive). If \code{"all"} (default) all scientific names are automatically selected.} @@ -75,8 +67,6 @@ get_rai_individuals(mica, sex = c("female", "unknown")) 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)) } \seealso{ Other exploration functions: diff --git a/man/get_record_table.Rd b/man/get_record_table.Rd index b5f10898..006626f2 100644 --- a/man/get_record_table.Rd +++ b/man/get_record_table.Rd @@ -6,7 +6,6 @@ \usage{ get_record_table( package, - ..., stationCol = "locationName", exclude = NULL, minDeltaTime = 0, @@ -18,8 +17,6 @@ get_record_table( \item{package}{Camera trap data package object, as returned by \code{\link[camtrapdp:read_camtrapdp]{camtrapdp::read_camtrapdp()}}.} -\item{...}{Filter predicates for filtering on deployments} - \item{stationCol}{Character name of the column containing stations. Default: \code{"locationName"}.} @@ -124,9 +121,6 @@ get_record_table(mica_dup) # 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)) } \seealso{ Other exploration functions: diff --git a/man/map_dep.Rd b/man/map_dep.Rd index 58df2f47..4cd9450e 100644 --- a/man/map_dep.Rd +++ b/man/map_dep.Rd @@ -7,7 +7,6 @@ map_dep( package, feature, - ..., species = NULL, sex = NULL, life_stage = NULL, @@ -42,8 +41,6 @@ One of: \item \code{effort}: Effort (duration) of the deployment. }} -\item{...}{Filter predicates for subsetting deployments.} - \item{species}{Character with a scientific name. Required for \code{rai}, optional for \code{n_obs}. Default: \code{NULL}.} @@ -378,8 +375,4 @@ map_dep( ) } } -\seealso{ -Check documentation about filter predicates: \code{\link[=pred]{pred()}}, \code{\link[=pred_in]{pred_in()}}, -\code{\link[=pred_and]{pred_and()}}, ... -} \concept{visualization functions} diff --git a/man/reexports.Rd b/man/reexports.Rd index c095b81e..91338da6 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -11,18 +11,6 @@ \seealso{ Other read functions: \code{\link{read_wi}()} - -Other filter functions: -\code{\link{apply_filter_predicate}()}, -\code{\link{pred}()} - -Other filter functions: -\code{\link{apply_filter_predicate}()}, -\code{\link{pred}()} - -Other filter functions: -\code{\link{apply_filter_predicate}()}, -\code{\link{pred}()} } \concept{filter functions} \concept{read functions} diff --git a/tests/testthat/test-filter_predicates.R b/tests/testthat/test-filter_predicates.R deleted file mode 100644 index b6281da2..00000000 --- a/tests/testthat/test-filter_predicates.R +++ /dev/null @@ -1,281 +0,0 @@ -test_that("right class for all filter predicates", { - expect_s3_class(pred(arg = "a", value = "b"), class = "filter_predicate") - expect_s3_class(pred_not(arg = "a", value = "b"), class = "filter_predicate") - expect_s3_class(pred_gt(arg = "a", value = 1), class = "filter_predicate") - expect_s3_class(pred_gte(arg = "a", value = 1), class = "filter_predicate") - expect_s3_class(pred_lt(arg = "a", value = 1), class = "filter_predicate") - expect_s3_class(pred_lte(arg = "a", value = 1), class = "filter_predicate") - expect_s3_class(pred_in( - arg = "a", - value = c(1, 2) - ), - class = "filter_predicate" - ) - expect_s3_class(pred_notin( - arg = "a", - value = c(1, 2) - ), - class = "filter_predicate" - ) - expect_s3_class(pred_na(arg = "a"), class = "filter_predicate") -}) - -test_that("right predicate slots for all filter predicates", { - # expected slots - pred_slots <- c("arg", "value", "type", "expr") - expect_equal(names(pred(arg = "a", value = "b")), pred_slots) - expect_equal(names(pred_not(arg = "a", value = "b")), pred_slots) - expect_equal(names(pred_gt(arg = "a", value = 1)), pred_slots) - expect_equal(names(pred_gte(arg = "a", value = 1)), pred_slots) - expect_equal(names(pred_lt(arg = "a", value = 1)), pred_slots) - expect_equal(names(pred_lte(arg = "a", value = 1)), pred_slots) - expect_equal(names(pred_in(arg = "a", value = c(1, 2))), pred_slots) - expect_equal(names(pred_notin(arg = "a", value = c(1, 2))), pred_slots) - expect_equal(names(pred_notna(arg = "a")), pred_slots) -}) - -test_that("right length predicate slots for all filter predicates", { - # check length of all slots (arg, value, type, expr) for basic pred() - basic_pred <- pred(arg = "a", value = "b") - expect_equal(length(basic_pred$arg), 1) - expect_equal(length(basic_pred$value), 1) - expect_equal(length(basic_pred$type), 1) - expect_equal(length(basic_pred$expr), 1) - - # check length of all slots (arg, value, type, expr) for negation not_pred() - not_pred <- pred(arg = "a", value = "b") - expect_equal(length(not_pred$arg), 1) - expect_equal(length(not_pred$value), 1) - expect_equal(length(not_pred$type), 1) - expect_equal(length(not_pred$expr), 1) - - # check length of all slots (arg, value, type, expr) for pred_in() - in_pred <- pred_in(arg = "a", value = c(1, 2)) - expect_equal(length(in_pred$arg), 1) - expect_equal(length(in_pred$value), 2) - expect_equal(length(in_pred$type), 1) - expect_equal(length(in_pred$expr), 1) - - # check length of all slots (arg, value, type, expr) for combination - # predicates by pred_and - and_pred <- pred_and( - basic_pred, - not_pred, - in_pred - ) - expect_equal(length(and_pred$arg), 3) - expect_equal(length(and_pred$value), 3) - expect_equal(length(and_pred$type), 3) - expect_equal(length(and_pred$expr), 1) # always one returned expression - - expect_equal(length(and_pred$arg[[1]]), 1) - expect_equal(length(and_pred$arg[[2]]), 1) - expect_equal(length(and_pred$arg[[3]]), 1) - expect_equal(length(and_pred$value[[1]]), 1) # == "b" - expect_equal(length(and_pred$value[[2]]), 1) # != "b" - expect_equal(length(and_pred$value[[3]]), 2) # in c(1,2) - expect_equal(length(and_pred$type[[1]]), 1) # "==" - expect_equal(length(and_pred$type[[2]]), 1) # "!=" - expect_equal(length(and_pred$type[[3]]), 1) # "in" - - # check length of all slots (arg, value, type, expr) for combination - # predicates by pred_or - or_pred <- pred_or( - basic_pred, - not_pred, - in_pred - ) - expect_equal(length(or_pred$arg), 3) - expect_equal(length(or_pred$value), 3) - expect_equal(length(or_pred$type), 3) - expect_equal(length(or_pred$expr), 1) # always one returned expression -}) - -test_that("specific tests: pred_na and pred_notna", { - - # pred_na - expect_error(pred_na(arg = "a", value = "b")) - na_pred <- pred_na(arg = "a") - expect_equal(na_pred$arg, "a") - expect_true(is.na(na_pred$value)) - expect_equal(na_pred$type, "na") - expect_equal(na_pred$expr, glue::glue("(is.na(a))")) - - # pred_notna - expect_error(pred_notna(arg = "a", value = "b")) - notna_pred <- pred_notna(arg = "a") - expect_equal(notna_pred$arg, "a") - expect_true(is.na(notna_pred$value)) - expect_equal(notna_pred$type, "notNa") - expect_equal(notna_pred$expr, glue::glue("(!is.na(a))")) -}) - -test_that("specific tests: pred and pred_not", { - # pred - basic_pred <- pred(arg = "a", value = "b") - expect_equal(basic_pred$arg, "a") - expect_equal(basic_pred$value, "b") - expect_equal(basic_pred$type, "equals") - expect_equal(basic_pred$expr, glue::glue("(a == \"b\")")) - # pred_not - not_pred <- pred_not(arg = "a", value = "b") - expect_equal(not_pred$arg, "a") - expect_equal(not_pred$value, "b") - expect_equal(not_pred$type, "notEquals") - expect_equal(not_pred$expr, glue::glue("(a != \"b\")")) -}) - -test_that("specific tests: pred_gt and pred_gte", { - # pred_gt - gt_pred <- pred_gt(arg = "a", value = 3) - expect_equal(gt_pred$arg, "a") - expect_equal(gt_pred$value, 3) - expect_equal(gt_pred$type, "greaterThan") - expect_equal(gt_pred$expr, glue::glue("(a > 3)")) - # pred_gte - gte_pred <- pred_gte(arg = "a", value = 3) - expect_equal(gte_pred$arg, "a") - expect_equal(gte_pred$value, 3) - expect_equal(gte_pred$type, "greaterThanOrEquals") - expect_equal(gte_pred$expr, glue::glue("(a >= 3)")) -}) - -test_that("specific tests: pred_lt and pred_lte", { - # pred_lt - lt_pred <- pred_lt(arg = "a", value = 3) - expect_equal(lt_pred$arg, "a") - expect_equal(lt_pred$value, 3) - expect_equal(lt_pred$type, "lessThan") - expect_equal(lt_pred$expr, glue::glue("(a < 3)")) - # pred_lte - lte_pred <- pred_lte(arg = "a", value = 3) - expect_equal(lte_pred$arg, "a") - expect_equal(lte_pred$value, 3) - expect_equal(lte_pred$type, "lessThanOrEquals") - expect_equal(lte_pred$expr, glue::glue("(a <= 3)")) -}) - -test_that("specific tests: pred_in and pred_notin", { - # pred_in - in_pred <- pred_in(arg = "a", value = c("b", "c")) - expect_equal(in_pred$arg, "a") - expect_equal(in_pred$value, c("b", "c")) - expect_equal(in_pred$type, "in") - expect_equal(in_pred$expr, glue::glue("(a %in% c(\"b\",\"c\"))")) - # pred_notin - notin_pred <- pred_notin(arg = "a", value = c("b", "c")) - expect_equal(notin_pred$arg, "a") - expect_equal(notin_pred$value, c("b", "c")) - expect_equal(notin_pred$type, "notIn") - expect_equal(notin_pred$expr, glue::glue("(!(a %in% c(\"b\",\"c\")))")) -}) - -test_that("specific tests: pred_and and pred_or", { - basic_pred <- pred(arg = "col1", value = "b") - in_pred <- pred_in(arg = "col2", value = c("b", "c")) - lt_pred <- pred_lt(arg = "col3", value = 3) - notna_pred <- pred_notna(arg = "col4") - # pred_and - and_pred <- pred_and(basic_pred, in_pred, lt_pred, notna_pred) - expect_equal(and_pred$arg, list( - basic_pred$arg, - in_pred$arg, - lt_pred$arg, - notna_pred$arg - )) - expect_equal(and_pred$value, list( - basic_pred$value, - in_pred$value, - lt_pred$value, - notna_pred$value - )) - expect_equal(and_pred$type, list( - basic_pred$type, - in_pred$type, - lt_pred$type, - notna_pred$type - )) - expect_equal(and_pred$expr, glue::glue( - "(", - glue::glue_collapse(c( - basic_pred$expr, - in_pred$expr, - lt_pred$expr, - notna_pred$expr - ), - sep = " & " - ), - ")" - )) - # pred_or - or_pred <- pred_or(basic_pred, in_pred, lt_pred, notna_pred) - expect_equal(or_pred$arg, list( - basic_pred$arg, - in_pred$arg, - lt_pred$arg, - notna_pred$arg - )) - expect_equal(or_pred$value, list( - basic_pred$value, - in_pred$value, - lt_pred$value, - notna_pred$value - )) - expect_equal(or_pred$type, list( - basic_pred$type, - in_pred$type, - lt_pred$type, - notna_pred$type - )) - expect_equal(or_pred$expr, glue::glue( - "(", - glue::glue_collapse(c( - basic_pred$expr, - in_pred$expr, - lt_pred$expr, - notna_pred$expr - ), - sep = " | " - ), - ")" - )) -}) - -test_that("specific tests: nesting pred_and and pred_or", { - basic_pred <- pred(arg = "col1", value = "b") - in_pred <- pred_in(arg = "col2", value = c("b", "c")) - lt_pred <- pred_lt(arg = "col3", value = 3) - notna_pred <- pred_notna(arg = "col4") - # nested pred_and and pred_or - nested_pred <- pred_and( - pred_and(basic_pred, in_pred), - pred_or(lt_pred, notna_pred) - ) - expect_equal(length(nested_pred$arg), 2) - expect_equal(nested_pred$arg[[1]], pred_and(basic_pred, in_pred)$arg) - expect_equal(nested_pred$arg[[2]], pred_or(lt_pred, notna_pred)$arg) - expect_equal(nested_pred$value[[1]], pred_and(basic_pred, in_pred)$value) - expect_equal(nested_pred$value[[2]], pred_or(lt_pred, notna_pred)$value) - expect_equal(nested_pred$type[[1]], pred_and(basic_pred, in_pred)$type) - expect_equal(nested_pred$type[[2]], pred_or(lt_pred, notna_pred)$type) - expect_equal( - nested_pred$expr, - glue::glue( - "(", - glue::glue_collapse(c( - pred_and(basic_pred, in_pred)$expr, - pred_or(lt_pred, notna_pred)$expr - ), - sep = " & " - ), - ")" - ) - ) -}) - -test_that("apply_filter_predicate returns error if input is not a df", { - expect_error( - apply_filter_predicate("a", pred(arg = "col1", value = "b")), - "Predicates must be applied to a df" - ) -}) diff --git a/tests/testthat/test-get_cam_op.R b/tests/testthat/test-get_cam_op.R index 948f6cf0..9da66539 100644 --- a/tests/testthat/test-get_cam_op.R +++ b/tests/testthat/test-get_cam_op.R @@ -317,13 +317,6 @@ test_that( } ) -test_that("filtering predicates are allowed and work well", { - filtered_cam_op_matrix <- suppressMessages( - get_cam_op(mica, pred_lt("longitude", 4.0)) - ) - expect_identical(rownames(filtered_cam_op_matrix), "Mica Viane") -}) - test_that("Argument datapkg is deprecated: warning returned", { expect_warning( rlang::with_options( diff --git a/tests/testthat/test-get_custom_effort.R b/tests/testthat/test-get_custom_effort.R index fe073958..4a72bdc7 100644 --- a/tests/testthat/test-get_custom_effort.R +++ b/tests/testthat/test-get_custom_effort.R @@ -231,8 +231,8 @@ test_that("check effort and unit values", { tot_effort <- get_custom_effort(mica) # Filtering deployments reduces effort value filter_deploys <- suppressMessages( - get_custom_effort(mica, - pred_gte("latitude", 51.18), + get_custom_effort( + filter_deployments(mica, latitude >= 51.18), group_by = "year" ) ) diff --git a/tests/testthat/test-get_n_individuals.R b/tests/testthat/test-get_n_individuals.R index 79ba8cc9..fc5b0af5 100644 --- a/tests/testthat/test-get_n_individuals.R +++ b/tests/testthat/test-get_n_individuals.R @@ -164,9 +164,9 @@ test_that("number of individuals is equal to sum of counts", { dplyr::filter(scientificName == species) %>% dplyr::pull(count) %>% sum() - n_individuals <- suppressMessages(get_n_individuals(mica, - species = "Mallard", - pred("deploymentID", deploy_id) + n_individuals <- suppressMessages(get_n_individuals( + filter_deployments(mica, deploymentID == deploy_id) %>% + filter_observations(scientificName == species) )) expect_equal(n_individuals$n, n_individuals_via_count) }) diff --git a/tests/testthat/test-get_n_obs.R b/tests/testthat/test-get_n_obs.R index a761490f..01a456b4 100644 --- a/tests/testthat/test-get_n_obs.R +++ b/tests/testthat/test-get_n_obs.R @@ -176,10 +176,12 @@ test_that(paste( dplyr::pull(.data$sequenceID) %>% dplyr::n_distinct() # one sequenceID linked to two observations (different age, sex and count) - n_obs <- suppressMessages(get_n_obs(mica, - species = "Mallard", - pred("deploymentID", deploy_id) - )) + n_obs <- suppressMessages( + get_n_obs( + filter_observations(mica, deploymentID == deploy_id), + species = "Mallard" + ) +) expect_equal(n_obs$n, n_obs_via_sequence_id) }) @@ -257,30 +259,6 @@ test_that(paste( expect_true(all(species_value %in% n_obs$scientificName)) }) -test_that("Filter by date of deployments via predicates works correctly", { - end_date <- as.Date("2021-01-01", format = "%Y-%m-%d") - mica_with_obs_filtered_manually <- mica - mica_with_obs_filtered_manually$data$deployments <- - mica_with_obs_filtered_manually$data$deployments %>% - dplyr::filter(end < end_date) - deploys_filtered <- unique( - mica_with_obs_filtered_manually$data$deployments$deploymentID - ) - mica_with_obs_filtered_manually$data$observations <- - mica_with_obs_filtered_manually$data$observations %>% - dplyr::filter(.data$deploymentID %in% deploys_filtered) - obs_filtered_man <- suppressMessages(get_n_obs( - mica_with_obs_filtered_manually, - pred_lt(arg = "end", value = end_date) - )) %>% - dplyr::arrange(deploymentID, scientificName) - obs_filtered <- suppressMessages( - get_n_obs(mica, pred_lt(arg = "end", value = end_date)) - ) %>% - dplyr::arrange(deploymentID, scientificName) - expect_equal(obs_filtered, obs_filtered_man) -}) - test_that("Argument datapkg is deprecated: warning returned", { expect_warning( rlang::with_options( diff --git a/tests/testthat/test-get_record_table.R b/tests/testthat/test-get_record_table.R index 75a12015..820e4c1f 100644 --- a/tests/testthat/test-get_record_table.R +++ b/tests/testthat/test-get_record_table.R @@ -209,16 +209,6 @@ test_that(paste( ) }) -test_that("filtering predicates are allowed and work well", { - stations <- unique( - suppressMessages(get_record_table(mica, pred_lt("longitude", 4.0)))$Station - ) - stations_calculate <- mica$data$deployments %>% - dplyr::filter(longitude < 4.0) %>% - dplyr::pull(locationName) - expect_identical(stations, stations_calculate) -}) - test_that("Argument datapkg is deprecated: warning returned", { expect_warning( rlang::with_options( diff --git a/tests/testthat/test-map_dep.R b/tests/testthat/test-map_dep.R index 9f8f1cd3..37a90657 100644 --- a/tests/testthat/test-map_dep.R +++ b/tests/testthat/test-map_dep.R @@ -190,31 +190,6 @@ test_that("map_dep() allows disabling of hover columns", { !is.na(map_hover$x$calls[[3]]$args[[11]]) ) ) - - -}) - -test_that("map_dep() allows filtering by predicates", { - # expect_no_error( - # map_dep(mica, - # pred("scientificName", "Anas platyrhynchos"), - # feature = "n_species") - # ) - - expect_message( - map_dep(mica, pred_gt("latitude", 51.18), feature = "n_species"), - "df %>% dplyr::filter((latitude > 51.18))", - fixed = TRUE) - - suppressMessages(expect_message( - map_dep(mica, pred_gt("latitude", 90), feature = "n_species"), - "No deployments left.", - fixed = TRUE)) - - suppressMessages(expect_message( - map_dep(mica, pred_gt("latitude", 90), feature = "n_species"), - "df %>% dplyr::filter((latitude > 90))", - fixed = TRUE)) }) test_that("map_dep() returns a leaflet", { diff --git a/vignettes/filter-predicates.Rmd b/vignettes/filter-predicates.Rmd deleted file mode 100644 index 905e2ba7..00000000 --- a/vignettes/filter-predicates.Rmd +++ /dev/null @@ -1,207 +0,0 @@ ---- -title: "Filter predicates" -author: "Damiano Oldoni" -date: "`r Sys.Date()`" -output: rmarkdown::html_vignette -vignette: > - %\VignetteIndexEntry{Filter predicates} - %\VignetteEngine{knitr::rmarkdown} - %\VignetteEncoding{UTF-8} ---- - -```{r setup, include = FALSE} -knitr::opts_chunk$set( - collapse = TRUE, - comment = "#>" -) -``` - -This vignette shows what filter predicates are and how to use them in `get_*()` functions or in `map_dep()`. - -## Setup - -Load packages: - -```{r load_pkgs} -library(camtraptor) -library(lubridate) -library(dplyr) -``` - -We can load a camera trap data package, `x`: - -```{r load_dataset} -x <- example_dataset() -``` - -It contains camera trap data about musk rat and coypu. We will use this variable from now on. - -## Filter predicates - -All filter predicates are functions starting with `pred` prefix. They can be distinguished in four categories based on the type of inputs they accept: - -1. one argument, one value -2. one argument, no value -3. one argument, multiple values (vector) -4. multiple predicates - -They are called filter predicates because they build (dplyr) filter statement. Filter predicates return objects of class `filter_predicate`, which are a particular kind of list with the following slots: - -1. `arg`, the argument -2. `value`, the value -3. `type`, the type of filter predicate -4. `expr`, the filter dplyr expression - -### One argument - one value predicates - -This filter predicates accept one argument and one value. - -#### `pred()`, `pred_not()` - -The `pred()` is the most basic predicates and refers to equality statements. Example, if you want to select rows where column `a` is equal to 5: - -```{r pred} -pred(arg = "a", value = 5) -``` - -The opposite operator of `pred()` (equals) is `pred_not` (notEquals): - -```{r pred_not} -pred_not(arg = "a", value = 5) -``` - -#### `pred_gt()`, `pred_gte()`, `pred_lt()`, `pred_lte()` - -These predicates express `>` (greaterThan), `>=` (greaterThanOrEqual),`<` (lessThan) and `<=` (lessThanOrEqual) respectively. Example: if you want to select rows where column `a` is greater than 5: - -```{r pred_gt} -pred_gt(arg = "a", value = 5) -``` - -### One argument - no value predicates - -The predicate `pred_na()` compares the argument against NA. To select rows where column `a` is NA: - -```{r pred_na} -pred_na(arg = "a") -``` - -To select all the rows where `a` is not NA, you can use the opposite predicate `pred_notna()`: - -```{r pred_notna} -pred_notna(arg = "a") -``` - -### One argument - multiple value predicates - -These predicates accept a vector with multiple values as argument. To get rows where column `a` is one of the values `c(1,3,5)`: - -```{r pred_in} -pred_in(arg = "a", value = c(1,3,5)) -``` - -The opposite of `pred_in()` is `pred_notin()`: - -```{r pred_notin} -pred_notin(arg = "a", value = c(1,3,5)) -``` - -### multiple predicates: `pred_and()` and `pred_or()` - -You can combine the predicates described above to make more complex filter statements by using `pred_and()` (AND operator) and `pred_or()` (OR operator). - -Some examples. Select rows where column `a` is equal to 5 and column `b` is not NA: - -```{r pred_and} -pred_and(pred("a", 5), pred_notna("b")) -``` - -Select rows where column `a` is equal to 5 or column `b` is not NA: - -```{r pred_or} -pred_or(pred("a", 5), pred_notna("b")) -``` - -Notice how these two predicates return `filter_predicate` objects with the same structure as any other predicate, but with slots `arg`, `value` and `type` as long as the number of input predicates they combine. - -## How to use filter predicates - -The filter predicates are useful to select a subset of **deployments** for the `get_*()` functions and the visualization function `map_dep()`. - -### One predicate - -Apply get_* functions only to the deployments with location name _"B_DL_val 5_beek kleine vijver"_ or _"B_DL_val 3_dikke boom"_: - -```{r example_locationName_get_n_obs} -x <- example_dataset() -get_n_obs(x, - pred_in("locationName", - c("B_DL_val 5_beek kleine vijver", "B_DL_val 3_dikke boom"))) -``` - -```{r example_locationName_get_effort} -get_effort(x, - pred_in("locationName", - c("B_DL_val 5_beek kleine vijver", "B_DL_val 3_dikke boom"))) -``` - -```{r example_locationName_get_n_species} -get_n_species(x, - pred_in("locationName", - c("B_DL_val 5_beek kleine vijver", "B_DL_val 3_dikke boom"))) -``` - -### Multiple predicates - -As shown above, you can combine several predicates for more complex filtering. E.g. calculate the number of species detected by the deployments with one of the location names _B_ML_val 06_Oostpolderkreek_ and _B_ML_val 07_Sint-Anna_, or deployments further south than 50.7 degrees: - -```{r pred_or_get_n_species} -get_n_species(x, - pred_or( - pred_in("locationName", - c("B_DL_val 5_beek kleine vijver", "B_DL_val 3_dikke boom")), - pred_lt("latitude", 50.7))) -``` - -Same syntax is valid for visualizing such information via `map_dep()` function: - -```{r exmaple_map_Dep_with_multiple_predicates} -map_dep(x, - feature = "n_species", - pred_or( - pred_in("locationName", - c("B_DL_val 5_beek kleine vijver", "B_DL_val 3_dikke boom")), - pred_lt("latitude", 50.7))) -``` - -Notice also that you can pass as much predicates as you want to `get_*()` functions or `map_dep()` by separating them with comma: they will be combined internally using the AND operator. E.g. to get effort of deployments southern than 51 degrees AND eastern than 4 degrees, you can simplify this: - -```{r example_pred_and_get_n_species} -get_n_species(x, - pred_and(pred_lt("latitude", 51), - pred_gt("longitude", 4))) -``` - -by omitting the `pred_and()`: - -```{r example_pred_and_get_n_species_simplified} -get_n_species(x, - pred_lt("latitude", 51), - pred_gt("longitude", 4)) -``` - -This is similar to the behaviour of dplyr's `filter()` function, where this: - -```{r example_dplyr_filter_and} -x$data$deployments %>% - dplyr::filter(latitude < 51 & longitude > 4) -``` - -is exactly the same as this: - -```{r example_dplyr_filter_and_simplified} -x$data$deployments %>% - dplyr::filter(latitude < 51, longitude > 4) -``` - -Happy filtering!