R/getActivePeople.R

In jemus42/wurstmineR: Work with a vanilla Minecraft server API

#' Get active server members dataframe
#' @name getActivePeople
#' @description Get a dataframe of active server members based on a \href{http://wiki.wurstmineberg.de/People_file}{people.json}.
#' @keywords strings, people
#' @param url The source of the people.json file. Defaults to using the option \code{url.strings.people}, 
#' if that is \code{NULL}, the Wurstmineberg people file will be used.
#' @param size Size of people dataset to return. \code{active} (default) 
#' for currently whitelisted members only, \code{full} for all members, including former members.
#' @return A \code{data.frame} containing most fields from a people.json and some other things
#' @export
#' @examples
#' options(url.strings.people = "http://wurstmineberg.de/assets/serverstatus/people.json")
#' activePeople <- getActivePeople()
getActivePeople <- function(url = getOption("url.strings.people"), size = "active"){
  if (is.null(url)){
    url <- "http://wurstmineberg.de/assets/serverstatus/people.json"
  }
  ## Get people.json for player id and join dates
  people <- jsonlite::fromJSON(url)
  people <- people$people
  # Add category to people$status for easier matching, give numIDs excluding Dinnerbone
  people$status[is.na(people$status)] <- "later"
  # The no-DB-clause (sorry DB)
  people <- people[people$id != "dinnerbone", ]
  # Get a num ID
  people$numID <- 1:nrow(people)
  
  ## Handle favColours
  people$color[!is.na(people$favColor[1])] <- rgb(people$favColor[!is.na(people$favColor[1]), 
                                                                  c("red", "green", "blue")], 
                                                  maxColorValue=255)
  
  ## Start to construct activePeople, which is like people.json, but useful ##
  activePeople           <- data.frame(numID = people$numID)
  activePeople$id        <- people$id
  activePeople$mc        <- people$minecraft
  activePeople$name      <- people$name
  activePeople$UUID      <- people$minecraftUUID
  activePeople$color     <- people$color
  activePeople$invitedBy <- people$invitedBy
  activePeople$joinDate  <- people$join_date
  
  # If people name not set, use ID instead
  activePeople$name[is.na(activePeople$name)] <- activePeople$id[is.na(activePeople$name)]
  activePeople$name.ord <- factor(activePeople$name, levels = activePeople$name, ordered = TRUE)
  
  # In case of missing join date, apply NA / For invited but not yet joined players
  activePeople$joinDate[people$joinDate == 0] <- NA
  # Convert joinDate to POSIXct UTC because time
  activePeople$joinDate <- as.POSIXct(activePeople$joinDate, origin="1970-01-01", tz="UTC")
  
  # player specific server age (days since their whitelisting)
  activePeople$serverAge <- round(as.numeric(difftime(Sys.time(),
                                                      activePeople$joinDate, 
                                                      units ="days")))
  
  # player specific server birth (days they've been whitelisted after server creation)
  activePeople$serverBirth <- round(as.numeric(difftime(activePeople$joinDate,
                                                        activePeople$joinDate[1], 
                                                        units ="days")))
  
  activePeople$joinStatus <- factor(people$status, 
                                    levels = c("founding", "later", "postfreeze", "invited", "former"), 
                                    ordered = TRUE)
  
  activePeople$inviteGap <- c(0, round(as.numeric(difftime(
    activePeople$joinDate[2:nrow(activePeople)], 
    activePeople$joinDate[1:(nrow(activePeople)-1)], 
    units="days"))))
  
  # Use id as rownames for easier indexing, e.g. activePeople["jemus42", "joinDate"]
  rownames(activePeople) <- activePeople$id
  
  if (size == "active"){
    return(activePeople[!(activePeople$joinStatus %in% c("former", "invited")), ])
  } else if (size == "full"){
    return(activePeople)
  }
}