Review for headings+speeds plus split and merge plus misc small changes (#11)

* wip

* add initial tests for heading and speed temporal

* finish head_speed_temporal review

* fixupo

* improve arg checking

* Add tests for centroid

* add tests of speed

* fixup

* test group heading/speed

* fixup

* fix typo

* initial testing for splits and merges

* add shuffle

* Finish up identify_splits_and_merge test

* analyze split and merge

* Refactor heading and speed tests

* WIP

* clean up tests

* lint helpers

* lint tests

* Deal with build check warnings

* add some visualization scripts

* fix some checks

* fix final warning

* add locker to renv file

Author: katrinabrock

.Rbuildignore

@@ -6,3 +6,5 @@
 ^docs$
 ^pkgdown$
 ^\.github$
+^\.vscode$
+^\.lintr$

.lintr

@@ -0,0 +1,11 @@
+linters: linters_with_defaults(
+    line_length_linter(120),
+    indentation_linter(hanging_indent_style = 'never'),
+    object_name_linter(
+      styles = c("snake_case", "symbols"),
+      regexes = c('allowed_single_letters' = c('N'))
+    ),
+    quotes_linter(delimiter = '\'')
+  )
+exclusions: list('tests', 'R') # Currently only running on tests in inst
+encoding: "UTF-8"

DESCRIPTION

@@ -16,11 +16,12 @@ RoxygenNote: 7.3.2
 Imports: 
   checkmate,
   dbscan,
+  fields,
   lubridate,
+  logger,
+  magrittr,
   sf,
-  fields,
-  stringr,
-  magrittr
+  stringr
 Suggests: 
     tinytest
 URL: https://livingingroups.github.io/cocomo/

NAMESPACE

@@ -34,6 +34,7 @@ export(reformat_movebank_to_matrix)
 export(utm_to_latlon)
 importFrom(dbscan,dbscan)
 importFrom(fields,image.plot)
+importFrom(logger,log_info)
 importFrom(lubridate,date)
 importFrom(lubridate,hour)
 importFrom(lubridate,parse_date_time)

R/analyze_split_or_merge_event.R

@@ -218,19 +218,78 @@ analyze_split_or_merge_event <- function(events, i,
                                          seconds_per_time_step = 1,
                                          breaks = NULL, break_by_day = F,
                                          make_plot = T){
-
+  checkmate::assert_matrix(xs, mode = 'numeric')
+  checkmate::assert_matrix(ys, mode = 'numeric', nrows = nrow(xs), ncol=ncol(xs))
+  checkmate::assert_int(i, lower=1)                                          
+  checkmate::assert_data_frame(events, min.rows=i)
+  checkmate::assert_names(
+    names(events), must.include = c('tidx', 'group_A_idxs', 'group_B_idxs', 'group_A', 'group_B', 'event_type', 'big_group_idxs')
+  )
   #get info about the event from the events data frame
-  t_event <- events$tidx[i] #time of the event
-  group_A <- events$group_A_idxs[i][[1]] #group A individual idxs
-  group_B <- events$group_B_idxs[i][[1]] #group B individual idxs
+  t_event <- checkmate::assert_int(
+    events$tidx[i],  #time of the event
+    lower = 1,
+    upper = ncol(xs)
+  )
+  group_A <- checkmate::assert_integerish(
+    events$group_A_idxs[i][[1]], #group A individual idxs
+    lower = 1,
+    upper = nrow(xs),
+    min.len = 1,
+    max.len = nrow(xs) - 1,
+    unique = TRUE,
+    sorted = TRUE,
+    any.missing = FALSE
+  )
+  group_B <-  checkmate::assert_integerish(
+    events$group_B_idxs[i][[1]], #group B individual idxs
+    lower = 1,
+    upper = nrow(xs),
+    len = nrow(xs) - length(group_A),
+    max.len = nrow(xs) - 1,
+    unique = TRUE,
+    sorted = TRUE,
+    any.missing = FALSE
+
+  )
+  checkmate::assert_null(events$group_C)
+
   group_A_names <- events$group_A[i] #group A names
+  # checkmate::assert_character(
+  #   len = length(group_A),
+  #   unique = TRUE,
+  #   any.missing = FALSE
+  # )
+     
   group_B_names <- events$group_B[i] #group B names
-  event_type <- events$event_type[i] #event type - fission, fusion, or shuffle
-  big_group_idxs <- events$big_group_idxs[i][[1]] #all individuals involved in the event
-
-  if(!(event_type %in% c('fission','fusion'))){
-    stop('event must be a fission or fusion')
-  }
+  # checkmate::assert_character(
+  #   len = length(group_B),
+  #   unique = TRUE,
+  #   any.missing = FALSE
+  # )
+  event_type <- checkmate::assert_subset(
+    events$event_type[i], #event type - fission, fusion, or shuffle
+    c('fission', 'fusion')
+  )
+  big_group_idxs <- checkmate::assert_set_equal(
+    events$big_group_idxs[i][[1]], #all individuals involved in the event
+    sort(c(group_A, group_B))
+  )
+  checkmate::assert_posixct(
+    timestamps,
+    len = ncol(xs)
+  )
+  checkmate::assert_int(
+    max_time,
+    lower = 1
+  )
+  checkmate::assert_number(thresh_h)
+  checkmate::assert_number(thresh_l)
+  checkmate::assert_number(depart_or_arrive_radius)
+  checkmate::assert_int(time_window, lower = 0, upper = ncol(xs))
+  checkmate::assert_number(seconds_per_time_step, lower = 0)
+  checkmate::assert_flag(break_by_day)
+  checkmate::assert_flag(make_plot)
 
   #calculate a few metrics from event info
   ti <- t_event - max_time #initial time to plot
@@ -249,7 +308,7 @@ analyze_split_or_merge_event <- function(events, i,
     }
   }
 
-  #if braeks is null, create a breaks variable specifying one data chunk
+  #if breaks is null, create a breaks variable specifying one data chunk
   if(is.null(breaks)){
     breaks <- c(1, length(timestamps) + 1)
   }
@@ -334,7 +393,7 @@ analyze_split_or_merge_event <- function(events, i,
   if(upper <= thresh_l){
     upper <- thresh_h
   }
-  #likewise for lower bound
+ #likewise for lower bound
   if(lower >= thresh_h){
     lower <- thresh_l
   }

R/generate_movement_and_calls_visualization.R

@@ -11,8 +11,8 @@
 #' @author Ariana Strandburg-Peshkin (primary author)
 #' @author NOT YET CODE REVIEWED
 #'
-#' @param xs UTM eastings matrix (`n_inds` x `n_times` matrix where xs[i,t] gives the easting of individual i at time step t)
-#' @param ys UTM northings matrix (`n_inds` x `n_times` matrix where ys[i,t] gives the northing of individual i at time step t)
+#' @param xs UTM eastings matrix (`n_inds` x `n_times` matrix where xs\[i,t\] gives the easting of individual i at time step t)
+#' @param ys UTM northings matrix (`n_inds` x `n_times` matrix where ys\[i,t\] gives the northing of individual i at time step t)
 #' @param timestamps vector of timestamps (POSIXct), must have same dimensions as columns of `xs` and `ys` matrices
 #' @param calls data frame where first column (`'ind_idx'`) specifies the index of the individual that gave the call, second column (`'time_idx'`) specifies the time index at which the call was given, and third column (`'call_type'`) specifies the type of call (character string)
 #' @param start_time time index at which to start the video

R/get_angle_between_vectors.R

@@ -4,7 +4,7 @@
 #'Vector 1 is defined as the vector pointing from the point `(x1_i, y1_i)` to `(x1_f, y1_f)` and
 #'vector 2 is defined as the vector point from the point `(x2_i, y2_i)` to `(x2_f, y2_f)`.
 #'The angle is defined as the angle produced if the two vectors are joined at the initial
-#'endpoints (rather than head-to-tail). The reuslting angle is always positive.
+#'endpoints (rather than head-to-tail). The resulting angle is always positive.
 #'
 #' @author Ariana Strandburg-Peshkin
 #' @author NOT YET CODE REVIEWED

R/get_group_centroid.R

@@ -5,7 +5,7 @@
 #'time step.
 #'
 #' @author Ariana Strandburg-Peshkin (primary author)
-#' @author NOT YET CODE REVIEWED
+#' @author Reviewed by Brock
 #'
 #' @param xs `N x n_times` matrix giving x coordinates of each individual over time
 #' @param ys `N x n_times` matrix giving y coordinates of each individual over time
@@ -14,6 +14,9 @@
 #' @export
 #'
 get_group_centroid <- function(xs, ys, min_inds_tracked = NULL){
+  checkmate::assert_matrix(xs, 'numeric')
+  checkmate::assert_matrix(ys, 'numeric')
+  checkmate::assert_int(min_inds_tracked, lower=0, upper=nrow(xs), null.ok = TRUE)
 
   #check matrix dimensions
   if(nrow(xs) != nrow(ys) || ncol(xs) != ncol(ys)){
@@ -26,7 +29,7 @@ get_group_centroid <- function(xs, ys, min_inds_tracked = NULL){
 
   #replace time points with too few individuals with NAs
   if(!is.null(min_inds_tracked)){
-    n_tracked <- colSums(!is.na(xs))
+    n_tracked <- colSums(!is.na(xs) & !is.na(ys))
     not_enough_inds <- which(n_tracked < min_inds_tracked)
     x_centr[not_enough_inds] <- NA
     y_centr[not_enough_inds] <- NA

R/get_group_heading_and_speed.R

@@ -4,45 +4,43 @@
 #' going either forward (into the future) or backward (into the past) when computing the heading
 #'
 #' @author Ariana Strandburg-Peshkin (primary author)
-#' @author NOT YET CODE REVIEWED
+#' @author Reviewed by Brock
 #'
 #' @param xs `N x n_times` matrix giving x coordinates of each individual over time
 #' @param ys `N x n_times` matrix giving y coordinates of each individual over time
 #' @param heading_type character string specifying heading type - `'spatial'` or `'temporal'`
 #' @param spatial_R radius to use for spatial headings (if `heading_type = 'spatial'`)
 #' @param t_window temporal window to use for temporal headings (if `heading_type = 'temporal'`)
 #' @param forward whether to compute headings into the future (`forward = T`) or the past (`forward = F`)
-#' @param min_inds_tracked if specified, sets a minimum number of individuals that must be tracked at any moment in time to compute heading (otherwise the heading will be NA at that time point
+#' @param min_inds_tracked if specified, sets a minimum number of individuals that must be tracked to use that time point in computing heading. headings, speeds, and dt that would rely on data with an insufficient number of individuals will be reported as NA.
 #' @param seconds_per_time_step number of seconds corresponding to each time step
 #'
 #' @returns Returns the group heading over time, a vector of length `n_times`
 #' @export
 #'
 get_group_heading_and_speed <- function(xs, ys, heading_type, spatial_R = NULL, t_window = NULL, forward = T, min_inds_tracked = NULL, seconds_per_time_step = 1){
+  checkmate::assert_matrix(xs, 'numeric')
+  checkmate::assert_matrix(ys, 'numeric')
+  checkmate::assert_subset(heading_type, c('spatial', 'temporal'), empty.ok = FALSE)
+  if(heading_type == 'spatial'){
+    checkmate::assert_number(spatial_R)
+    if(!is.null(t_window)) warning('heading_type is set to spatial so t_window argument is ignored')
+  } else {
+    if(!is.null(spatial_R)) warning('heading_type is set to temporal so spatial_R argument is ignored')
+    checkmate::assert_int(t_window, lower = 1, upper = ncol(xs))
+  }
+  checkmate::assert_logical(forward)
+  checkmate::assert_int(min_inds_tracked, lower=0, upper=nrow(xs), null.ok = TRUE)
+  checkmate::assert_number(seconds_per_time_step, lower = 0)
+
 
-  #TODO: Think about what to do if number of tracked individuals changes - should probably have heading = NA at those times
+   #TODO: Think about what to do if number of tracked individuals changes - should probably have heading = NA at those times
 
   #check matrix dimensions
   if(nrow(xs) != nrow(ys) || ncol(xs) != ncol(ys)){
     stop('xs and ys matrices must have same dimensions')
   }
 
-  #check that the required variables exist for computing headings
-  if(heading_type %in% c('spatial','temporal')){
-    if(heading_type == 'spatial'){
-      if(is.null(spatial_R)){
-        stop('Must specify spatial_R for spatial headings')
-      }
-    }
-    if(heading_type == 'temporal'){
-      if(is.null(t_window)){
-        stop('Must specify t_window for temporal headings')
-      }
-    }
-  } else{
-    stop('Must specify heading_type as either spatial or temporal')
-  }
-
   #get centroid trajectory
   centr_xy <- cocomo::get_group_centroid(xs = xs, ys = ys, min_inds_tracked = min_inds_tracked)
   x_centr <- centr_xy$x_centr
@@ -51,7 +49,7 @@ get_group_heading_and_speed <- function(xs, ys, heading_type, spatial_R = NULL,
   #get heading
   if(heading_type == 'temporal'){
     heads_speeds <- cocomo::get_heading_and_speed_temporal(x_i = x_centr, y_i = y_centr, t_window = t_window, forward = forward, seconds_per_time_step = seconds_per_time_step)
-  } else{
+  } else {
     heads_speeds <- cocomo::get_heading_and_speed_spatial(x_i = x_centr, y_i = y_centr, R = spatial_R, forward = forward, seconds_per_time_step = seconds_per_time_step )
   }
 

R/get_heading_and_speed_spatial.R

@@ -5,24 +5,42 @@
 #'its location after it mas moved a distance of at least `R`.
 #'
 #' @author Ariana Strandburg-Peshkin (primary author)
-#' @author NOT YET CODE REVIEWED
+#' @author Reviewed by Brock
 #'
 #' @param x_i vector of x coordinates for the trajectory
 #' @param y_i vector of y coordinates for the trajectory
 #' @param R radius used to compute the headings
-#' @param t_idxs: time indexes at which to compute the headings (defaults to entire trajectory)
+#' @param t_idxs time indexes at which to compute the headings, speed, dts (defaults to entire trajectory)
 #' @param forward whether to go forward in time from current position (if T), or backward (if F) when computing headings
 #' @param seconds_per_time_step number of seconds corresponding to each time step
 #'
-#' @returns Returns a list containing `$heads`: a time series of the heading of
-#' the individual (a vector of the same length as x_i and y_i), in radians, computed based on
-#' spatial discretization around the time point,`$speeds`: a time series of the speed of the individual at each time point, and
-#' `$dts`: time differences between the current point and the first point outside of the radius R (either forward or backward in time)
+#' @returns Returns a list containing
+#'   * `$heads`: a time series of the heading of the individual (a vector of the same length as x_i and y_i), in radians, computed based on
+#' spatial discretization around the time point
+#'   * `$speeds`: a time series of the average speed of the individual from the first point outside radius R to the current point
+#'   * `$dts`: time differences between the current point and the first point outside of the radius R (either forward or backward in time)
 #'
 #' vector of spatially discretized headings, computed at all times or at times t_idxs if specified (other times are then filled in with NAs)
 #' @export
 get_heading_and_speed_spatial <- function(x_i, y_i, R, t_idxs=1:length(x_i), forward=T, seconds_per_time_step = 1){
 
+  checkmate::assert_numeric(x_i)
+  checkmate::assert_numeric(y_i)
+  checkmate::assert_number(R, lower = 0)
+  checkmate::assert_integerish(
+    t_idxs,
+    lower = 1,
+    upper = length(x_i),
+    any.missing = FALSE,
+    min.len = 1,
+    max.len = length(x_i),
+    unique = TRUE,
+    typed.missing = FALSE
+  )
+  checkmate::assert_logical(forward, len = 1)
+  checkmate::assert_number(seconds_per_time_step, lower = 0)
+
+
   #check that x_i and y_i are the same length
   if(length(x_i) != length(y_i)){
     stop('x_i and y_i must be vectors of the same length')
@@ -56,9 +74,9 @@ get_heading_and_speed_spatial <- function(x_i, y_i, R, t_idxs=1:length(x_i), for
     #move forward (or backward) until radius reached
     found <- 0
     na_found <- 0
-    time_vec <- t:n_times
+    time_vec <- min((t+1), n_times):n_times
     if(!forward){
-      time_vec <- seq(t,1,-1)
+      time_vec <- max((t-1), 1):1
     }
     for(i in time_vec){
 

R/get_heading_and_speed_temporal.R

@@ -10,7 +10,7 @@
 #'
 #'
 #' @author Ariana Strandburg-Peshkin
-#' @author NOT YET CODE REVIEWED
+#' @author Reviewed by Brock
 #'
 #' @param	x_i x coordinates of the individual (a vector whose length is the number of timesteps) or of a group centroid
 #' @param y_i y coordinates of the individual (a vector whose length is the number of timesteps) or of the group centroid
@@ -27,7 +27,7 @@ get_heading_and_speed_temporal <- function(x_i, y_i, t_window = 1, forward = T,
   checkmate::assert_numeric(y_i)
   checkmate::assert_int(t_window, lower = 1, upper = length(x_i))
   checkmate::assert_logical(forward, len = 1)
-  checkmate::assert_numeric(seconds_per_time_step, lower = 0, len = 1)
+  checkmate::assert_number(seconds_per_time_step, lower = 0)
 
 
 
@@ -69,8 +69,8 @@ get_heading_and_speed_temporal <- function(x_i, y_i, t_window = 1, forward = T,
   heads <- atan2(head_y, head_x)
 
   #output
-  out$speeds <- ds / (t_window * seconds_per_time_step)
   out$heads <- heads
+  out$speeds <- ds / (t_window * seconds_per_time_step)
   out$dts <- rep(t_window * seconds_per_time_step, len)
 
   return(out)

R/get_pulls_and_anchors.R

@@ -5,16 +5,16 @@
 #' @author Ariana Strandburg-Peshkin (primary author)
 #' @author NOT YET CODE REVIEWED
 #'
-#' @param xa: x coordinates for individual a (vector of length `n_times`)- must be continuous data (no NAs)
-#' @param	xb: x coordinates for individual b (vector of length `n_times`)- must be continuous data (no NAs)
-#' @param ya: x coordinates for individual a (vector of length `n_times`)- must be continuous data (no NAs)
-#' @param	yb: x coordinates for individual b (vector of length `n_times`)- must be continuous data (no NAs)
-#' @param a: index of the first individual
-#' @param	b: index of the second individual
-#' @param	noise_thresh: noise threshold (defaults to 5 m)
-#' @param plot_results: whether to plot results or not
-#' @param include_initial_fusion: if T, the function will also output an initial fusion event. In most use cases, this should be set to false. See below for details.
-#' @param include_final_fission: if T, the funciton will also output a final fission event. In most use cases, this should be set to false. See below for details.
+#' @param xa x coordinates for individual a (vector of length `n_times`)- must be continuous data (no NAs)
+#' @param	xb x coordinates for individual b (vector of length `n_times`)- must be continuous data (no NAs)
+#' @param ya x coordinates for individual a (vector of length `n_times`)- must be continuous data (no NAs)
+#' @param	yb x coordinates for individual b (vector of length `n_times`)- must be continuous data (no NAs)
+#' @param a index of the first individual
+#' @param	b index of the second individual
+#' @param	noise_thresh noise threshold (defaults to 5 m)
+#' @param plot_results whether to plot results or not
+#' @param include_initial_fusion if T, the function will also output an initial fusion event. In most use cases, this should be set to false. See below for details.
+#' @param include_final_fission if T, the funciton will also output a final fission event. In most use cases, this should be set to false. See below for details.
 #'
 #' @section Details on fission and fusion events:
 #'