R/fw.R

In allosaurus-scientificus/fouu: functions of uncertain utility

#' fw helper fxs
#'
#' landing, retaining, expanding  
#'
#' may not need to export because not used outside of \code{fouu}.
#' 
#' @param x something at time 0
#' @param y something at time 1
fw_land <- function(x, y) dplyr::if_else(x == 0, y, 0)

#' @rdname fw_land
fw_retain <- function(x, y) dplyr::if_else(y < x, y, x)

#' @rdname fw_land
fw_expand <- function(x, y) dplyr::if_else(y > x & x > 0, y - x, 0)

#' @rdname fw_land
fw_net <- function(x, y) dplyr::if_else(x > 0, y, x)

#' @rdname fw_land
fw_growth <- function(x, y) dplyr::if_else(y > x, y - x, 0)

#' @rdname fw_land
fw_loss <- function(x, y) dplyr::if_else(y < x, x - y, 0)

#' @rdname fw_land
fw_dg <- function(x, y) dplyr::if_else(y < x & y > 0, x - y, 0)

#' @rdname fw_land
fw_term <- function(x, y) dplyr::if_else(y == 0, x, 0)


#' land, retain, expand
#' 
#' when used with \code{purrr::map} can loop fw logic across many dates
#' 
#' assumes unit of measure = arr
#' 
#' @param fw data frame with row per account per month
#' @param x earlier ymd 
#' @param y later ymd
#' @export
fw_compare_dates <- function(fw, x = "2018-01-01", y = "2018-07-01"){
  
  x_quo <- rlang::enquo(x)
  y_quo <- rlang::enquo(y)

  dplyr::full_join(fw %>% dplyr::filter(date == lubridate::ymd(!!x_quo)),
                   fw %>% dplyr::filter(date == lubridate::ymd(!!y_quo)),
                   by = "fw_id") %>% 
    dplyr::ungroup() %>% 
    ##  mutate_if(is.integer, as.numeric)
    dplyr::mutate(arr.x = dplyr::coalesce(arr.x, 0),
                  arr.y = dplyr::coalesce(arr.y, 0),
                  arr_lost = fw_loss(arr.x, arr.y),
                  arr_dg = fw_dg(arr.x, arr.y),
                  arr_term = fw_term(arr.x, arr.y),
                  arr_retain = fw_retain(arr.x, arr.y),
                  arr_growth = fw_growth(arr.x, arr.y),
                  arr_land = fw_land(arr.x, arr.y),
                  arr_expand = fw_expand(arr.x, arr.y))
  
}

#' land, retain, expand
#' 
#' when used with \code{purrr::map} can loop fw logic across many dates
#' 
#' assumes unit of measure = arr and that your ran \code{fw_compare_dates}
#' 
#' @param fw data frame with row per account per month
#' @export
fw_summarize <- function(fw){
  
  ##  assumes you ran fw_compare_dates
  
  fw %>% 
    dplyr::summarize(start_dt = min(date.x, na.rm = TRUE),
                     end_dt = max(date.y, na.rm = TRUE),
                     agg_start = sum(arr.x),
                     agg_end = sum(arr.y),
                     agg_lost = sum(arr_lost),
                     agg_dg = sum(arr_dg),
                     agg_term = sum(arr_term),
                     agg_retain = sum(arr_retain),
                     agg_growth = sum(arr_growth),
                     arr_land = sum(arr_land),
                     arr_expand = sum(arr_expand))
  
}