R/track-methods.R

In jacobnabe/DEPONS2R: Read, Plot and Analyse Output from the DEPONS Model

# Author: Jacob Nabe-Nielsen
# Date: 1 August 2020
# Licence GPL v3
# Description: Methods and classses for reading and summarizing DEPONS track
#   objects


#' @title DeponsTrack-class
#' @description Stores objects containing animal movement tracks simulated using
#' the DEPONS model
#' @description Classes for manipulating and plotting movement
#' tracks generated with DEPONS.
#' @slot title Name of the object (character)
#' @slot landscape Name of the object (character)
#' @slot simtime POSIXlt object with the date and time when the simulation was
#' finished. This is read from the name of the imput file.
#' @slot crs CRS object providing the coordinate reference system used; see
#' \code{\link[sf]{st_crs}} for details
#' @slot tracks Listwith one or more tracks, each stored
#' as a \code{\link[sp]{SpatialPointsDataFrame}} object)
#' @exportClass DeponsTrack
#' @seealso \code{\link[DEPONS2R]{plot.DeponsTrack}} and
#' \code{\link[DEPONS2R]{read.DeponsTrack}}
#' @import sf
setClass(Class="DeponsTrack",
         slots=list(title="character", landscape="character", simtime="POSIXlt",
                    crs="character", tracks="list")
)


setMethod("initialize", "DeponsTrack",
          function(.Object) {
            .Object@title <- "NA"
            .Object@landscape <- "NA"
            .Object@simtime <- as.POSIXlt(NA)
            .Object@crs <- "NA"
            one.track <- sp::SpatialPointsDataFrame(as.matrix(data.frame("x"=0,
                          "y"=0), ncol=2), proj4string=sp::CRS(as.character(NA)),
                          data=data.frame(data="NA"))
            .Object@tracks <- list(one.track)
            return((.Object))
          }
)


#' @name summary
#' @title Summary
#' @rdname summary
#' @aliases summary,DeponsTrack-method
#' @return list summarizing the DeponsTrack object
#' @exportMethod summary
setMethod("summary", "DeponsTrack",
          function(object) {
            cat("class:    \t", "DeponsTrack \n")
            cat("title:    \t", object@title, "\n")
            cat("landscape:\t", object@landscape, "\n")
            cat("simtime:  \t", as.character(object@simtime), "\n")
            cat("crs:      \t", object@crs, "\n")
            cat("N tracks: \t", length(object@tracks), "\n")
            out <- list(
              "title" <- object@title,
              "landscape" <- object@landscape,
              "simtime" <- object@simtime,
              "crs" <- object@crs,
              "tracks" <- object@tracks
            )
            return(invisible(out))
          }
)


#' @title Reading DEPONS track files
#' @description Function  for reading movement tracks produced by DEPONS. These
#' describe movements of simulated animals within the simulation landscape, where
#' the positions after each 30-min time step are provided using the coordinate
#' reference system that were used for generating these landscapes.See
#' van Beest et al. (2018) and Nabe-Nielsen et al. (2013) for details regarding
#' how these files were generated as a balance between correlated random walk
#' behaviour and spatial memory behaviour, which allows animals to return to
#' previously visited food patches.
#'
#' @param fname Name of the file (character) that contains movement data
#' generated by DEPONS. The name includes the path to the directory if this is
#' not the current working directory.
#' @param title Optional character string giving name of simulation
#' @param landscape Optional character string with the landscape used in the
#' simulation
#' @param simtime Character sting with date of simulation (format yyyy-mm-dd).
#' If not provided this is obtained from name of input file
#' @param crs Character, coordinate reference system (map projection)
#' @param tz Time zone used in simulations. Defaults to UTC/GMT.
#' #'
#' @return Returns a \code{DeponsTrack} object with the elements \code{title},
#' \code{simtime}, \code{crs}, and \code{tracks}. The \code{date} is extracted
#' from input data if not provided explicitly and stored as a
#' \code{\link{POSIXlt}} object. The element \code{tracks} is a list of objects
#' of class \link[sp]{SpatialPointsDataFrame}, each of which corresponds to one
#' simulated animal (several animals can be tracked in one simulation).
#' @examples
#' data(porpoisetrack) # Load data for use in example
#'
#' # Use standard DEPONS coordinate reference system / map projection:
#' the.crs <- "+proj=laea +lat_0=52 +lon_0=10 +x_0=4321000 +y_0=3210000
#'  +datum=WGS84 +units=m +no_defs"
#'
#' \dontrun{
#' one.fname <- "~/Applications/DEPONS/
#'   RandomPorpoise.2020.Jul.31.09_43_10.csv"
#'
#' porpoisetrack <- read.DeponsTrack(one.fname, title="Track simulated using DEPONS 2.0",
#'   crs=the.crs)
#'
#' }
#'
#' # Plot the first of the simulated tracks
#' plot(porpoisetrack)
#' @export read.DeponsTrack
read.DeponsTrack <- function(fname, title="NA", landscape="NA", simtime="NA",
                             crs=as.character(NA), tz="UTC") {
  raw.data <- utils::read.csv(fname, sep=";")
  # Get sim date and time from file name
  if (simtime=="NA")  simtime <- get.simtime(fname)
  tracks <- list()
  ids <- sort(unique(raw.data$Id))
  for (i in length(ids)) {
    id <- ids[i]
    one.track <- raw.data[raw.data$Id==id, ]
    ot.coords <- one.track[, c("UtmX", "UtmY")]
    colnames(ot.coords) <- c("x", "y")
    ot.data <- one.track[, c("tick", "Id", "EnergyLevel", "DeterStrength",
                             "DispersalMode", "PSMActive", "PSMTargetUtmX",
                             "PSMTargetUtmX")]
    if(is.na(as.character(crs))) crs <- as.character(NA)
    one.track.spdf <- sp::SpatialPointsDataFrame(ot.coords, ot.data,
                                                 proj4string=sp::CRS(crs))
    tracks[[i]] <- one.track.spdf
  }
  all.data <- new("DeponsTrack")
  all.data@title <- title
  all.data@landscape <- landscape
  if ("POSIXlt" %in% class(simtime)) all.data@simtime <- simtime
  else if ("character" %in% class(simtime)) all.data@simtime <- as.POSIXlt(simtime, tz=tz)
  else stop("Couldn't read the simtime")
  all.data@crs <- crs
  all.data@tracks <- tracks
  return(all.data)
}


