R/catTrajectory.R

Defines functions catTrajectory

Documented in catTrajectory

#' Creates a list of data frames. The first item in the list is the data frame
#' containing the trajectories for creating the map of change.The second
#' data frame contains the data for creating the stacked bars.
#'
#' @param dfRaster A data frame from a stack or brick of at least 2 raster files.
#' @param noDataa A number representing no data. The default  0.
#' @param category A number representing the category of interest. The default 1.
#'
#' @return A list of dataframes. The first item in the list is the data frame
#' containing the trajectories for creating the map of chnchangeThe second
#' data frame contains the data for creating the stacked bars.
#' @importFrom raster raster

#'
#' @export
#'

#' @examples
#' ras <- brick(system.file("external/datarasterutm.tif", package="timeComponents"))
#'
#' df <- as.data.frame(ras, xy = TRUE)
#'
#' catTrajectory(dfRaster = df,noData = 0, category = 1)
#'
catTrajectory <- function(dfRaster,noData = 0, category = 1) {

  pixelColumns <- length(dfRaster[1,])
  dfRaster[,3:pixelColumns][dfRaster[,3:pixelColumns] == as.numeric(noData)] <- NA
  dfNa <- dfRaster %>% filter_all(any_vars(is.na(.)))
  naXY <- dfNa[1:2]
  naXYChange <- naXY %>% mutate(change = 0)

  dfNonZero <- dfRaster[complete.cases(dfRaster), ]
  nonNaXY <- dfNonZero[, 1:2]
  dfNonZero2 <- dfNonZero[, 3:pixelColumns]
  lenDfNonZero2 <- length(dfNonZero2)

  pixelColumnsBy1 <- pixelColumns + 1
  pixelColumnsBy2 <- pixelColumns + 2

  dfNonZero2[dfNonZero2 != as.numeric(category)] <- as.numeric(0)
  dfBoolean2 <- dfNonZero2
  dfBoolean2[dfBoolean2 == as.numeric(category)] <- as.numeric(1)

  dfXYZBoolean <- cbind(nonNaXY,dfBoolean2)

  absence <- dfXYZBoolean %>% mutate(change = ifelse(
    .[3] == 0 &.[pixelColumns] == 0 ,1,0))

  absence <-absence %>% subset(.$change == 1) %>% subset(., select=c("x", "y", "change"))

  presence <- dfXYZBoolean %>% mutate(change = ifelse(
    .[3] == 1 &.[pixelColumns] == 1 ,2,0))

  presence <-presence %>% subset(.$change == 2) %>% subset(., select=c("x", "y", "change"))

  lastFirstTimepoints <- dfXYZBoolean[pixelColumns] - dfXYZBoolean[3]

  xylastFirstTimepoints<- cbind(nonNaXY,lastFirstTimepoints)

  xylastFirstTimepoints2 <- xylastFirstTimepoints %>% filter(lastFirstTimepoints!=0)

  dfReclass <- xylastFirstTimepoints2 %>% mutate(change = ifelse(.[3] == 1,3,4))

  dfReclass2 <- data.frame(dfReclass$x,dfReclass$y,dfReclass$change)

  names(dfReclass2) <- c("x","y","change")

  noNaComponents <- rbind(absence,presence,dfReclass2)

  combinedTrajectory <- rbind(naXYChange,absence,presence,dfReclass2)

  return(list("combinedTrajectory" = combinedTrajectory, "dfXYZBoolean" = dfXYZBoolean ))
}
bilintoh/timeComponents documentation built on Dec. 19, 2021, 9:42 a.m.