Added length<- method for sps objects

marberts · Jul 8, 2023 · e0a43a9 · e0a43a9
1 parent 655d037
commit e0a43a9
Show file tree

Hide file tree

Showing 5 changed files with 12 additions and 3 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: sps
 Title: Sequential Poisson Sampling
-Version: 0.5.1.9001
+Version: 0.5.1.9002
 Authors@R: c(
     person("Steve", "Martin", role = c("aut", "cre", "cph"), email = "stevemartin041@gmail.com", comment = c(ORCID = "0000-0003-2544-9480")),
     person("Justin", "Francis", role = "ctb")

diff --git a/NAMESPACE b/NAMESPACE
@@ -7,6 +7,7 @@ export(
 S3method(weights, sps)
 S3method(levels, sps)
 S3method("levels<-", sps)
+S3method("length<-", sps)
 S3method(print, sps)
 S3method(Ops, sps)
 S3method(Math, sps)

diff --git a/NEWS.md b/NEWS.md
@@ -4,7 +4,7 @@
 
 - `sps` objects now inherit from numeric instead of integer.
 
-- Fixed a bug where the levels attribute could be set for `sps` objects.
+- Replacement methods for `length` and `levels` no longer mangle `sps` objects.
 
 ## Changes in version 0.5.0
 

diff --git a/R/sps.R b/R/sps.R
@@ -70,7 +70,7 @@ ps <- stratify(ps_)
 
 #---- Methods for class 'sps' ----
 levels.sps <- function(x) {
-  res <- rep_len("TS", length(x))
+  res <- rep.int("TS", length(x))
   res[weights(x) == 1] <- "TA"
   res
 }
@@ -79,6 +79,11 @@ levels.sps <- function(x) {
   stop("cannot replace levels attribute")
 }
 
+`length<-.sps` <- function(x, value) {
+  x <- as.vector(x)
+  NextMethod()
+}
+
 weights.sps <- function(object, ...) {
   attr(object, "weights")
 }

diff --git a/tests/testthat/test-sps.R b/tests/testthat/test-sps.R
@@ -206,4 +206,7 @@ test_that("attributes get removed", {
   # and replacement methods
   expect_true(inherits(replace(samp, 1, 1), "numeric"))
   expect_true(inherits(replace(samp, 1, 1L), "integer"))
+
+  length(samp) <- 2
+  expect_true(inherits(samp, "integer"))
 })