#' @title Convert DEPONS track to data frame
#' @description Function  for converting DEPONS movement track file to a
#' data frame.
#' @param x DeponsTrack object
#' @param row.names NULL or a character vector giving the row names for the data
#' frame. Missing values are not allowed.
#' @param optional Logical (not used)
#' @param ... additional arguments to be passed to or from methods.
#' @exportMethod as.data.frame
#' @return \code{data.frame} object
#' @examples
#' data(porpoisetrack)
#' class(porpoisetrack)
#' the.track <- as.data.frame(porpoisetrack)
setMethod("as.data.frame", signature("DeponsTrack"),
            function(x, row.names = NULL, optional = FALSE, ...) {
              if (is.null(x))
                return(as.data.frame(list()))
              tracks <- as.data.frame(x@tracks)
              row.names(tracks) <- row.names
              return(tracks)
            }
)


#' @title Plot a DeponsTrack object
#' @description Plot the coordinates in a movement track simulated with DEPONS.
#' @aliases plot.DeponsTrack
#' @param x DeponsTrack object
#' @param y Not used
#' @param trackToPlot Integer; indicates which track to plot if there is more
#' than one track in the object. Defaults to 1
#' @param add Logical, whether to add the track to an existing plot
#' one animal was tracked during the simulation.
#' @param ... Optional plotting parameters
#' @return No return value, called for side effects
#' @examples data(porpoisetrack)
#' data("porpoisetrack")
#' plot(porpoisetrack)
#' @exportMethod plot
setMethod("plot", signature("DeponsTrack", "missing"),
          function(x, y, trackToPlot=1, add=FALSE, ...)  {
            oldpar <- graphics::par(no.readonly = TRUE)
            on.exit(graphics::par(oldpar))
            dots <- list(...)
            col <- "black"
            if("col" %in% names(dots)) col <- dots$col
            lwd <- 1
            if("lwd" %in% names(dots)) lwd <- dots$lwd
            lty <- 1
            if("lty" %in% names(dots)) lty <- dots$lty
            the.main <- ifelse(x@title=="NA", "DEPONS track", x@title)
            trk <- x@tracks[[trackToPlot]]
            if (!add) plot(sp::coordinates(trk), type="l", asp=1, main=the.main, col=col, lwd=lwd, lty=lty)
            else lines(sp::coordinates(trk), type="l", asp=1, main=the.main, col=col, lwd=lwd, lty=lty)
          }
)


# Don't move following method to file 'raster-methods' -- classes defined
# in that file have to be loaded first (files are loaded alphabetially)
### @describeIn plot-DeponsRaster-ANY-method Plots a DeponsRaster object
setMethod("plot", signature("DeponsRaster", "DeponsTrack"),
          function(x, y, trackToPlot=1, ...)  {
            dots <- list(...)
            col <- "black"
            if("col" %in% names(dots)) col <- dots$col
            lwd <- 1
            if("lwd" %in% names(dots)) lwd <- dots$lwd
            lty <- 1
            if("lty" %in% names(dots)) lty <- dots$lty
            main <- y@title
            if("main" %in% names(dots)) main <- dots$main
            oldpar <- graphics::par(no.readonly = TRUE)
            on.exit(graphics::par(oldpar))
            plot(y@tracks[[trackToPlot]], col="white", main=main)
            plot(x, main=main, add=TRUE, legend=FALSE)
            y.coords <- y@tracks[[trackToPlot]]@coords
            lines(y.coords, lwd=lwd, lty=lty, col=col)
          }
)


#' @name bbox
#' @rdname bbox
#' @title Get bbox from Depons* object
#' @description Retrieves spatial bounding box from object. If a Depons* object
#' is a DeponsTrack object containing multiple track, the box bounds all tracks.
#' @aliases bbox,DeponsTrack-method
#' @param obj DeponsRaster or DeponsTrack object
#' @return Returns a \code{matrix} defining the northern, southern, eastern and
#' western boundary of a DeponsRaster object or of one or more DeponsTrack
#' objects.
#' @seealso \code{\link{make.clip.poly}}
#' @exportMethod bbox
setMethod("bbox", signature("DeponsTrack"),
          function(obj) {
            xmin <- ymin <- 99999999999999999999999
            xmax <- ymax <- -99999999999999999999999
            for(i in 1:length(obj@tracks)) {
              one.track <- obj@tracks[[i]]
              if(one.track@bbox["x", "min"] < xmin) xmin <- one.track@bbox["x", "min"]
              if(one.track@bbox["y", "min"] < ymin) ymin <- one.track@bbox["y", "min"]
              if(one.track@bbox["x", "max"] > xmax) xmax <- one.track@bbox["x", "max"]
              if(one.track@bbox["y", "max"] > ymax) ymax <- one.track@bbox["y", "max"]
            }
            x <- c(xmin, xmax)
            y <- c(ymin, ymax)
            extremes <- sp::SpatialPoints(cbind(x,y))
            return(sp::bbox(extremes))
          }
)