case-insensitive `require` function replacement with similar package names suggestions

require2.R

#' @title require2
#'
#' @author Srikanth KS (talegari), gmail at sri dot teach GNU AGPLv3
#'   (http://choosealicense.com/licenses/agpl-3.0/)
#'
#' @param pkgname a string (character vector of length 1)
#' @param similar an positive integer indicating the number of similar package
#'   names to be suggested, if the match is not found
#'
#' @description The function attaches and loads a R library, if present and
#'   return an invisible TRUE. If the package is not present, it searches for
#'   the package name among the installed packages being case insentitive. If
#'   found, it attaches and loads it. Else, it looks for similar package names
#'   among the packages available on CRAN and suggests them.

require2 <- function(pkgname, similar = 5){

  stopifnot(is.character(pkgname) && length(pkgname) == 1)
  stopifnot(similar > 0 && as.integer(similar) == similar)
  existing <- rownames(installed.packages())
  stopifnot("tidyverse"  %in% existing)
  stopifnot("stringdist" %in% existing)
  stopifnot("knitr"      %in% existing)


  pkg_name <- gsub("\"", "" , deparse(substitute(pkgname)))

  # libraryQ function to load a function quietly
  libraryQ <- function(pkgName){
    stopifnot(is.character(pkgName) && length(pkgName) == 1)
    val <- suppressMessages(
      suppressWarnings(
        require(pkgName, character.only = TRUE)))
    return(invisible(val))
  }
  libraryQ("magrittr")

  if(!(pkg_name %in% existing)){
    existing_match <- which(tolower(pkg_name) == tolower(existing))

    if(length(existing_match) == 1){
      message("Attached package: ", existing[existing_match])
      return(libraryQ(existing[existing_match]))
    } else {

      available       <- rownames(available.packages())
      available_match <- which(tolower(pkg_name) == tolower(available))

      if(length(available_match) == 1){
        message("Did not attach anything, but found an yet to be installed package: "
                , available[[available_match]]
                )
        message("")
        return(invisible(FALSE))
      } else {
        pkg_status <-
        dist_df    <- tibble::tibble(package      = available
                                     , distance   = stringdist::stringdist(pkg_name
                                                            , available
                                                            )
                                     , installed = available %in% existing
                                  )
        message("No matching packages were found. Nearest matches are:")
        print(dplyr::top_n(dist_df, n = similar, wt = -distance) %>%
                dplyr::arrange(distance) %>%
                knitr::kable())
        return(invisible(FALSE))
      }
    }
  } else { # exact match
    message("Attached package: ", pkg_name)
    return(libraryQ(pkg_name))
  }
}