R/helpers.R

In mwhalen18/krspHelpR:

#' generate cone counts by grid and years
#' @export
coneCounts = function(con, grids = c("KL", "SU", "JO", "BT", "SUX", "AG", "LL", "CH", "RR"), years = 1988:2020){
  suppressWarnings({
    cone_counts<-tbl(con, "cones") %>%
      filter(Year>=1988) %>%
      collect() %>%
      mutate(across(c(Year,LocX,LocY,DBH,Per,NumNew), as.numeric),
             cone_index = log(NumNew + 1),
             total_cones = 1.11568 * exp(0.1681 + 1.1891 * log(NumNew + 0.01))) # according to Krebs et al. 2012
  })

  ##################################
  # Means calculated per Grid Year #
  ##################################
  cones_grids_years <- cone_counts %>%
    group_by(Grid, Year) %>%
    summarize(num_trees = sum(!is.na(NumNew)),
              cone_counts = mean(NumNew, na.rm = TRUE),
              cone_index = mean(cone_index, na.rm = TRUE)) %>%
    mutate(Year_tp1 = Year+1,
           cone_index_t = ifelse(is.finite(cone_index), cone_index, NA))

  #link in cones from the previous year
  cone_temp<-cones_grids_years %>%
    select(Grid, Year, Year_tp1, cone_index_tm1=cone_index_t)

  cones_grids_years<-left_join(cones_grids_years, cone_temp, by=c("Grid", "Year" = "Year_tp1")) %>%
    select(-Year_tp1, -Year.y)

  # Manually code mast years

  cones_grids_years = cones_grids_years %>%
    mutate(mast = case_when(
      Grid %in% c("KL", "LL", "SU") & Year == 1993 ~ "y",
      Grid %in% c("KL", "LL", "SU") & Year == 1998 ~ "y",
      Grid %in% c("KL", "JO", "SU") & Year == 2005 ~ "y",
      Grid %in% c("KL", "LL", "SU", "CH", "JO", "AG") & Year == 2010 ~ "y",
      Grid %in% c("KL", "LL", "SU", "CH", "JO", "AG") & Year == 2014 ~ "y",
      Grid %in% c("KL", "LL", "SU", "CH", "JO", "AG") & Year == 2019 ~ "y",
      TRUE ~ "n"),
      Exp = case_when(
        Grid == "AG" & Year > 2004 & Year < 2018 ~ "f",
        Grid == "JO" & Year > 2006 & Year < 2012 ~ "f",
        Grid == "LL" & Year > 2005 & Year < 2012 ~ "f",
        TRUE ~ "c"),
      EXP_label = case_when(
        Exp == "f" ~ 19,
        TRUE ~ 1),
      cone_index_tm1 = case_when(
        Year == 2005 & Grid == "AG" ~ 1.045008523,
        TRUE ~ cone_index_tm1)) %>%
    ungroup() %>%
    filter(Grid %in% grids,
           Year %in% years)

  colnames(cones_grids_years) = tolower(colnames(cones_grids_years))
  return(cones_grids_years)
}

#' generate annual grid densities
#' @description This function has not been optimized beyond simple dependenancy checks. Care should be taken when calling it.
#' @export
gridDensities = function(con){
  require(krsp)
  #Measures spring density for each grid in each year

  # Creates two tables.  One for spring densities for each grid in each year (grids_density) and one table for yearly spring densities for KL and SU combined (SUKL_yearly_density)
  #Importing midden census data
  census_1<-tbl(con, "dbamidden") %>%
    select(reflo, squirrel_id, locX, locY, grid, date, Sex) %>%
    # use collect to execute the sql query before using any R specific functions
    # such as loc_to_numeric
    collect %>%
    mutate(locX = loc_to_numeric(locX))

  #Importing squirrel census data
  census_2 <- tbl(con, "census") %>%
    # be careful with case, database uses locX in census, but locX in dbaMidden
    # sql doesn't care since it's not case sensitive, but R does!
    select(reflo, squirrel_id, locx, locy, gr, census_date, sq_fate, sex) %>%
    filter(sq_fate != 7) %>%
    # use collect to execute the sql query before using any R specific functions
    # such as loc_to_numeric
    collect() %>%
    mutate(locx = loc_to_numeric(locx))

  census_2 <- census_2 %>%
    select(-sq_fate) %>%
    dplyr::rename(locX = locx,
                  locY = locy,
                  grid = gr,
                  date = census_date,
                  Sex = sex)

  census_all<-bind_rows(census_1, census_2)%>%
    mutate(grid = factor(grid),
           year = lubridate::year(lubridate::ymd(date)),
           month = lubridate::month(lubridate::ymd(date)),
           locY=as.numeric(locY),
           Sex=factor(Sex))

  selected_grids <- c("AG", "CH", "JO", "KL", "LL", "SU")
  census_all <- filter(census_all, grid %in% selected_grids, year>=1989) %>%
    mutate(grid=factor(grid, levels = c("AG", "CH", "JO", "KL", "LL", "SU")))

  selected_grids2 <- c("CH", "JO", "KL", "SU")

  suchjokl_core_may_census<-filter(census_all, month==5,
                                   grid %in% selected_grids2,
                                   locX>=-0.2, locX<=20.8,
                                   locY>=-0.2, locY<=20.8)#39.69ha

  ag_core_may_census<-filter(census_all, month==5,
                             grid =="AG",
                             locX>=-0.2, locX<=20.8,
                             locY>=-0.2, locY<=23.8) #45.36ha

  ll2_core_may_census<-filter(census_all, month==5,
                              grid =="LL",
                              year>2005,
                              locX>=-10.2, locX<=22.8,
                              locY>=-0.2, locY<=8.8) #26.73ha

  core_may_census_all<-bind_rows(suchjokl_core_may_census, ag_core_may_census, ll2_core_may_census)

  grids_density <- group_by(core_may_census_all, year, grid) %>%
    filter(!is.na(squirrel_id)) %>%
    dplyr::summarize(spr_number = n_distinct(squirrel_id)) %>%
    dplyr::select(year, grid, spr_number)

  # Summary of Spring Density
  grid<-c("KL", "SU", "CH", "JO", "LL", "AG")
  area<-c(39.69, 39.69, 39.69, 39.69, 26.73, 45.36)
  area<-data.frame(grid, area)

  grids_density <- left_join(grids_density, area, by = "grid") %>%
    mutate(spr_density = spr_number/area)

  return(grids_density)
}