R/plotBursts.R

In move: Visualizing and Analyzing Animal Track Data

#  		#Find below the functions to plot a "centroid" point on the line of a certain line segment
setGeneric("plotBursts", function(object, add = TRUE, sizeFUN = function(x) {
  as.numeric(diff(range(timestamps(x))), units = 'mins')
}, col = NA, breaks = 3, ...) {
  standardGeneric("plotBursts")
})
setMethod(
  f = "plotBursts",
  signature = c(object = "list"),
  definition = function(object, add, sizeFUN, ...) {
    lapply(object, FUN = plotBursts, add = add, sizeFUN = sizeFUN, ...)
  }
)

setMethod(
  f = "plotBursts",
  signature = c(object = ".MoveTrackSingleBurst"),
  definition = function(object, add, sizeFUN, col, breaks, ...) {
    totalDur <-
      difftime(timestamps(object)[n.locs(object)],
               timestamps(object)[1], units = "mins") #duration in MIN
    splitobject <- split(object)
    midLST <- lapply(X = splitobject, FUN = lineMidpoint)
    
    if (length(col) == length(levels(burstId(object)))) {
      col <- col[as.numeric(factor(names(midLST)))]
    } else {
      if (length(levels(object@burstId)) > 8)
        warning("There are more burst IDs than colors.")
      col <- as.numeric(factor(names(midLST)))
    }
    sizesdf <- unlist(lapply(splitobject, sizeFUN))
    sizes  <-
      as.numeric(cut(sizesdf, breaks = breaks)) /
      max(as.numeric(cut(sizesdf, breaks = breaks)),na.rm = T) * 2
    df <-
      cbind(col,
            sizes,
            data.frame(tmp <- do.call(
              rbind, mapply("row.names<-",midLST,names(midLST))
            )))
    colnames(df) <- c("color", "size","x","y")
    spdf <-
      SpatialPointsDataFrame(
        coords = tmp, data = df[,1:2], 
        proj4string = CRS(proj4string(object))
      )
    
    if (add) {
      points(
        x = df[1,3], y = df[1,4], cex = as.numeric(df[1,2]), col = df[1,1],...
      )
      res <-
        apply(df[-1,], MARGIN = 1, function(x,...) {
          points(
            x = x[3], y = x[4], cex = as.numeric(x['size']), col = x['color'],...
          )
        }, ...)
    } else {
      plot(coordinates(object), type = "l", ...)
      res <-
        apply(df, MARGIN = 1, function(x,...) {
          points(
            x = x[3], y = x[4], cex = as.numeric(x['size']), col = x['color'],...
          )
        }, ...)
    }
  }
)