Menu
I found this R Function that can be used to make a Social Network of Reddit Users : https://www.rdocumentation.org/packages/RedditExtractoR/versions/2.1.5/topics/user_network
I tried out this function and I was able to plot the network:
# install the older version of the library
devtools::install_version("RedditExtractoR", version = "2.1.5", repos = "http://cran.us.r-project.org")
library(dplyr)
library(RedditExtractoR)
target_urls <- reddit_urls(search_terms="cats", subreddit="Art", cn_threshold=50)
target_df <- target_urls %>%
filter(num_comments==min(target_urls$num_comments)) %$%
URL %>% reddit_content # get the contents of a small thread
network_list <- target_df %>% user_network(include_author=FALSE, agg=TRUE) # extract the network
network_list$plot
Now, I am trying to figure out how this function ("reddit_content") works in the background.
The function "reddit_urls" returns a list of comments containing the term "cats" in the subrreddit "Art":
> head(target_urls)
date num_comments title subreddit URL
2 26-08-22 109 Cat, me, pencil, 2022 Art http://www.reddit.com/r/Art/comments/wydak5/cat_me_pencil_2022/
5 24-06-22 51 Cats, me, pen on paper plus digital, 2022 Art http://www.reddit.com/r/Art/comments/vjz27e/cats_me_pen_on_paper_plus_digital_2022/
6 27-07-22 177 Cat operator,me,acrylic,2022 Art http://www.reddit.com/r/Art/comments/w9983c/cat_operatormeacrylic2022/
7 25-07-22 166 Cat Study, Me, Digital Art, 2022 Art http://www.reddit.com/r/Art/comments/w81ih8/cat_study_me_digital_art_2022/
8 30-06-22 492 Cat, me, pastel pencils, 2022 Art http://www.reddit.com/r/Art/comments/voc43v/cat_me_pastel_pencils_2022/
9 08-08-22 83 Cat, me, pen and ink, 2022 Art http://www.reddit.com/r/Art/comments/wiuhqx/cat_me_pen_and_ink_2022/
From here, the "reddit_content" function seems to be able to figure out who is writing the comment and who the comment is being directed to:
test = target_urls[1,5] %>% reddit_content
head(test)
id structure post_date comm_date num_comments subreddit upvote_prop post_score author user comment_score controversiality comment title
1 1 1 26-08-22 26-08-22 109 Art 0.98 14101 ninadrawsalot Something_Average 146 0 He needs some head pats stat! Cat, me, pencil, 2022
2 2 1_1 26-08-22 27-08-22 109 Art 0.98 14101 ninadrawsalot littlebitsofspider 25 0 *Someone snuggle that cat immediately!* Cat, me, pencil, 2022
3 3 2 26-08-22 26-08-22 109 Art 0.98 14101 ninadrawsalot BrickGun 119 0 "What am I doing with my lives?" Cat, me, pencil, 2022
And finally, the "network_list" function is able to transform the above data set into a "graph network" format with edges/nodes (this is what is being visualized):
> network_list
$df
# A tibble: 3 x 4
sender receiver count comment
<chr> <chr> <dbl> <chr>
1 Amazing_SpiderLAN purr_in_ink 1 This so beautiful bud! Congrats
2 BeatlesTypeBeat macmynameismac 1 Zoom in and you'll see why.
3 purr_in_ink elhomerjas 1 Thank you :)
However, I am trying to figure out how the "reddit_content" function works. I tried using the "getAnywhere" command in R to look at the source code of the "reddit_content" function, but I still can't seem to understand how it works.
As an example:
API Request: https://api.pushshift.io/reddit/comment/search?limit=250&q=*&link_id=wydak5
Reddit Comment Link: https://www.reddit.com/r/Art/comments/wydak5/comment/ilwj4oq/
Below is an example:
"https://www.reddit.com/r/Art/comments/wydak5/comment/ilwj4oq/" %>% reddit_content # get the contents of a small thread
|==================================================================================================================================================================================================================| 100%
id structure post_date comm_date num_comments subreddit upvote_prop post_score author user comment_score controversiality comment title post_text
1 1 1 26-08-22 26-08-22 109 Art 0.98 14098 ninadrawsalot Something_Average 143 0 He needs some head pats stat! Cat, me, pencil, 2022
2 2 1_1 26-08-22 27-08-22 109 Art 0.98 14098 ninadrawsalot littlebitsofspider 25 0 *Someone snuggle that cat immediately!* Cat, me, pencil, 2022
link domain URL
1 https://i.redd.it/j8rx9llv13k91.jpg i.redd.it https://www.reddit.com/r/Art/comments/wydak5/comment/ilwj4oq/?ref=search_posts
2 https://i.redd.it/j8rx9llv13k91.jpg i.redd.it https://www.reddit.com/r/Art/comments/wydak5/comment/ilwj4oq/?ref=search_posts
But in the end - I still haven't understood the overall process. If I start with this comment here "https://www.reddit.com/r/Art/comments/wydak5/comment/ilwj4oq/" - how can I figure out who wrote this comment and who is the comment being directed at? If I have a list of many Reddit comments - how can I find out who is writing the comment and to whom the comment is being directed to, and thus create a network visualization?
Thank you!
479
asked Sep 11 '26 00:09
I am not sure if you want reddit_urls or reddit_content explained, I'll provide both.
If we type RedditExtractoR::reddit_urls we get the author's entire source code in the console. To decypher what a function does, we provide all parameters, the function needs.
target_urls <- reddit_urls(search_terms="cats", subreddit="Art", cn_threshold=50)
## provide all parameters the function needs, mixture of yours and defaults
search_terms = "cats"; regex_filter = ""; subreddit = "Art";
cn_threshold = 50; page_threshold = 1; sort_by = "relevance";
wait_time = 2
Then we run the function step by step and see what it does.
Basically the function runs queries in reddit's JSON database. It has three sections, 1. create query URL, 2. perform query, 3. summarize results to output. Please see for details the comments I've added before each line.
function (search_terms = NA, regex_filter = "", subreddit = NA,
cn_threshold = 0, page_threshold = 1, sort_by = "relevance",
wait_time = 2)
{
## check if input in parameter space
if (!grepl("^comments$|^new$|^relevance$", sort_by)) {
stop("sort_by must be either 'new', 'comments' or 'relevance'")
}
## create query URL ---------------------------------------------------------
## convert spaces to `+`
sterms = ifelse(is.na(search_terms), NA, gsub("\\s", "+",
search_terms))
## initialize empty data frame for output
cached_links = data.frame(date = as.Date(character()), num_comments = numeric(),
title = character(), subreddit = character(), URL = character())
## paste carriage return before subreddit (if specified)
subreddit = ifelse(is.na(subreddit), "", paste0("r/", gsub("\\s+",
"+", subreddit), "/"))
## paste `q=` before search terms, switch on `restrict_sr`
sterms = ifelse(is.na(sterms), "", paste0("q=", sterms, "&restrict_sr=on&"))
## create prefix
sterms_prefix = ifelse(sterms == "", "new", "search")
## paste everything together to query-URL
search_address = search_query = paste0("https://www.reddit.com/",
subreddit, sterms_prefix, ".json?", sterms, "sort=",
sort_by)
## perform query -------------------------------------------------------------
## set initial values
next_page = index = ""
page_counter = 0
comm_filter = 10000
## perform query loop
while (is.null(next_page) == FALSE & page_counter < page_threshold &
comm_filter >= cn_threshold & length(index) > 0) {
## perform query on page #
search_JSON = tryCatch(RJSONIO::fromJSON(readLines(search_query,
warn = FALSE)), error = function(e) NULL)
## check if search was unsuccessful
if (is.null(search_JSON)) {
cat(paste("Cannot connect to the website, skipping...\n"))
next
}
else {
## extract contents
contents = search_JSON[[2]]$children
## extract permalinks
search_permalink = paste0("http://www.reddit.com",
sapply(seq(contents), function(x) contents[[x]]$data$permalink))
## extract number of comments
search_num_comments = sapply(seq(contents), function(x) contents[[x]]$data$num_comments)
## extract title
search_title = sapply(seq(contents), function(x) contents[[x]]$data$title)
## extract score
search_score = sapply(seq(contents), function(x) contents[[x]]$data$score)
## extract subreddit
search_subreddit = sapply(seq(contents), function(x) contents[[x]]$data$subreddit)
## extract index
index = which(search_num_comments >= cn_threshold &
grepl(regex_filter, search_title, ignore.case = T,
perl = T))
## check if index available
if (length(index) > 0) {
## extract search dates
search_date = format(as.Date(as.POSIXct(unlist(lapply(seq(contents),
function(x) contents[[x]]$data$created_utc)),
origin = "1970-01-01")), "%d-%m-%y")
## create temp output
temp_dat = data.frame(date = search_date, num_comments = search_num_comments,
title = search_title, subreddit = search_subreddit,
URL = search_permalink, stringsAsFactors = FALSE)[index,
]
## rbind `cached_links` from above
cached_links = as.data.frame(rbind(cached_links,
temp_dat))
## extract next page's name
next_page = search_JSON$data$after
## extract relevant comment number
comm_filter = utils::tail(search_num_comments,
1)
## create URL for next query
search_query = paste0(search_address, "&after=",
next_page)
## increase counter by one
page_counter = page_counter + 1
}
## pause query for a moment
Sys.sleep(min(2, wait_time))
}
}
## summarize result ----------------------------------------------------------
## filter out dupes
final_table = cached_links[!duplicated(cached_links), ]
## check if results found
if (dim(final_table)[1] == 0) {
cat(paste("\nNo results retrieved, check your query"))
}
else {
## remove rows with no date
remove_row = which(final_table[, 1] == "")
if (length(remove_row) > 0) {
final_table = final_table[-remove_row, ]
}
## return result
return(final_table)
}
}
<bytecode: 0x55ffee70a6e0>
<environment: namespace:RedditExtractoR>
Paste parameters and code from above in a script and run it line by line (without function head) and you will be able to understand it well.
RedditExtractoR::reddit_content functionThis function loops over the URLs provided and also runs a JSON query, in your case just one.
URL=target_df$URL; wait_time=2 ## specify parameters
## run line by line
function (URL, wait_time = 2)
{
## roughly validate URL
if (is.null(URL) | length(URL) == 0 | !is.character(URL)) {
stop("invalid URL parameter")
}
## function definitions ------------------------------------------------------
GetAttribute = function(node, feature) {
Attribute = node$data[[feature]]
replies = node$data$replies
reply.nodes = if (is.list(replies))
replies$data$children
else NULL
return(list(Attribute, lapply(reply.nodes, function(x) {
GetAttribute(x, feature)
})))
}
get.structure = function(node, depth = 0) {
if (is.null(node)) {
return(list())
}
filter = is.null(node$data$author)
replies = node$data$replies
reply.nodes = if (is.list(replies))
replies$data$children
else NULL
return(list(paste0(filter, " ", depth), lapply(1:length(reply.nodes),
function(x) get.structure(reply.nodes[[x]], paste0(depth,
"_", x)))))
}
## initialize empty data frame for output ------------------------------------
data_extract = data.frame(id = numeric(), structure = character(),
post_date = as.Date(character()), comm_date = as.Date(character()),
num_comments = numeric(), subreddit = character(), upvote_prop = numeric(),
post_score = numeric(), author = character(), user = character(),
comment_score = numeric(), controversiality = numeric(),
comment = character(), title = character(), post_text = character(),
link = character(), domain = character(), URL = character())
## loop through URLs ---------------------------------------------------------
## start progressbar for console
pb = utils::txtProgressBar(min = 0, max = length(URL), style = 3)
## loop
for (i in seq(URL)) {
# i <- 1
## care for protocol specification in URL (DOESN'T CHANGE http TO https!)
if (!grepl("^https?://(.*)", URL[i]))
URL[i] = paste0("https://www.", gsub("^.*(reddit\\..*$)",
"\\1", URL[i]))
## paste `ref=search_posts` to URL if not specified
if (!grepl("\\?ref=search_posts$", URL[i]))
URL[i] = paste0(gsub("/$", "", URL[i]), "/?ref=search_posts")
## paste everything together
X = paste0(gsub("\\?ref=search_posts$", "", URL[i]),
".json?limit=500")
## run query
raw_data = tryCatch(RJSONIO::fromJSON(readLines(X, warn = FALSE)),
error = function(e) NULL)
## repeat query if unsuccessful
if (is.null(raw_data)) {
Sys.sleep(min(1, wait_time))
raw_data = tryCatch(RJSONIO::fromJSON(readLines(X,
warn = FALSE)), error = function(e) NULL)
}
## continue if successful
if (is.null(raw_data) == FALSE) {
## extract meta and main nodes
meta.node = raw_data[[1]]$data$children[[1]]$data
main.node = raw_data[[2]]$data$children
## if not empty, continue
if (min(length(meta.node), length(main.node)) > 0) {
## get structure of main node, using `get.structure` defined above
structure = unlist(lapply(1:length(main.node),
function(x) get.structure(main.node[[x]], x)))
## get temporary output df from query results/attributes by converting id,
## structure, post_date, comm_date, num_comments, subreddit, upvote_prop, post_score,
## author, user, comment_score, controversiality, comment, title, post_text,
## link, domain, URL into desired formats
TEMP = data.frame(id = NA, structure = gsub("FALSE ",
"", structure[!grepl("TRUE", structure)]),
## using `GetAttribute` from above
post_date = format(as.Date(as.POSIXct(meta.node$created_utc,
origin = "1970-01-01")), "%d-%m-%y"), comm_date = format(as.Date(as.POSIXct(unlist(lapply(main.node,
function(x) {
GetAttribute(x, "created_utc")
})), origin = "1970-01-01")), "%d-%m-%y"),
num_comments = meta.node$num_comments, subreddit = ifelse(is.null(meta.node$subreddit),
"UNKNOWN", meta.node$subreddit), upvote_prop = meta.node$upvote_ratio,
post_score = meta.node$score, author = meta.node$author,
user = unlist(lapply(main.node, function(x) {
GetAttribute(x, "author")
})), comment_score = unlist(lapply(main.node,
function(x) {
GetAttribute(x, "score")
})), controversiality = unlist(lapply(main.node,
function(x) {
GetAttribute(x, "controversiality")
})), comment = unlist(lapply(main.node, function(x) {
GetAttribute(x, "body")
})), title = meta.node$title, post_text = meta.node$selftext,
link = meta.node$url, domain = meta.node$domain,
URL = URL[i], stringsAsFactors = FALSE)
## fill ID column
TEMP$id = 1:nrow(TEMP)
## if result isn't empty, rbind to `data_extract` from above
if (dim(TEMP)[1] > 0 & dim(TEMP)[2] > 0)
data_extract = rbind(TEMP, data_extract)
## else print message to console
else print(paste("missed", i, ":", URL[i]))
}
}
## increment progres bar
utils::setTxtProgressBar(pb, i)
## pause query for a moment
Sys.sleep(min(2, wait_time))
}
## close progress bar
close(pb)
## return result
return(data_extract)
}
<bytecode: 0x55ffee946100>
<environment: namespace:RedditExtractoR>
|============================================================| 100%
## Result
head(data_extract)
# id structure post_date comm_date num_comments subreddit upvote_prop
# 1 1 1 24-06-22 24-06-22 51 Art 0.98
# 2 2 1_1 24-06-22 24-06-22 51 Art 0.98
# 3 3 1_1_1 24-06-22 25-06-22 51 Art 0.98
# 4 4 2 24-06-22 24-06-22 51 Art 0.98
# 5 5 3 24-06-22 25-06-22 51 Art 0.98
# 6 6 3_1 24-06-22 25-06-22 51 Art 0.98
# post_score author user comment_score controversiality
# 1 7008 purr_in_ink elhomerjas 49 0
# 2 7008 purr_in_ink purr_in_ink 17 0
# 3 7008 purr_in_ink Amazing_SpiderLAN 3 0
# 4 7008 purr_in_ink paprika_number_nine 26 0
# 5 7008 purr_in_ink macmynameismac 20 0
# 6 7008 purr_in_ink BeatlesTypeBeat 2 0
# comment
# 1 what an adorable stack of friendly felines in the work
# 2 Thank you :)
# 3 This so beautiful bud! Congrats
# 4 If you wouldn\031t mind I would love to get this tattooed. I have three black cats and a tiny little dog and this is just perfect.
# 5 For some reason the cats kinda remind me of the little soot balls from Spirited Away, I dig it
# 6 Zoom in and you'll see why.
# title post_text
# 1 Cats, me, pen on paper plus digital, 2022
# 2 Cats, me, pen on paper plus digital, 2022
# 3 Cats, me, pen on paper plus digital, 2022
# 4 Cats, me, pen on paper plus digital, 2022
# 5 Cats, me, pen on paper plus digital, 2022
# 6 Cats, me, pen on paper plus digital, 2022
# link domain
# 1 https://i.redd.it/d5gxvthc1n791.jpg i.redd.it
# 2 https://i.redd.it/d5gxvthc1n791.jpg i.redd.it
# 3 https://i.redd.it/d5gxvthc1n791.jpg i.redd.it
# 4 https://i.redd.it/d5gxvthc1n791.jpg i.redd.it
# 5 https://i.redd.it/d5gxvthc1n791.jpg i.redd.it
# 6 https://i.redd.it/d5gxvthc1n791.jpg i.redd.it
# URL
# 1 http://www.reddit.com/r/Art/comments/vjz27e/cats_me_pen_on_paper_plus_digital_2022/?ref=search_posts
# 2 http://www.reddit.com/r/Art/comments/vjz27e/cats_me_pen_on_paper_plus_digital_2022/?ref=search_posts
# 3 http://www.reddit.com/r/Art/comments/vjz27e/cats_me_pen_on_paper_plus_digital_2022/?ref=search_posts
# 4 http://www.reddit.com/r/Art/comments/vjz27e/cats_me_pen_on_paper_plus_digital_2022/?ref=search_posts
# 5 http://www.reddit.com/r/Art/comments/vjz27e/cats_me_pen_on_paper_plus_digital_2022/?ref=search_posts
# 6 http://www.reddit.com/r/Art/comments/vjz27e/cats_me_pen_on_paper_plus_digital_2022/?ref=search_posts
General: Sometimes, in functions un-exported helper functions are used which might yield an error Error: object '<object>' not found. In this case we may add the package with three colons <pkg>:::<object>, i.e. stats:::anova.glmlist (this can get quite nested!). If there are dots , ... we can temporary delete them (or figure something out how to provide the function with the information needed).
final_table
# date num_comments title
# 1 23-09-22 188 Cat, Me, Pastels on Paper, 2022
# 3 26-08-22 109 Cat, me, pencil, 2022
# 6 24-06-22 51 Cats, me, pen on paper plus digital, 2022
# 7 27-07-22 177 Cat operator,me,acrylic,2022
# 8 25-07-22 166 Cat Study, Me, Digital Art, 2022
# 9 30-06-22 492 Cat, me, pastel pencils, 2022
# 10 08-08-22 83 Cat, me, pen and ink, 2022
# 24 03-07-22 91 The cat and the lady, me, digital, 2022
# subreddit
# 1 Art
# 3 Art
# 6 Art
# 7 Art
# 8 Art
# 9 Art
# 10 Art
# 24 Art
# URL
# 1 http://www.reddit.com/r/Art/comments/xlqf2t/cat_me_pastels_on_paper_2022/
# 3 http://www.reddit.com/r/Art/comments/wydak5/cat_me_pencil_2022/
# 6 http://www.reddit.com/r/Art/comments/vjz27e/cats_me_pen_on_paper_plus_digital_2022/
# 7 http://www.reddit.com/r/Art/comments/w9983c/cat_operatormeacrylic2022/
# 8 http://www.reddit.com/r/Art/comments/w81ih8/cat_study_me_digital_art_2022/
# 9 http://www.reddit.com/r/Art/comments/voc43v/cat_me_pastel_pencils_2022/
# 10 http://www.reddit.com/r/Art/comments/wiuhqx/cat_me_pen_and_ink_2022/
# 24 http://www.reddit.com/r/Art/comments/vq8mv9/the_cat_and_the_lady_me_digital_2022/
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With
