R/utils.R

In PIP-Technical-Team/wbpip: What the Package Does (One Line, Title Case)

#' get_decimal_year_value
#'
#' Adjust auxiliary statistics for surveys that span multiple calendar years.
#' Values are adjusted by the weighted average of the years in question.
#'
#' @param year numeric: Year.
#' @param values numeric: A vector with two calendar year values.
#' @return numeric
#' @noRd
get_decimal_year_value <- function(year, values) {
  weights <- get_weights(year)
  out <- stats::weighted.mean(x = values, w = weights)
  return(out)
}

#' get_weights
#'
#' In case the survey year spans two calendar years this helper function returns
#' the proportion of the survey year in each respective calendar year.
#'
#' @param survey_year numeric: A vector with survey years.
#' @return numeric
#' @noRd
get_weights <- function(year) {
  if (year %% 1 == 0) {
    out <- 1 # No need for weighted average for single years
  } else {
    weight2 <- year %% 1
    weight1 <- 1 - weight2
    out <- c(weight1, weight2)
  }
  return(out)
}

#' Check for NA values in vector
#'
#' It is used for now on Lorenz curves equation
#'
#' @param x numeric: A vector
#' @return A message if any values are NA or Inf
#' @keywords internal
check_NA_Inf_values <- function(x){

  if((anyNA(x)==TRUE | any(is.infinite(x))==TRUE)){
    cli::cli_abort("x should not contain NA or Inf values")
  }

  return(invisible(TRUE))
}

#' Check for negative values in vector
#'
#' It is used for now on Lorenz curves equation
#'
#' @param x numeric: A vector
#' @return A message if any values are negative
#' @keywords internal
check_neg_values <- function(x){

  if(any(x<0)==TRUE){
    cli::cli_abort("All values in x should be positive")
  }

  return(invisible(TRUE))
}