Reorganised as_tibble.egor() and related functions:

* as_survey_design.egor() is gone.
* as_survey.egor() behaves the same as as_tibble.egor(), but returns a tbl_svy object (regardless of whether the egor has ego design).
* as_egos_df() has been added for consistency.
* as_(egos|alters|aaties)_survey() have been added, analogous to as_*_df() but returning a tbl_svy object.
* as_tibble.egor() is has been moved to conversions.R.
* as_tibble.egor() and as_survey.egor() are now documented in the same file as as_*_df() and as_*_survey().

References #14. Fixes #33. Fixes #53.

NAMESPACE

@@ -18,7 +18,6 @@ S3method(as.network,egor)
 S3method(as_igraph,egor)
 S3method(as_igraph,nested_egor)
 S3method(as_survey,egor)
-S3method(as_survey_design,egor)
 S3method(as_tibble,egor)
 S3method(clustered_graphs,data.frame)
 S3method(clustered_graphs,egor)
@@ -92,7 +91,11 @@ export(append_rows)
 export(as.egor)
 export(as.igraph.egor)
 export(as_aaties_df)
+export(as_aaties_survey)
 export(as_alters_df)
+export(as_alters_survey)
+export(as_egos_df)
+export(as_egos_survey)
 export(as_igraph)
 export(as_nested_egor)
 export(as_network)

R/conversions.R

