From 647779fbc4ea235e790f8d3ce9e809de2de129d4 Mon Sep 17 00:00:00 2001 From: Steve Martin Date: Sat, 6 Jul 2024 23:07:56 -0400 Subject: [PATCH] Added chkDots() --- DESCRIPTION | 2 +- R/inclusion_prob.R | 14 +++++++------- R/prop_allocation.R | 4 ++-- R/sps.R | 2 +- R/sps_repweights.R | 3 +-- R/sps_sample-class.R | 5 ++++- 6 files changed, 16 insertions(+), 14 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 975a3e2..1be21b0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: sps Title: Sequential Poisson Sampling -Version: 0.5.4 +Version: 0.5.4.9001 Authors@R: c( person("Steve", "Martin", role = c("aut", "cre", "cph"), diff --git a/R/inclusion_prob.R b/R/inclusion_prob.R index a2661cd..a2c5553 100644 --- a/R/inclusion_prob.R +++ b/R/inclusion_prob.R @@ -14,7 +14,7 @@ as_stratum <- function(strata) { #' Calculate unconstrained inclusion probabilities #' @noRd unbounded_pi <- function(x, n) { - # n == 0 should be a strong zero + # n == 0 should be a strong zero. if (n == 0L) { rep.int(0, length(x)) } else { @@ -25,10 +25,10 @@ unbounded_pi <- function(x, n) { #' Find the units that belong in a TA stratum #' @noRd ta_units <- function(x, n, alpha) { - # partial sorting is not stable, so if x[n] == x[n + 1] after sorting then + # Partial sorting is not stable, so if x[n] == x[n + 1] after sorting then # it is possible for the result to not resolve ties according to x # (as documented) when alpha is large enough to make at least one unit with - # x[n] TA + # x[n] TA. ord <- order(x, decreasing = TRUE) s <- seq_len(n) possible_ta <- rev(ord[s]) @@ -36,10 +36,10 @@ ta_units <- function(x, n, alpha) { definite_ts <- ord[seq.int(n + 1, length.out = length(x) - n)] p <- x_ta * s / (sum(x[definite_ts]) + cumsum(x_ta)) - # the sequence given by p has the following properties - # 1. if p[k] < 1, then p[k + 1] >= p[k] - # 2. if p[k] >= 1, then p[k + 1] >= 1 - # consequently, if p[k] >= 1 - alpha, then p[k + m] >= 1 - alpha + # The sequence given by p has the following properties + # 1. if p[k] < 1, then p[k + 1] >= p[k], + # 2. if p[k] >= 1, then p[k + 1] >= 1, + # consequently, if p[k] >= 1 - alpha, then p[k + m] >= 1 - alpha. possible_ta[p >= 1 - alpha] } diff --git a/R/prop_allocation.R b/R/prop_allocation.R index cd19c60..b38942d 100644 --- a/R/prop_allocation.R +++ b/R/prop_allocation.R @@ -42,8 +42,8 @@ highest_averages <- function(p, n, initial, available, ties, dist) { p <- p[ord] res <- res[ord] available <- available[ord] - # the while condition could be n > sum(res), but the loop below always - # terminates after at most n steps, even if i is integer(0) + # The while condition could be n > sum(res), but the loop below always + # terminates after at most n steps, even if i is integer(0). while (n > 0L) { i <- which.max(p / dist(res) * (res < available)) res[i] <- res[i] + 1L diff --git a/R/sps.R b/R/sps.R index 4059bd7..74a9669 100644 --- a/R/sps.R +++ b/R/sps.R @@ -56,7 +56,7 @@ stratify <- function(f) { p <- inclusion_prob_(x, n, strata, alpha, cutoff) samp <- Map(f, p, n, split(prn, strata)) pos <- split(seq_along(prn), strata) - # strata must have at least one level, so unlist won't return NULL + # Strata must have at least one level, so unlist won't return NULL. res <- unlist(Map(`[`, pos, samp), use.names = FALSE) weights <- 1 / unlist(Map(`[`, p, samp), use.names = FALSE) diff --git a/R/sps_repweights.R b/R/sps_repweights.R index 118bd89..aea63c3 100644 --- a/R/sps_repweights.R +++ b/R/sps_repweights.R @@ -107,8 +107,7 @@ sps_repweights <- function(w, replicates = 1000L, tau = 1, dist = NULL) { p <- 1 / w n <- length(w) * replicates - a <- if (is.null(dist)) { - # pseudo-population method + a <- if (is.null(dist)) { # pseudo-population method wf <- floor(w) wr <- wf + (stats::runif(n) < w - wf) stats::rbinom(n, wr, p) - p * wr diff --git a/R/sps_sample-class.R b/R/sps_sample-class.R index c3a792c..71a4043 100644 --- a/R/sps_sample-class.R +++ b/R/sps_sample-class.R @@ -29,6 +29,7 @@ levels.sps_sample <- function(x) { #' @export #' @importFrom stats weights weights.sps_sample <- function(object, ...) { + chkDots(...) attr(object, "weights") } @@ -40,6 +41,7 @@ print.sps_sample <- function(x, ...) { #' @export summary.sps_sample <- function(object, ...) { + chkDots(...) n <- length(object) ts <- sum(weights(object) > 1) structure(list(n = n, ts = ts, ta = n - ts), class = "sps_sample_summary") @@ -47,8 +49,9 @@ summary.sps_sample <- function(object, ...) { #' @export print.sps_sample_summary <- function(x, ...) { + chkDots(...) cat( - "Sample for", x$n, "units with", x$ta, + "Sample of", x$n, "units with", x$ta, "take-all unit and", x$ts, "take-some units" ) invisible(x)