R/dot.R

In gobbios/socialindices: social and association indices

#' dyadic observation time
#'
#' @param ot.source observation time data, for the moment only supported in table form, not yet in party-style. Must contain a "focal" column, a date column, and a observation time column
#' @param dyads a character matrix with four columns, the first two correspond to the individual ids, and the third and fourth are dyadic, first in alphabetical order, second the reversed of that, and in which individuals are separated by \code{"_@_"}. See \code{\link{makedyads}}. If only a character vector is used, dyads are generated by \code{makedyads}
#' @param daterange character of length 2, with date range...
#' @param presence presence "matrix" (usually a data frame...); see \code{\link{createnullpresence}}. \code{presence2} is only necessary if focal-nonfocal dyads are to be considered at the same time, e.g. when interested in male-male focal dyads and male-female focal-nonfocal dyads. In this case, \code{presence2} would be the female presence data.
#' @param ot.style character, either \code{"table"} (default) or \code{"party"}, ie. party style...
#' @param exclcols character string with column names (or numerical index of these) to be excluded. Normally used to exclude columns that neither represent IDs, date or focal.
#'
#' @details
#' returned are only dyads that were co-resident at least one day and were observed for more than zero minutes/hours (depending on the unit of the OT) MAYBE NOT TRUE ANYMORE???
#' @return data.frame
#' @export
#'
#' @examples
#' \dontrun{
#' data(dataset3)
#' # limit presence to focals (not yet differentiated between presence and presence2
#' in the example data sets..)
#' focalpresence <- dataset3$pres[, c("date", "m", "g", "y")]
#' dot(daterange = c("2000-01-11", "2000-04-01"), OT = dataset3$ot, presence = dataset3$presence)
#' dot(daterange = c("2000-01-11", "2000-04-01"), OT = dataset3$ot, presence = NULL)
#' }

dot <- function(ot.source, dyads, daterange=NULL, presence=NULL, ot.style="table", exclcols=NULL) {

  if(ot.style=="party") {
    # exclude columns
    if(!is.null(exclcols)) {
      if (inherits(exclcols, "character")) ot.source <- ot.source[, -c(which(colnames(ot.source) %in% exclcols))]
      if (inherits(exclcols, "numeric")) ot.source <- ot.source[, -c(exclcols)]
    }

    if(!is.matrix(dyads)) {
      dyads <- makedyads(sort(dyads))
    }
    # limit objects to date range
    d <- varname("date", ot.source);
    if(is.null(daterange)) {
      from <- min(as.Date(ot.source[, d]))
      to   <- max(as.Date(ot.source[, d]))
    } else {
      from <- as.Date(daterange[1])
      to   <- as.Date(daterange[2])
    }

    ot.source <- droplevels(ot.source[ot.source[, d] >= from & ot.source[, d] <= to , ])


    # create presence if not supplied and limit to date range...
    if(is.null(presence)) presence <- createnullpresence(sort(unique(dyads[,1:2])), from, to)
    pd <- varname("date", presence)
    presence <- droplevels(presence[presence[, pd] >= from & presence[, pd] <= to , ])

    of <- varname("focal", ot.source)
    #fot <- varname("obstime", ot.source)
    res <- data.frame(dyad=dyads[,3], dot=NA, cores=NA)

    # remove focal from its own party (just in case)
    pdata <- as.matrix(ot.source[, -c(which(colnames(ot.source)==d ))])
    for(i in unique(pdata[, of])) pdata[pdata[,of]==i, i] <- "0"
    #head(pdata)

    i=1
    for(i in 1:nrow(dyads)) {
      coresdays <- presence[, pd][rowSums(presence[, dyads[i, 1:2]])==2]
      copres <- length(coresdays)
      if(copres>0) {
        temp <- pdata[ot.source[, d] %in% coresdays, c(of, dyads[i, 1:2])]
        temp <- temp[temp[, of] %in% dyads[i, 1:2], dyads[i, 1:2]]
        res$dot[i] <- sum(temp=="1")
        if(nrow(temp)==0) res$dot[i] <- NA
        rm( temp)
      }
      res$cores[i] <- copres
      rm(coresdays, copres)
    }
    res <- res[res$cores>0, ];
    rownames(res) <- NULL

  }


  if(ot.style=="table") {
    if(!is.matrix(dyads)) {
      dyads <- makedyads(dyads)
    }
    # limit objects to date range
    d <- varname("date", ot.source);
    if(is.null(daterange)) {
      from <- min(as.Date(ot.source[, d]))
      to   <- max(as.Date(ot.source[, d]))
    } else {
      from <- as.Date(daterange[1])
      to   <- as.Date(daterange[2])
    }

    ot.source <- droplevels(ot.source[ot.source[, d] >= from & ot.source[, d] <= to , ])


    # create presence if not supplied and limit to date range...
    if(is.null(presence)) presence <- createnullpresence(sort(unique(dyads[,1:2])), from, to)
    pd <- varname("date", presence)
    presence <- droplevels(presence[presence[, pd] >= from & presence[, pd] <= to , ])

    of <- varname("focal", ot.source)
    fot <- varname("obstime", ot.source)
    res <- data.frame(dyad=dyads[,3], dot=NA, cores=NA)

    i=1
    for(i in 1:nrow(dyads)) {
      coresdays <- presence[, pd][rowSums(presence[, c(dyads[i, 1:2])])==2]
      copres <- length(coresdays)
      if(copres>0) {
        temp <- ot.source[ot.source[, d] %in% coresdays, ]
        temp <- temp[temp[, of] %in% dyads[i, 1:2], ]
        dyot <- sum(temp[, fot])
        res$dot[i] <- dyot
        rm(dyot, temp)
      }
      res$cores[i] <- copres
      rm(coresdays, copres)
    }
    res <- res[res$cores>0, ]
    rownames(res) <- NULL
  }



  return(res)

}