R/utilities.R

In USAID-OHA-SI/Wavelength: Wavelength

#' Current Fiscal Year
#'
#' @return Current Fiscal Year
#' @export
#'
  curr_fy <- 2023



#' Check if package exists
#'
#' @param pkg package name
#'
#' @return warning message if package is not installed
#' @export
#' @family utility

  package_check <- function(pkg){
    if (!requireNamespace(pkg, quietly = TRUE)) {
      stop(paste("Package", pkg, "needed for this function to work. Please install it."),
           call. = FALSE)
    }
  }


#' Check if variable exist
#'
#' @param df data frame to check against
#' @param var quoted variable of interest
#' @export
#' @family utility
#' @examples
#' \dontrun{
#' var_exists(df, "val") }
  var_exists <- function(df, var) {

    var %in% names(df)

  }


#' Determine whether meta tab exists
#'
#' @export
#' @param filepath filepath to sumbitted template
#' @family utility

is_metatab <- function(filepath){

  if(missing(filepath))
    stop("No filepath provided.")

  shts <- readxl::excel_sheets(filepath)
  "meta" %in% shts
}



#' Extract Meta Data Information about Template
#'
#' @description Useful for pulling information about the template, whether
#' It be the Operating Unit (OU), Period, template version, or type, eg wide or long.
#'
#' @param filepath filepath to sumbitted template
#' @param meta_type type of meta data requesting: ou, period, version, type (default)
#'
#' @export
#'
#' @examples
#' \dontrun{
#' #identify whether template is long or wide
#'   filepath <- "~/WeeklyData/Raw/KEN_Weekly.xlsx"
#'   hfr_extract_meta(filepath, meta_type = "type")
#' #identify period
#'   hfr_extract_meta(filepath, meta_type = "period")
#' #identify OU
#'   hfr_extract_meta(filepath, meta_type = "ou") }

hfr_extract_meta <- function(filepath, meta_type = "type"){

  if(is_metatab(filepath)){
    metatable <- readxl::read_excel(filepath, range = "meta!B2:C5",
                                    col_names = c("mtype", "mvalue"))

    meta <- metatable %>%
      dplyr::mutate(mtype =
                      stringr::str_remove_all(mtype,
                                              "Template|HFR FY and|, eg 2020.1|perating|nit|\\/Country| ")
                    %>% tolower) %>%
      dplyr::filter(mtype == meta_type) %>%
      dplyr::pull()


  } else {
    meta <- NA
  }

  return(meta)
}




#' Count missing values
#'
#' Counts the number of rows where there are missing records
#'
#' @param df data frame
#' @param var variable to count missing values
#' @family internal

count_missing <- function(df, var){

  missing <- df %>%
    dplyr::filter(is.na({{var}})) %>%
    NROW()

  missing_pct <- round(missing/NROW(df), 2)*100
  missing_pct <- paste0("(",missing_pct, "%)")

  count <- ifelse(missing > 0, crayon::red(missing, "out of", NROW(df), "rows", missing_pct), crayon::green("No"))
  return(count)
}


#' Flag Missing Variables
#'
#' @param required list of required vars
#' @param submitted list of vars pulled from submission
#'
#' @family internal
  flag_missing <- function(required, submitted){

    missing <- setdiff(required, submitted)
    if(length(missing) > 0){
      missing <- crayon::yellow(missing)
    } else {
      missing <- crayon::green("No")
    }

    return(missing)
  }


#' Flag Extra Variables
#' @param required list of required vars
#' @param submitted list of vars pulled from submission
#' @family internal

  flag_extra <- function(required, submitted){

    extra <- setdiff(submitted, required)
    if(length(extra > 0)){
      extra <- crayon::red(extra)
    } else {
      extra <- crayon::green("No")
    }

    return(extra)
  }


#' Paint console text in red
#'
#' @param txt text to be printed
#' @export
#' @family text_color
#'
paint_red <- function(txt) {
  msg <- crayon::red(txt)
  return(msg)
}

#' Paint console text in green
#'
#' @param txt text to be printed
#' @export
#' @family text_color
#'
paint_green <- function(txt) {
  msg <- crayon::green(txt)
  return(msg)
}

#' Paint console text in blue
#'
#' @param txt text to be printed
#' @export
#' @family text_color
paint_blue <- function(txt) {
  msg <- crayon::blue(txt)
  return(msg)
}

#' Paint console text in yellow
#' @family text_color
#' @param txt text to be printed
#' @export
#'
paint_yellow <- function(txt) {
  msg <- rayon::yellow(txt)
  return(msg)
}



#' Search Org Hierarchy for Org Unit
#'
#' A look up for an partial orgunit name against the DATIM list of orgunits,
#' when trying to find the correct or missing orgunituid
#'
#' @param df org hierarchy, created in pull_hierarchy()
#' @param orgunit_name full or partial orgunit name for matching
#' @param ou operating unit; if added searches only that OU default = NULL
#'
#' @export
#'
#' @examples
#' \dontrun{
#' load_secrets("datim")
#' org <- pull_hierarchy(datim_user(), datim_pwd())
#' # orgunit - "Kewot"
#' hfr_orgunit_search(org, "Kew", "Ethiopia") }

hfr_orgunit_search <- function(df, orgunit_name, ou = NULL){

  if(!is.null(ou))
    df <- dplyr::filter(df, operatingunit == ou)

  df %>%
    dplyr::filter(stringr::str_detect(orgunit, orgunit_name)) %>%
    dplyr::select(orgunit, orgunituid, psnu, operatingunit, level)
}