Check cov data frame dimensions when making umf

5 files changed, 52 insertions, 16 deletions

diff --git a/DESCRIPTION b/DESCRIPTION
index ef05301..3006543 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: unmarked
-Version: 1.3.2.9002
-Date: 2023-08-11
+Version: 1.3.2.9003
+Date: 2023-10-13
 Type: Package
 Title: Models for Data from Unmarked Animals
 Authors@R: c(
diff --git a/R/unmarkedFrame.R b/R/unmarkedFrame.R
index 3b8895f..c936bdf 100644
--- a/R/unmarkedFrame.R
+++ b/R/unmarkedFrame.R
@@ -160,7 +160,13 @@ setClass("unmarkedFrameDSO",
 
 #Convert covs provided as list of matrices/dfs to data frame
 covsToDF <- function(covs, name, obsNum, numSites){
-  if(!inherits(covs, "list")) return(covs)
+  if(is.null(covs)) return(covs)
+  if(inherits(covs, "data.frame")){
+    if(nrow(covs) != (obsNum * numSites)){
+      stop("Incorrect number of rows in ", name, " data frame", call.=FALSE)
+    }
+    return(covs)
+  }
   
   if(is.null(names(covs)) | any(is.na(names(covs))) | any(names(covs)=="")){
     stop("All elements of list provided to ", name, " argument must be named", call.=FALSE)
@@ -178,8 +184,11 @@ covsToDF <- function(covs, name, obsNum, numSites){
 # Constructor for unmarkedFrames.
 unmarkedFrame <- function(y, siteCovs = NULL, obsCovs = NULL, mapInfo,
                           obsToY) {
-    if(!missing(obsToY))
+    if(!missing(obsToY)){
         obsNum <- nrow(obsToY)
+    } else {
+        obsNum <- ncol(y)
+    }
 
     if(is.null(obsNum) & inherits(obsCovs, "list"))
       obsNum <- ncol(obsCovs[[1]]) #??
@@ -1491,14 +1500,21 @@ setMethod("[", c("unmarkedFrameOccuTTD", "missing", "numeric", "missing"),
 
     if(any(j>x@numPrimary)) stop("Can't select primary periods that don't exist", call.=FALSE)
     if(!all(j>0)) stop("All indices must be positive", call.=FALSE)
-
-    pp_vec <- rep(1:x@numPrimary, each=ncol(getY(x))/x@numPrimary)
+    
+    R <- ncol(getY(x))/x@numPrimary
+    pp_vec <- rep(1:x@numPrimary, each=R)
     keep_cols <- which(pp_vec%in%j)
     y <- getY(x)[,keep_cols,drop=FALSE]
-    ysc <- yearlySiteCovs(x)[,j,drop=FALSE]
-    oc <- obsCovs(x)[,keep_cols,drop=FALSE]
     sl <- x@surveyLength[,keep_cols,drop=FALSE]
 
+    pp_vec2 <- rep(1:x@numPrimary, numSites(x))
+    keep_rows <- which(pp_vec2 %in% j)
+    ysc <- yearlySiteCovs(x)[keep_rows,,drop=FALSE]
+
+    obs_vec <- rep(rep(1:x@numPrimary, each = R), numSites(x))
+    keep_rows <- which(obs_vec %in% j)
+    oc <- obsCovs(x)[keep_rows,,drop=FALSE]
+
     unmarkedFrameOccuTTD(y=y, surveyLength=sl, siteCovs=siteCovs(x),
                          yearlySiteCovs=ysc, obsCovs=oc,
                          numPrimary=length(j))
diff --git a/man/unmarkedMultFrame.Rd b/man/unmarkedMultFrame.Rd
index 383b905..97533ee 100644
--- a/man/unmarkedMultFrame.Rd
+++ b/man/unmarkedMultFrame.Rd
@@ -155,7 +155,7 @@ o2y
 umfGMM2 <- unmarkedFrameGMM(y=y,
     siteCovs = data.frame(site=site),
     obsCovs=list(occasion=occasions),
-    yearlySiteCovs=data.frame(year=years),
+    yearlySiteCovs=data.frame(year=c(t(years))),
     numPrimary=T, obsToY=o2y, piFun="instRemPiFun")
 
 str(umfGMM2)
diff --git a/tests/testthat/test_gdistsamp.R b/tests/testthat/test_gdistsamp.R
index c993013..96636d0 100644
--- a/tests/testthat/test_gdistsamp.R
+++ b/tests/testthat/test_gdistsamp.R
@@ -111,7 +111,8 @@ test_that("gdistsamp with halfnorm keyfunction works",{
     #expect_equivalent(coef(fm_R),coef(fm_C),tol=1e-4)
 
     #With covariates
-    umf <- unmarkedFrameGDS(y = y, siteCovs=covs, yearlySiteCovs=covs,
+    ysc <- as.data.frame(rbind(covs, covs, covs))
+    umf <- unmarkedFrameGDS(y = y, siteCovs=covs, yearlySiteCovs=ysc,
                             survey="line", unitsIn="m",
                             dist.breaks=breaks,
                             tlength=rep(transect.length, R), numPrimary=T)
@@ -149,7 +150,7 @@ test_that("gdistsamp with halfnorm keyfunction works",{
     #With missing values
     yna <- y
     yna[1,c(1,6)] <- NA
-    umf <- unmarkedFrameGDS(y = yna, siteCovs=covs, yearlySiteCovs=covs,
+    umf <- unmarkedFrameGDS(y = yna, siteCovs=covs, yearlySiteCovs=ysc,
                             survey="line", unitsIn="m",
                             dist.breaks=breaks,
                             tlength=rep(transect.length, R), numPrimary=T)
@@ -166,7 +167,7 @@ test_that("gdistsamp with halfnorm keyfunction works",{
     #With an entire session missing
     yna <- y
     yna[1,1:J] <- NA
-    umf <- unmarkedFrameGDS(y = yna, siteCovs=covs, yearlySiteCovs=covs,
+    umf <- unmarkedFrameGDS(y = yna, siteCovs=covs, yearlySiteCovs=ysc,
                             survey="line", unitsIn="m",
                             dist.breaks=breaks,
                             tlength=rep(transect.length, R), numPrimary=T)
@@ -250,7 +251,8 @@ test_that("gdistsamp with uniform keyfunction works",{
     }
     y <- matrix(y, nrow=R) # convert array to matrix
 
-    umf <- unmarkedFrameGDS(y = y, siteCovs=covs, yearlySiteCovs=covs,
+    ysc <- as.data.frame(rbind(covs, covs, covs))
+    umf <- unmarkedFrameGDS(y = y, siteCovs=covs, yearlySiteCovs=ysc,
                             survey="line", unitsIn="m",
                             dist.breaks=breaks,
                             tlength=rep(transect.length, R), numPrimary=T)
@@ -328,7 +330,8 @@ test_that("gdistsamp with exp keyfunction works",{
     y <- matrix(y, nrow=R) # convert array to matrix
 
     #With covariates
-    umf <- unmarkedFrameGDS(y = y, siteCovs=covs, yearlySiteCovs=covs,
+    ysc <- as.data.frame(rbind(covs, covs, covs))
+    umf <- unmarkedFrameGDS(y = y, siteCovs=covs, yearlySiteCovs=ysc,
                             survey="line", unitsIn="m",
                             dist.breaks=breaks,
                             tlength=rep(transect.length, R), numPrimary=T)
@@ -415,7 +418,8 @@ test_that("gdistsamp with hazard keyfunction works",{
     y <- matrix(y, nrow=R) # convert array to matrix
 
     #With covariates
-    umf <- unmarkedFrameGDS(y = y, siteCovs=covs, yearlySiteCovs=covs,
+    ysc <- as.data.frame(rbind(covs, covs, covs))
+    umf <- unmarkedFrameGDS(y = y, siteCovs=covs, yearlySiteCovs=ysc,
                             survey="line", unitsIn="m",
                             dist.breaks=breaks,
                             tlength=rep(transect.length, R), numPrimary=T)
@@ -625,7 +629,8 @@ test_that("gdistsamp simulate method works",{
     y <- matrix(y, nrow=R) # convert array to matrix
 
     covs$par1[2] <- NA
-    umf <- unmarkedFrameGDS(y = y, siteCovs=covs, yearlySiteCovs=covs,
+    ysc <- as.data.frame(rbind(covs, covs, covs))
+    umf <- unmarkedFrameGDS(y = y, siteCovs=covs, yearlySiteCovs=ysc,
                             survey="line", unitsIn="m",
                             dist.breaks=breaks,
                             tlength=rep(transect.length, R), numPrimary=T)
diff --git a/tests/testthat/test_unmarkedFrame.R b/tests/testthat/test_unmarkedFrame.R
index c3194fe..66bc902 100644
--- a/tests/testthat/test_unmarkedFrame.R
+++ b/tests/testthat/test_unmarkedFrame.R
@@ -256,3 +256,18 @@ test_that("lists provided to obsCovs or yearlySiteCovs must be named", {
         obsCovs = oc,
         numPrimary = 3))
 })
+
+test_that("covsToDF", {
+  expect_equal(covsToDF(NULL, "obsCovs", 2, 3), NULL)
+  
+  df <- data.frame(x = rnorm(6), y = rnorm(6))
+  expect_equal(covsToDF(df, "obsCovs", 2, 3),
+               df)
+  expect_error(covsToDF(df, "obsCovs", 2, 2))
+
+  cl <- list(x = matrix(rnorm(6), 2, 3), y =matrix(rnorm(6), 2, 3))
+  df_cl <- as.data.frame(lapply(cl, function(x) as.vector(t(x))))
+  expect_equal(covsToDF(cl, "obsCovs", 3, 2),
+               df_cl)
+  expect_error(covsToDF(cl, "obsCovs", 2, 3))
+})