marray* gets groups argument

10 files changed, 79 insertions, 9 deletions

diff --git a/.local_checks/@making_IPMbook_package.R b/.local_checks/@making_IPMbook_package.R
index a784fd8..62578d1 100644
--- a/.local_checks/@making_IPMbook_package.R
+++ b/.local_checks/@making_IPMbook_package.R
@@ -20,7 +20,7 @@ devtools::load_all("D:/Github/IPMbook_package/IPMbook")
 # ==========================
 unlink(list.files(pattern="Rplots.pdf", recursive=TRUE))
 system("R CMD build IPMbook")  # Produces the .tar.gz
-pkg <- "IPMbook_0.1.2.9005.tar.gz"  # <-- fix version number here
+pkg <- "IPMbook_0.1.2.9006.tar.gz"  # <-- fix version number here
 
 # Pick one to check:
 ## on desktop
diff --git a/DESCRIPTION b/DESCRIPTION
index dd82df4..a472a79 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: IPMbook
 Type: Package
 Title: Functions and Data for the Book 'Integrated Population Models'
-Version: 0.1.2.9005
-Date: 2021-10-03
+Version: 0.1.2.9006
+Date: 2021-10-04
 Depends: R (>= 2.10)
 Imports: stats, abind
 Suggests:
diff --git a/NEWS b/NEWS
index 2b19746..7bfb296 100644
--- a/NEWS
+++ b/NEWS
@@ -1,3 +1,7 @@
+CHANGES in version 0.1.2.9005 (2021-10-04)
+
+  * `marray*` functions gain a `groups` argument, as an alternative to columns in `freq`.
+
 CHANGES in version 0.1.2.9005 (2021-10-03)
 
   * Added `ch2matrix` utility to convert capture histories in text format to matrices.
diff --git a/R/groupfreq.R b/R/groupfreq.R
new file mode 100644
index 0000000..26752ad
--- /dev/null
+++ b/R/groupfreq.R
@@ -0,0 +1,46 @@
+
+# Function to combine a vector of frequncies and a vector of group IDs
+#  into a matrix with frequencies for each group
+
+# Input:
+# freq is a vector of frequencies.
+# groups is a factor (or coercible object) identifying the group of each row.
+
+# Value: a numeric matrix with 1 column per group
+
+groupfreq <- function(freq, groups) {
+  groups <- factor(groups)
+  ng <- nlevels(groups)
+  nind <- length(groups)
+
+  out <- matrix(0, nrow=nind, ncol=ng)
+  colnames(out) <- levels(groups)
+  out[cbind(1:nind, as.numeric(groups))] <- freq
+  return(out)
+}
+
+
+# For testing:
+if(FALSE) {
+library(wiqid)
+data(dippers)
+CH <- dippers[, 1:7]
+groups <- dippers$sex
+CHf <- CH[groups=="F", ]
+CHm <- CH[groups=="M", ]
+
+freq <- rep(1, length(groups))
+
+library(IPMbook)
+
+mf <- marray(CHf)
+mm <- marray(CHm)
+
+f2 <- groupfreq(freq, groups)
+mg <- marray(CH, freq=f2)
+mg
+all(mg[,,1] == mf)
+all(mg[,,2] == mm)
+
+
+}
diff --git a/R/marray.R b/R/marray.R
index 1a666c7..7820fdd 100644
--- a/R/marray.R
+++ b/R/marray.R
@@ -20,7 +20,7 @@
 #
 #####################################################################################################
 
