Refactor unmarkedFrame bracket selectors

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: unmarked
-Version: 1.5.0.9004
-Date: 2025-07-21
+Version: 1.5.0.9005
+Date: 2025-07-27
 Type: Package
 Title: Models for Data from Unmarked Animals
 Authors@R: c(
@@ -65,6 +65,7 @@ Collate: 'classes.R' 'unmarkedEstimate.R' 'unmarkedFrame.R'
     'occuCOP.R'
     'occuComm.R'
     'removed_functions.R'
+    'square_brackets.R'
     'RcppExports.R'
     'zzz.R'
 LinkingTo: 

R/gdistremoval.R

@@ -54,118 +54,6 @@ setAs("unmarkedFrameGDR", "data.frame", function(from){
   data.frame(yDistance, yRemoval, out)
 })
 
-setMethod("[", c("unmarkedFrameGDR", "numeric", "missing", "missing"),
-  function(x, i) {
-  M <- numSites(x)
-  T <- x@numPrimary
-
-  if(length(i) == 0) return(x)
-  if(any(i < 0) && any(i > 0))
-    stop("i must be all positive or all negative indices.")
-  if(all(i < 0)) { # if i is negative, then convert to positive
-    i <- (1:M)[i]
-  }
-
-  yDist <- x@yDistance
-  Rdist <- ncol(yDist)
-  Jdist <- Rdist / T
-  yRem <- x@yRemoval
-  Rrem <- ncol(yRem)
-  Jrem <- Rrem / T
-  sc <- siteCovs(x)
-  oc <- obsCovs(x)
-  ysc <- NULL
-  if(T > 1){
-    ysc <- yearlySiteCovs(x)
-  }
-
-  yDist <- yDist[i,,drop=FALSE]
-  yRem <- yRem[i,,drop=FALSE]
-
-  if(!is.null(sc)){
-    sc <- sc[i,,drop=FALSE]
-  }
-
-  if(!is.null(oc)){
-    site_idx <- rep(1:M, each=Rrem)
-    oc <- do.call("rbind", lapply(i, function(ind){
-      obsCovs(x)[site_idx == ind,,drop=FALSE]
-    }))
-  }
-
-  if(!is.null(ysc)){
-    site_idx <- rep(1:M, each=T)
-    ysc <- do.call("rbind", lapply(i, function(ind){
-      yearlySiteCovs(x)[site_idx == ind,,drop=FALSE]
-    }))
-  }
-
-  umf <- x
-  umf@y <- yRem
-  umf@yDistance <- yDist
-  umf@yRemoval <- yRem
-  umf@siteCovs <- sc
-  umf@obsCovs <- oc
-  umf@yearlySiteCovs <- ysc
-
-  umf
-})
-
-setMethod("[", c("unmarkedFrameGDR", "logical", "missing", "missing"),
-  function(x, i) {
-  i <- which(i)
-  x[i, ]
-})
-
-setMethod("[", c("unmarkedFrameGDR", "missing", "numeric", "missing"),
-  function(x, i, j){
-
-  M <- numSites(x)
-  T <- x@numPrimary
-  if(T == 1){
-    stop("Only possible to subset by primary period", call.=FALSE)
-  }
-  yDist <- x@yDistance
-  Rdist <- ncol(yDist)
-  Jdist <- Rdist / T
-  yRem <- x@yRemoval
-  Rrem <- ncol(yRem)
-  Jrem <- Rrem / T
-  oc <- obsCovs(x)
-  ysc <- yearlySiteCovs(x)
-
-  rem_idx <- rep(1:T, each=Jrem) %in% j
-  yRem <- yRem[,rem_idx,drop=FALSE]
-  obsToY <- x@obsToY[rem_idx, rem_idx]
-
-  dist_idx <- rep(1:T, each=Jdist) %in% j
-  yDist <- yDist[,dist_idx,drop=FALSE]
-
-  if(!is.null(oc)){
-    T_idx <- rep(rep(1:T, each=Jrem),M)
-    keep <- T_idx %in% j
-    oc <- oc[keep,,drop=FALSE]
-  }
-
-  if(!is.null(ysc)){
-    site_idx <- rep(1:T, M)
-    keep <- site_idx %in% j
-    ysc <- ysc[keep,,drop=FALSE]
-  }
-
-  umf <- x
-  umf@y <- yRem
-  umf@yDistance <- yDist
-  umf@yRemoval <- yRem
-  umf@obsCovs <- oc
-  umf@yearlySiteCovs <- ysc
-  umf@obsToY <- obsToY
-  umf@numPrimary <- length(j)
-
-  umf
-})
-
-
 setClass("unmarkedFitGDR", contains = "unmarkedFitGDS")
 
 gdistremoval <- function(lambdaformula=~1, phiformula=~1, removalformula=~1,

R/occuCOP.R

@@ -90,87 +90,6 @@ setMethod("summary", "unmarkedFrameOccuCOP", function(object,...) {
 })
 
 
-## umf[i, j] ----
-setMethod("[", c("unmarkedFrameOccuCOP", "numeric", "numeric", "missing"),
-          function(x, i, j) {
-            # Gey dimensions of x
-            M <- numSites(x)
-            J <- obsNum(x)
-
-            if (length(i) == 0 & length(j) == 0) {
-              return(x)
-            }
-
-            # Check i
-            if (any(i < 0) &&
-                any(i > 0)) {
-              stop("i must be all positive or all negative indices.")
-            }
-            if (all(i < 0)) {
-              i <- (1:M)[i]
-            }
-
-            # Check j
-            if (any(j < 0) &&
-                any(j > 0)) {
-              stop("j must be all positive or all negative indices.")
-            }
-            if (all(j < 0)) {
-              j <- (1:J)[j]
-            }
-
-            # y observation count data subset
-            y <- getY(x)[i, j, drop = FALSE]
-            if (min(length(i), length(j)) == 1) {
-              y <- t(y)
-            }
-
-            # L subset
-            L <- x@L[i, j, drop = FALSE]
-            if (min(length(i), length(j)) == 1) {
-              L <- t(L)
-            }
-
-            # siteCovs subset
-            siteCovs <- siteCovs(x)
-            if (!is.null(siteCovs)) {
-              siteCovs <- siteCovs(x)[i, , drop = FALSE]
-            }
-
-            # obsCovs subset
-            obsCovs <- obsCovs(x)
-            if (!is.null(obsCovs)) {
-              MJ_site <- rep(1:M, each = J)
-              MJ_obs <- rep(1:J, times = M)
-              obsCovs <- obsCovs[((MJ_obs %in% j) & (MJ_site %in% i)), , drop = FALSE]
-              rownames(obsCovs) <- NULL
-            }
-
-            # Recreate umf
-            new(
-              Class = "unmarkedFrameOccuCOP",
-              y = y,
-              L = L,
-              siteCovs = siteCovs,
-              obsCovs = obsCovs,
-              obsToY = diag(length(j))
-            )
-          })
-
-
-## umf[i, ] ----
-setMethod("[", c("unmarkedFrameOccuCOP", "numeric", "missing", "missing"),
-          function(x, i) {
-            x[i, 1:obsNum(x)]
-          })
-
-## umf[, j] ----
-setMethod("[", c("unmarkedFrameOccuCOP", "missing", "numeric", "missing"),
-          function(x, j) {
-            x[1:numSites(x), j]
-          })
-
-
 ## fl_getY ----
 setMethod("fl_getY", "unmarkedFitOccuCOP", function(fit, ...){
   fl <- fit@formlist

R/occuComm.R

@@ -100,67 +100,6 @@ setMethod("plot", c(x="unmarkedFrameOccuComm", y="missing"),
         labels=names(x@ylist), ...)
 })
 
-#[ Methods for community occupancy frames
-setMethod("[", c("unmarkedFrameOccuComm", "numeric", "missing", "missing"),
-    function(x, i){
-  if(length(i) == 0) return(x)
-  M <- numSites(x)
-  J <- obsNum(x)
-  S <- length(x@ylist)
-
-  ylist <- lapply(x@ylist,function(x) x[i,,drop=F])
-
-  siteCovs <- siteCovs(x)
-  if (!is.null(siteCovs)) {
-    siteCovs <- siteCovs(x)[i, , drop = FALSE]
-  }
-
-  obsCovs <- obsCovs(x)
-  if (!is.null(obsCovs)) {
-    .site <- rep(1:M, each = J)
-    oc <- lapply(i, function(ind){
-      obsCovs[.site==ind,,drop=FALSE]
-    })
-    obsCovs <- do.call(rbind, oc)
-  }
-
-  # Species covs
-  spc <- x@speciesCovs
-  if(!is.null(spc)){
-    # length S covs are unchanged
-    spc_sp <- sapply(spc, function(x) identical(length(x), S))
-    spc_sp <- spc[spc_sp]
-
-    # M x S covs
-    spc_site <- sapply(spc, function(x) identical(dim(x), c(M, S))) 
-    spc_site <- spc[spc_site]
-    if(length(spc_site) > 0){
-      spc_site <- lapply(spc_site, function(x){
-        x[i,,drop=FALSE]
-      })
-    }
-    # M x J x S covs
-    spc_obs <- sapply(spc, function(x) identical(dim(x), c(M, J, S)))
-    spc_obs <- spc[spc_obs]
-    if(length(spc_obs) > 0){
-      spc_obs <- lapply(spc_obs, function(x){
-        x[i,,,drop=FALSE]
-      })
-    }
-    new_spc <- c(spc_site, spc_obs, spc_sp)
-  } else {
-    new_spc <- NULL
-  }
-
-  umf <- x
-  umf@y <- ylist[[1]]
-  umf@ylist <- ylist
-  umf@siteCovs <- siteCovs
-  umf@obsCovs <- obsCovs
-  umf@speciesCovs <- new_spc
-  umf
-})
-
 process_multispecies_umf <- function(umf, interact_covs){
   ylist <- umf@ylist
   M <- nrow(ylist[[1]])