R/getPlayerSessions.R

#' Extract player sessions from server sessions
#' 
#' Uses the server sessions pulled by \link[wurstmineR]{getSessions} and creates a \code{data.frame} of 
#' player sessions, including the time played per person/session.
#' @keywords sessions
#' @param sessions A session object as returned by \link[wurstmineR]{getSessions}
#' @param splitByDay Should the player sessions be split by day, as to avoid overlapping sessions?
#' Helpful for visualizations of the played time for any given day. Defaults to \code{TRUE}.
#' @return \code{data.frame} with server- and lists of player sessions
#' @export
#' @note If sessions are split by day, additional columns for date, 
#' day of week and month are appended.
#' @examples
#' \dontrun{
#' sessions       <- getSessions("http://api.wurstmineberg.de/server/sessions/overview.json")
#' playerSessions <- getPlayerSessions(sessions, splitByDay = FALSE)
#' }
getPlayerSessions <- function(sessions = NULL, splitByDay = TRUE){
  if (is.null(sessions)){
    stop("No sessions given, what am I supposed to do now?")
  }
  list.months <- months(seq(from = as.Date("14-01-01", "%F"), to = as.Date("14-12-01", "%F"), by = "month"))
  list.wdays  <- as.character(lubridate::wday(c(2:7, 1), T, F))
  
  # Now we can use the sessions set as a dataframe of player sessions
  playerSessions <- plyr::ldply(sessions$uptimes.sessions, as.data.frame)
  playerSessions <- plyr::arrange(playerSessions, joinTime, leaveTime)
  
  # Now we reformat shit because time is a fucking mess
  playerSessions$joinTime  <- as.POSIXct(playerSessions$joinTime, tz="UTC")
  playerSessions$leaveTime <- as.POSIXct(playerSessions$leaveTime, tz="UTC")
  
  # Fixing remains of the last fix (overlapping sessions get sequentialized)
  for(i in 1:(nrow(playerSessions)-1)){
    if(playerSessions$minecraftNick[i] == playerSessions$minecraftNick[i+1]){
      if(playerSessions$leaveTime[i] > playerSessions$joinTime[i+1]){
        playerSessions$leaveTime[i] <- playerSessions$joinTime[i+1]
      }
    }
  }
  
  # Add duration column
  playerSessions$playedMinutes <- as.numeric(difftime(playerSessions$leaveTime, 
                                                      playerSessions$joinTime, units = "mins"))
  if (!splitByDay){
    return(playerSessions)
  } else if (splitByDay){
    playerSessions$joinDate     <- format(playerSessions$joinTime, "%F")
    playerSessions$joinDate     <- as.POSIXct(playerSessions$joinDate, origin="1970-01-01", tz="UTC")
    playerSessions$leaveDate    <- format(playerSessions$leaveTime, "%F")
    playerSessions$leaveDate    <- as.POSIXct(playerSessions$leaveDate, origin="1970-01-01", tz="UTC")
    
    overlaps    <- playerSessions[playerSessions$leaveDate > playerSessions$joinDate, ]
    noOverlaps  <- playerSessions[playerSessions$leaveDate == playerSessions$joinDate, ]
    overlapsNum <- nrow(overlaps)
    
    for(i in 1:overlapsNum){
      temp1 <- overlaps[1,]
      temp1[1, ] <- overlaps[i, ]
      temp1[2, ] <- overlaps[i, ]
      
      temp1$leaveTime[1] <- overlaps$leaveDate[i]
      temp1$joinTime[2]  <- overlaps$leaveDate[i]
      
      noOverlaps <- rbind(noOverlaps, temp1)
      rm(temp1)
    }
    
    playerSessions      <- plyr::arrange(noOverlaps, joinTime, person)
    playerSessions$date <- format(playerSessions$joinTime, "%F")
    playerSessions$date <- as.POSIXct(playerSessions$date, origin="1970-01-01", tz="UTC")
    playerSessions      <- dplyr::select(playerSessions, -joinDate, -leaveDate)
    
    # Update duration column
    playerSessions$playedMinutes <- as.numeric(difftime(playerSessions$leaveTime, 
                                                        playerSessions$joinTime, units = "mins"))
    
    playerSessions$wday <- factor(weekdays(playerSessions$date), 
                                  levels = list.wdays, ordered = T)
    playerSessions$month <- factor(months(playerSessions$date), 
                                   levels = list.months, ordered = T)
    return(playerSessions)
  } else {
    stop("splitByDay must be either TRUE or FALSE")
  }
}
jemus42/wurstmineR documentation built on May 19, 2019, 4:03 a.m.