#' Retrieve a user (lover)
#'
#' Retrieve a lover (user) or set of lovers from the COLOURlovers API.
#'
#' Retrieve details about a COLOURlovers user or users.
#'
#' Specifying named arguments to \code{...} allows the user to request a
#' specific response, as follows:
#'
#' \itemize{
#' \item \code{orderCol}: A character string containing a sort criterion. One of
#' \dQuote{dateCreated}, \dQuote{score}, \dQuote{name}, \dQuote{numVotes},
#' \dQuote{numViews}.
#' \item \code{sortBy}: A character string containing either \dQuote{ASC} (for
#' ascending by the \code{orderCol} criterion, the default) or \dQuote{DSC}
#' (for descending).
#' \item \code{numResults}: A numeric value indicating the number of results to
#' return, with a maximum of 100. Default is 20.
#' \item \code{resultOffset}: A numeric value indicating the page of results to
#' return, with page size specified in the \code{numResults} argument.
#' }
#'
#' @param set Optionally, a subset of COLOURlovers palettes. Allowed values are
#' \dQuote{new} and \dQuote{top}.
#' @param ... A named list of parameters passed to the API request. Allowed
#' parameters are \code{orderCol}, \code{sortBy}, \code{numResults}, and
#' \code{resultOffset}. Specifying \code{orderCol} overrules any argument to
#' \code{set}. See details.
#' @param fmt A format for the API response, one of \dQuote{xml} (the default)
#' or \dQuote{json}. This has essentially no effect on function behavior.
#'
#' @return A list of class \dQuote{cllover}, including details about one or
#' more users. This should be the same regardless of the value of \code{fmt}.
#'
#' @export
#'
#' @aliases cllover cllovers print.cllover print.cllovers
#'
#' @author Thomas J. Leeper
#' @references \url{http://www.colourlovers.com/api/#lovers}
#'
#' @examples \dontrun{
#' # Retrieve top users
#' cllovers(set = 'top', fmt = 'json')
#'
#' # Retrieve a single user
#' cllover('COLOURlovers', fmt = 'json')
#' }
cllovers <- function(set = NULL, ..., fmt = 'xml') {
# request multiple lovers
if (!is.null(set)) {
set <- match.arg(set, c('new', 'top'))
}
query <- list(...)
query <- query[!sapply(query, is.null)]
allowed <- c('orderCol', 'sortBy', 'numResults', 'resultOffset')
query[which(!names(query) %in% allowed)] <- NULL
n <- names(query)
if ('orderCol' %in% n) {
ord <- c('dateCreated', 'score', 'name', 'numVotes', 'numViews')
if (!query$orderCol %in% ord) {
query$orderCol <- NULL
warning("orderCol not recognized")
}
}
if ('sortBy' %in% n) {
if (!query$sortBy %in% c('ASC', 'DSC')) {
query$sortBy <- NULL
warning("sortBy not recognized")
}
}
if ('numResults' %in% n) {
if (query$numResults > 100 | query$numResults < 1)
query$numResults <- 20
}
if ('resultOffset' %in% n) {
if (query$resultOffset < 1)
query$resultOffset <- 1
}
out <- clquery('lovers', set, query = query, fmt = fmt)
names(out) <- rep('lover', length(out))
class(out) <- c('cllovers', class(out))
for (i in 1:length(out)) {
class(out[[i]]) <- c('cllover', class(out))
}
return(out)
}
#' @rdname cllovers
#' @param user The COLOURlovers username for a specific user.
#' @param comments A boolean indicating whether to include the last ten
#' comments for the user. Default is \code{FALSE}.
#' @export
cllover <- function(user, comments = FALSE, fmt = 'xml') {
# request a single lover/user
out <- list(lover = clquery('lover', user,
query = list(comments = as.numeric(comments)),
fmt = fmt)[[1]])[[1]]
class(out) <- c('cllover', class(out))
return(out)
}
#' @export
print.cllover <- function(x, ...) {
cat('Lover username: ', x$userName[[1]], '\n')
cat('Registered: ', x$dateRegistered, '\n')
cat('Last active: ', x$dateLastActive, '\n')
cat('Rating: ', x$rating, '\n')
cat('Location: ', x$location[[1]], '\n')
cat('Colors: ', x$numColors, '\n')
cat('Palettes: ', x$numPalettes, '\n')
cat('Patterns: ', x$numPatterns, '\n')
cat('Comments made: ', x$numCommentsMade, '\n')
cat('Lovers: ', x$numLovers, '\n')
cat('Comments on profile:', x$numCommentsOnProfile, '\n')
cat('URL: ', x$url[[1]], '\n')
cat('API URL: ', x$apiUrl[[1]], '\n')
cat('\n')
invisible(x)
}
#' @export
print.cllovers <- function(x, ...) sapply(x, print)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.