diff --git a/NAMESPACE b/NAMESPACE index 35843368..92150927 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,8 +10,8 @@ export("is_split<-") export("method_func<-") export("raw_formula<-") export("spm_boundaries<-") -export("spm_boundary_area_column<-") -export("spm_boundary_column<-") +export("spm_boundary<-") +export("spm_boundary_area<-") export("spm_coords_col<-") export("spm_data<-") export("spm_datasets<-") @@ -20,12 +20,12 @@ export("spm_formulas<-") export("spm_get_fit<-") export("spm_name<-") export("spm_patches<-") -export("spm_patches_area_column<-") +export("spm_patches_area<-") export("spm_points<-") export("spm_response<-") export("spm_smoothed_data<-") export("spm_smoothed_fit<-") -export("spm_time_column<-") +export("spm_time<-") export("spm_unique_ID<-") export("translated_formula<-") export(as_discretization_method) @@ -49,8 +49,8 @@ export(spm_aggregate_catch) export(spm_as_boundary) export(spm_as_dataset) export(spm_boundaries) -export(spm_boundary_area_column) -export(spm_boundary_column) +export(spm_boundary) +export(spm_boundary_area) export(spm_coords_col) export(spm_data) export(spm_datasets) @@ -62,7 +62,7 @@ export(spm_lag) export(spm_methods) export(spm_name) export(spm_patches) -export(spm_patches_area_column) +export(spm_patches_area) export(spm_points) export(spm_response) export(spm_smooth) @@ -70,7 +70,7 @@ export(spm_smooth_methods) export(spm_smoothed_data) export(spm_smoothed_fit) export(spm_split) -export(spm_time_column) +export(spm_time) export(spm_unique_ID) export(sspm) export(tesselate_voronoi) @@ -86,8 +86,8 @@ exportMethods("is_split<-") exportMethods("method_func<-") exportMethods("raw_formula<-") exportMethods("spm_boundaries<-") -exportMethods("spm_boundary_area_column<-") -exportMethods("spm_boundary_column<-") +exportMethods("spm_boundary<-") +exportMethods("spm_boundary_area<-") exportMethods("spm_coords_col<-") exportMethods("spm_data<-") exportMethods("spm_datasets<-") @@ -96,12 +96,12 @@ exportMethods("spm_formulas<-") exportMethods("spm_get_fit<-") exportMethods("spm_name<-") exportMethods("spm_patches<-") -exportMethods("spm_patches_area_column<-") +exportMethods("spm_patches_area<-") exportMethods("spm_points<-") exportMethods("spm_response<-") exportMethods("spm_smoothed_data<-") exportMethods("spm_smoothed_fit<-") -exportMethods("spm_time_column<-") +exportMethods("spm_time<-") exportMethods("spm_unique_ID<-") exportMethods("translated_formula<-") exportMethods(as_discretization_method) @@ -124,8 +124,8 @@ exportMethods(spm_aggregate_catch) exportMethods(spm_as_boundary) exportMethods(spm_as_dataset) exportMethods(spm_boundaries) -exportMethods(spm_boundary_area_column) -exportMethods(spm_boundary_column) +exportMethods(spm_boundary) +exportMethods(spm_boundary_area) exportMethods(spm_coords_col) exportMethods(spm_data) exportMethods(spm_datasets) @@ -136,14 +136,14 @@ exportMethods(spm_get_fit) exportMethods(spm_lag) exportMethods(spm_name) exportMethods(spm_patches) -exportMethods(spm_patches_area_column) +exportMethods(spm_patches_area) exportMethods(spm_points) exportMethods(spm_response) exportMethods(spm_smooth) exportMethods(spm_smoothed_data) exportMethods(spm_smoothed_fit) exportMethods(spm_split) -exportMethods(spm_time_column) +exportMethods(spm_time) exportMethods(spm_unique_ID) exportMethods(sspm) exportMethods(translated_formula) diff --git a/R/AAA_S4_all_classes_definitions.R b/R/AAA_S4_all_classes_definitions.R index ff12bdc3..24d5fd83 100644 --- a/R/AAA_S4_all_classes_definitions.R +++ b/R/AAA_S4_all_classes_definitions.R @@ -43,9 +43,9 @@ setClass("discretization_method", #' object(s) of class `sspm_boundary` from an `sf` object. #' #' @slot boundaries **\[sf\]** Spatial boundaries (polygons). -#' @slot boundary_column **\[character\]** The column of `data` that represents the +#' @slot boundary **\[character\]** The column of `data` that represents the #' spatial boundaries. -#' @slot boundary_area_column **\[character\]** The column of `data` that represents the +#' @slot boundary_area **\[character\]** The column of `data` that represents the #' area of spatial boundaries. #' @slot method **\[[discretization_method][discretization_method-class]\]** #' *(if discrete)* discretization method used. @@ -53,7 +53,7 @@ setClass("discretization_method", #' discretization. #' @slot points **\[sf or NULL\]** *(if discrete)* Sample points used for #' discretization. -#' @slot patches_area_column **\[character\]** The column of `data` that represents the +#' @slot patches_area **\[character\]** The column of `data` that represents the #' area of patches. #' #' @name sspm_boundary-class @@ -61,14 +61,14 @@ setClass("discretization_method", #' setClass("sspm_boundary", slots = list(boundaries = "sf", - boundary_column = "character", - boundary_area_column = "character") + boundary = "character", + boundary_area = "character") ) #' @describeIn sspm_boundary-class sspm_discrete_boundary setClass("sspm_discrete_boundary", slots = list(method = "discretization_method", - patches_area_column = "character", + patches_area = "character", patches = "sf", points = "ANY"), contains = "sspm_boundary" @@ -89,7 +89,7 @@ setClassUnion("sspm_discrete_boundaryOrNULL", c("sspm_discrete_boundary", "NULL" #' @slot data **\[data.frame OR sf OR tibble\]** The dataset. #' @slot biomass **\[character\]** The biomass columns of `data`. #' @slot density **\[character\]** The biomass density columns of `data`. -#' @slot time_column **\[character\]** The column of `data` that represents the +#' @slot time **\[character\]** The column of `data` that represents the #' temporal dimension of the dataset. #' @slot coords **\[character\]** The columns of `data` that represent the #' spatial dimension of the dataset: the two columns for longitude and @@ -114,7 +114,7 @@ setClass("sspm_dataset", data = "ANY", biomass = "characterOrNULL", density = "characterOrNULL", - time_column = "character", + time = "character", coords = "characterOrNULL", uniqueID = "character", boundaries = "sspm_discrete_boundary", @@ -167,7 +167,7 @@ setClass("sspm_formula", #' #' @slot datasets **\[list\]** List of #' [sspm_dataset][sspm_dataset-class] that define variables in the SPM model. -#' @slot time_column **\[character\]** The column of `data` that represents the +#' @slot time **\[character\]** The column of `data` that represents the #' temporal dimension of the dataset. # @slot biomass_var **\[character\]** The column of `datasets` that # represents the biomass. @@ -183,7 +183,7 @@ setClass("sspm_formula", #' @rdname sspm-class setClass("sspm", slots = list(datasets = "list", - time_column = "character", + time = "character", uniqueID = "character", boundaries = "sspm_discrete_boundary", smoothed_data = "ANY", @@ -200,7 +200,7 @@ setClass("sspm", #' The fit object for a sspm model #' #' @slot smoothed_data **\[ANY (sf)\]** The smoothed data. -#' @slot time_column **\[character\]** The column of `smoothed_data` that +#' @slot time **\[character\]** The column of `smoothed_data` that #' represents the temporal dimension of the dataset. # @slot biomass_var **\[character\]** The column of `smoothed_data` that # represents the biomass. @@ -215,7 +215,7 @@ setClass("sspm", #' @rdname sspm_fit-class setClass("sspm_fit", slots = list(smoothed_data = "ANY", - time_column = "character", + time = "character", uniqueID = "character", formula = "sspm_formula", boundaries = "sspm_discrete_boundary", diff --git a/R/A_accessors-methods.R b/R/A_accessors-methods.R index 5732f1d3..0fbc6f40 100644 --- a/R/A_accessors-methods.R +++ b/R/A_accessors-methods.R @@ -143,31 +143,31 @@ setMethod("spm_smoothed_data<-", #' @rdname sspm-accessors-methods #' @export -setGeneric(name = "spm_time_column", - def = function(sspm_object) standardGeneric("spm_time_column") +setGeneric(name = "spm_time", + def = function(sspm_object) standardGeneric("spm_time") ) #' @rdname sspm-accessors-methods #' @export -setMethod("spm_time_column", +setMethod("spm_time", signature("sspm_object" = "sspm"), - function(sspm_object) sspm_object@time_column + function(sspm_object) sspm_object@time ) # Replacers --------------------------------------------------------------- #' @rdname sspm-accessors-methods #' @export -setGeneric(name = "spm_time_column<-", - def = function(object, value) standardGeneric("spm_time_column<-") +setGeneric(name = "spm_time<-", + def = function(object, value) standardGeneric("spm_time<-") ) #' @rdname sspm-accessors-methods #' @export -setMethod("spm_time_column<-", +setMethod("spm_time<-", signature("object" = "sspm"), function(object, value) { - object@time_column <- value + object@time <- value validObject(object) return(object) } diff --git a/R/accessors-methods-sspm_boundary.R b/R/accessors-methods-sspm_boundary.R index 19a5d5a6..79c6edb6 100644 --- a/R/accessors-methods-sspm_boundary.R +++ b/R/accessors-methods-sspm_boundary.R @@ -143,31 +143,31 @@ setMethod("spm_points<-", #' @rdname accessors-methods-sspm_boundary #' @export -setGeneric(name = "spm_boundary_column", - def = function(sspm_object) standardGeneric("spm_boundary_column") +setGeneric(name = "spm_boundary", + def = function(sspm_object) standardGeneric("spm_boundary") ) #' @rdname accessors-methods-sspm_boundary #' @export -setMethod("spm_boundary_column", +setMethod("spm_boundary", signature("sspm_object" = "sspm_boundary"), - function(sspm_object) sspm_object@boundary_column + function(sspm_object) sspm_object@boundary ) # Replacers --------------------------------------------------------------- #' @rdname accessors-methods-sspm_boundary #' @export -setGeneric(name = "spm_boundary_column<-", - def = function(object, value) standardGeneric("spm_boundary_column<-") +setGeneric(name = "spm_boundary<-", + def = function(object, value) standardGeneric("spm_boundary<-") ) #' @rdname accessors-methods-sspm_boundary #' @export -setMethod("spm_boundary_column<-", +setMethod("spm_boundary<-", signature("object" = "sspm_boundary"), function(object, value) { - object@boundary_column <- value + object@boundary <- value validObject(object) return(object) } @@ -178,31 +178,31 @@ setMethod("spm_boundary_column<-", #' @rdname accessors-methods-sspm_boundary #' @export -setGeneric(name = "spm_boundary_area_column", - def = function(sspm_object) standardGeneric("spm_boundary_area_column") +setGeneric(name = "spm_boundary_area", + def = function(sspm_object) standardGeneric("spm_boundary_area") ) #' @rdname accessors-methods-sspm_boundary #' @export -setMethod("spm_boundary_area_column", +setMethod("spm_boundary_area", signature("sspm_object" = "sspm_boundary"), - function(sspm_object) sspm_object@boundary_area_column + function(sspm_object) sspm_object@boundary_area ) # Replacers --------------------------------------------------------------- #' @rdname accessors-methods-sspm_boundary #' @export -setGeneric(name = "spm_boundary_area_column<-", - def = function(object, value) standardGeneric("spm_boundary_area_column<-") +setGeneric(name = "spm_boundary_area<-", + def = function(object, value) standardGeneric("spm_boundary_area<-") ) #' @rdname accessors-methods-sspm_boundary #' @export -setMethod("spm_boundary_area_column<-", +setMethod("spm_boundary_area<-", signature("object" = "sspm_boundary"), function(object, value) { - object@boundary_area_column <- value + object@boundary_area <- value validObject(object) return(object) } @@ -212,31 +212,31 @@ setMethod("spm_boundary_area_column<-", #' @rdname accessors-methods-sspm_boundary #' @export -setGeneric(name = "spm_patches_area_column", - def = function(sspm_object) standardGeneric("spm_patches_area_column") +setGeneric(name = "spm_patches_area", + def = function(sspm_object) standardGeneric("spm_patches_area") ) #' @rdname accessors-methods-sspm_boundary #' @export -setMethod("spm_patches_area_column", +setMethod("spm_patches_area", signature("sspm_object" = "sspm_discrete_boundary"), - function(sspm_object) sspm_object@patches_area_column + function(sspm_object) sspm_object@patches_area ) # Replacers --------------------------------------------------------------- #' @rdname accessors-methods-sspm_boundary #' @export -setGeneric(name = "spm_patches_area_column<-", - def = function(object, value) standardGeneric("spm_patches_area_column<-") +setGeneric(name = "spm_patches_area<-", + def = function(object, value) standardGeneric("spm_patches_area<-") ) #' @rdname accessors-methods-sspm_boundary #' @export -setMethod("spm_patches_area_column<-", +setMethod("spm_patches_area<-", signature("object" = "sspm_discrete_boundary"), function(object, value) { - object@patches_area_column <- value + object@patches_area <- value validObject(object) return(object) } diff --git a/R/accessors-methods-sspm_dataset.R b/R/accessors-methods-sspm_dataset.R index 0b45bcca..e23b4921 100644 --- a/R/accessors-methods-sspm_dataset.R +++ b/R/accessors-methods-sspm_dataset.R @@ -127,19 +127,19 @@ setMethod("spm_coords_col<-", #' @rdname accessors-methods-sspm_dataset #' @export -setMethod("spm_time_column", +setMethod("spm_time", signature("sspm_object" = "sspm_dataset"), - function(sspm_object) sspm_object@time_column + function(sspm_object) sspm_object@time ) # Replacers --------------------------------------------------------------- #' @rdname accessors-methods-sspm_dataset #' @export -setMethod("spm_time_column<-", +setMethod("spm_time<-", signature("object" = "sspm_dataset"), function(object, value) { - object@time_column <- value + object@time <- value validObject(object) return(object) } diff --git a/R/accessors-methods-sspm_fit.R b/R/accessors-methods-sspm_fit.R index 25b538dd..5c5d9e7f 100644 --- a/R/accessors-methods-sspm_fit.R +++ b/R/accessors-methods-sspm_fit.R @@ -36,19 +36,19 @@ setMethod("spm_unique_ID<-", #' @rdname accessors-methods-sspm_fit #' @export -setMethod("spm_time_column", +setMethod("spm_time", signature("sspm_object" = "sspm_fit"), - function(sspm_object) sspm_object@time_column + function(sspm_object) sspm_object@time ) # Replacers --------------------------------------------------------------- #' @rdname accessors-methods-sspm_fit #' @export -setMethod("spm_time_column<-", +setMethod("spm_time<-", signature("object" = "sspm_fit"), function(object, value) { - object@time_column <- value + object@time <- value validObject(object) return(object) } @@ -164,18 +164,18 @@ setMethod("spm_boundaries<-", #' @rdname accessors-methods-sspm_fit #' @export -setMethod("spm_boundary_column", signature("sspm_object" = "sspm_fit"), - function(sspm_object) sspm_object@boundaries@boundary_column +setMethod("spm_boundary", signature("sspm_object" = "sspm_fit"), + function(sspm_object) sspm_object@boundaries@boundary ) # Replacers --------------------------------------------------------------- #' @rdname accessors-methods-sspm_fit #' @export -setMethod("spm_boundary_column<-", +setMethod("spm_boundary<-", signature("object" = "sspm_fit"), function(object, value) { - object@boundaries@boundary_column <- value + object@boundaries@boundary <- value validObject(object) return(object) } diff --git a/R/extract-methods.R b/R/extract-methods.R index 86ce3f7d..c2be968e 100644 --- a/R/extract-methods.R +++ b/R/extract-methods.R @@ -14,7 +14,7 @@ setMethod("$", "sspm_boundary", function(x, name) { x@boundaries %>% - dplyr::select(c(name, spm_boundary_column(x), "geometry")) + dplyr::select(c(name, spm_boundary(x), "geometry")) } ) @@ -24,7 +24,7 @@ setMethod("$", "sspm_discrete_boundary", function(x, name) { x@boundaries %>% - dplyr::select(c(name, spm_boundary_column(x), "geometry")) + dplyr::select(c(name, spm_boundary(x), "geometry")) } ) @@ -35,10 +35,10 @@ setMethod("$", function(x, name) { if (is.null(x@smoothed_data)) { x@data %>% - dplyr::select(c(name, spm_time_column(x), "geometry")) + dplyr::select(c(name, spm_time(x), "geometry")) } else { x@smoothed_data %>% - dplyr::select(c(name, spm_time_column(x), "geometry")) + dplyr::select(c(name, spm_time(x), "geometry")) } } ) @@ -50,10 +50,10 @@ setMethod("$", function(x, name) { if (is.null(x@smoothed_data)) { x@data %>% - dplyr::select(c(name, spm_time_column(x), "geometry")) + dplyr::select(c(name, spm_time(x), "geometry")) } else { x@smoothed_data %>% - dplyr::select(c(name, spm_time_column(x), "geometry")) + dplyr::select(c(name, spm_time(x), "geometry")) } } ) @@ -65,10 +65,10 @@ setMethod("$", function(x, name) { if (is.null(x@smoothed_data)) { x@data %>% - dplyr::select(c(name, spm_time_column(x), "geometry")) + dplyr::select(c(name, spm_time(x), "geometry")) } else { x@smoothed_data %>% - dplyr::select(c(name, spm_time_column(x), "geometry")) + dplyr::select(c(name, spm_time(x), "geometry")) } } ) diff --git a/R/fit.R b/R/fit.R index 80f6a965..d8a92be4 100644 --- a/R/fit.R +++ b/R/fit.R @@ -49,7 +49,7 @@ setMethod(f = "fit_smooths", # Get data the_data <- units::drop_units(spm_data(sspm_object)) - time_col <- spm_time_column(sspm_object) + time_col <- spm_time(sspm_object) boundaries <- spm_boundaries(sspm_object) patches <- spm_patches(boundaries) @@ -150,7 +150,7 @@ setMethod(f = "fit_spm", dplyr::filter(.data$train_test == TRUE) # Get/Initializa vars of use - time_col_name <- spm_time_column(sspm_object) + time_col_name <- spm_time(sspm_object) the_fit <- NULL # Index formula diff --git a/R/map_formula.R b/R/map_formula.R index 0c8d374c..7f306321 100644 --- a/R/map_formula.R +++ b/R/map_formula.R @@ -13,7 +13,7 @@ setGeneric(name = "map_formula", def = function(data_frame, boundaries, formula, - time_column, + time, ...) { standardGeneric("map_formula") } @@ -32,7 +32,7 @@ setMethod(f = "map_formula", signature(data_frame = "sf", boundaries = "ANY", formula = "formula"), - function(data_frame, boundaries, formula, time_column, ...) { + function(data_frame, boundaries, formula, time, ...) { # Retrieve terms, response, and term labels formula_terms <- terms(formula) @@ -71,7 +71,7 @@ setMethod(f = "map_formula", lapply(smooth_calls, modify_call, args = list(data_frame = data_frame, boundaries = substitute(boundaries), - time_column = time_column)) + time = time)) smooth_and_vars <- lapply(smooth_calls_modified, eval, envir = list(. = data_frame, diff --git a/R/plot.R b/R/plot.R index 4726ade3..3a3cb4cf 100644 --- a/R/plot.R +++ b/R/plot.R @@ -43,7 +43,7 @@ setMethod("plot", definition = function(x, y, ...) { boundaries <- spm_boundaries(x) - boundary_column <- spm_boundary_column(x) + boundary <- spm_boundary(x) if (checkmate::test_class(x, "sspm_discrete_boundary")) { @@ -54,9 +54,9 @@ setMethod("plot", ggplot2::geom_sf(data = patches, fill = NA, col = "#36454F") + ggplot2::geom_sf(data = boundaries, - ggplot2::aes(col = .data[[boundary_column]]), + ggplot2::aes(col = .data[[boundary]]), fill = NA) + - ggplot2::scale_color_viridis_d(boundary_column) + + ggplot2::scale_color_viridis_d(boundary) + ggplot2::theme_light() if(!is.null(points)){ @@ -68,9 +68,9 @@ setMethod("plot", sspm_discrete_plot <- ggplot2::ggplot() + ggplot2::geom_sf(data = boundaries, - ggplot2::aes(fill = .data[[boundary_column]]), + ggplot2::aes(fill = .data[[boundary]]), col = "#36454F") + - ggplot2::scale_fill_viridis_d(boundary_column) + + ggplot2::scale_fill_viridis_d(boundary) + ggplot2::theme_light() } @@ -97,7 +97,7 @@ setMethod("plot", smoothed_data <- smoothed_data %>% dplyr::mutate(color = "Smoothed") - time_col <- spm_time_column(x) + time_col <- spm_time(x) if (is.null(var)) { @@ -110,7 +110,7 @@ setMethod("plot", stop("`var` must be a column of the smoothed data", call. = FALSE) } - time_col <- spm_time_column(x) + time_col <- spm_time(x) color_profile <- c("Smoothed" = "black") @@ -158,7 +158,7 @@ setMethod("plot", ggplot2::theme_light() + ggplot2::labs(x = "actual") + ggplot2::scale_color_viridis_d("Set") + - ggplot2::facet_wrap(~.data[[spm_boundary_column(x)]], + ggplot2::facet_wrap(~.data[[spm_boundary(x)]], scales = scales) + ggplot2::geom_abline(slope = 1, intercept = 0, lty = 2, size = 0.2) @@ -169,8 +169,8 @@ setMethod("plot", color_profile <- c("Predictions" = "red") - boundary_col <- spm_boundary_column(x) - patch_area_col <- spm_patches_area_column(spm_boundaries(x)) + boundary_col <- spm_boundary(x) + patch_area_col <- spm_patches_area(spm_boundaries(x)) checkmate::assert_character(biomass) @@ -188,7 +188,7 @@ setMethod("plot", aggregate = aggregate) %>% dplyr::mutate(color = next_ts_label) - time_col <- spm_time_column(x) + time_col <- spm_time(x) mext_ts_timestep <- max(unique(next_ts_preds[[time_col]]))-1 biomass_preds_previous <- biomass_preds %>% @@ -206,8 +206,8 @@ setMethod("plot", "firebrick") } - time_col <- spm_time_column(x) - boundary_col <- spm_boundary_column(x) + time_col <- spm_time(x) + boundary_col <- spm_boundary(x) if (is.null(biomass_origin)){ # TODO check presence of column in data frame @@ -245,7 +245,7 @@ setMethod("plot", } else { - boundary_col <- spm_boundary_column(x) + boundary_col <- spm_boundary(x) prod_preds <- predict(x, aggregate = aggregate, interval = interval) %>% @@ -258,7 +258,7 @@ setMethod("plot", prod_preds <- prod_preds %>% dplyr::bind_rows(actual) - time_col <- spm_time_column(x) + time_col <- spm_time(x) color_profile <- c("Predictions" = "red", "Actual" = "black") diff --git a/R/predict.R b/R/predict.R index 06315649..92bf5979 100644 --- a/R/predict.R +++ b/R/predict.R @@ -31,11 +31,11 @@ setMethod(f = "predict", # Get data bounds <- spm_boundaries(object) - bounds_col <- spm_boundary_column(bounds) - patch_area_col <- spm_patches_area_column(bounds) - time_col <- spm_time_column(object) + bounds_col <- spm_boundary(bounds) + patch_area_col <- spm_patches_area(bounds) + time_col <- spm_time(object) patches <- spm_patches(bounds) - patch_area_col <- spm_patches_area_column(bounds) + patch_area_col <- spm_patches_area(bounds) # If biomass variable is not provided, we are predicting productivity if(is.null(biomass)){ @@ -206,7 +206,7 @@ setMethod(f = "predict", signature(object = "sspm_dataset"), function(object, new_data = NULL, discrete = TRUE, type = "response") { - time_col <- spm_time_column(object) + time_col <- spm_time(object) the_fit <- spm_smoothed_fit(object) the_formulas <- spm_formulas(object) responses <- sapply(the_formulas, spm_response) @@ -225,7 +225,7 @@ setMethod(f = "predict", new_data <- make_prediction_matrix(the_data = spm_data(object), - time_col = spm_time_column(object), + time_col = spm_time(object), patches = spm_patches(spm_boundaries(object))) } else { @@ -316,8 +316,8 @@ get_var_names <- function(sspm_object, exclude_mats = TRUE, if (exclude_mats){ var_names <- var_names %>% stringr::str_subset("patch_id", negate = TRUE) %>% - stringr::str_subset(spm_time_column(sspm_object), negate = TRUE) %>% - stringr::str_subset(spm_boundary_column(sspm_object), negate = TRUE) + stringr::str_subset(spm_time(sspm_object), negate = TRUE) %>% + stringr::str_subset(spm_boundary(sspm_object), negate = TRUE) } return(var_names) } diff --git a/R/show-methods.R b/R/show-methods.R index f661fe12..01255e1a 100644 --- a/R/show-methods.R +++ b/R/show-methods.R @@ -105,7 +105,7 @@ setMethod("show", cli::cat_line() custom_h1("SSPM Model Fit") cat_boundaries(object, column = FALSE) - cat_smoothed_data(object, print_columns = FALSE) + cat_smoothed_data(object, prints = FALSE) cat_spm_fit(object) cli::cat_line() } @@ -143,11 +143,11 @@ cat_boundaries <- function(object, column = TRUE) { bullet = "arrow_right") cli::cat_bullet(" Boundary col. : ", - cli::col_blue(object@boundary_column), + cli::col_blue(object@boundary), bullet = "arrow_right") cli::cat_bullet(" Boundary area col. : ", - cli::col_blue(object@boundary_area_column), + cli::col_blue(object@boundary_area), bullet = "arrow_right") } else { @@ -192,7 +192,7 @@ cat_data <- function(object) { cli::col_blue(object@uniqueID), bullet = "arrow_right") cli::cat_bullet(" Time col. : ", - cli::col_blue(object@time_column), + cli::col_blue(object@time), bullet = "arrow_right") if (!is.null(object@coords)) { cli::cat_bullet(" Coordinates cols. : ", @@ -226,7 +226,7 @@ cat_data <- function(object) { # # } -cat_smoothed_data <- function(object, print_columns = TRUE) { +cat_smoothed_data <- function(object, prints = TRUE) { if (!is.null(object@smoothed_data)) { @@ -252,7 +252,7 @@ cat_smoothed_data <- function(object, print_columns = TRUE) { bullet = "arrow_right") } - if (print_columns) { + if (prints) { columns_with_smooth <- object@smoothed_vars diff --git a/R/smooths.R b/R/smooths.R index 0621598e..a3f52cd0 100644 --- a/R/smooths.R +++ b/R/smooths.R @@ -4,7 +4,7 @@ #' `smooth_space()`, `smooth_space_time()`. #' #' @param data_frame **\[sf data.frame\]** The data. -#' @param time_column **\[character\]** The time column. +#' @param time **\[character\]** The time column. #' @param var **\[symbol\]** Variable (only for smooth_lag). #' @param type **\[character\]** Type of smooth, currently only "ICAR" is #' supported. @@ -23,7 +23,7 @@ setGeneric(name = "smooth_time", def = function(data_frame, boundaries, - time_column, + time, type = "ICAR", k = NULL, bs = "re", @@ -39,7 +39,7 @@ setGeneric(name = "smooth_time", setGeneric(name = "smooth_space", def = function(data_frame, boundaries, - time_column, + time, type = "ICAR", k = NULL, bs = "mrf", @@ -55,7 +55,7 @@ setGeneric(name = "smooth_space", setGeneric(name = "smooth_space_time", def = function(data_frame, boundaries, - time_column, + time, type = "ICAR", k = NULL, bs = c("re", "mrf"), @@ -72,7 +72,7 @@ setGeneric(name = "smooth_lag", def = function(var, data_frame, boundaries, - time_column, + time, type = "LINPRED", k = 5, m = 1, @@ -88,13 +88,13 @@ setGeneric(name = "smooth_lag", setMethod(f = "smooth_time", signature(data_frame = "sf", boundaries = "sspm_discrete_boundary"), - function(data_frame, boundaries, time_column, type, k, bs, xt, is_spm, ...) { + function(data_frame, boundaries, time, type, k, bs, xt, is_spm, ...) { args_list <- as.list(match.call(expand.dots = FALSE)$`...`) do.call(smooth_routine, append(list(dimension = "time", var = NULL, data_frame = data_frame, - boundaries = boundaries, time_column = time_column, + boundaries = boundaries, time = time, type = type, k = k, m = NULL, bs = bs, xt = xt, is_spm = is_spm, smooth_type = "s"), args_list)) @@ -107,13 +107,13 @@ setMethod(f = "smooth_time", setMethod(f = "smooth_space", signature(data_frame = "sf", boundaries = "sspm_discrete_boundary"), - function(data_frame, boundaries, time_column, type, k, bs, xt, is_spm, ...) { + function(data_frame, boundaries, time, type, k, bs, xt, is_spm, ...) { args_list <- as.list(match.call(expand.dots = FALSE)$`...`) do.call(smooth_routine, append(list(dimension = "space", var = NULL, data_frame = data_frame, - boundaries = boundaries, time_column = time_column, + boundaries = boundaries, time = time, type = type, k = k, m = NULL, bs = bs, xt = xt, is_spm = is_spm, smooth_type = "s"), args_list)) @@ -126,13 +126,13 @@ setMethod(f = "smooth_space", setMethod(f = "smooth_space_time", signature(data_frame = "sf", boundaries = "sspm_discrete_boundary"), - function(data_frame, boundaries, time_column, type, k, bs, xt, is_spm, ...) { + function(data_frame, boundaries, time, type, k, bs, xt, is_spm, ...) { args_list <- as.list(match.call(expand.dots = FALSE)$`...`) do.call(smooth_routine, append(list(dimension = "space_time", var = NULL, data_frame = data_frame, - boundaries = boundaries, time_column = time_column, + boundaries = boundaries, time = time, type = type, k = k, m = NULL, bs = bs, xt = xt, is_spm = is_spm, smooth_type = "ti"), args_list)) @@ -145,13 +145,13 @@ setMethod(f = "smooth_space_time", setMethod(f = "smooth_lag", signature(data_frame = "sf", boundaries = "sspm_discrete_boundary"), - function(var, data_frame, boundaries, time_column, type, k, m, ...) { + function(var, data_frame, boundaries, time, type, k, m, ...) { args_list <- as.list(match.call(expand.dots = FALSE)$`...`) do.call(smooth_routine, append(list(dimension = NULL, var = var, data_frame = data_frame, - boundaries = boundaries, time_column = time_column, + boundaries = boundaries, time = time, type = type, k = k, m = m, bs = NULL, xt = NULL, is_spm = NULL, smooth_type = "s"), args_list)) @@ -162,7 +162,7 @@ setMethod(f = "smooth_lag", # Routine ----------------------------------------------------------------- -smooth_routine <- function(dimension, var, data_frame, boundaries, time_column, +smooth_routine <- function(dimension, var, data_frame, boundaries, time, type, k, m, bs, xt, is_spm, smooth_type, ...){ # Get args from ellipsis for extra args: this form is necessary for @@ -175,7 +175,7 @@ smooth_routine <- function(dimension, var, data_frame, boundaries, time_column, var = var, data_frame = data_frame, boundaries = boundaries, - time_column = time_column, + time = time, k = k, m = m, bs = bs, xt = xt, is_spm = is_spm), @@ -201,12 +201,12 @@ smooth_routine <- function(dimension, var, data_frame, boundaries, time_column, # Construct an ICAR penalization matrix for a given "dimension" and returns the # double list args_and_vars that have the args to build a new call to s() and the # vars necessary for the evaluation of that s() smooth -ICAR <- function(data_frame, boundaries, time_column, dimension, +ICAR <- function(data_frame, boundaries, time, dimension, k, bs, xt, is_spm, unused_names = c("var", "m"), ...) { checkmate::assert_class(data_frame, "sf") checkmate::assert_class(boundaries, "sspm_discrete_boundary") - checkmate::assert_character(time_column) + checkmate::assert_character(time) checkmate::assert_character(dimension) checkmate::assert_choice(dimension, choices = c("time", "space", "space_time")) @@ -215,13 +215,13 @@ ICAR <- function(data_frame, boundaries, time_column, dimension, args_list <- args_list[!(names(args_list) %in% unused_names)] # ---- TIME ---- - time_levels <- levels(data_frame[[time_column]]) + time_levels <- levels(data_frame[[time]]) n_time_levels = as.numeric(length(time_levels)) # ---- SPACE ---- # Here we assume the hardcoded convention that the patch column is patch_id # (from the discretization) - space_column <- "patch_id" + space <- "patch_id" patches <- boundaries@patches # Setup done ---- @@ -229,7 +229,7 @@ ICAR <- function(data_frame, boundaries, time_column, dimension, if (dimension == "time") { - out_column <- list(str2lang(time_column)) + out <- list(str2lang(time)) if (is.null(k)) { if (!is_spm) { @@ -275,7 +275,7 @@ ICAR <- function(data_frame, boundaries, time_column, dimension, } else if (dimension == "space") { - out_column <- list(str2lang(space_column)) + out <- list(str2lang(space)) if (is.null(k)) { if (!is_spm) { @@ -289,14 +289,14 @@ ICAR <- function(data_frame, boundaries, time_column, dimension, if (is.null(xt)) { - pen_mat_space <- ICAR_space(patches, space_column) + pen_mat_space <- ICAR_space(patches, space) } else { checkmate::assert_list(xt) if (is.null(xt$penalty)) { - pen_mat_space <- ICAR_space(patches, space_column) + pen_mat_space <- ICAR_space(patches, space) } else { checkmate::assert_matrix(xt$penalty) pen_mat_space <- xt @@ -311,7 +311,7 @@ ICAR <- function(data_frame, boundaries, time_column, dimension, } else if (dimension == "space_time") { - out_column <- list(str2lang(time_column), str2lang(space_column)) + out <- list(str2lang(time), str2lang(space)) if (is.null(k)) { if (is_spm) { @@ -332,7 +332,7 @@ ICAR <- function(data_frame, boundaries, time_column, dimension, if (is.null(xt)) { pen_mat_time <- ICAR_time(time_levels) - pen_mat_space <- ICAR_space(patches, space_column) + pen_mat_space <- ICAR_space(patches, space) vars$pen_mat_time <- pen_mat_time vars$pen_mat_space <- pen_mat_space @@ -343,33 +343,33 @@ ICAR <- function(data_frame, boundaries, time_column, dimension, checkmate::assert_list(xt) lapply(xt, checkmate::assert_list) checkmate::assert_names(names(xt), - subset.of = c(time_column, space_column)) + subset.of = c(time, space)) - if (is.null(xt[[time_column]]$penalty)) { + if (is.null(xt[[time]]$penalty)) { vars$pen_mat_time <- ICAR_time(time_levels) } else { - checkmate::assert_matrix(xt[[time_column]]$penalty) - vars$pen_mat_time <- xt[[time_column]]$penalty + checkmate::assert_matrix(xt[[time]]$penalty) + vars$pen_mat_time <- xt[[time]]$penalty } - if (is.null(xt[[space_column]]$penalty)) { - vars$pen_mat_space <- ICAR_space(patches, space_column) + if (is.null(xt[[space]]$penalty)) { + vars$pen_mat_space <- ICAR_space(patches, space) } else { - checkmate::assert_matrix(xt[[space_column]]$penalty) - vars$pen_mat_space <- xt[[space_column]]$penalty + checkmate::assert_matrix(xt[[space]]$penalty) + vars$pen_mat_space <- xt[[space]]$penalty } } xt_list <- list(xt = list(list(penalty = rlang::expr(pen_mat_time)), list(penalty = rlang::expr(pen_mat_space)))) - names(xt_list$xt) <- c(time_column, space_column) + names(xt_list$xt) <- c(time, space) } if (is.null(xt)) { - pen_mat_space <- ICAR_space(patches, space_column) + pen_mat_space <- ICAR_space(patches, space) vars$pen_mat_space <- pen_mat_space @@ -379,13 +379,13 @@ ICAR <- function(data_frame, boundaries, time_column, dimension, checkmate::assert_list(xt) lapply(xt, checkmate::assert_list) checkmate::assert_names(names(xt), - subset.of = c(time_column, space_column)) + subset.of = c(time, space)) - if (is.null(xt[[space_column]]$penalty)) { - vars$pen_mat_space <- ICAR_space(patches, space_column) + if (is.null(xt[[space]]$penalty)) { + vars$pen_mat_space <- ICAR_space(patches, space) } else { - checkmate::assert_matrix(xt[[space_column]]$penalty) - vars$pen_mat_space <- xt[[space_column]]$penalty + checkmate::assert_matrix(xt[[space]]$penalty) + vars$pen_mat_space <- xt[[space]]$penalty } } @@ -398,7 +398,7 @@ ICAR <- function(data_frame, boundaries, time_column, dimension, } return(list(args = do.call(c, - args = list(out_column, + args = list(out, list(k = k, bs = bs), xt_list, args_list)), @@ -425,13 +425,13 @@ ICAR_time <- function(time_levels) { } -ICAR_space <- function(patches, space_column) { +ICAR_space <- function(patches, space) { - checkmate::assert_choice(space_column, names(patches)) + checkmate::assert_choice(space, names(patches)) patches_adj_mat = suppressAll(sf::st_intersects(patches, sparse = FALSE)) - dimnames(patches_adj_mat) = list(unique(patches[[space_column]]), - unique(patches[[space_column]])) + dimnames(patches_adj_mat) = list(unique(patches[[space]]), + unique(patches[[space]])) patches_adj_mat = patches_adj_mat + 0 diag(patches_adj_mat) = 0 pen_mat = diag(rowSums(patches_adj_mat)) - patches_adj_mat @@ -445,24 +445,24 @@ ICAR_space <- function(patches, space_column) { # Construct the lag matrix and associated lag columns for the linear predictor # method of fitting the smooth -LINPRED <- function(data_frame, boundaries, time_column, var, k, m, +LINPRED <- function(data_frame, boundaries, time, var, k, m, unused_names = c("dimension", "bs", "xt", "is_spm"), ...) { checkmate::assert_class(data_frame, "sf") checkmate::assert_class(boundaries, "sspm_discrete_boundary") - checkmate::assert_character(time_column) + checkmate::assert_character(time) # Recapture the ellipsis again args_list <- as.list(match.call(expand.dots = FALSE)$`...`) args_list <- args_list[!(names(args_list) %in% unused_names)] # Make the lag matrix - boundary_col <- spm_boundary_column(boundaries) + boundary_col <- spm_boundary(boundaries) lag_matrix <- as.data.frame(matrix(-(1:k), nrow = nrow(data_frame), ncol = k, byrow = TRUE)) %>% dplyr::rename_all(.funs = gsub, pattern = "V", replacement = "lag") %>% - dplyr::mutate(!!time_column := data_frame[[time_column]], + dplyr::mutate(!!time := data_frame[[time]], !!boundary_col := data_frame[[boundary_col]], "patch_id" = data_frame[["patch_id"]]) %>% dplyr::select(dplyr::contains('lag')) %>% @@ -470,7 +470,7 @@ LINPRED <- function(data_frame, boundaries, time_column, var, k, m, by_matrix <- data_frame %>% sf::st_set_geometry(NULL) %>% - dplyr::select(.data$patch_id, !!boundary_col, !!time_column, !!var) %>% + dplyr::select(.data$patch_id, !!boundary_col, !!time, !!var) %>% dplyr::nest_by(.data$patch_id, !!boundary_col := .data[[boundary_col]]) %>% dplyr::mutate(lags = list(multilag(variable = .data$data[[var]], n_lags = k, @@ -483,13 +483,13 @@ LINPRED <- function(data_frame, boundaries, time_column, var, k, m, dplyr::select(-dplyr::contains(var)) %>% as.matrix() - out_column <- list(str2lang("lag_matrix")) + out <- list(str2lang("lag_matrix")) vars <- list() vars$lag_matrix <- lag_matrix vars$by_matrix <- by_matrix return(list(args = do.call(c, - args = list(out_column, + args = list(out, list(k = k, m = m, by = str2lang("by_matrix")), args_list)), diff --git a/R/spm.R b/R/spm.R index 4f6398a0..9a7f6d6b 100644 --- a/R/spm.R +++ b/R/spm.R @@ -50,14 +50,14 @@ setMethod(f = "spm", # dplyr::filter(.data$train_test == TRUE) # 2. call map_formula - time_column <- spm_time_column(sspm_object) + time <- spm_time(sspm_object) boundaries <- spm_boundaries(sspm_object) # Pass onto the sspm_dataset method sspm_formula <- map_formula(data_frame = all_data, boundaries = boundaries, formula = formula, - time_column = time_column, + time = time, ...) # Call the fit function @@ -67,7 +67,7 @@ setMethod(f = "spm", sspm_fit <- new("sspm_fit", smoothed_data = all_data, - time_column = spm_time_column(sspm_object), + time = spm_time(sspm_object), uniqueID = spm_unique_ID(sspm_object), formula = sspm_formula, boundaries = spm_boundaries(sspm_object), diff --git a/R/spm_aggregate.R b/R/spm_aggregate.R index e757cccb..8cc87424 100644 --- a/R/spm_aggregate.R +++ b/R/spm_aggregate.R @@ -53,7 +53,7 @@ setMethod(f = "spm_aggregate", checkmate::assert_function(fun) checkmate::assert_choice(group_by, spm_aggregation_choices()) - time_col <- spm_time_column(dataset) + time_col <- spm_time(dataset) if (!is_mapped(dataset)) { # Need to map dataset dataset <- join_datasets(dataset, boundaries) diff --git a/R/spm_aggregate_catch.R b/R/spm_aggregate_catch.R index 4a8d6701..0c6443e1 100644 --- a/R/spm_aggregate_catch.R +++ b/R/spm_aggregate_catch.R @@ -72,10 +72,10 @@ setMethod(f = "spm_aggregate_catch", cli::cli_alert_info(info_message) # Get the right columns - biomass_time_col <- spm_time_column(biomass) - catch_time_col <- spm_time_column(catch) - boundary_col <- spm_boundary_column(spm_boundaries(biomass)) - area_col <- spm_patches_area_column(spm_boundaries(biomass)) + biomass_time_col <- spm_time(biomass) + catch_time_col <- spm_time(catch) + boundary_col <- spm_boundary(spm_boundaries(biomass)) + area_col <- spm_patches_area(spm_boundaries(biomass)) # Aggregate the catch catch <- spm_aggregate(dataset = catch, diff --git a/R/spm_as_boundary.R b/R/spm_as_boundary.R index 4142b2f4..19fa1d97 100644 --- a/R/spm_as_boundary.R +++ b/R/spm_as_boundary.R @@ -3,13 +3,13 @@ #' Create a sspm_boundary object. #' #' @param boundaries **\[sf\]** The sf object to cast. -#' @param boundary_column **\[character\]** The column that contains the possible +#' @param boundary **\[character\]** The column that contains the possible #' subdivisions of the boundaries. #' @param patches **\[sf\]** Patches resulting from discretization. #' @param points **\[sf\]** Sample points used for discretization. -#' @param boundary_area_column **\[character\]** The column that contains the area +#' @param boundary_area **\[character\]** The column that contains the area #' of the subdivisions (optional). -#' @param patch_area_column **\[character\]** The column that contains the area +#' @param patch_area **\[character\]** The column that contains the area #' of the patches (optional). #' #' @return @@ -19,11 +19,11 @@ #' @export setGeneric(name = "spm_as_boundary", def = function(boundaries, - boundary_column, + boundary, patches = NULL, points = NULL, - boundary_area_column = NULL, - patch_area_column = NULL) { + boundary_area = NULL, + patch_area = NULL) { standardGeneric("spm_as_boundary") } ) @@ -34,8 +34,8 @@ setGeneric(name = "spm_as_boundary", #' @rdname spm_as_boundary setMethod(f = "spm_as_boundary", signature(boundaries = "missing"), - function(boundaries, boundary_column, patches, points, - boundary_area_column, patch_area_column) { + function(boundaries, boundary, patches, points, + boundary_area, patch_area) { stop("`boundaries` cannot be missing", call. = FALSE) } @@ -44,10 +44,10 @@ setMethod(f = "spm_as_boundary", #' @export #' @rdname spm_as_boundary setMethod(f = "spm_as_boundary", - signature(boundary_column = "missing"), - function(boundaries, boundary_column, patches, points, - boundary_area_column, patch_area_column) { - stop("`boundary_column` cannot be missing", + signature(boundary = "missing"), + function(boundaries, boundary, patches, points, + boundary_area, patch_area) { + stop("`boundary` cannot be missing", call. = FALSE) } ) @@ -56,23 +56,23 @@ setMethod(f = "spm_as_boundary", #' @rdname spm_as_boundary setMethod(f = "spm_as_boundary", signature(boundaries = "sf", - boundary_column = "character", + boundary = "character", patches = "missing", points = "missing"), - function(boundaries, boundary_column, patches, points, - boundary_area_column, patch_area_column) { + function(boundaries, boundary, patches, points, + boundary_area, patch_area) { - boundaries_list <- check_boundaries(boundaries, boundary_column, - boundary_area_column) + boundaries_list <- check_boundaries(boundaries, boundary, + boundary_area) boundaries <- boundaries_list$features - boundary_area_column <- boundaries_list$column + boundary_area <- boundaries_list$column boundary_object <- new("sspm_boundary", boundaries = boundaries, - boundary_column = boundary_column, - boundary_area_column = boundary_area_column) + boundary = boundary, + boundary_area = boundary_area) return(boundary_object) @@ -83,30 +83,30 @@ setMethod(f = "spm_as_boundary", #' @rdname spm_as_boundary setMethod(f = "spm_as_boundary", signature(boundaries = "sf", - boundary_column = "character", + boundary = "character", patches = "ANY", points = "ANY"), - function(boundaries, boundary_column, patches, points, - boundary_area_column, patch_area_column) { + function(boundaries, boundary, patches, points, + boundary_area, patch_area) { checkmate::assert_class(patches, "sf", null.ok = TRUE) checkmate::assert_class(points, "sf", null.ok = TRUE) # Boundaries - boundaries_list <- check_boundaries(boundaries, boundary_column, - boundary_area_column) + boundaries_list <- check_boundaries(boundaries, boundary, + boundary_area) boundaries <- boundaries_list$features - boundary_area_column <- boundaries_list$column + boundary_area <- boundaries_list$column # Patches ## TODO patches vs points provision patches_list <- check_patches(patches, - patch_area_column) + patch_area) patches <- patches_list$features - patch_area_column <- patches_list$column + patch_area <- patches_list$column patches <- patches %>% dplyr::mutate(patch_id = @@ -114,9 +114,9 @@ setMethod(f = "spm_as_boundary", dplyr::mutate(patch_id = factor(.data$patch_id, levels = paste0("P", 1:length(unique(.data$patch_id))))) %>% - dplyr::relocate("patch_id", .after = boundary_column) %>% + dplyr::relocate("patch_id", .after = boundary) %>% # TODO add option for joining here as well - dplyr::mutate(!!boundary_column := as.factor(.data[[boundary_column]])) + dplyr::mutate(!!boundary := as.factor(.data[[boundary]])) # Points ## TODO @@ -124,10 +124,10 @@ setMethod(f = "spm_as_boundary", boundary_object <- new("sspm_discrete_boundary", boundaries = boundaries, - boundary_column = boundary_column, - boundary_area_column = boundary_area_column, + boundary = boundary, + boundary_area = boundary_area, method = as_discretization_method(method = I), - patches_area_column = patch_area_column, + patches_area = patch_area, patches = patches, points = points) @@ -136,27 +136,27 @@ setMethod(f = "spm_as_boundary", # ------------------------------------------------------------------------- -check_boundaries <- function(boundaries, boundary_column, - boundary_area_column){ +check_boundaries <- function(boundaries, boundary, + boundary_area){ checkmate::assert_class(boundaries, "sf") - checkmate::assert_class(boundary_column, "character") - checkmate::assert_class(boundary_area_column, "character", null.ok = TRUE) + checkmate::assert_class(boundary, "character") + checkmate::assert_class(boundary_area, "character", null.ok = TRUE) - if (!checkmate::test_subset(boundary_column, names(boundaries))) { - stop("`boundary_column` must be a column of `boundaries`", + if (!checkmate::test_subset(boundary, names(boundaries))) { + stop("`boundary` must be a column of `boundaries`", call. = FALSE) } # Ensure boundaries are factors - boundaries[[boundary_column]] <- as.factor(boundaries[[boundary_column]]) + boundaries[[boundary]] <- as.factor(boundaries[[boundary]]) - new_boundary_area_column <- paste0("area_", boundary_column) + new_boundary_area <- paste0("area_", boundary) - if(!is.null(boundary_area_column)){ + if(!is.null(boundary_area)){ - if (!checkmate::test_subset(boundary_area_column, names(boundaries))) { - stop("`boundary_area_column` must be a column of `boundaries`", + if (!checkmate::test_subset(boundary_area, names(boundaries))) { + stop("`boundary_area` must be a column of `boundaries`", call. = FALSE) } @@ -164,34 +164,34 @@ check_boundaries <- function(boundaries, boundary_column, boundaries <- dplyr::mutate(boundaries, - !!boundary_area_column := units::set_units(.data[[boundary_area_column]], + !!boundary_area := units::set_units(.data[[boundary_area]], value = "km^2")) %>% - dplyr::rename(!!new_boundary_area_column := .data$boundary_area_column) + dplyr::rename(!!new_boundary_area := .data$boundary_area) } else { boundaries <- calculate_spatial_feature_areas(boundaries) %>% - dplyr::rename(!!new_boundary_area_column := .data$area) + dplyr::rename(!!new_boundary_area := .data$area) } boundary_list <- list(features = boundaries, - column = new_boundary_area_column) + column = new_boundary_area) return(boundary_list) } check_patches <- function(patches, - patches_area_column){ + patches_area){ checkmate::assert_class(patches, "sf") - checkmate::assert_class(patches_area_column, "character", null.ok = TRUE) + checkmate::assert_class(patches_area, "character", null.ok = TRUE) - if(!is.null(patches_area_column)){ + if(!is.null(patches_area)){ - if (!checkmate::test_subset(patches_area_column, names(patches))) { - stop("`boundary_area_column` must be a column of `boundaries`", + if (!checkmate::test_subset(patches_area, names(patches))) { + stop("`boundary_area` must be a column of `boundaries`", call. = FALSE) } @@ -199,19 +199,19 @@ check_patches <- function(patches, patches <- dplyr::mutate(patches, - !!patches_area_column := units::set_units(.data[[patches_area_column]], + !!patches_area := units::set_units(.data[[patches_area]], value = "km^2")) } else { patches <- calculate_spatial_feature_areas(patches) %>% dplyr::rename(patch_area = .data$area) - patches_area_column <- "patch_area" + patches_area <- "patch_area" } patches_list <- list(features = patches, - column = patches_area_column) + column = patches_area) return(patches_list) diff --git a/R/spm_as_dataset.R b/R/spm_as_dataset.R index d21eccbc..05509719 100644 --- a/R/spm_as_dataset.R +++ b/R/spm_as_dataset.R @@ -4,7 +4,7 @@ #' [`sspm_dataset`][sspm_dataset-class]. #' #' @param data **\[data.frame OR sf\]** The dataset. -#' @param time_column **\[character\]** The column of `data` for the temporal +#' @param time **\[character\]** The column of `data` for the temporal #' dimensions (i.e. year). #' @param coords **\[character\]** The column of `data` for longitude and #' latitude of the observations. @@ -24,7 +24,7 @@ #' #' @export setGeneric(name = "spm_as_dataset", - def = function(data, name, time_column, uniqueID, coords = NULL, ...) { + def = function(data, name, time, uniqueID, coords = NULL, ...) { if (!checkmate::test_subset(uniqueID, names(data))) { stop("`uniqueID` must be a column of `data`", call. = FALSE) @@ -34,12 +34,12 @@ setGeneric(name = "spm_as_dataset", stop("`uniqueID` must be unique for each row of `data`", call. = FALSE) } - if (!checkmate::test_subset(time_column, names(data))) { - stop("`time_column` must be a column of `data`", call. = FALSE) + if (!checkmate::test_subset(time, names(data))) { + stop("`time` must be a column of `data`", call. = FALSE) } - if (!checkmate::test_factor(data[[time_column]])) { - stop("`time_column` must be a factor", call. = FALSE) + if (!checkmate::test_factor(data[[time]])) { + stop("`time` must be a factor", call. = FALSE) } standardGeneric("spm_as_dataset") @@ -52,7 +52,7 @@ setGeneric(name = "spm_as_dataset", #' @export setMethod(f = "spm_as_dataset", signature(data = "data.frame", coords = "missingOrNULL"), - function(data, name, time_column, uniqueID, coords, crs = NULL, + function(data, name, time, uniqueID, coords, crs = NULL, boundaries = NULL, biomass = NULL, density = NULL, biomass_units = NULL, density_units = NULL) { @@ -66,11 +66,11 @@ setMethod(f = "spm_as_dataset", #' @export setMethod(f = "spm_as_dataset", signature(data = "data.frame", coords = "list"), - function(data, name, time_column, uniqueID, coords, crs = NULL, + function(data, name, time, uniqueID, coords, crs = NULL, boundaries = NULL, biomass = NULL, density = NULL, biomass_units = "kg", density_units = "kg/km^2") { coords <- unlist(coords) - spm_as_dataset(data, name, time_column, uniqueID, coords, crs, boundaries, + spm_as_dataset(data, name, time, uniqueID, coords, crs, boundaries, biomass, density, biomass_units, density_units) } ) @@ -81,7 +81,7 @@ setMethod(f = "spm_as_dataset", #' @export setMethod(f = "spm_as_dataset", signature(data = "data.frame", coords = "character"), - function(data, name, time_column, uniqueID, coords, crs = NULL, + function(data, name, time, uniqueID, coords, crs = NULL, boundaries = NULL, biomass = NULL, density = NULL, biomass_units = "kg", density_units = "kg/km^2") { @@ -111,7 +111,7 @@ setMethod(f = "spm_as_dataset", new_data <- sf::st_as_sf(x = data, coords = coords, crs = crs, remove = FALSE) - spm_as_dataset(new_data, name, time_column, uniqueID, coords, crs, boundaries, + spm_as_dataset(new_data, name, time, uniqueID, coords, crs, boundaries, biomass, density, biomass_units, density_units) } ) @@ -121,7 +121,7 @@ setMethod(f = "spm_as_dataset", #' @export setMethod(f = "spm_as_dataset", signature(data = "sf", coords = "ANY"), - function(data, name, time_column, uniqueID, coords, crs = NULL, + function(data, name, time, uniqueID, coords, crs = NULL, boundaries = NULL, biomass = NULL, density = NULL, biomass_units = "kg", density_units = "kg/km^2") { @@ -139,7 +139,7 @@ setMethod(f = "spm_as_dataset", data = data, biomass = biomass, density = density, - time_column = time_column, + time = time, uniqueID = uniqueID, coords = coords) @@ -170,7 +170,7 @@ setMethod(f = "spm_as_dataset", dplyr::rename(geometry = .data$x) boundaries <- spm_as_boundary(boundaries = boundary_data, - boundary_column = "boundary_col", + boundary = "boundary_col", patches = patches, points = NULL) @@ -179,7 +179,7 @@ setMethod(f = "spm_as_dataset", data = data, biomass = biomass, density = density, - time_column = time_column, + time = time, uniqueID = uniqueID, coords = coords, is_mapped = TRUE, diff --git a/R/spm_discretize.R b/R/spm_discretize.R index f635b84d..521264a2 100644 --- a/R/spm_discretize.R +++ b/R/spm_discretize.R @@ -23,7 +23,7 @@ #' #' 1. Accept at least 1 argument: **boundaries** (the `sf` boundary object), #' and optionnaly **with** (can be NULL) a separate object to be used for -#' discretization and **boundary_column**, the boundary column of +#' discretization and **boundary**, the boundary column of #' **boundaries** (these last 2 arguments are passed and connot be #' overwritten but could be ignored). #' @@ -139,13 +139,13 @@ setMethod(f = "spm_discretize", # Send to discretization routine boundaries <- boundary_object@boundaries - boundary_column <- spm_boundary_column(boundary_object) + boundary <- spm_boundary(boundary_object) other_args <- list(...) discrete <- do.call(method_func(method), args = append(list(boundaries = boundaries, - boundary_column = boundary_column, + boundary = boundary, with = with), other_args)) @@ -157,9 +157,9 @@ setMethod(f = "spm_discretize", new_sspm_discrete_boundary <- new("sspm_discrete_boundary", boundaries = spm_boundaries(boundary_object), - boundary_column = boundary_column, - boundary_area_column = spm_boundary_area_column(boundary_object), - patches_area_column = "patch_area", + boundary = boundary, + boundary_area = spm_boundary_area(boundary_object), + patches_area = "patch_area", method = method, patches = discrete[["patches"]], points = discrete[["points"]]) diff --git a/R/spm_lag.R b/R/spm_lag.R index 5c3c37ce..841ae96e 100644 --- a/R/spm_lag.R +++ b/R/spm_lag.R @@ -77,7 +77,7 @@ lag_data_frame <- function(smoothed_data, boundaries, vars, n, default, ...){ smoothed_data <- smoothed_data %>% dplyr::group_by(.data$patch_id, - .data[[spm_boundary_column(boundaries)]]) %>% + .data[[spm_boundary(boundaries)]]) %>% dplyr::mutate(!!var_name := dplyr::lag(x = .data[[var]], n = n, default = def_val, ...)) %>% dplyr::ungroup() %>% diff --git a/R/spm_smooth.R b/R/spm_smooth.R index 16f0ce02..bbbb3c3d 100644 --- a/R/spm_smooth.R +++ b/R/spm_smooth.R @@ -94,12 +94,12 @@ setMethod(f = "spm_smooth", # 2. call map_formula data_frame <- spm_data(sspm_object_joined) - time_column <- spm_time_column(sspm_object_joined) + time <- spm_time(sspm_object_joined) sspm_formula <- map_formula(data_frame = data_frame, boundaries = boundaries, formula = formula, - time_column = time_column, + time = time, ...) # Check that response is a density @@ -161,7 +161,7 @@ join_datasets <- function(sspm_dataset, sspm_boundary) { join_smoothed_datasets <- function(sspm_object, preds_df){ smoothed_data <- spm_smoothed_data(sspm_object) - time_col <- spm_time_column(sspm_object) + time_col <- spm_time(sspm_object) boundaries <- spm_boundaries(sspm_object) patches <- spm_patches(boundaries) diff --git a/R/spm_split.R b/R/spm_split.R index f9c4ce1b..a1938b9b 100644 --- a/R/spm_split.R +++ b/R/spm_split.R @@ -26,12 +26,12 @@ setMethod(f = "spm_split", # Check correct dataset name the_data <- spm_smoothed_data(sspm_object) - time_col <- spm_time_column(sspm_object) + time_col <- spm_time(sspm_object) # TODO add check if splitted is_factor <- FALSE - if (is.factor(the_data[[spm_time_column(sspm_object)]])) { + if (is.factor(the_data[[spm_time(sspm_object)]])) { is_factor <- TRUE the_data <- the_data %>% dplyr::mutate(!!time_col := as.numeric(as.character(.data[[time_col]]))) diff --git a/R/sspm.R b/R/sspm.R index 5182a8a4..7c31e9b1 100644 --- a/R/sspm.R +++ b/R/sspm.R @@ -37,7 +37,7 @@ setMethod(f = "sspm", new_sspm <- new("sspm", datasets = list(biomass = biomass), - time_column = spm_time_column(biomass), + time = spm_time(biomass), # biomass_var = biomass_var, uniqueID = "row_ID", boundaries = spm_boundaries(biomass), @@ -79,7 +79,7 @@ setMethod(f = "sspm", # 2. Check boundaries biomass_boundaries <- spm_boundaries(biomass) - patch_area_column <- spm_patches_area_column(biomass_boundaries) + patch_area <- spm_patches_area(biomass_boundaries) predictors_boundaries <- lapply(predictors, spm_boundaries) all_boundaries <- unname(append(list(biomass_boundaries), predictors_boundaries)) @@ -98,10 +98,10 @@ setMethod(f = "sspm", cli::cli_alert_info(info_message) biomass_clean <- clean_data_for_joining(spm_smoothed_data(biomass)) - joining_vars <- c("patch_id", spm_boundary_column(spm_boundaries(biomass))) + joining_vars <- c("patch_id", spm_boundary(spm_boundaries(biomass))) - if (patch_area_column %in% names(biomass_clean)) { - joining_vars <- c(joining_vars, patch_area_column) + if (patch_area %in% names(biomass_clean)) { + joining_vars <- c(joining_vars, patch_area) } full_smoothed_data <- biomass_clean @@ -115,13 +115,13 @@ setMethod(f = "sspm", dataset <- predictor %>% spm_smoothed_data() %>% clean_data_for_joining() %>% - dplyr::rename(!!spm_time_column(biomass) := - spm_time_column(predictor)) + dplyr::rename(!!spm_time(biomass) := + spm_time(predictor)) full_smoothed_data <- full_smoothed_data %>% dplyr::left_join(dataset, by = c(dplyr::all_of(joining_vars), - spm_time_column(biomass)), + spm_time(biomass)), suffix = the_suffix) predictor_smoothed_vars <- predictor@smoothed_vars @@ -165,7 +165,7 @@ setMethod(f = "sspm", new_sspm <- new("sspm", datasets = all_data, - time_column = spm_time_column(biomass), + time = spm_time(biomass), # biomass_var = biomass_var, uniqueID = "row_ID", boundaries = spm_boundaries(biomass), diff --git a/R/tesselate_voronoi.R b/R/tesselate_voronoi.R index eef37e79..d39a0d19 100644 --- a/R/tesselate_voronoi.R +++ b/R/tesselate_voronoi.R @@ -6,7 +6,7 @@ #' #' @param boundaries **\[sf\]** The boundaries to be used. #' @param with **\[sf\]** A set of data points to use for voronoisation. -#' @param boundary_column **\[character\]** The column in `boundaries` that is to +#' @param boundary **\[character\]** The column in `boundaries` that is to #' be used for the stratified sampling. #' #' @param sample_surface **\[logical]** Whether to sample the surfaces in @@ -15,7 +15,7 @@ #' to take all points in `with`. Default to `TRUE`. #' #' @param nb_samples **\[named character vector\]** The number of samples to draw -#' by boundary polygons (must bear the levels of `boundary_column` as names +#' by boundary polygons (must bear the levels of `boundary` as names #' or be a single value to be applied to each level). #' @param min_size **\[numeric\]** The minimum size for a polygon above which it #' will be merged (in km2). @@ -33,7 +33,7 @@ #' @export tesselate_voronoi <- function(boundaries, with, - boundary_column = "sfa", + boundary = "sfa", sample_surface = FALSE, sample_points = TRUE, nb_samples = NULL, @@ -52,10 +52,10 @@ tesselate_voronoi <- function(boundaries, checkmate::assert_logical(sample_surface) checkmate::assert_logical(sample_points) - checkmate::assert_character(boundary_column) + checkmate::assert_character(boundary) - if (!checkmate::test_subset(boundary_column, names(boundaries))) { - stop("`boundary_column` must be a column of `boundaries`", + if (!checkmate::test_subset(boundary, names(boundaries))) { + stop("`boundary` must be a column of `boundaries`", call. = FALSE) } @@ -63,7 +63,7 @@ tesselate_voronoi <- function(boundaries, checkmate::assert_numeric(min_size) checkmate::assert_numeric(seed) - unique_boundaries <- unique(boundaries[[boundary_column]]) + unique_boundaries <- unique(boundaries[[boundary]]) if (length(nb_samples) == 1){ nb_samples <- rep(nb_samples, length(unique_boundaries)) @@ -80,7 +80,7 @@ tesselate_voronoi <- function(boundaries, if (getRversion() >= 3.6) suppressWarnings(RNGkind(sample.kind = "Rounding")) # 2. Create (sample) the points - boundaries_split <- split(boundaries, boundaries[[boundary_column]]) + boundaries_split <- split(boundaries, boundaries[[boundary]]) if (sample_surface){ @@ -89,14 +89,14 @@ tesselate_voronoi <- function(boundaries, stop("nb_samples is NULL") } - sample_fun <- function(polygon, boundary_column, nb_samples){ + sample_fun <- function(polygon, boundary, nb_samples){ sf::st_sample(polygon, - size = nb_samples[polygon[[boundary_column]]]) + size = nb_samples[polygon[[boundary]]]) } set.seed(seed) ; voronoi_points <- lapply(boundaries_split, FUN = sample_fun, - boundary_column = boundary_column, + boundary = boundary, nb_samples = nb_samples) %>% lapply(sf::st_as_sf) %>% dplyr::bind_rows() %>% @@ -120,18 +120,18 @@ tesselate_voronoi <- function(boundaries, set.seed(seed) ; voronoi_points <- suppressMessages(sf::st_join(with, boundaries, suffix = c("", "_duplicate"))) %>% - dplyr::filter(!is.na(eval(dplyr::sym(boundary_column)))) %>% - dplyr::group_by(.data[[boundary_column]]) %>% + dplyr::filter(!is.na(eval(dplyr::sym(boundary)))) %>% + dplyr::group_by(.data[[boundary]]) %>% dplyr::filter(1:dplyr::n() %in% sample(1:dplyr::n(), - size = nb_samples[[.data[[boundary_column]][1]]])) + size = nb_samples[[.data[[boundary]][1]]])) } else { # TODO checks that with is points geometry here voronoi_points <- suppressMessages(sf::st_join(with, boundaries, suffix = c("", "_duplicate"))) %>% - dplyr::filter(!is.na(eval(dplyr::sym(boundary_column)))) + dplyr::filter(!is.na(eval(dplyr::sym(boundary)))) } @@ -145,7 +145,7 @@ tesselate_voronoi <- function(boundaries, lapply(function(x) { x[["geometry"]] } ) voronoi <- voronoi_points %>% - split(voronoi_points[[boundary_column]]) %>% + split(voronoi_points[[boundary]]) %>% lapply(function(x) { suppressAll(sf::st_union(x)) } ) %>% mapply(FUN = function(x, y) { suppressAll(sf::st_voronoi(x, envelope = y)) }, @@ -179,7 +179,7 @@ tesselate_voronoi <- function(boundaries, st_cast("POLYGON") %>% sf::st_make_valid() %>% dplyr::mutate(patch_id = paste("P", 1:dplyr::n(), sep = "")) %>% - dplyr::group_by(.data$patch_id, .data[[boundary_column]]) %>% + dplyr::group_by(.data$patch_id, .data[[boundary]]) %>% dplyr::summarize() %>% sf::st_make_valid() %>% dplyr::ungroup()) @@ -202,8 +202,8 @@ tesselate_voronoi <- function(boundaries, # TODO this could maybe be vectorized for (i in small_voronoi) { current_polygons <- voronoi[voronoi_edges[[i]], ] %>% - dplyr::filter(.data[[boundary_column]] == - unique(.data[[boundary_column]][.data$patch_id == i])) %>% + dplyr::filter(.data[[boundary]] == + unique(.data[[boundary]][.data$patch_id == i])) %>% dplyr::filter(.data$area == max(.data$area)) max_id <- current_polygons$patch_id voronoi$patch_id[voronoi$patch_id == i] <- max_id @@ -215,7 +215,7 @@ tesselate_voronoi <- function(boundaries, suppressWarnings( suppressMessages( voronoi %>% - dplyr::group_by(.data[[boundary_column]], .data$patch_id) %>% + dplyr::group_by(.data[[boundary]], .data$patch_id) %>% dplyr::summarize() %>% dplyr::ungroup())) voronoi <- diff --git a/R/triangulate_delauney.R b/R/triangulate_delauney.R index e297a693..85c7191a 100644 --- a/R/triangulate_delauney.R +++ b/R/triangulate_delauney.R @@ -4,7 +4,7 @@ #' #' @param boundaries **\[sf\]** The boundaries to be used. #' @param with **\[sf\]** A set of data points to use for voronoisation. -#' @param boundary_column **\[character\]** The column in `boundaries` that is to +#' @param boundary **\[character\]** The column in `boundaries` that is to #' be used for the stratified sampling. #' #' @param sample_surface **\[logical]** Whether to sample the surfaces in @@ -13,7 +13,7 @@ #' to take all points in `with`. Default to `TRUE`. #' #' @param nb_samples **\[named character vector\]** The number of samples to draw -#' by boundary polygons (must bear the levels of `boundary_column` as names +#' by boundary polygons (must bear the levels of `boundary` as names #' or be a single value to be applied to each level). #' @param min_size **\[numeric\]** The minimum size for a triangle above which it #' will be merged (in km2). @@ -31,7 +31,7 @@ #' @export triangulate_delaunay <- function(boundaries, with = NULL, - boundary_column = "sfa", + boundary = "sfa", sample_surface = FALSE, sample_points = FALSE, nb_samples = NULL, @@ -50,10 +50,10 @@ triangulate_delaunay <- function(boundaries, checkmate::assert_logical(sample_surface) checkmate::assert_logical(sample_points) - checkmate::assert_character(boundary_column) + checkmate::assert_character(boundary) - if (!checkmate::test_subset(boundary_column, names(boundaries))) { - stop("`boundary_column` must be a column of `boundaries`", + if (!checkmate::test_subset(boundary, names(boundaries))) { + stop("`boundary` must be a column of `boundaries`", call. = FALSE) } @@ -66,7 +66,7 @@ triangulate_delaunay <- function(boundaries, checkmate::assert_numeric(min_size) checkmate::assert_numeric(seed) - unique_boundaries <- unique(boundaries[[boundary_column]]) + unique_boundaries <- unique(boundaries[[boundary]]) if (length(nb_samples) == 1){ nb_samples <- rep(nb_samples, length(unique_boundaries)) names(nb_samples) <- unique_boundaries @@ -82,18 +82,18 @@ triangulate_delaunay <- function(boundaries, if (getRversion() >= 3.6) suppressWarnings(RNGkind(sample.kind = "Rounding")) # 2. Create (sample) the points - boundaries_split <- split(boundaries, boundaries[[boundary_column]]) + boundaries_split <- split(boundaries, boundaries[[boundary]]) if (sample_surface){ - sample_fun <- function(polygon, boundary_column, nb_samples){ + sample_fun <- function(polygon, boundary, nb_samples){ sf::st_sample(polygon, - size = nb_samples[polygon[[boundary_column]]]) + size = nb_samples[polygon[[boundary]]]) } set.seed(seed) ; delaunay_base <- lapply(boundaries_split, FUN = sample_fun, - boundary_column = boundary_column, + boundary = boundary, nb_samples = nb_samples) %>% lapply(sf::st_as_sf) %>% dplyr::bind_rows() %>% @@ -104,11 +104,11 @@ triangulate_delaunay <- function(boundaries, set.seed(seed) ; delaunay_base <- suppressMessages(sf::st_join(with, boundaries)) %>% - dplyr::filter(!is.na(eval(dplyr::sym(boundary_column)))) %>% - dplyr::group_by(.data[[boundary_column]]) %>% + dplyr::filter(!is.na(eval(dplyr::sym(boundary)))) %>% + dplyr::group_by(.data[[boundary]]) %>% dplyr::filter(1:dplyr::n() %in% sample(1:dplyr::n(), - size = nb_samples[[.data[[boundary_column]][1]]])) + size = nb_samples[[.data[[boundary]][1]]])) } else if (!is.null(with)) { @@ -158,7 +158,7 @@ triangulate_delaunay <- function(boundaries, # suppressAll(voronoi %>% # sf::st_make_valid() %>% # dplyr::mutate(patch_id = paste("P", 1:dplyr::n(), sep = "")) %>% - # dplyr::group_by(.data$patch_id, .data[[boundary_column]]) %>% + # dplyr::group_by(.data$patch_id, .data[[boundary]]) %>% # dplyr::summarize() %>% # dplyr::ungroup()) @@ -182,8 +182,8 @@ triangulate_delaunay <- function(boundaries, # TODO vectorize this for (i in small_triangle) { current_triangles <- delaunay_mesh[voronoi_edges[[i]], ] %>% - dplyr::filter(.data[[boundary_column]] == - unique(.data[[boundary_column]][.data$patch_id == i])) %>% + dplyr::filter(.data[[boundary]] == + unique(.data[[boundary]][.data$patch_id == i])) %>% dplyr::filter(.data$area == max(.data$area)) max_id <- current_triangles$patch_id delaunay_mesh$patch_id[delaunay_mesh$patch_id == i] <- max_id @@ -195,7 +195,7 @@ triangulate_delaunay <- function(boundaries, suppressWarnings( suppressMessages( delaunay_mesh %>% - dplyr::group_by(.data[[boundary_column]], .data$patch_id) %>% + dplyr::group_by(.data[[boundary]], .data$patch_id) %>% dplyr::summarize() %>% dplyr::ungroup())) delaunay_mesh <- diff --git a/README.Rmd b/README.Rmd index 4399dae2..1ddfbcaf 100644 --- a/README.Rmd +++ b/README.Rmd @@ -58,11 +58,11 @@ catch <- sspm:::catch_simulated sfa_boundaries <- sspm:::sfa_boundaries ``` -1. The first step of the `sspm` workflow is to create a `sspm_boundary` from an `sf` object, providing the `boundary_column` that delineates the boundary regions. The object can then be plotted with `spm_plot` (as can most `sspm` objects). +1. The first step of the `sspm` workflow is to create a `sspm_boundary` from an `sf` object, providing the `boundary` that delineates the boundary regions. The object can then be plotted with `spm_plot` (as can most `sspm` objects). ```{r} bounds <- spm_as_boundary(boundaries = sfa_boundaries, - boundary_column = "sfa") + boundary = "sfa") plot(bounds) ``` @@ -73,7 +73,7 @@ plot(bounds) biomass_dataset <- spm_as_dataset(borealis, name = "borealis", density = "weight_per_km2", - time_column = "year_f", + time = "year_f", coords = c('lon_dec','lat_dec'), uniqueID = "uniqueID") @@ -86,7 +86,7 @@ biomass_dataset predator_dataset <- spm_as_dataset(predator, name = "all_predators", density = "weight_per_km2", - time_column = "year", + time = "year", coords = c("lon_dec", "lat_dec"), uniqueID = "uniqueID") @@ -171,7 +171,7 @@ predator_smooth catch_dataset <- spm_as_dataset(catch, name = "catch_data", biomass = "catch", - time_column = "year_f", + time = "year_f", uniqueID = "uniqueID", coords = c("lon_start", "lat_start")) catch_dataset diff --git a/README.md b/README.md index 35f178fd..559d7929 100644 --- a/README.md +++ b/README.md @@ -74,13 +74,13 @@ sfa_boundaries <- sspm:::sfa_boundaries ``` 1. The first step of the `sspm` workflow is to create a `sspm_boundary` - from an `sf` object, providing the `boundary_column` that delineates - the boundary regions. The object can then be plotted with `spm_plot` - (as can most `sspm` objects). + from an `sf` object, providing the `boundary` that delineates the + boundary regions. The object can then be plotted with `spm_plot` (as + can most `sspm` objects). ``` r bounds <- spm_as_boundary(boundaries = sfa_boundaries, - boundary_column = "sfa") + boundary = "sfa") plot(bounds) ``` @@ -99,7 +99,7 @@ plot(bounds) biomass_dataset <- spm_as_dataset(borealis, name = "borealis", density = "weight_per_km2", - time_column = "year_f", + time = "year_f", coords = c('lon_dec','lat_dec'), uniqueID = "uniqueID") #> ℹ Casting data matrix into simple feature collection using columns: lon_dec, lat_dec @@ -121,7 +121,7 @@ biomass_dataset predator_dataset <- spm_as_dataset(predator, name = "all_predators", density = "weight_per_km2", - time_column = "year", + time = "year", coords = c("lon_dec", "lat_dec"), uniqueID = "uniqueID") #> ℹ Casting data matrix into simple feature collection using columns: lon_dec, lat_dec @@ -307,7 +307,7 @@ predator_smooth catch_dataset <- spm_as_dataset(catch, name = "catch_data", biomass = "catch", - time_column = "year_f", + time = "year_f", uniqueID = "uniqueID", coords = c("lon_start", "lat_start")) #> ℹ Casting data matrix into simple feature collection using columns: lon_start, lat_start #> ! Warning: sspm is assuming WGS 84 CRS is to be used for casting diff --git a/man/accessors-methods-sspm_boundary.Rd b/man/accessors-methods-sspm_boundary.Rd index ca445799..322235ba 100644 --- a/man/accessors-methods-sspm_boundary.Rd +++ b/man/accessors-methods-sspm_boundary.Rd @@ -15,18 +15,18 @@ \alias{spm_points,sspm_discrete_boundary-method} \alias{spm_points<-} \alias{spm_points<-,sspm_discrete_boundary-method} -\alias{spm_boundary_column} -\alias{spm_boundary_column,sspm_boundary-method} -\alias{spm_boundary_column<-} -\alias{spm_boundary_column<-,sspm_boundary-method} -\alias{spm_boundary_area_column} -\alias{spm_boundary_area_column,sspm_boundary-method} -\alias{spm_boundary_area_column<-} -\alias{spm_boundary_area_column<-,sspm_boundary-method} -\alias{spm_patches_area_column} -\alias{spm_patches_area_column,sspm_discrete_boundary-method} -\alias{spm_patches_area_column<-} -\alias{spm_patches_area_column<-,sspm_discrete_boundary-method} +\alias{spm_boundary} +\alias{spm_boundary,sspm_boundary-method} +\alias{spm_boundary<-} +\alias{spm_boundary<-,sspm_boundary-method} +\alias{spm_boundary_area} +\alias{spm_boundary_area,sspm_boundary-method} +\alias{spm_boundary_area<-} +\alias{spm_boundary_area<-,sspm_boundary-method} +\alias{spm_patches_area} +\alias{spm_patches_area,sspm_discrete_boundary-method} +\alias{spm_patches_area<-} +\alias{spm_patches_area<-,sspm_discrete_boundary-method} \title{Accessing OR replacing \code{sspm_boundary} model elements} \usage{ \S4method{spm_boundaries}{sspm_boundary}(sspm_object) @@ -57,29 +57,29 @@ spm_points(object) <- value \S4method{spm_points}{sspm_discrete_boundary}(object) <- value -spm_boundary_column(sspm_object) +spm_boundary(sspm_object) -\S4method{spm_boundary_column}{sspm_boundary}(sspm_object) +\S4method{spm_boundary}{sspm_boundary}(sspm_object) -spm_boundary_column(object) <- value +spm_boundary(object) <- value -\S4method{spm_boundary_column}{sspm_boundary}(object) <- value +\S4method{spm_boundary}{sspm_boundary}(object) <- value -spm_boundary_area_column(sspm_object) +spm_boundary_area(sspm_object) -\S4method{spm_boundary_area_column}{sspm_boundary}(sspm_object) +\S4method{spm_boundary_area}{sspm_boundary}(sspm_object) -spm_boundary_area_column(object) <- value +spm_boundary_area(object) <- value -\S4method{spm_boundary_area_column}{sspm_boundary}(object) <- value +\S4method{spm_boundary_area}{sspm_boundary}(object) <- value -spm_patches_area_column(sspm_object) +spm_patches_area(sspm_object) -\S4method{spm_patches_area_column}{sspm_discrete_boundary}(sspm_object) +\S4method{spm_patches_area}{sspm_discrete_boundary}(sspm_object) -spm_patches_area_column(object) <- value +spm_patches_area(object) <- value -\S4method{spm_patches_area_column}{sspm_discrete_boundary}(object) <- value +\S4method{spm_patches_area}{sspm_discrete_boundary}(object) <- value } \arguments{ \item{sspm_object}{\strong{[sspm_boundary]} An object of class diff --git a/man/accessors-methods-sspm_dataset.Rd b/man/accessors-methods-sspm_dataset.Rd index d2e8436a..edba1aaf 100644 --- a/man/accessors-methods-sspm_dataset.Rd +++ b/man/accessors-methods-sspm_dataset.Rd @@ -13,8 +13,8 @@ \alias{spm_coords_col,sspm_dataset-method} \alias{spm_coords_col<-} \alias{spm_coords_col<-,sspm_dataset-method} -\alias{spm_time_column,sspm_dataset-method} -\alias{spm_time_column<-,sspm_dataset-method} +\alias{spm_time,sspm_dataset-method} +\alias{spm_time<-,sspm_dataset-method} \alias{spm_formulas} \alias{spm_formulas,sspm_dataset-method} \alias{spm_formulas<-} @@ -57,9 +57,9 @@ spm_coords_col(object) <- value \S4method{spm_coords_col}{sspm_dataset}(object) <- value -\S4method{spm_time_column}{sspm_dataset}(sspm_object) +\S4method{spm_time}{sspm_dataset}(sspm_object) -\S4method{spm_time_column}{sspm_dataset}(object) <- value +\S4method{spm_time}{sspm_dataset}(object) <- value spm_formulas(sspm_object) diff --git a/man/accessors-methods-sspm_fit.Rd b/man/accessors-methods-sspm_fit.Rd index 29603751..df43db0a 100644 --- a/man/accessors-methods-sspm_fit.Rd +++ b/man/accessors-methods-sspm_fit.Rd @@ -3,8 +3,8 @@ \name{spm_unique_ID,sspm_fit-method} \alias{spm_unique_ID,sspm_fit-method} \alias{spm_unique_ID<-,sspm_fit-method} -\alias{spm_time_column,sspm_fit-method} -\alias{spm_time_column<-,sspm_fit-method} +\alias{spm_time,sspm_fit-method} +\alias{spm_time<-,sspm_fit-method} \alias{spm_formulas,sspm_fit-method} \alias{spm_formulas<-,sspm_fit-method} \alias{spm_smoothed_data,sspm_fit-method} @@ -15,17 +15,17 @@ \alias{spm_get_fit<-,sspm_fit-method} \alias{spm_boundaries,sspm_fit-method} \alias{spm_boundaries<-,sspm_fit-method} -\alias{spm_boundary_column,sspm_fit-method} -\alias{spm_boundary_column<-,sspm_fit-method} +\alias{spm_boundary,sspm_fit-method} +\alias{spm_boundary<-,sspm_fit-method} \title{Accessing OR replacing \code{sspm_fit} model elements} \usage{ \S4method{spm_unique_ID}{sspm_fit}(sspm_object) \S4method{spm_unique_ID}{sspm_fit}(object) <- value -\S4method{spm_time_column}{sspm_fit}(sspm_object) +\S4method{spm_time}{sspm_fit}(sspm_object) -\S4method{spm_time_column}{sspm_fit}(object) <- value +\S4method{spm_time}{sspm_fit}(object) <- value \S4method{spm_formulas}{sspm_fit}(sspm_object) @@ -47,9 +47,9 @@ spm_get_fit(object) <- value \S4method{spm_boundaries}{sspm_fit}(object) <- value -\S4method{spm_boundary_column}{sspm_fit}(sspm_object) +\S4method{spm_boundary}{sspm_fit}(sspm_object) -\S4method{spm_boundary_column}{sspm_fit}(object) <- value +\S4method{spm_boundary}{sspm_fit}(object) <- value } \arguments{ \item{sspm_object}{\strong{[sspm_fit]} An object of class diff --git a/man/map_formula.Rd b/man/map_formula.Rd index eed98af4..a5184e8b 100644 --- a/man/map_formula.Rd +++ b/man/map_formula.Rd @@ -8,9 +8,9 @@ \alias{spm_smooth,ANY,ANY,sspm_boundary-method} \title{Map model formula onto a sspm_dataset object} \usage{ -map_formula(data_frame, boundaries, formula, time_column, ...) +map_formula(data_frame, boundaries, formula, time, ...) -\S4method{map_formula}{sf,ANY,formula}(data_frame, boundaries, formula, time_column, ...) +\S4method{map_formula}{sf,ANY,formula}(data_frame, boundaries, formula, time, ...) \S4method{spm_smooth}{ANY,missing,ANY}( sspm_object, @@ -48,7 +48,7 @@ map_formula(data_frame, boundaries, formula, time_column, ...) \item{formula}{\strong{[formula]} A formula definition of the form response ~ smoothing_terms + ...} -\item{time_column}{\strong{[character]} The time column.} +\item{time}{\strong{[character]} The time column.} \item{...}{ a list of variables that are the covariates that this smooth is a function of. Transformations whose form depends on diff --git a/man/smooths.Rd b/man/smooths.Rd index 03b84a02..36619f9f 100644 --- a/man/smooths.Rd +++ b/man/smooths.Rd @@ -14,7 +14,7 @@ smooth_time( data_frame, boundaries, - time_column, + time, type = "ICAR", k = NULL, bs = "re", @@ -26,7 +26,7 @@ smooth_time( smooth_space( data_frame, boundaries, - time_column, + time, type = "ICAR", k = NULL, bs = "mrf", @@ -38,7 +38,7 @@ smooth_space( smooth_space_time( data_frame, boundaries, - time_column, + time, type = "ICAR", k = NULL, bs = c("re", "mrf"), @@ -51,7 +51,7 @@ smooth_lag( var, data_frame, boundaries, - time_column, + time, type = "LINPRED", k = 5, m = 1, @@ -61,7 +61,7 @@ smooth_lag( \S4method{smooth_time}{sf,sspm_discrete_boundary}( data_frame, boundaries, - time_column, + time, type = "ICAR", k = NULL, bs = "re", @@ -73,7 +73,7 @@ smooth_lag( \S4method{smooth_space}{sf,sspm_discrete_boundary}( data_frame, boundaries, - time_column, + time, type = "ICAR", k = NULL, bs = "mrf", @@ -85,7 +85,7 @@ smooth_lag( \S4method{smooth_space_time}{sf,sspm_discrete_boundary}( data_frame, boundaries, - time_column, + time, type = "ICAR", k = NULL, bs = c("re", "mrf"), @@ -98,7 +98,7 @@ smooth_lag( var, data_frame, boundaries, - time_column, + time, type = "LINPRED", k = 5, m = 1, @@ -111,7 +111,7 @@ smooth_lag( \item{boundaries}{\strong{[sspm_boundary]} An object of class \link[=sspm_boundary-class]{sspm_discrete_boundary}.} -\item{time_column}{\strong{[character]} The time column.} +\item{time}{\strong{[character]} The time column.} \item{type}{\strong{[character]} Type of smooth, currently only "ICAR" is supported.} diff --git a/man/spm_as_boundary.Rd b/man/spm_as_boundary.Rd index a4cee93e..1680b597 100644 --- a/man/spm_as_boundary.Rd +++ b/man/spm_as_boundary.Rd @@ -10,63 +10,63 @@ \usage{ spm_as_boundary( boundaries, - boundary_column, + boundary, patches = NULL, points = NULL, - boundary_area_column = NULL, - patch_area_column = NULL + boundary_area = NULL, + patch_area = NULL ) \S4method{spm_as_boundary}{missing,ANY,ANY,ANY}( boundaries, - boundary_column, + boundary, patches = NULL, points = NULL, - boundary_area_column = NULL, - patch_area_column = NULL + boundary_area = NULL, + patch_area = NULL ) \S4method{spm_as_boundary}{ANY,missing,ANY,ANY}( boundaries, - boundary_column, + boundary, patches = NULL, points = NULL, - boundary_area_column = NULL, - patch_area_column = NULL + boundary_area = NULL, + patch_area = NULL ) \S4method{spm_as_boundary}{sf,character,missing,missing}( boundaries, - boundary_column, + boundary, patches = NULL, points = NULL, - boundary_area_column = NULL, - patch_area_column = NULL + boundary_area = NULL, + patch_area = NULL ) \S4method{spm_as_boundary}{sf,character,ANY,ANY}( boundaries, - boundary_column, + boundary, patches = NULL, points = NULL, - boundary_area_column = NULL, - patch_area_column = NULL + boundary_area = NULL, + patch_area = NULL ) } \arguments{ \item{boundaries}{\strong{[sf]} The sf object to cast.} -\item{boundary_column}{\strong{[character]} The column that contains the possible +\item{boundary}{\strong{[character]} The column that contains the possible subdivisions of the boundaries.} \item{patches}{\strong{[sf]} Patches resulting from discretization.} \item{points}{\strong{[sf]} Sample points used for discretization.} -\item{boundary_area_column}{\strong{[character]} The column that contains the area +\item{boundary_area}{\strong{[character]} The column that contains the area of the subdivisions (optional).} -\item{patch_area_column}{\strong{[character]} The column that contains the area +\item{patch_area}{\strong{[character]} The column that contains the area of the patches (optional).} } \value{ diff --git a/man/spm_as_dataset.Rd b/man/spm_as_dataset.Rd index 94478ab3..ad7d0bdb 100644 --- a/man/spm_as_dataset.Rd +++ b/man/spm_as_dataset.Rd @@ -8,12 +8,12 @@ \alias{spm_as_dataset,sf,ANY,ANY,ANY,ANY-method} \title{Create a \code{sspm_dataset} dataset structure} \usage{ -spm_as_dataset(data, name, time_column, uniqueID, coords = NULL, ...) +spm_as_dataset(data, name, time, uniqueID, coords = NULL, ...) \S4method{spm_as_dataset}{data.frame,ANY,ANY,ANY,missingOrNULL}( data, name, - time_column, + time, uniqueID, coords, crs = NULL, @@ -27,7 +27,7 @@ spm_as_dataset(data, name, time_column, uniqueID, coords = NULL, ...) \S4method{spm_as_dataset}{data.frame,ANY,ANY,ANY,list}( data, name, - time_column, + time, uniqueID, coords, crs = NULL, @@ -41,7 +41,7 @@ spm_as_dataset(data, name, time_column, uniqueID, coords = NULL, ...) \S4method{spm_as_dataset}{data.frame,ANY,ANY,ANY,character}( data, name, - time_column, + time, uniqueID, coords, crs = NULL, @@ -55,7 +55,7 @@ spm_as_dataset(data, name, time_column, uniqueID, coords = NULL, ...) \S4method{spm_as_dataset}{sf,ANY,ANY,ANY,ANY}( data, name, - time_column, + time, uniqueID, coords, crs = NULL, @@ -71,7 +71,7 @@ spm_as_dataset(data, name, time_column, uniqueID, coords = NULL, ...) \item{name}{\strong{[character]} The name of the dataset, default to "Biomass".} -\item{time_column}{\strong{[character]} The column of \code{data} for the temporal +\item{time}{\strong{[character]} The column of \code{data} for the temporal dimensions (i.e. year).} \item{uniqueID}{\strong{[character]} The column of \code{data} that is unique for all diff --git a/man/spm_discretize.Rd b/man/spm_discretize.Rd index 43e0b38b..87ebd166 100644 --- a/man/spm_discretize.Rd +++ b/man/spm_discretize.Rd @@ -52,7 +52,7 @@ Custom discretization functions can be written. The function must: \enumerate{ \item Accept at least 1 argument: \strong{boundaries} (the \code{sf} boundary object), and optionnaly \strong{with} (can be NULL) a separate object to be used for -discretization and \strong{boundary_column}, the boundary column of +discretization and \strong{boundary}, the boundary column of \strong{boundaries} (these last 2 arguments are passed and connot be overwritten but could be ignored). \item Returns a named list with 2 elements: \code{patches}. an \code{sf} object that diff --git a/man/sspm-accessors-methods.Rd b/man/sspm-accessors-methods.Rd index bf4ea23a..a02b1167 100644 --- a/man/sspm-accessors-methods.Rd +++ b/man/sspm-accessors-methods.Rd @@ -16,10 +16,10 @@ \alias{spm_smoothed_data,sspm-method} \alias{spm_smoothed_data<-} \alias{spm_smoothed_data<-,sspm-method} -\alias{spm_time_column} -\alias{spm_time_column,sspm-method} -\alias{spm_time_column<-} -\alias{spm_time_column<-,sspm-method} +\alias{spm_time} +\alias{spm_time,sspm-method} +\alias{spm_time<-} +\alias{spm_time<-,sspm-method} \alias{is_split} \alias{is_split,sspm-method} \alias{is_split<-} @@ -58,13 +58,13 @@ spm_smoothed_data(object) <- value \S4method{spm_smoothed_data}{sspm}(object) <- value -spm_time_column(sspm_object) +spm_time(sspm_object) -\S4method{spm_time_column}{sspm}(sspm_object) +\S4method{spm_time}{sspm}(sspm_object) -spm_time_column(object) <- value +spm_time(object) <- value -\S4method{spm_time_column}{sspm}(object) <- value +\S4method{spm_time}{sspm}(object) <- value is_split(sspm_object) diff --git a/man/sspm-class.Rd b/man/sspm-class.Rd index 537aef0c..c77cd912 100644 --- a/man/sspm-class.Rd +++ b/man/sspm-class.Rd @@ -13,7 +13,7 @@ The \strong{\code{sspm}} model object, made from biomass, predictor and catch da \item{\code{datasets}}{\strong{[list]} List of \link[=sspm_dataset-class]{sspm_dataset} that define variables in the SPM model.} -\item{\code{time_column}}{\strong{[character]} The column of \code{data} that represents the +\item{\code{time}}{\strong{[character]} The column of \code{data} that represents the temporal dimension of the dataset.} \item{\code{uniqueID}}{\strong{[character]} The column of \code{datasets} that is unique for diff --git a/man/sspm_boundary-class.Rd b/man/sspm_boundary-class.Rd index 2f0a0f9c..c68fc344 100644 --- a/man/sspm_boundary-class.Rd +++ b/man/sspm_boundary-class.Rd @@ -19,10 +19,10 @@ object(s) of class \code{sspm_boundary} from an \code{sf} object. \describe{ \item{\code{boundaries}}{\strong{[sf]} Spatial boundaries (polygons).} -\item{\code{boundary_column}}{\strong{[character]} The column of \code{data} that represents the +\item{\code{boundary}}{\strong{[character]} The column of \code{data} that represents the spatial boundaries.} -\item{\code{boundary_area_column}}{\strong{[character]} The column of \code{data} that represents the +\item{\code{boundary_area}}{\strong{[character]} The column of \code{data} that represents the area of spatial boundaries.} \item{\code{method}}{\strong{[\link[=discretization_method-class]{discretization_method}]} @@ -34,7 +34,7 @@ discretization.} \item{\code{points}}{\strong{[sf or NULL]} \emph{(if discrete)} Sample points used for discretization.} -\item{\code{patches_area_column}}{\strong{[character]} The column of \code{data} that represents the +\item{\code{patches_area}}{\strong{[character]} The column of \code{data} that represents the area of patches.} }} diff --git a/man/sspm_dataset-class.Rd b/man/sspm_dataset-class.Rd index 54d1194c..391844a4 100644 --- a/man/sspm_dataset-class.Rd +++ b/man/sspm_dataset-class.Rd @@ -19,7 +19,7 @@ object(s) of class \code{sspm_dataset} from a \code{data.frame}, \code{tibble} o \item{\code{density}}{\strong{[character]} The biomass density columns of \code{data}.} -\item{\code{time_column}}{\strong{[character]} The column of \code{data} that represents the +\item{\code{time}}{\strong{[character]} The column of \code{data} that represents the temporal dimension of the dataset.} \item{\code{coords}}{\strong{[character]} The columns of \code{data} that represent the diff --git a/man/sspm_fit-class.Rd b/man/sspm_fit-class.Rd index 1fb9b60d..b66402e3 100644 --- a/man/sspm_fit-class.Rd +++ b/man/sspm_fit-class.Rd @@ -12,7 +12,7 @@ The fit object for a sspm model \describe{ \item{\code{smoothed_data}}{\strong{[ANY (sf)]} The smoothed data.} -\item{\code{time_column}}{\strong{[character]} The column of \code{smoothed_data} that +\item{\code{time}}{\strong{[character]} The column of \code{smoothed_data} that represents the temporal dimension of the dataset.} \item{\code{uniqueID}}{\strong{[character]} The column of \code{smoothed_data} that is unique diff --git a/man/tesselate_voronoi.Rd b/man/tesselate_voronoi.Rd index 528cbfd7..a3a07a1c 100644 --- a/man/tesselate_voronoi.Rd +++ b/man/tesselate_voronoi.Rd @@ -7,7 +7,7 @@ tesselate_voronoi( boundaries, with, - boundary_column = "sfa", + boundary = "sfa", sample_surface = FALSE, sample_points = TRUE, nb_samples = NULL, @@ -21,7 +21,7 @@ tesselate_voronoi( \item{with}{\strong{[sf]} A set of data points to use for voronoisation.} -\item{boundary_column}{\strong{[character]} The column in \code{boundaries} that is to +\item{boundary}{\strong{[character]} The column in \code{boundaries} that is to be used for the stratified sampling.} \item{sample_surface}{\strong{[logical]} Whether to sample the surfaces in @@ -31,7 +31,7 @@ be used for the stratified sampling.} to take all points in \code{with}. Default to \code{TRUE}.} \item{nb_samples}{\strong{[named character vector]} The number of samples to draw -by boundary polygons (must bear the levels of \code{boundary_column} as names +by boundary polygons (must bear the levels of \code{boundary} as names or be a single value to be applied to each level).} \item{min_size}{\strong{[numeric]} The minimum size for a polygon above which it diff --git a/man/triangulate_delaunay.Rd b/man/triangulate_delaunay.Rd index 5f7e1912..4eb25d6c 100644 --- a/man/triangulate_delaunay.Rd +++ b/man/triangulate_delaunay.Rd @@ -7,7 +7,7 @@ triangulate_delaunay( boundaries, with = NULL, - boundary_column = "sfa", + boundary = "sfa", sample_surface = FALSE, sample_points = FALSE, nb_samples = NULL, @@ -21,7 +21,7 @@ triangulate_delaunay( \item{with}{\strong{[sf]} A set of data points to use for voronoisation.} -\item{boundary_column}{\strong{[character]} The column in \code{boundaries} that is to +\item{boundary}{\strong{[character]} The column in \code{boundaries} that is to be used for the stratified sampling.} \item{sample_surface}{\strong{[logical]} Whether to sample the surfaces in @@ -31,7 +31,7 @@ be used for the stratified sampling.} to take all points in \code{with}. Default to \code{TRUE}.} \item{nb_samples}{\strong{[named character vector]} The number of samples to draw -by boundary polygons (must bear the levels of \code{boundary_column} as names +by boundary polygons (must bear the levels of \code{boundary} as names or be a single value to be applied to each level).} \item{min_size}{\strong{[numeric]} The minimum size for a triangle above which it