docs: ego_design (both in egor and as LHS) expanded and suggests alis…

…t() rather than list(), with examples added; hint provided on error

fixes #90

DESCRIPTION

@@ -53,7 +53,7 @@ Suggests:
     network,
     haven
 VignetteBuilder: knitr
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2
 Roxygen: list(markdown = TRUE)
 LazyData: true
 Encoding: UTF-8

R/ego.design.R

@@ -14,13 +14,12 @@ weights.egor <- function(object, ...) {
 }
 
 #' A helper function that takes an egor object and a list with arguments
-#' to ego_design and runs survey::svydesign().
+#' to ego_design and runs [srvyr::as_survey_design()].
 #'
 #' @param egor an [`egor`] object (possibly missing design
 #'   information).
-#' @param ego_design a [`list`] of arguments to [a_survey_design()]
-#'   specifying the sampling design for the egos. The arguments can
-#'   refer to columns (ego attributes) of `egor`.
+#' @templateVar ego_design_name ego_design
+#' @template ego_design
 #' @param pos where the call to `as_survey_design`.
 #'
 #' @return If `ego_design` is a `list`, [`ego`] as a [`tbl_svy`]. If
@@ -29,12 +28,19 @@ weights.egor <- function(object, ...) {
 #'
 #' @noRd
 .gen.ego_design <- function(egor, ego_design, pos=-1L){
+  cl <- rlang::caller_env()
+  tryCatch(force(ego_design),
+           error = function(e) rlang::abort(c(conditionMessage(e),
+                                              i = paste0("Did you pass ego design variable names unquoted and wrap them in ",
+                                                         sQuote('list()'), " rather than ", sQuote('alist()'), "?")),
+                                            use_cli_format = TRUE, call = cl))
+
   egos <- if(is(egor, "nested_egor")) egor else egor$ego
   if(is.null(ego_design)) return(as_tibble(egos))
 
   envir <- as.environment(pos)
 #' @importFrom srvyr as_survey_design
-  suppressWarnings(do.call(as_survey_design, c(list(egos), ego_design), envir=envir))
+  do.call(as_survey_design, c(list(egos), ego_design), envir=envir)
 }
 
 #' Set and query the ego sampling design
@@ -62,14 +68,21 @@ ego_design.nested_egor <- function(x, ...) if (has_ego_design(x)) x # otherwise
 `ego_design<-` <- function(x, ..., value) UseMethod("ego_design<-")
 
 #' @rdname ego_design
-#' @param value a [`list`] of arguments to [srvyr::as_survey_design()]
-#'   specifying the sampling design for the egos. If the arguments are
-#'   formulas, they can refer to columns (ego attributes) of
-#'   `x`. `NULL` clears design information.
+#' @templateVar ego_design_name value
+#' @template ego_design
 #'
 #' @note This can be useful for adjusting or re-initializing the ego
 #'   design information after the underlying ego attributes had been
 #'   modified.
+#'
+#' @examples
+#' data(egor32)
+#'
+#' ego_design(egor32)
+#'
+#' ego_design(egor32) <- alist(strata = sex)
+#'
+#' ego_design(egor32)
 #' @export
 `ego_design<-.egor` <- function(x, ..., value){
   x$ego <- .gen.ego_design(x, value, parent.frame())

R/egor.R

@@ -15,10 +15,8 @@ if (getRversion() >= "2.15.1") utils::globalVariables(c(":="))
 #'   relations in the style of an edge list, or a list of data frames
 #'   similar to `alters.df`.
 #' @template ID.vars
-#' @param ego_design A [`list`] of arguments to
-#'   [srvyr::as_survey_design()] specifying the sampling design for
-#'   the egos. If formulas, they can refer to columns of
-#'   `egos.df`. `NULL` means that no design is set.
+#' @templateVar ego_design_name ego_design
+#' @template ego_design
 #' @param alter_design A [`list`] of arguments specifying nomination
 #'   information. Currently, the following elements are supported:
 #'   \describe{\item{\code{"max"}}{Maximum number of alters that an
@@ -55,13 +53,19 @@ if (getRversion() >= "2.15.1") utils::globalVariables(c(":="))
 #' data("alters32")
 #' data("aaties32") 
 #' 
-#' egor(alters32, 
-#'      egos32, 
-#'      aaties32,
-#'      ID.vars = list(ego = ".EGOID", 
-#'                     alter = ".ALTID", 
-#'                     source = ".SRCID",
-#'                     target =  ".TGTID"))
+#' e <- egor(alters32,
+#'           egos32,
+#'           aaties32,
+#'           ID.vars = list(ego = ".EGOID",
+#'                          alter = ".ALTID",
+#'                          source = ".SRCID",
+#'                          target =  ".TGTID"),
+#'           ego_design = alist(strata = sex))
+#'
+#' e
+#'
+#' ego_design(e)
+#'
 #' @export
 egor <- function(alters,
                     egos = NULL,

man-roxygen/ego_design.R

@@ -0,0 +1,7 @@
+#' @param <%=ego_design_name%> A [`list`] of arguments to [srvyr::as_survey_design()] specifying
+#' the sampling design for the egos in terms of the ego
+#' variables. Variable names can be referenced as strings, as
+#' one-sided formulas, or using [dplyr::select()] syntax. It is
+#' recommended to use [alist()] rather than [list()] to construct this
+#' argument, particularly when using the `select()` syntax. Pass
+#' `NULL` to set no design.

tests/testthat/test-ego_design.R

@@ -26,6 +26,10 @@ test_that("ego_density works with ego_design", {
   ego_design(x) <- list(weight = "sampling_weight")
   library(srvyr)
   expect_error(ego_density(x), NA)
+
+  ## tidyselect arguments work as well
+  ego_design(x) <- alist(weight = sampling_weight)
+  expect_error(ego_density(x), NA)
 })
 
 test_that("survey_mean and svymean work with ego_design", {
@@ -40,6 +44,17 @@ test_that("survey_mean and svymean work with ego_design", {
     srvyr::summarise(mean_dens = srvyr::survey_mean(density)), NA)
 
   expect_error(survey::svymean(~density, ego_density(x)), NA)
+})
 
-
+o <- options(useFancyQuotes = FALSE, width = 999)
+
+test_that("sensible error message is produced when using list() instead of alist()", {
+  expect_error(
+    egor(alters32, egos32, aaties32,
+         ID.vars = list(ego = ".EGOID", alter = ".ALTID", source = ".SRCID", target =  ".TGTID"),
+         ego_design = list(strata = sex)),
+    ".* Did you pass ego design variable names unquoted and wrap them in 'list\\(\\)' rather than 'alist\\(\\)'\\?.*"
+  )
 })
+
+options(o)