#' @title Add columns of video information to network dataframes
#'
#' @description Network is supplemented with additional downloaded video information.
#'
#' @note Only supports YouTube actor networks. Refer to \code{\link{AddVideoData.actor.youtube}}.
#'
#' @param net A named list of dataframes \code{nodes} and \code{edges} generated by \code{Create}.
#' @param youtubeAuth YouTube Authenticate object.
#' @param ... Additional parameters passed to function.
#' @param writeToFile Logical. Write data to file. Default is \code{FALSE}.
#' @param verbose Logical. Output additional information. Default is \code{TRUE}.
#'
#' @return Network as a named list of three dataframes containing \code{$nodes}, \code{$edges} and \code{$videos} nodes
#' and edges include columns for additional video data.
#'
#' @aliases AddVideoData
#' @name AddVideoData
#' @export
AddVideoData <- function(net, youtubeAuth = NULL, ..., writeToFile = FALSE, verbose = TRUE) {
if ("voson.video" %in% class(net)) stop("Network already has video data attribute.")
if (is.null(youtubeAuth)) stop("AddVideoData requires Authenticate object.", call. = FALSE)
# searches the class list of net for matching method
UseMethod("AddVideoData", net)
}
#' @noRd
#' @export
AddVideoData.default <- function(net, youtubeAuth = NULL, ..., writeToFile = FALSE, verbose = TRUE) {
stop("Unknown network type passed to AddVideoData.", call. = FALSE)
}
#' @noRd
#' @method AddVideoData actor
#' @export
AddVideoData.actor <- function(net, youtubeAuth = NULL, ..., writeToFile = FALSE, verbose = TRUE) {
UseMethod("AddVideoData.actor", net)
}
#' @noRd
#' @export
AddVideoData.actor.default <- function(net, youtubeAuth = NULL, ..., writeToFile = FALSE, verbose = TRUE) {
stop("Unknown social media type passed to AddVideoData.", call. = FALSE)
}
#' @title Add video information to youtube actor network dataframes
#'
#' @description YouTube actor network is supplemented with additional downloaded video information. Adds video id,
#' title, description and publish time as edge attributes. Nodes or actor references to video id's in the network are
#' substituted with the actor id (video channel id) retrieved from the video details.
#'
#' @param net A named list of dataframes \code{nodes} and \code{edges} generated by \code{Create}.
#' @param youtubeAuth YouTube Authenticate object.
#' @param videoIds List. Video id's for which to download video information.
#' @param actorSubOnly Logical. Only substitute video id's for their publishers channel id. Don't add additional video
#' data to edge list.
#' @param ... Additional parameters passed to function.
#' @param writeToFile Logical. Write data to file. Default is \code{FALSE}.
#' @param verbose Logical. Output additional information. Default is \code{TRUE}.
#'
#' @return Network as a named list of three dataframes containing \code{$nodes}, \code{$edges} and \code{$videos} nodes
#' and edges include columns for additional video data.
#'
#' @examples
#' \dontrun{
#' # replace video id references with actors and add video id, title, description and plublish time
#' # to an actor network
#' actorNetwork <- collectData |> Create("actor") |> AddVideoData(youtubeAuth)
#'
#' # only replace video id references with actors that published videos in network
#' actorNetwork <- collectData |> Create("actor") |> AddVideoData(youtubeAuth, actorSubOnly = TRUE)
#'
#' # network
#' # actorNetwork$nodes
#' # actorNetwork$edges
#'
#' # dataframe of downloaded video data
#' # actorNetwork$videos
#' }
#'
#' @aliases AddVideoData.actor.youtube
#' @name AddVideoData.actor.youtube
#' @export
AddVideoData.actor.youtube <-
function(net,
youtubeAuth = NULL,
videoIds = NULL,
actorSubOnly = FALSE,
...,
writeToFile = FALSE,
verbose = TRUE) {
# set opts for data collection
opts <- get_env_opts()
on.exit(set_collect_opts(opts), add = TRUE)
set_collect_opts()
if (is.null(videoIds)) {
# extract video ids from network nodes
rm_videoid_str <- function(col) sub("VIDEOID:", "", col)
videoIds <-
net$nodes |> dplyr::filter(.data$node_type == "video") |> dplyr::select(.data$id) |>
dplyr::mutate_at(.vars = "id", .funs = rm_videoid_str)
videoIds <- unlist(unname(as.list(videoIds)))
}
videoIds <- unique(videoIds)
df_video <- GetVideoData(youtubeAuth, videoIds, verbose = verbose)
net$videos <- df_video
if (nrow(df_video) == 0) {
msg("No video data could be retrieved.\n", .x = "warn")
return(net)
}
# downloaded video data
df_video <- df_video |> dplyr::mutate(id = paste0("VIDEOID:", .data$VideoID))
ch_details <-
df_video |> dplyr::select(.data$id, .data$ChannelTitle, .data$ChannelID) |>
dplyr::rename(
video_author_title = .data$ChannelTitle,
video_author_id = .data$ChannelID
)
# replace video id values in nodes with the video publishers id (channel id) and screen name
net$nodes <- net$nodes |> dplyr::left_join(ch_details, by = c("id")) |>
dplyr::mutate(
id = dplyr::if_else(
!is.na(.data$video_author_id),
.data$video_author_id,
.data$id
),
screen_name = dplyr::if_else(
!is.na(.data$video_author_id),
.data$video_author_title,
.data$screen_name
),
node_type = dplyr::if_else(!is.na(.data$video_author_id), "actor", .data$node_type),
video_author_id = NULL,
video_author_title = NULL
) |>
dplyr::distinct(.data$id, .keep_all = TRUE)
ch_details <- ch_details |> dplyr::select(-.data$video_author_title)
# replace from and to video id values in edges with the video publishers id (channel id)
net$edges <- net$edges |> dplyr::left_join(ch_details, by = c("from" = "id")) |>
dplyr::mutate(
from = dplyr::if_else(
!is.na(.data$video_author_id),
.data$video_author_id,
.data$from
),
video_author_id = NULL
) |>
dplyr::left_join(ch_details, by = c("to" = "id")) |>
dplyr::mutate(
to = dplyr::if_else(
!is.na(.data$video_author_id),
.data$video_author_id,
.data$to
),
video_author_id = NULL
)
# change node type from actor to publisher if they published a video in network
net$nodes <- net$nodes |> dplyr::left_join(
dplyr::filter(net$edges, .data$edge_type == "self-loop") |>
dplyr::select(.data$from, .data$edge_type) |> dplyr::distinct(.keep_all = TRUE),
by = c("id" = "from")
) |>
dplyr::mutate(
node_type = dplyr::if_else(!is.na(.data$edge_type), "publisher", .data$node_type),
edge_type = NULL
)
# add video title, description and publish time
if (actorSubOnly == FALSE) {
net$edges <- net$edges |> dplyr::left_join(dplyr::select(df_video, dplyr::starts_with("Video")),
by = c("video_id" = "VideoID")) |>
dplyr::rename(
video_title = .data$VideoTitle,
video_description = .data$VideoDescription,
video_published_at = .data$VideoPublishedAt
)
}
class(net) <- union(class(net), c("voson.video"))
if (writeToFile) write_output_file(net, "rds", "YoutubeActorNet_Vid", verbose = verbose)
net
}
# make a single api request for video data for supplied video id's
# when id's are supplied the api request for videos does not support paging
GetVideoData <- function(youtubeAuth, videoIds, verbose = TRUE) {
video_data <- list()
base_url_videos <- "https://www.googleapis.com/youtube/v3/videos"
api_opts_videos <- list(
part = "snippet",
id = paste0(videoIds, collapse = ","),
key = youtubeAuth$auth
)
base_url_videos <- "https://www.googleapis.com/youtube/v3/videos"
req <- httr2::request(base_url_videos) |>
httr2::req_user_agent(vsml_ua()) |>
httr2::req_url_query(!!!api_opts_videos)
resp <- req |>
httr2::req_error(is_error = \(resp) FALSE) |>
httr2::req_perform()
if (httr2::resp_is_error(resp)) {
msg(
paste0(
"\nStatus: ",
httr2::resp_status(resp),
"\nDetail: ",
httr2::resp_status_desc(resp),
"\n"
)
)
return(NULL)
} else {
resp_json <- resp |> httr2::resp_body_json()
video_data <- c(video_data, resp_json$items)
}
df_video <- lapply(video_data, function(x) {
tibble::tibble(
VideoID = x$id,
VideoTitle = x$snippet$title,
VideoDescription = x$snippet$description,
VideoPublishedAt = x$snippet$publishedAt,
ChannelID = x$snippet$channelId,
ChannelTitle = x$snippet$channelTitle
)
})
df_video <- dplyr::bind_rows(df_video)
df_video
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.