@@ -263,45 +263,146 @@ as_network <- function(x,
 #' @export
 as.network.egor <- as_network
 
-#' Create global alters and alter-alter relations dataframes from an `egor` object
+#' Extract ego, alter, and alter-alter tables from an `egor` object.
 #'
-#' Provided an egor-object, these functions create a 'global' \code{data.frame},
-#' containing alter attributes, or alter-alter relations. The resulting dataframes
+#' @description Provided an `egor` object, these functions create a "global" `tibble` or `srvyr`'s [`tbl_svy`] object
+#' containing egos, alter attributes, or alter-alter relations. The resulting tables
 #' are useful for advanced analysis procedures, e.g. multi-level regressions.
 #'
-#' @param object An `egor` object.
-#' a new variable with the specified name is created.
+#' @description [as_tibble()] method for `egor` extracts the currently active component (`ego`, `alter`, or `aaties`) table, optionally joining it with the others, dropping any survey design information.
+#'
+#' @param object,.data An `egor` object.
 #' @param include.ego.vars Logical, specifying if ego variables should be included in the result.
 #' @param include.alter.vars Logical, specifying if alter variables should be included in the result.
 #' @examples
 #' # Load example data
 #' data(egor32)
 #'
-#' # Create global alters dataframes
-#' as_alters_df(egor32)
+#' as_tibble(egor32) # Ego table.
 #'
-#' # Create global alter-alter relaions dataframes
-#' as_aaties_df(egor32)
+#' egor32 %>% activate("alter") %>% as_tibble(include.ego.vars=TRUE) # Alter table, but also with ego variables.
+#'
+#' @return A `tibble` for the `as_tibble` and `*_df` functions and a `tbl_svy` for `as_survey` and the `*_survey` functions.
+#' @export
+as_tibble.egor <- function(x,
+                           ...,
+                           include.ego.vars = FALSE,
+                           include.alter.vars = FALSE){
+  res <- as_tibble(x[[attr(x, "active")]])
+
+  if (include.ego.vars && attr(x, "active") != "ego") {
+    ego <- if(has_ego_design(x)) x$ego$variables else x$ego
+
+    names(ego)[names(ego) != ".egoID"] <-
+      paste0(names(ego)[names(ego) != ".egoID"] , "_ego")
+    res <- full_join(res, ego, by = ".egoID")
+  }
+
+  if (include.alter.vars & attr(x, "active") == "aatie") {
+    res <- left_join(res,
+                     x$alter,
+                     by = c(".egoID", ".srcID" = ".altID"))
+    res <- left_join(res,
+                     x$alter,
+                     by = c(".egoID", ".tgtID" = ".altID"),
+                     suffix = c("_src","_tgt"))
+  }
+
+  res
+}
+
+#' @rdname as_tibble.egor
+#' @description [as_survey()] method for `egor` instead returns a `srvyr` [`tbl_svy`] survey, taking into account any replication due to multiple alters or alter-alter ties incident on each ego. If no design is specified for the egos, then the default design (simple random sample with replacement) is assumed as the starting point.
+#' @examples
+#' library(srvyr)
+#' as_survey(egor32) # Ego table with survey design.
+#' @importFrom srvyr as_survey
+#' @export
+as_survey.egor <- function(.data, ...,
+                           include.ego.vars = FALSE,
+                           include.alter.vars = FALSE){
+  if(!has_ego_design(.data)) .data$ego <- as_survey(.data$ego)
+  # Obtain the results ignoring design.
+  result <- as_tibble(.data, ...,
+                      include.ego.vars = include.ego.vars,
+                      include.alter.vars = include.alter.vars)
+  # Now, figure out to which original ego row each of the output rows corresponds.
+  emap <- match(result$.egoID, .data$ego$variables$.egoID)
+  # Augment the initial ego survey design
+  result.design <- .data$ego[emap,]
+  result.design$variables <- result
+  result.design
+}
+
+#' @rdname as_tibble.egor
+#' @description `as_egos_df()`, `as_alters_df()`, `as_aaties_df()`, `as_egos_survey()`, `as_alters_survey()`, and `as_aaties_survey()` are convenience functions for the `as_tibble()` and `as_survey()` methods, activating the corresponding component of the `egor` object.
+#' @examples
+#'
+#' # Despite alter table being active, obtain the ego table.
+#' (egor32 <- activate(egor32, "alter"))
+#' as_egos_df(egor32)
+#'
+#' @export
+as_egos_df <- function(object) {
+  object <- activate(object, "ego")
+  as_tibble(object)
+}
+
+#' @rdname as_tibble.egor
+#' @examples
+#' # Create global alter table
+#' as_alters_df(egor32)
 #'
-#' # ... adding alter variables
-#' as_aaties_df(egor32, include.alter.vars = TRUE)
 #' @export
-#' @return A `tibble`.
-#' @details These functions are convenience functions for egor's `as_tibble` method.
 as_alters_df <- function(object, include.ego.vars = FALSE) {
   object <- activate(object, "alter")
-  as_tibble.egor(object, include.ego.vars = include.ego.vars)
+  as_tibble(object, include.ego.vars = include.ego.vars)
 }
 
-#' @rdname as_alters_df
+#' @rdname as_tibble.egor
+#' @examples
+#' # Create global alter-alter relations table
+#' as_aaties_df(egor32)
+#'
+#' # ... adding alter variables
+#' as_aaties_df(egor32, include.alter.vars = TRUE)
 #' @export
 #' @importFrom dplyr left_join
 #' @importFrom purrr map_lgl
 as_aaties_df <- function(object,
                          include.ego.vars = FALSE,
                          include.alter.vars = FALSE) {
   object <- activate(object, "aatie")
-  as_tibble.egor(object,
-                 include.ego.vars = include.ego.vars,
-                 include.alter.vars = include.alter.vars)
+  as_tibble(object,
+            include.ego.vars = include.ego.vars,
+            include.alter.vars = include.alter.vars)
+}
+
+#' @rdname as_tibble.egor
+#' @examples
+#' as_egos_survey(egor32)
+#' @export
+as_egos_survey <- function(object, include.ego.vars = FALSE) {
+  object <- activate(object, "ego")
+  as_survey(object, include.ego.vars = include.ego.vars)
+}
+
+#' @rdname as_tibble.egor
+#' @examples
+#' as_alters_survey(egor32) # Notice the resulting cluster design.
+#' @export
+as_alters_survey <- function(object, include.ego.vars = FALSE) {
+  object <- activate(object, "alter")
+  as_survey(object, include.ego.vars = include.ego.vars)
+}
+
+#' @rdname as_tibble.egor
+#' @export
+as_aaties_survey <- function(object,
+                             include.ego.vars = FALSE,
+                             include.alter.vars = FALSE) {
+  object <- activate(object, "aatie")
+  as_survey(object,
+            include.ego.vars = include.ego.vars,
+            include.alter.vars = include.alter.vars)
 }

R/dplyr_methods.R

@@ -97,7 +97,7 @@ bind_IDs_if_missing <- function(.data, result) {
 tibble_egos <- function(.data) {
   if (attr(.data, "active") == "ego" && has_ego_design(.data)) {
     .data[["ego"]] <-
-      cbind(.data[["ego"]][["variables"]], .rowID_for_design = seq_len(nrow(.data[["ego"]])))
+      bind_cols(.data[["ego"]][["variables"]], .rowID_for_design = seq_len(nrow(.data[["ego"]])))
   }
   .data
 }
@@ -1093,16 +1093,3 @@ setequal.egor <- function(x, y, ...) {
   result <- bind_IDs_if_missing(x, result)
   return_egor_with_result(x, result)
 }
-
-#' @noRd
-#' @importFrom srvyr as_survey
-#' @export
-as_survey.egor <- function(.data, ...) {
-  .data$ego
-}
-
-#' @noRd
-#' @export
-as_survey_design.egor <- function(.data, ...) {
-  .data$ego
-}

R/egor.R

@@ -48,6 +48,7 @@ if (getRversion() >= "2.15.1") utils::globalVariables(c(":="))
 #'   nominated. See the argument above for currently implemented
 #'   settings.
 #' @keywords ego-centered network analysis
+#' @seealso [as_tibble()] for extracting ego, alter, and alter--alter tables, as [`tibble`]s or as `srvyr`'s [`tbl_svy`] surveys.
 #' @examples 
 #' data("egos32")
 #' data("alters32")
@@ -324,37 +325,3 @@ as.egor.nested_egor <- function(x, ID.vars = list(
     )
   }
 }
-
-#' @method as_tibble egor
-#' @export
-as_tibble.egor <- function(x, 
-                           ..., 
-                           include.ego.vars = FALSE, 
-                           include.alter.vars = FALSE){
-  res <- as_tibble(x[[attr(x, "active")]])
-
-  if (include.ego.vars & attr(x, "active") != "ego") {
-
-    if (has_ego_design(x)) {
-      names(x$ego$variables)[names(x$ego$variables) != ".egoID"] <-
-        paste0(names(x$ego$variables)[names(x$ego$variables) != ".egoID"] , "_ego")
-      res <- full_join(res, x$ego$variables, by = ".egoID")
-    }else{
-      names(x$ego)[names(x$ego) != ".egoID"] <-
-        paste0(names(x$ego)[names(x$ego) != ".egoID"] , "_ego")
-      res <- full_join(res, x$ego, by = ".egoID")
-    }
-  }
-
-  if (include.alter.vars & attr(x, "active") == "aatie") {
-    res <- left_join(res, 
-                     x$alter, 
-                     by = c(".egoID", ".srcID" = ".altID"))
-    res <- left_join(res, 
-                     x$alter, 
-                     by = c(".egoID", ".tgtID" = ".altID"),
-                     suffix = c("_src","_tgt"))
-  }
-
-  res
-}