R/densitiy.R

In mwhalen18/krspHelpR:

#' Calculate local densities for individual squirrels from midden data.
#' @description This functions uses midden data from 1988-2012. For subsequent years use \link[krspHelpR]{squirrelDensities}
#' @export
middenDensities = function(con, radius = 150, grids = c("KL", "SU"), years = 1986:2019, verbose = TRUE){
  suppressMessages({
    require(dplyr)
    require(purrr)
    require(parallel)
  })

  midden_densities = tbl(con, "dbamidden") %>%
    select(squirrel_id, sex = Sex, grid, date, locX, locY, census_fate = fate, census_def = def) %>%
    collect() #generate a working dataframe of individuals you want

  census = midden_densities %>%
    mutate(date = lubridate::ymd(date),
           year = lubridate::year(date),
           month = lubridate::month(date),
           locX = as.numeric(locX),
           locY = as.numeric(locY)) %>%
    select(-date) %>%
    unique()

  data = census %>%
    filter(!is.na(squirrel_id),
           grid %in% grids,
           year %in% years) %>%
    mutate(local_density = 0) #generate new column to store densities


  n = length(data$squirrel_id)
  data$ids = seq(n)

  if(verbose) message("Generating local densities . . .")
  if(verbose) message("This process will take a while and is intentionally left that way to retain the intent of the original author. For tips on boosting the speed, see the vignettes with `browseVignettes('krspHelpR')")

  neighbors = data$ids %>%
    purrr::map(getDensity, census = census, data = data, radius = radius)

  data$local_density = unlist(replace(neighbors, !sapply(neighbors, length), 0), recursive = T) #convert list to vector and append to dataframe
  return(data)
  }


#' creates a neighborhood within a given radius for an individual squirrel
#' @export
getNeighbors = function(id, census, data, radius){#This function is parallelized to take in the census and data dfs and generate social neighborhoods
  require(dplyr)
  neighbors = census %>%
    filter(census$grid == data$grid[id] &
             census$year == data$year[id] &
             census$month == data$month[id] &
             (30*data$locX[id]-30 * census$locX)^2 + (30*data$locY[id] - 30*census$locY)^2 <=(radius)^2 &
             !squirrel_id == data$squirrel_id[id]) %>%
    mutate(nind = length(unique(squirrel_id)),
           density = nind / ((pi*radius^2) / 10000))
  return(neighbors)
}

#' generates densities from a social neighborhood for an individual squirrel
#' @export
getDensity = function(id, census, data, radius){
  densities = getNeighbors(id, census, data, radius) %>%
    pull(density) %>%
    unique()
  return(densities)
}




#' Calculate local densities for individual squirrels from squirrel data.
#' @description This functions uses midden data from 2012 onward. For previous years use \link[krspHelpR]{middenDensities}
#' @export
squirrelDensities = function(con, radius = 150, grids = c("KL", "SU"), years = 2010:2020, verbose = FALSE){
  suppressMessages({
    require(dplyr)
    require(furrr)
    require(tictoc)
    require(lubridate)
    require(parallel)
  })

  suppressWarnings({
    plan(multisession(workers = (parallel::detectCores() / 2) + 1)) #starts a multi-session using n/2-1 cores
  })

  squirrel_census = tbl(con, "census") %>%
    select(squirrel_id, sex, grid = gr, date = census_date, locX = locx, locY = locy, census_fate = sq_fate) %>%
    collect()

  census = squirrel_census %>%
    mutate(date = ymd(date),
           year = year(date),
           month = month(date),
           locX = krsp::loc_to_numeric(locX),
           locY = krsp::loc_to_numeric(locY))

  data = census %>%
    filter(grid %in% grids,
           year %in% years,
           #!duplicated(squirrel_id),
           !is.na(squirrel_id)) %>%
    mutate(local_density = 0)

  n = length(data$squirrel_id)
  data$ids = seq(n)

  if(verbose) message("Generating local densities . . .")

  neighbors = data$ids %>%
    purrr::map(getDensity, census = census, data = data, radius = radius)

  data$local_density = unlist(replace(neighbors, !sapply(neighbors, length), 0), recursive = T)
  return(data)
}