From d52c3710b77e430fcb3dad38ea80ab5c0b0f15ae Mon Sep 17 00:00:00 2001
From: "Pavel N. Krivitsky"
Date: Sun, 13 Sep 2020 15:21:58 +1000
Subject: [PATCH] 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 | 5 +-
R/conversions.R | 137 ++++++++++++++++++++++++++++++++++++------
R/dplyr_methods.R | 15 +----
R/egor.R | 35 +----------
man/as_alters_df.Rd | 43 -------------
man/as_tibble.egor.Rd | 76 +++++++++++++++++++++++
man/egor.Rd | 3 +
7 files changed, 204 insertions(+), 110 deletions(-)
delete mode 100644 man/as_alters_df.Rd
create mode 100644 man/as_tibble.egor.Rd
diff --git a/NAMESPACE b/NAMESPACE
index b8e234d..9d98ccc 100644
--- a/NAMESPACE
+++ b/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)
diff --git a/R/conversions.R b/R/conversions.R
index c8da9ab..680276d 100644
--- a/R/conversions.R
+++ b/R/conversions.R
@@ -263,37 +263,109 @@ 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
@@ -301,7 +373,36 @@ 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)
}
diff --git a/R/dplyr_methods.R b/R/dplyr_methods.R
index 626291a..7665291 100644
--- a/R/dplyr_methods.R
+++ b/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
-}
diff --git a/R/egor.R b/R/egor.R
index ad76b08..3acccba 100644
--- a/R/egor.R
+++ b/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
-}
diff --git a/man/as_alters_df.Rd b/man/as_alters_df.Rd
deleted file mode 100644
index 4191af1..0000000
--- a/man/as_alters_df.Rd
+++ /dev/null
@@ -1,43 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/conversions.R
-\name{as_alters_df}
-\alias{as_alters_df}
-\alias{as_aaties_df}
-\title{Create global alters and alter-alter relations dataframes from an \code{egor} object}
-\usage{
-as_alters_df(object, include.ego.vars = FALSE)
-
-as_aaties_df(object, include.ego.vars = FALSE, include.alter.vars = FALSE)
-}
-\arguments{
-\item{object}{An \code{egor} object.
-a new variable with the specified name is created.}
-
-\item{include.ego.vars}{Logical, specifying if ego variables should be included in the result.}
-
-\item{include.alter.vars}{Logical, specifying if alter variables should be included in the result.}
-}
-\value{
-A \code{tibble}.
-}
-\description{
-Provided an egor-object, these functions create a 'global' \code{data.frame},
-containing alter attributes, or alter-alter relations. The resulting dataframes
-are useful for advanced analysis procedures, e.g. multi-level regressions.
-}
-\details{
-These functions are convenience functions for egor's \code{as_tibble} method.
-}
-\examples{
-# Load example data
-data(egor32)
-
-# Create global alters dataframes
-as_alters_df(egor32)
-
-# Create global alter-alter relaions dataframes
-as_aaties_df(egor32)
-
-# ... adding alter variables
-as_aaties_df(egor32, include.alter.vars = TRUE)
-}
diff --git a/man/as_tibble.egor.Rd b/man/as_tibble.egor.Rd
new file mode 100644
index 0000000..b442f50
--- /dev/null
+++ b/man/as_tibble.egor.Rd
@@ -0,0 +1,76 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/conversions.R
+\name{as_tibble.egor}
+\alias{as_tibble.egor}
+\alias{as_survey.egor}
+\alias{as_egos_df}
+\alias{as_alters_df}
+\alias{as_aaties_df}
+\alias{as_egos_survey}
+\alias{as_alters_survey}
+\alias{as_aaties_survey}
+\title{Extract ego, alter, and alter-alter tables from an \code{egor} object.}
+\usage{
+\method{as_tibble}{egor}(x, ..., include.ego.vars = FALSE, include.alter.vars = FALSE)
+
+\method{as_survey}{egor}(.data, ..., include.ego.vars = FALSE, include.alter.vars = FALSE)
+
+as_egos_df(object)
+
+as_alters_df(object, include.ego.vars = FALSE)
+
+as_aaties_df(object, include.ego.vars = FALSE, include.alter.vars = FALSE)
+
+as_egos_survey(object, include.ego.vars = FALSE)
+
+as_alters_survey(object, include.ego.vars = FALSE)
+
+as_aaties_survey(object, include.ego.vars = FALSE, include.alter.vars = FALSE)
+}
+\arguments{
+\item{include.ego.vars}{Logical, specifying if ego variables should be included in the result.}
+
+\item{include.alter.vars}{Logical, specifying if alter variables should be included in the result.}
+
+\item{object, .data}{An \code{egor} object.}
+}
+\value{
+A \code{tibble} for the \code{as_tibble} and \verb{*_df} functions and a \code{tbl_svy} for \code{as_survey} and the \verb{*_survey} functions.
+}
+\description{
+Provided an \code{egor} object, these functions create a "global" \code{tibble} or \code{srvyr}'s \code{\link{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.
+
+\code{\link[=as_tibble]{as_tibble()}} method for \code{egor} extracts the currently active component (\code{ego}, \code{alter}, or \code{aaties}) table, optionally joining it with the others, dropping any survey design information.
+
+\code{\link[=as_survey]{as_survey()}} method for \code{egor} instead returns a \code{srvyr} \code{\link{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.
+
+\code{as_egos_df()}, \code{as_alters_df()}, \code{as_aaties_df()}, \code{as_egos_survey()}, \code{as_alters_survey()}, and \code{as_aaties_survey()} are convenience functions for the \code{as_tibble()} and \code{as_survey()} methods, activating the corresponding component of the \code{egor} object.
+}
+\examples{
+# Load example data
+data(egor32)
+
+as_tibble(egor32) # Ego table.
+
+egor32 \%>\% activate("alter") \%>\% as_tibble(include.ego.vars=TRUE) # Alter table, but also with ego variables.
+
+library(srvyr)
+as_survey(egor32) # Ego table with survey design.
+
+# Despite alter table being active, obtain the ego table.
+(egor32 <- activate(egor32, "alter"))
+as_egos_df(egor32)
+
+# Create global alter table
+as_alters_df(egor32)
+
+# Create global alter-alter relations table
+as_aaties_df(egor32)
+
+# ... adding alter variables
+as_aaties_df(egor32, include.alter.vars = TRUE)
+as_egos_survey(egor32)
+as_alters_survey(egor32) # Notice the resulting cluster design.
+}
diff --git a/man/egor.Rd b/man/egor.Rd
index 7819154..3c7f58f 100644
--- a/man/egor.Rd
+++ b/man/egor.Rd
@@ -122,6 +122,9 @@ egor(alters32,
source = ".SRCID",
target = ".TGTID"))
}
+\seealso{
+\code{\link[=as_tibble]{as_tibble()}} for extracting ego, alter, and alter--alter tables, as \code{\link{tibble}}s or as \code{srvyr}'s \code{\link{tbl_svy}} surveys.
+}
\keyword{analysis}
\keyword{ego-centered}
\keyword{network}