Merge pull request #154 from birdflow-science/combine-transitions

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: BirdFlowR
 Title: Predict and Visualize Bird Movement
-Version: 0.1.0.9044
+Version: 0.1.0.9045
 Authors@R: 
     c(person("Ethan", "Plunkett",  email = "plunkett@umass.edu", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-4405-2251")),

NAMESPACE

@@ -25,6 +25,7 @@ export(build_collection_index)
 export(build_transitions)
 export(calc_movement_vectors)
 export(col_to_x)
+export(combine_transitions)
 export(distribution_performance)
 export(drop_transitions)
 export(evaluate_performance)

NEWS.md

@@ -1,3 +1,17 @@
+# BirdFlowR 0.1.0.9045
+2023-12-18
+
+New function `combine_transitions()` combines the transition matricies from a 
+series of timesteps into a single transition matrix that encodes the transition
+probabilities between the starting and ending timesteps in a single multi-week
+transition matrix.  
+
+New  **BirdFlowExtras** package uses `combine_transitions()` to calculate
+migratory connectivity.  That package will hold more esoteric uses of 
+BirdFlow models, and any functions that rely on packages that are not on either
+CRAN or BioConductor. 
+
+
 # BirdFlowR 0.1.0.9044
 2023-12-16
 

R/combine_transitions.R

@@ -0,0 +1,30 @@
+#' Function to combine a sequence of transition matrices into one
+#'
+#' @param bf A BirdFlow object
+#' @inheritDotParams lookup_transitions -x
+#'
+#' @return This returns the transition probabilities associated with a
+#' sequence of timesteps. It will have a column for every unmasked cell
+#' at the starting timestep and a row for every unmasked cell in the
+#' last timestep, with cell values being the probably of transitioning from
+#' that row to that column between the start and end of the time sequence
+#' described by `...`
+#'
+#' @export
+combine_transitions <- function(bf, ...){
+  # Lookup transition names
+  transitions <- lookup_transitions(x = bf, ...)
+
+  # Multiply all the transitions together
+  for(i in seq_along(transitions)){
+    # Origin timestep get transtion
+    if(i == 1){
+      trans <- get_transition(bf,  transitions[i])
+      next
+    }
+    # All other timesteps get transition and multiple with prior
+    a <- get_transition(bf, transitions[i])
+    trans <- a %*% trans
+  }
+  return(trans)
+}

tests/testthat/test-combine_transitions.R

@@ -0,0 +1,33 @@
+test_that("combine_transitions is consistent with predict", {
+
+  bf <- BirdFlowModels::amewoo
+
+  start <- 5
+  end <- 49
+  direction <- "backward"
+
+  # Combine the transitions
+  expect_no_error(
+    trans <- combine_transitions(bf, start = start,
+                                 end = end, direction = direction )
+  )
+
+  # predict ending distribution with bf
+  # - by stepping through intervening transitions
+  s_st <- get_distr(bf, start)
+  e_st <- get_distr(bf, end) # status and trends
+  p <- predict.BirdFlow(bf, s_st, start = start,
+                        end = end, direction = direction)
+  e_bf <- p[, ncol(p)] # end distribution from Birdflow predict (active cells)
+
+  start_dm <- get_dynamic_mask(bf, start)
+  end_dm <- get_dynamic_mask(bf, end)
+
+  # end distribution from consolidated transition (just dynamic)
+  e_trans <- as.vector(trans %*% s_st[start_dm])
+
+  # They should be identical
+  expect_equal <- cor(e_trans, e_bf[end_dm])
+
+
+})