Simplify response parsing

R/entities_objects.R

@@ -0,0 +1,114 @@
+# Contains functions to parse the objects described here: 
+# https://developer.twitter.com/en/docs/twitter-api/v1/data-dictionary/object-model/entities
+
+# <https://developer.twitter.com/en/docs/twitter-api/v1/data-dictionary/object-model/entities#hashtags>
+hashtags <- function(x) {
+  if (NROW(x) == 0) {
+    data.frame(text = NA, indices = I(list(NA)), 
+                      stringsAsFactors = FALSE)
+  } else {
+    i <- indices_vec(x$indices)
+    data.frame(text = x$text, indices = I(i))
+  }
+}
+
+# PowerTrack $ text
+# has:symbol
+# They are the same
+# <https://developer.twitter.com/en/docs/twitter-api/v1/data-dictionary/object-model/entities#symbols>
+# parse_entities2 uses the name of the columns to match the appropriate function to parse it. 
+# It needs a symbols function that is the same as hashtags
+symbols <- hashtags
+
+indices_vec <- function(x) {
+  lapply(x, function(y){
+    matrix(y, ncol = 2, dimnames = list(NULL, c("start", "end")))})
+}
+
+# The extended entities is really for media
+# <https://developer.twitter.com/en/docs/twitter-api/v1/data-dictionary/object-model/extended-entities>
+media <- function(x) {
+  df <- data.frame(id = NA, id_str = NA, indices = I(list(NA)), 
+                   media_url = NA, media_url_https = NA, 
+                   url = NA, display_url = NA, expanded_url = NA, 
+                   type = NA, sizes = I(list(NA)), ext_alt_text = NA,
+                   stringsAsFactors = FALSE)
+  if (NROW(x) == 0) {
+    return(df)
+  }
+  indices <- as.data.frame(t(simplify2array(x$indices)))
+  colnames(indices) <- c("start", "end")
+  x$indices <- I(list(indices))
+  sizes <- rbind(x$sizes$large, x$sizes$small, x$sizes$thumb, x$sizes$medium)
+  sizes$type <- c("large", "small", "thumb", "medium")
+  x$sizes <- list(sizes)
+  x[setdiff(colnames(df), colnames(x))] <- rep(NA, nrow(x))
+  x
+}
+
+urls <- function(x) {
+  df <- data.frame(url = NA, expanded_url = NA, display_url = NA, 
+                   indices = I(list(NA)), unwound = I(list(NA)), 
+                   stringsAsFactors = FALSE)
+  if (NROW(x) == 0) {
+    return(df)
+  }
+  indices <- as.data.frame(t(simplify2array(x$indices)))
+  colnames(indices) <- c("start", "end")
+  x$indices <- I(indices)
+  x[setdiff(colnames(df), colnames(x))] <- rep(NA, nrow(x))
+  x
+}
+
+# PowerTrack @ screen_name
+# has:mentions
+# <https://developer.twitter.com/en/docs/twitter-api/v1/data-dictionary/object-model/entities#mentions>
+user_mentions <- function(x) {
+  df <- data.frame(screen_name = NA, name = NA, id = NA, id_str = NA,
+                   indices = I(list(NA)), stringsAsFactors = FALSE)
+  if (NROW(x) == 0) {
+    return(df)
+  }
+  indices <- as.data.frame(t(simplify2array(x$indices)))
+  colnames(indices) <- c("start", "end")
+  x$indices <- indices
+  x[setdiff(colnames(df), colnames(x))] <- rep(NA, nrow(x))
+  rownames(x) <- NULL
+  x
+}
+
+# <https://developer.twitter.com/en/docs/twitter-api/v1/data-dictionary/object-model/entities#polls>
+# Not testable without fullarchive access
+polls <- function(x) {
+  df <- data.frame(options= I(list(NA)), end_datetime = NA, 
+                   duration_minutes = NA, stringsAsFactors = FALSE)
+  if (NROW(x) == 0) {
+    return(df)
+  } 
+  x[setdiff(colnames(df), colnames(x))] <- rep(NA, nrow(x))
+  x
+}
+
+
+parse_entities <- function(x) {
+
+  if (is.null(x)) {
+    return(list(description = urls(NULL), url = urls(NULL)))
+  }
+
+  if (is.null(x$description$urls)) {
+    description <- list(description = urls(x$description$urls))
+  } else {
+    description <- lapply(x$description$urls, urls)
+
+  }
+
+  if (is.null(x$url$urls)) {
+    url <- list(url = urls(x$url$urls))
+  } else {
+    url <- lapply(x$url$urls, urls)
+  }
+  l <- Map(list, description, url)
+  lapply(l, `names<-`, value = c("description", "url"))
+}
+

R/favorites.R

@@ -45,9 +45,10 @@ get_favorites <- function(user,
 }
 
 get_favorites_user <- function(user, ..., parse = TRUE, token = NULL) {
+  stopifnot(length(user) == 1)
   params <- list(
-    tweet_mode = "extended",
-    include_ext_alt_text = "true"
+    # Undocumented parameter https://github.com/ropensci/rtweet/issues/575#issuecomment-829605892
+    tweet_mode = "extended"
   )
   params[[user_type(user)]] <- user
 

R/geo_objects.R

@@ -0,0 +1,56 @@
+# Contains functions to parse the objects described here: 
+# https://developer.twitter.com/en/docs/twitter-api/v1/data-dictionary/object-model/geo
+
+bounding_box <- function(x) {
+  empty <- data.frame(long = NA, lat = NA, type = NA)
+  if (is.null(x) || (identical(x, NA))) {
+    return(empty)
+  }
+  if (is.data.frame(x)) {
+    coord <- x$coordinates[[1]][1, , ]
+    if (is.null(coord)) {
+      return(empty)
+    }
+    return(data.frame(long = coord[, 1], lat = coord[, 2], type = x$type))
+  }
+  m <- x$coordinates[1, , ]
+  colnames(m) <- c("long", "lat")
+  df <- as.data.frame(m)
+  df$type <- x$type
+  df
+}
+
+# <https://developer.twitter.com/en/docs/twitter-api/v1/data-dictionary/object-model/geo#coordinates>
+coordinates <- function(x) {
+  if (is.null(x) || length(x) == 1 && is.na(x)) {
+    return(data.frame(long = NA, lat = NA, type = NA))
+  }
+  if (has_name_children(x, "coordinates", "coordinates")) {
+    return(data.frame(long = x$coordinates[[1]], lat = x$coordinates[[2]], type = x$type))
+  }
+  data.frame(long = x$coordinates[[1]], lat = x$coordinates[[2]], type = x$type)
+}
+
+# <https://developer.twitter.com/en/docs/twitter-api/v1/data-dictionary/object-model/geo#place>
+place <- function(x) {
+  if (is.null(x) || length(x) == 1 && is.na(x)) {
+    df <- data.frame(geo = I(list(coordinates(NA))), coordinates = I(list(coordinates(NA))),
+                             place = I(list(NA)))
+    return(df)
+  }
+
+  if (is.data.frame(x)) {
+    l <- simplify2array(x[!colnames(x) %in% c("geo", "coordinates", "bounding_box")])
+  } else if (is.list(x)) {
+    l <- simplify2array(x[!names(x) %in% c("geo", "coordinates", "bounding_box")])
+    if (nrow(l) != 1) {
+      l <- t(l)
+    }
+  }
+  place <- as.data.frame(l)
+  place$bounding_box <- list(bounding_box(x$bounding_box))
+
+  data.frame(geo = I(coordinates(x$geo)),
+            coordinates = I(coordinates(x$coordinates)),
+            place = I(place))
+}