diff options
author | Ken Kellner <ken@kenkellner.com> | 2023-10-13 14:55:38 -0400 |
---|---|---|
committer | Ken Kellner <ken@kenkellner.com> | 2023-10-13 16:18:15 -0400 |
commit | b7044c9b64fafdb22c9a7a22467b9551c70af8ae (patch) | |
tree | cf23650eccbbf5474dfec6f1bebdb97a85643275 | |
parent | ac40eede793b0997209117080912a866a2ff18ae (diff) |
Check cov data frame dimensions when making umf
-rw-r--r-- | DESCRIPTION | 4 | ||||
-rw-r--r-- | R/unmarkedFrame.R | 28 | ||||
-rw-r--r-- | man/unmarkedMultFrame.Rd | 2 | ||||
-rw-r--r-- | tests/testthat/test_gdistsamp.R | 19 | ||||
-rw-r--r-- | tests/testthat/test_unmarkedFrame.R | 15 |
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)) +}) |