R/prepSlopeHealthData.R

In robschick/tangled: Creates data objects and plots for Knowlton, Schick et al. manuscript on entanglement

#' Prepare the individual line data for slope health plot
#'
#' This function starts with the health data generated by the model
#' takes the entanglement event window, and using these to create
#' a data object summarising the change from start to finish of
#' an entanglement window. The input values of health are: 
#' \code{healthmeanSP} and \code{anomSP}, which are the estimated
#' health of each animal, and the anomaly of each animal's health
#' compared to the population median
#' 
#' @return \code{dfout} A data frame containing the health and health anomaly 
#' for each entanglement event at each of the three locations
#' @export
#' @examples 
#' \dontrun{
#' prepSlopeHealthData()
#' }
prepSlopeHealthData <- function(){
  
  # pvec <- tangleOut[, 'EndDate'] - tangleOut[, 'StartDate'] <= 365
  # tangleOut <- tangleOut[pvec, ]
  dfout <- numeric(0)
  
  for(i in 1:nrow(tangleOut)){
    
    ind <- tangleOut$EGNo[i]
    tsub <- tangleOut[i, ]
    htest <- healthmeanSP[which(ID == ind),]
    atest <- anomSP[which(ID == ind),]
    
    s <- match(tsub[, 'smonyr'], myName)  
    e <- match(tsub[, 'ewindmonyr'], myName)
    r <- match(tsub[, 'rec12monyr'], myName)
    gstat <- tsub[, 'gearInj']
    sVal <- htest[s]
    eVal <- htest[e]
    rVal <- htest[r]
    asVal <- atest[s]
    aeVal <- atest[e]
    arVal <- atest[r]
    
    dfi <- data.frame(egno = ind, startHealth = sVal, endHealth = eVal, recHealth = rVal, 
                      startAnom = asVal, endAnom = aeVal, recAnom = arVal, gearInjury = gstat) 
    dfout <- rbind(dfout, dfi)
  }
  
  labels <- data.frame(gearInjury = 1:6, 
                       fullLab = c('Severe Gear', 'Moderate Gear', 'Severe No Gear', 
                                   'Minor Gear', 'Moderate No Gear', 'Minor No Gear'),
                       sevLab = c('Severe', 'Moderate', 'Severe', 
                                  'Minor', 'Moderate', 'Minor'),
                       gearLab = c('Gear', 'Gear', 'No Gear', 
                                   'Gear', 'No Gear', 'No Gear'))
  
  labels$gearLab <- factor(labels$gearLab, levels = c('No Gear', 'Gear'))
  
  dfout <- tbl_df(merge(dfout, labels, by.x = 'gearInj', by.y = 'gearInjury'))
  dfout
  
}