Completes conversion of benvo to S3 class with accompanying methods.

Updated `benvo()` now allows for construction of relational data with
pre-constructed data or data calculated via `add_BEF()` using `sf` or
lubridate date/time columns. Helper methods in the form of dplyr verbs and
plotting functions are also provided.

DESCRIPTION

@@ -1,9 +1,9 @@
 Package: rbenvo
 Type: Package
 Title: Built Environment Objects for Point Pattern Data in R 
-Version: 0.1.1.9000
+Version: 1.0.0
 Authors@R: person("Adam", "Peterson", , "[email protected]", c("aut", "cre"))
-Description: rbenvo is package that holds S4 class objects and methods for built environment data to ease the use of working with these data and improve interoperability with other packages.
+Description: rbenvo is package that holds S3 class objects and methods for built environment data to ease the use of working with these data and improve interoperability with other packages.
 License: GPL-3
 Encoding: UTF-8
 LazyData: true
@@ -22,7 +22,9 @@ Imports:
     sf,
     lubridate,
     rlang,
-    tidygraph
+    tidygraph,
+    ggmap,
+    stringr
 RoxygenNote: 7.1.1
 Depends:
 	R (>= 2.10)

NAMESPACE

@@ -2,35 +2,85 @@
 
 S3method(activate,benvo)
 S3method(aggrenvo,benvo)
+S3method(arrange,benvo)
 S3method(bef_names,benvo)
 S3method(bwinvo,benvo)
 S3method(component_lookup,benvo)
 S3method(components,benvo)
+S3method(distinct,benvo)
+S3method(drop_BEF,benvo)
+S3method(filter,benvo)
+S3method(has_subject_dt,benvo)
+S3method(head,benvo)
 S3method(is.longitudinal,benvo)
 S3method(joinvo,benvo)
+S3method(mutate,benvo)
 S3method(num_BEF,benvo)
 S3method(plot,benvo)
 S3method(print,benvo)
+S3method(select,benvo)
 S3method(subject_design,benvo)
 S3method(summary,benvo)
+S3method(tail,benvo)
 export("%>%")
 export(activate)
 export(active)
+export(add_BEF)
 export(aggrenvo)
+export(arrange)
+export(bef_has_sf)
 export(bef_names)
 export(benvo)
 export(bwinvo)
 export(component_lookup)
 export(components)
+export(contains)
+export(distinct)
+export(drop_BEF)
+export(ends_with)
+export(everything)
+export(filter)
+export(has_bef_dt)
+export(has_subject_dt)
 export(is.benvo)
 export(is.longitudinal)
 export(joinvo)
 export(longitudinal_design)
+export(matches)
+export(mutate)
+export(mutate_all)
+export(mutate_at)
+export(n)
+export(num_range)
+export(one_of)
 export(plot_map)
 export(plot_pointrange)
-import(methods)
-import(stats)
+export(plot_timeline)
+export(select)
+export(set_datetime_cols)
+export(starts_with)
+export(subject_design)
+export(subject_has_sf)
+export(top_n)
+export(transmute)
+importFrom(dplyr,arrange)
+importFrom(dplyr,contains)
+importFrom(dplyr,distinct)
+importFrom(dplyr,ends_with)
+importFrom(dplyr,everything)
+importFrom(dplyr,filter)
+importFrom(dplyr,matches)
+importFrom(dplyr,mutate)
+importFrom(dplyr,mutate_all)
+importFrom(dplyr,mutate_at)
+importFrom(dplyr,n)
+importFrom(dplyr,num_range)
+importFrom(dplyr,one_of)
+importFrom(dplyr,select)
+importFrom(dplyr,starts_with)
 importFrom(dplyr,tibble)
+importFrom(dplyr,top_n)
+importFrom(dplyr,transmute)
 importFrom(lme4,glmerControl)
 importFrom(magrittr,"%>%")
 importFrom(rlang,enquo)
@@ -40,3 +90,5 @@ importFrom(stats,median)
 importFrom(stats,model.matrix)
 importFrom(stats,model.response)
 importFrom(stats,quantile)
+importFrom(utils,head)
+importFrom(utils,tail)

R/activate.R

