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}