R/stackedBarData.R

In bilintoh/timeComponents: Methods to analyze components of a category during a time series

#' Create the data required to create the stacked bars for a time series.
#'
#' @param cattrajectory A data frame containing the X,Y, and binary values for pixels in each input map.
#' @param timePoints A vector containing the time points for the time series in chronological order.
#' @param pixelSize A vector containing the pixel size for the raster files. The default is 1000 X 1000 meters.
#'

#'
#' @return
#' "NonetData"= Components of gains and losses
#' "NetData" = Components of net gain s and net losses
#' "GrossGain" = Size of gross gain
#' "GrossLoss" = Size of gross loss
#'
#' @export

#'
#' @examples
#' time_points <- c(2000,2001,2002,2003)
#' data gets results from the catTrajectory function
#' stackedBarData(cattrajectory = data,timePoints = time_points,pixelSize = c(1000,1000)))
#'
stackedBarData <- function(cattrajectory,timePoints,pixelSize = c(1000,1000)) {

  dfXYZBoolean <- as.data.frame(cattrajectory$dfXYZBoolean)

  numColumns <- length(dfXYZBoolean)

  dfXYZBoolean2 <- dfXYZBoolean[, 3:numColumns]

  numbTimePoints <- length(dfXYZBoolean2)

  pairTimepoints <- data.frame(cbind(timePoints[-length(timePoints)], timePoints[-1]))
  fromToTimepoints <- paste(pairTimepoints$X1, "to", pairTimepoints$X2)

  sizeTimeInterval<- pairTimepoints[-1] - pairTimepoints[-ncol(pairTimepoints)]


  temporalExtent <- timePoints[[numbTimePoints]]-timePoints[[1]]

  lastInterval <- paste(head(timePoints,n=1), "TO", tail(timePoints,n=1))

  numbTimeIntervals <- numbTimePoints - 1

  dfXYZBoolean3<- dfXYZBoolean2[rowSums(dfXYZBoolean2[]) > 0,] # absence

  dfXYZBoolean4<- dfXYZBoolean3[rowSums(dfXYZBoolean3[]) < numbTimePoints,] # persistence

  trajectory <- dfXYZBoolean4[-1] - dfXYZBoolean4[ - ncol(dfXYZBoolean4)] # 1= gains, -1=losses

  trajectoryGains <- as.data.frame(colSums(trajectory == 1)) # sum gain for each tim e inetrval

  trajectoryLoss <- as.data.frame(colSums(trajectory == - 1) * -1)# sum loss for each tim e inetrval

  trajectoryGainLoss <- cbind(sizeTimeInterval,trajectoryGains,trajectoryLoss)

  names(trajectoryGainLoss) <- c("interval","gain","loss")

  trajectoryGainLossNet <- trajectoryGainLoss %>% mutate(net = .$gain + .$loss)


  sqkilometer <- pixelSize[1] * pixelSize[2]/1000^2

  trajectoryGainLossNet2 <- (
    trajectoryGainLossNet[-1]/
      (trajectoryGainLossNet$interval)) * sqkilometer


  trajectoryGainLossNet2 <- cbind(
    sizeTimeInterval,trajectoryGainLossNet2,fromToTimepoints)


  maxGain <- max(trajectoryGainLossNet2$gain)

  maxLoss <- max(abs(trajectoryGainLossNet2$loss))

  # Create label for stacked bar's vertical axis
  labVerticalAxis <- ifelse(
    maxGain >= 1000 |
      maxLoss >= 1000,
    "Change (thousand sqaure Kilometers per year)",
    "Change (sqaure Kilometers per year)")

  if(labVerticalAxis == "Change (sqaure Kilometers per year)"){
    dfStackedBar <- trajectoryGainLossNet2

  }else{
    dfStackedBar <- trajectoryGainLossNet2[,2:4]/ (1000)

    dfStackedBar <- cbind(sizeTimeInterval,dfStackedBar,fromToTimepoints)

  }


  dfStackedBar2 <- dfStackedBar


  dfStackedBar2$net <- NULL

  trajdfStackedBar <- melt(dfStackedBar2,id = c("X2","fromToTimepoints"))

  dfStackedBar3 <- dfStackedBar

  dfStackedBar4 <- subset(dfStackedBar3,select =  -c(gain,loss))

  net_loss <-  dfStackedBar4 %>% subset(.$net < 0)

  colnames(net_loss)[2] <- "net loss"

  net_gain <- dfStackedBar4 %>% subset(.$net > 0)

  colnames(net_gain)[2] <- "net gain"

  dfCombinedNet <- merge(net_gain,net_loss, all = TRUE)

  dfCombinedNet[is.na(dfCombinedNet)] <- 0

  dfCombinedNet2 <- melt(dfCombinedNet,id = c("X2","fromToTimepoints"))

  grossGain <- sum(dfStackedBar$gain)/(numbTimePoints - 1) # compute gross gain

  grossLoss <- sum(dfStackedBar$loss)/(numbTimePoints - 1) # compute gross loss

  grossPosition <- levels(trajdfStackedBar$fromToTimepoints)

  grossPosition <- grossPosition[1]


  return(list("NonetData" = trajdfStackedBar,
              "NetData" = dfCombinedNet2,
              "GrossGain" = grossGain,
              "GrossLoss" = grossLoss,
              "lastTimeInterval" = lastInterval,
              "numbTimeIntervals" = numbTimeIntervals,
              "yaxisLable" = labVerticalAxis


  ))


}