@@ -37,17 +37,31 @@ active <- function(x)
 get_active <- function(x){
 	if(active(x)=="subject")
 		return(x$subject_data)
-	else
+	else if(bef_is_active(x))
 		return(x$bef_data[[active(x)]])
+	else
+		return(x$sub_bef_data[[active(x)]])
 }
 
 # Internal -------------------------
 
 check_activate <- function(x,value){
 	if(!(value %in% active_names(x)))
-		stop(paste0(value," is not a table in this benvo. For a list of possible tables use `bef_names()` "))
+		stop(value," is not a table in this benvo. For a list of possible tables use `bef_names()` ")
 }
 
 active_names <- function(x){
-	c("subject",bef_names(x))
+	c("subject",bef_names(x),paste0("bef_",bef_names(x)))
+}
+
+pre_bef <- function(x){
+	paste0("bef_",x)
+}
+
+no_pre_bef <- function(x){
+	stringr::str_replace(x,"_bef","")
+}
+
+bef_is_active <- function(x){
+	stringr::str_detect(active(x),"^bef_")
 }

R/aggregation.R

@@ -1,3 +1,51 @@
+#' Join BEF and subject data within a benvo
+#'
+#' @export
+#' @details Joins the subject dataframe within a benvo to the supplied BEF dataframe keeping the selected component
+#' @param x benvo object
+#' @param term string of bef name to join on in sub_bef_data
+#' @param component one of c("Distance","Time","Distance-Time") indicating which column(s) of the bef dataset should be returned
+#' @param NA_to_zero replaces NA values with zeros - potentially useful when constructing design matrices
+#'
+joinvo <- function(x,term,component = "Distance",NA_to_zero = F) UseMethod("joinvo")
+
+#'
+#' @export
+#' @importFrom stats quantile median
+#' @describeIn joinvo method
+#'
+joinvo.benvo <- function(x,term,component = "Distance",NA_to_zero = F){
+
+
+	stopifnot(component %in% c("Distance","Time","Distance-Time"))
+	Distance <- Time <- NULL
+
+	ix <- term_check(x,term)
+	id <- get_id(x)
+	component_check(x,term,component)
+
+
+	if(subject_has_sf(x))
+		sdf <- sf::st_drop_geometry(x$subject_data[,id,drop=F])
+	else
+		sdf <- x$subject_data[,id,drop=F]
+
+	jdf <- dplyr::right_join(x$sub_bef_data[[ix]],sdf, by=id)
+
+	if(NA_to_zero){
+		col <- switch(component,
+			   "Distance" = "Distance",
+			   "Time" = "Time",
+			   "Distance-Time" = c("Distance","Time"))
+		jdf <- jdf %>% dplyr::mutate_at(col,function(x) tidyr::replace_na(x,0))
+	}
+
+	return(jdf)
+}
+
+
+
+
 
 #' Aggregate Matrix to Subject or Subject - Measurement Level
 #'
@@ -25,12 +73,16 @@ aggrenvo.benvo <- function(x,M,stap_term,component){
 	else
 		component_ <- component
 
+	if(subject_has_sf(x))
+	  sdf <- sf::st_drop_geometry(x$subject_data)
+	else
+	  sdf <- x$subject_data
 
 	if(is.longitudinal(x)){
 		AggMat <- create_unique_ID_mat(jndf[,id[1],drop=TRUE],jndf[,id[2],drop=TRUE])
-		IDMat <- Matrix::t(create_unique_ID_mat(x$subject_data[,id[1],drop=TRUE],x$subject_data[,id[2],drop=TRUE]))
+		IDMat <- Matrix::t(create_unique_ID_mat(sdf[,id[1],drop=TRUE],sdf[,id[2],drop=TRUE]))
 	}else{
-		IDMat <- Matrix::t(create_unique_ID_mat(x %>% dplyr::select_at(id) %>% dplyr::pull(name = id)))
+		IDMat <- Matrix::t(create_unique_ID_mat(sdf %>% dplyr::select_at(id) %>% dplyr::pull(name = id)))
 		AggMat <- create_unique_ID_mat(jndf[,id,drop=TRUE])
 	}
 	zeromat <- jndf %>% dplyr::group_by_at(id)  %>%

R/arrange.R

@@ -0,0 +1,16 @@
+#' @export
+#' @importFrom dplyr arrange
+arrange.benvo <- function(.data, ...) {
+
+	tmp_df <- get_active(.data)
+	if(active(.data) == 'subject')
+		.data$subject_data <- dplyr::arrange(tmp_df,...)
+	else if(bef_is_active(.data))
+		.data$bef_data[[active(.data)]] <- dplyr::arrange(tmp_df,...)
+	else
+		.data$subj_bef_data[[active(.data)]] <- dplyr::arrange(tmp_df,...)
+	.data
+}
+
+#' @export
+dplyr::arrange