setRefClass('userList',
contains='twitterObjList'
)
setValidity('userList', function(object) {
listClassValidity(object, 'user')
})
setRefClass("user",
contains='twitterObj',
fields = list(
description="character",
statusesCount="numeric",
followersCount="numeric",
favoritesCount="numeric",
friendsCount="numeric",
url="character",
name="character",
created="POSIXct",
protected="logical",
verified="logical",
screenName="character",
location="character",
lang="character",
id="character",
lastStatus="status",
listedCount="numeric",
followRequestSent="logical",
profileImageUrl="character"
),
methods = list(
initialize = function(json, ...) {
if (!missing(json)) {
if (!is.null(json[['status']]))
lastStatus <<- buildStatus(json[['status']])
if (is.character(json[['description']]))
description <<- json[['description']]
if (!is.null(json[['statuses_count']]))
statusesCount <<- as.numeric(json[['statuses_count']])
if (!is.null(json[['followers_count']]))
followersCount <<- as.numeric(json[['followers_count']])
if (!is.null(json[['friends_count']]))
friendsCount <<- as.numeric(json[['friends_count']])
## NOTE: Twitter uses the british spelling for historical reasons
favorites_count = get_json_value(json, c("favourites_count", "favorites_count"))
if (!is.null(favorites_count)) {
favoritesCount <<- as.numeric(favorites_count)
}
if ((!is.null(json[['url']]))&&(!is.na(json[['url']])))
url <<- json[['url']]
if (is.character(json[['name']]))
name <<- json[['name']]
created_at = get_json_value(json, c("created_at", "created"))
if (is.null(created_at)) {
created <<- Sys.time()
} else {
created <<- twitterDateToPOSIX(created_at)
}
if ((is.null(json[['protected']])) ||
(json[['protected']] == FALSE))
protected <<- FALSE
else
protected <<- TRUE
if ((is.null(json[['verified']])) ||
(json[['verified']] == FALSE))
verified <<- FALSE
else
verified <<- TRUE
if (is.character(json[['screen_name']]))
screenName <<- json[['screen_name']]
# Note: id_str must be checked first!
id_field = get_json_value(json, c("id_str", "id"))
if (!is.null(id_field)) {
id <<- as.character(id_field)
}
if (!is.null(json[['location']])) {
location <<- json[['location']]
}
if (!is.null(json[['lang']])) {
lang <<- json[['lang']]
}
if (!is.null(json[["listed_count"]])) {
listedCount <<- json[["listed_count"]]
}
if ((is.null(json[["followRequestSent"]])) ||
(json[["followRequestSent"]] == FALSE)) {
followRequestSent <<- FALSE
} else {
followRequestSent <<- TRUE
}
if (!is.null(json[["profile_image_url"]])) {
profileImageUrl <<- json[["profile_image_url"]]
}
}
callSuper(...)
},
getFollowerIDs = function(n=NULL, ...) {
return(unlist(followers(.self$id, n, ...)))
},
getFollowers = function(n=NULL, ...) {
fol <- .self$getFollowerIDs(n, ...)
lookupUsers(fol, ...)
},
getFriendIDs = function(n=NULL, ...) {
return(unlist(friends(.self$id, n, ...)))
},
getFriends = function(n=NULL, ...) {
fri <- .self$getFriendIDs(n, ...)
lookupUsers(fri, ...)
},
getFavouritesCount = function() {
return(favoritesCount)
},
getFavorites = function(n=20, max_id=NULL, since_id=NULL, ...) {
return(favorites(screenName, n=n, max_id=max_id, since_id=since_id, ...))
},
toDataFrame = function(row.names=NULL, optional=FALSE, stringsAsFactors=FALSE) {
callSuper(row.names=row.names, optional=optional, stringsAsFactors=stringsAsFactors,
fieldsToRemove='lastStatus')
}
)
)
userFactory <- getRefClass("user")
userFactory$accessors(names(userFactory$fields()))
buildUser <- function(json) {
if (is.null(json)) {
NULL
} else {
userFactory$new(json)
}
}
setMethod("show", signature="user", function(object) {
print(screenName(object))
})
getUser <- function(user, ...) {
params <- parseUsers(user)
buildUser(twInterfaceObj$doAPICall(paste('users', 'show', sep='/'),
params=params, ...))
}
lookupUsers <- function(users, includeNA=FALSE, ...) {
MatchLookedUpUsers <- function(vals) {
order <- match(tolower(users), tolower(vals))
na.eles <- which(is.na(order))
if (length(na.eles) > 0) {
if (!includeNA) {
order <- order[-na.eles]
users <- users[-na.eles]
}
}
out <- out[order]
names(out) <- users
return(out)
}
if (is.null(users) || length(users) == 0) {
return(list())
}
batches <- split(users, ceiling(seq_along(users) / 100))
results <- lapply(batches, function(batch) {
params <- parseUsers(batch)
twInterfaceObj$doAPICall(paste('users', 'lookup', sep='/'),
params=params, ...)
})
out <- sapply(do.call(c, results), buildUser)
## Order these to match the users vector - if !includeNA,
## drop out the elements of the return list which weren't
## found
sn.lookups <- MatchLookedUpUsers(sapply(out,
function(x) x$getScreenName()))
id.lookups <- MatchLookedUpUsers(sapply(out, function(x) x$getId()))
## The problem with doing it in the two batch way above is that
## anything that was SN will be NULL for ID and vice versa.
## If includeNA is TRUE, we can't just remove all empty
## entries. As a hack, only retain the NULL values that are shared
## between both lists
if (includeNA) {
sn.nulls <- sapply(sn.lookups, is.null)
id.nulls <- sapply(id.lookups, is.null)
false.nulls <- xor(sn.nulls, id.nulls)
sn.lookups <- sn.lookups[!(sn.nulls & false.nulls)]
id.lookups <- id.lookups[!(id.nulls & false.nulls)]
} else {
## Otherwise, just strip out the names that have been
## taken out
users <- intersect(users, union(names(sn.lookups), names(id.lookups)))
}
out <- c(sn.lookups, id.lookups)
return(out[users])
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.