Nothing
#' @title Add columns containing text data to network dataframes
#'
#' @description Network is supplemented with additional social media text data applied as node or edge attributes.
#'
#' @note Supports social media \code{activity} and \code{actor} networks. Refer to \code{\link{AddText.activity.reddit}}
#' and \code{\link{AddText.actor.reddit}} for additional reddit parameters. Refer to
#' \code{\link{AddText.actor.youtube}} for additional YouTube actor network parameters.
#'
#' @param net A named list of dataframes \code{nodes} and \code{edges} generated by \code{Create}.
#' @param data A dataframe generated by \code{Collect}.
#' @param ... Additional parameters passed to function.
#'
#' @return Network as a named list of two dataframes containing \code{$nodes} and \code{$edges} including columns
#' containing text data.
#'
#' @examples
#' \dontrun{
#' # add text to an activity network
#' net_activity <- collect_data |>
#' Create("activity") |> AddText(collect_data)
#'
#' # network
#' net_activity$nodes
#' net_activity$edges
#' }
#'
#' @aliases AddText
#' @name AddText
#' @export
AddText <- function(net, data, ...) {
msg <- f_verbose(check_dots("verbose", ...))
msg("Adding text data to network...")
if ("voson.text" %in% class(net)) {
stop("Network already has text attribute.")
}
# searches the class list of net for matching method
UseMethod("AddText", net)
}
#' @noRd
#' @export
AddText.default <- function(net, ...) {
stop("Unknown network type passed to AddText.", call. = FALSE)
}
#' @noRd
#' @method AddText activity
#' @export
AddText.activity <- function(net, ...) {
UseMethod("AddText.activity", net)
}
#' @noRd
#' @export
AddText.activity.default <- function(net, ...) {
stop("Unknown social media type passed to AddText.", call. = FALSE)
}
#' @noRd
#' @method AddText actor
#' @export
AddText.actor <- function(net, ...) {
UseMethod("AddText.actor", net)
}
#' @noRd
#' @export
AddText.actor.default <- function(net, ...) {
stop("Unknown social media type passed to AddText.", call. = FALSE)
}
#' @noRd
#' @method AddText semantic
#' @export
AddText.semantic <- function(net, ...) {
UseMethod("AddText.semantic", net)
}
#' @noRd
#' @export
AddText.semantic.default <- function(net, ...) {
stop("Unknown social media type passed to AddText.", call. = FALSE)
}
#' @noRd
#' @method AddText twomode
#' @export
AddText.twomode <- function(net, ...) {
UseMethod("AddText.twomode", net)
}
#' @noRd
#' @export
AddText.twomode.default <- function(net, ...) {
stop("Unknown social media type passed to AddText.", call. = FALSE)
}
#' @title Add columns containing text data to YouTube activity network dataframes
#'
#' @description Text comments are added to the network as node attributes.
#'
#' @param net A named list of dataframes \code{nodes} and \code{edges} generated by \code{Create}.
#' @param data A dataframe generated by \code{Collect}.
#' @param ... Additional parameters passed to function. Not used in this method.
#'
#' @return Network as a named list of two dataframes containing \code{$nodes} and \code{$edges} including columns
#' containing text data.
#'
#' @examples
#' \dontrun{
#' # add text to an activity network
#' net_activity <- collect_yt |>
#' Create("activity") |> AddText(collect_yt)
#'
#' # network
#' net_activity$nodes
#' net_activity$edges
#' }
#'
#' @aliases AddText.actor.youtube
#' @name AddText.actor.youtube
#' @export
AddText.activity.youtube <- function(net, data, ...) {
net$nodes <- dplyr::left_join(
net$nodes,
dplyr::select(data, .data$CommentID, .data$Comment) |>
dplyr::rename(
id = .data$CommentID,
vosonTxt_comment = .data$Comment
),
by = c("id")
)
class(net) <- union(class(net), c("voson.text"))
msg("Done.\n")
net
}
#' @title Add columns containing text data to YouTube actor network dataframes
#'
#' @description Text comments are added to the network as edge attributes. References to actors are detected at the
#' beginning of comments and edges redirected to that actor instead if they differ from the top-level comment author.
#'
#' @param net A named list of dataframes \code{nodes} and \code{edges} generated by \code{Create}.
#' @param data A dataframe generated by \code{Collect}.
#' @param repliesFromText Logical. If comment text for an edge begins with \code{screen_name} change the edge to be
#' directed to \code{screen_name} - if different from the top level comment author that the reply comment was posted
#' to. Default is \code{FALSE}.
#' @param atRepliesOnly Logical. Comment \code{screen_names} must begin with an '@' symbol to be redirected. Default is
#' \code{TRUE}.
#' @param ... Additional parameters passed to function. Not used in this method.
#'
#' @return Network as a named list of two dataframes containing \code{$nodes} and \code{$edges} including columns
#' containing text data.
#'
#' @examples
#' \dontrun{
#' # add text to an actor network ignoring references to actors at
#' # the beginning of comment text
#' net_actor <- collect_yt |>
#' Create("actor") |>
#' AddText(collect_yt, repliesFromText = FALSE)
#'
#' # network
#' net_actor$nodes
#' net_actor$edges
#' }
#'
#' @aliases AddText.actor.youtube
#' @name AddText.actor.youtube
#' @export
AddText.actor.youtube <-
function(net,
data,
repliesFromText = FALSE,
atRepliesOnly = TRUE,
...) {
net$edges <- net$edges |> dplyr::left_join(
dplyr::select(data, .data$CommentID, .data$Comment) |>
dplyr::rename(
comment_id = .data$CommentID,
vosonTxt_comment = .data$Comment
),
by = c("comment_id")
)
# in comment reply to
if (repliesFromText) {
net$edges <- net$edges |> dplyr::left_join(dplyr::select(net$nodes, -.data$node_type),
by = c("from" = "id"))
vid_comments <-
dplyr::select(net$edges, .data$video_id, .data$vosonTxt_comment) |> purrr::transpose()
net$edges$at_id <- sapply(vid_comments, function(x) {
for (name_at in net$nodes$screen_name) {
if (atRepliesOnly) {
name_at_regex <- paste0("^", escape_regex(paste0("@", name_at)))
} else {
name_at_regex <- paste0("^[@]?", escape_regex(name_at))
}
if (grepl(name_at_regex, x$vosonTxt_comment)) {
to_id <-
dplyr::filter(net$edges,
.data$screen_name == name_at & .data$video_id == x$video_id) |>
dplyr::select(.data$from) |> dplyr::distinct()
if (nrow(to_id)) {
return(as.character(tail(to_id, n = 1)))
} # choose last match - best effort
}
}
return(as.character(NA))
})
net$edges <- net$edges |> dplyr::mutate(
to = ifelse(is.na(.data$at_id), .data$to, .data$at_id),
edge_type = ifelse(
is.na(.data$at_id),
.data$edge_type,
"reply-comment-text"
)
)
}
class(net) <- union(class(net), c("voson.text"))
msg("Done.\n")
net
}
#' @title Add columns containing text data to reddit activity network dataframes
#'
#' @param net A named list of dataframes \code{nodes} and \code{edges} generated by \code{Create}.
#' @param data A dataframe generated by \code{Collect}.
#' @param cleanText Logical. Simple removal of problematic characters for XML 1.0 standard. Implemented to prevent
#' reddit specific XML control character errors when generating graphml files. Default is \code{FALSE}.
#' @param ... Additional parameters passed to function. Not used in this method.
#'
#' @return Network as a named list of two dataframes containing \code{$nodes} and \code{$edges} including columns
#' containing text data.
#'
#' @examples
#' \dontrun{
#' # add text to an activity network
#' net_activity <- collect_rd |>
#' Create("activity") |>
#' AddText(collect_rd)
#'
#' # network
#' net_activity$nodes
#' net_activity$edges
#' }
#'
#' @aliases AddText.activity.reddit
#' @name AddText.activity.reddit
#' @export
AddText.activity.reddit <-
function(net, data, cleanText = FALSE, ...) {
net$nodes <- dplyr::left_join(
net$nodes,
dplyr::mutate(data, id = paste0(.data$thread_id, ".", .data$structure)) |>
dplyr::select(.data$id, .data$subreddit, .data$comment),
by = c("id", "subreddit")
)
threads <-
dplyr::select(data,
.data$subreddit,
.data$thread_id,
.data$title,
.data$post_text) |>
dplyr::distinct() |> dplyr::mutate(id = paste0(.data$thread_id, ".0"), thread_id = NULL)
net$nodes <-
dplyr::left_join(net$nodes, threads, by = c("id", "subreddit")) |>
dplyr::mutate(comment = ifelse(.data$node_type == "thread", .data$post_text, .data$comment)) |>
dplyr::select(-c(.data$post_text)) |> dplyr::rename(vosonTxt_comment = .data$comment)
if (cleanText) {
net$nodes$vosonTxt_comment <-
xml_clean_reddit(net$nodes$vosonTxt_comment)
net$nodes$title <- xml_clean_reddit(net$nodes$title)
}
class(net) <- union(class(net), c("voson.text"))
msg("Done.\n")
net
}
#' @title Add columns containing text data to reddit actor network dataframes
#'
#' @param net A named list of dataframes \code{nodes} and \code{edges} generated by \code{Create}.
#' @param data A dataframe generated by \code{Collect}.
#' @param cleanText Logical. Simple removal of problematic characters for XML 1.0 standard. Implemented to prevent
#' reddit specific XML control character errors when generating graphml files. Default is \code{FALSE}.
#' @param ... Additional parameters passed to function. Not used in this method.
#'
#' @return Network as a named list of two dataframes containing \code{$nodes} and \code{$edges} including columns
#' containing text data.
#'
#' @examples
#' \dontrun{
#' # add text to an actor network ignoring references to actors at the beginning of
#' # comment text
#' net_actor <- collect_rd |>
#' Create("actor") |>
#' AddText(collect_rd)
#'
#' # network
#' net_actor$nodes
#' net_actor$edges
#' }
#'
#' @aliases AddText.actor.reddit
#' @name AddText.actor.reddit
#' @export
AddText.actor.reddit <-
function(net, data, cleanText = FALSE, ...) {
# rename the edge attribute containing the thread comment
net$edges <- dplyr::left_join(
net$edges,
dplyr::select(
data,
.data$subreddit,
.data$thread_id,
.data$id,
.data$comment
),
by = c("subreddit", "thread_id", "comment_id" = "id")
) |>
dplyr::rename(vosonTxt_comment = .data$comment)
authors <-
dplyr::select(data,
.data$subreddit,
.data$thread_id,
.data$title,
.data$post_text) |>
dplyr::distinct() |> dplyr::mutate(comment_id = 0)
net$edges <-
dplyr::left_join(net$edges,
authors,
by = c("subreddit", "thread_id", "comment_id")) |>
dplyr::mutate(
vosonTxt_comment = ifelse(
.data$comment_id == 0,
.data$post_text,
.data$vosonTxt_comment
),
post_text = NULL
)
net$edges$vosonTxt_comment <-
ifelse(trimws(net$edges$vosonTxt_comment) == "",
NA,
net$edges$vosonTxt_comment)
if (cleanText) {
net$edges$vosonTxt_comment <-
xml_clean_reddit(net$edges$vosonTxt_comment)
net$edges$title <- xml_clean_reddit(net$edges$title)
}
class(net) <- union(class(net), c("voson.text"))
msg("Done.\n")
net
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.