-marray <- function(ch, unobs = 0, freq = 1){
+marray <- function(ch, unobs = 0, freq = 1, groups = NULL){
   if(is.data.frame(ch))
     ch <- as.matrix(ch)
   if(!is.matrix(ch))
@@ -36,6 +36,9 @@ marray <- function(ch, unobs = 0, freq = 1){
   if(!is.matrix(freq))
     freq <- matrix(freq, ncol=1)
   freq <- round(freq)
+  if(!is.null(groups) && ncol(freq) == 1)
+    freq <- groupfreq(freq, groups)
+  
   absfreq <- abs(freq)
 
   ns <- length(table(ch)) - 1 + unobs # number of states, excluding 0, can be 1
@@ -77,6 +80,8 @@ marray <- function(ch, unobs = 0, freq = 1){
     }
 
     for(g in 1:ng) {
+      if(absfreq[i, g] == 0)
+        next
       if (length(state) == 1 && !traploss[i, g]) {  # no recaptures
          out[capID[1], 'never', g] <- out[capID[1], 'never', g] + absfreq[i, g]
       }
diff --git a/R/marrayAge.R b/R/marrayAge.R
index d3e5ecc..c397a73 100644
--- a/R/marrayAge.R
+++ b/R/marrayAge.R
@@ -20,7 +20,7 @@
 ################################################
 
 
-marrayAge <- function(ch, age, mAge = 1, freq = 1){
+marrayAge <- function(ch, age, mAge = 1, freq = 1, groups = NULL){
   if(is.data.frame(ch))
     ch <- as.matrix(ch)
   if (!is.matrix(ch))
@@ -38,6 +38,9 @@ marrayAge <- function(ch, age, mAge = 1, freq = 1){
   if(!is.matrix(freq))
     freq <- matrix(freq, ncol=1)
   freq <- round(freq)
+  if(!is.null(groups) && ncol(freq) == 1)
+    freq <- groupfreq(freq, groups)
+
   absfreq <- abs(freq)
 
   maxAge <- max(age, mAge)
diff --git a/R/marrayDead.R b/R/marrayDead.R
index 188f085..f72c642 100644
--- a/R/marrayDead.R
+++ b/R/marrayDead.R
@@ -3,7 +3,7 @@
 # Modified to deal with a single individual as a vector 2020-10-15
 # Modified to deal with a matrix of unique capture histories plus a vector of frequencies 2021-09-28.
 
-marrayDead <- function(MR, freq = 1){
+marrayDead <- function(MR, freq = 1, groups = NULL){
   if(is.data.frame(MR))
     MR <- as.matrix(MR)
   MR <- round(MR)
@@ -19,6 +19,9 @@ marrayDead <- function(MR, freq = 1){
   if(!is.matrix(freq))
     freq <- matrix(freq, ncol=1)
   freq <- round(freq)
+  if(!is.null(groups) && ncol(freq) == 1)
+    freq <- groupfreq(freq, groups)
+
   absfreq <- abs(freq)
 
   nind <- nrow(MR)
diff --git a/man/marray.Rd b/man/marray.Rd
index c63e25a..9a40373 100644
--- a/man/marray.Rd
+++ b/man/marray.Rd
@@ -9,7 +9,7 @@ Converts capture-histories to an m-array for one age class
 Creates an m-array for a single- or multistate capture-recapture data with one age class and optionally more than one group.
 }
 \usage{
-marray(ch, unobs = 0, freq = 1)
+marray(ch, unobs = 0, freq = 1, groups = NULL)
 }
 \arguments{
   \item{ch}{
@@ -21,6 +21,9 @@ number of unobserved states (default is 0, needs to be given only in specific ca
   \item{freq}{
 a vector with the number of animals with each capture history, or a matrix with a column for each group. If a single value is supplied, it will be used for all rows in the capture history; the default is to assume each row corresponds to a single animal.
 }
+  \item{groups}{
+a factor (or a vector that can be coerced to a factor) which identifies the group that each row of \code{ch} refers to. Ignored if \code{freq} is a matrix with > 1 column.
+}
 }
 
 \details{
diff --git a/man/marrayAge.Rd b/man/marrayAge.Rd
index 03e19c6..4ee33c1 100644
--- a/man/marrayAge.Rd
+++ b/man/marrayAge.Rd
@@ -9,7 +9,7 @@ Creates age-dependent m-arrays
 Converts single-state capture-recapture data to age-dependent m-arrays.
 }
 \usage{
-marrayAge(ch, age, mAge = 1, freq = 1)
+marrayAge(ch, age, mAge = 1, freq = 1, groups = NULL)
 }
 \arguments{
   \item{ch}{
@@ -24,6 +24,9 @@ maximum number of age classes for which m-arrays are constructed; ignored if \co
   \item{freq}{
 a vector with the number of animals with each capture history, or a matrix with a column for each group. If a single value is supplied, it will be used for all rows in the capture history; the default is to assume each row corresponds to a single animal.
 }
+  \item{groups}{
+a factor (or a vector that can be coerced to a factor) which identifies the group that each row of \code{ch} refers to. Ignored if \code{freq} is a matrix with > 1 column.
+}
 }
 
 \details{
diff --git a/man/marrayDead.Rd b/man/marrayDead.Rd
index 5e85a8b..9b516f3 100644
--- a/man/marrayDead.Rd
+++ b/man/marrayDead.Rd
@@ -9,7 +9,7 @@ Converts dead-recovery capture histories to an m-array
 Converts dead-recovery capture histories to an m-array.
 }
 \usage{
-marrayDead(MR, freq = 1)
+marrayDead(MR, freq = 1, groups = NULL)
 }
 \arguments{
   \item{MR}{
@@ -18,6 +18,9 @@ an individuals x time matrix with 1 denoting either the time of marking or the t
   \item{freq}{
 a vector with the number of animals with each capture history, or a matrix with a column for each group. If a single value is supplied, it will be used for all rows in the capture history; the default is to assume each row corresponds to a single animal.
 }
+  \item{groups}{
+a factor (or a vector that can be coerced to a factor) which identifies the group that each row of \code{ch} refers to. Ignored if \code{freq} is a matrix with > 1 column.
+}
 }
 
 \details{