R/codename.R

In polymathematic/CodenameR: CodenameR

#' Codename
#'
#' The main function for defining reproducible codenames
#'
#' @param x A vector of values to be encoded
#' @param pattern A format string. See ?sprintf().
#' @param conventions A list of naming convention. This should be a list of either (1) naming conventions from the list below or (2) a vector of custom values. The list should be equal in length to the number of values required by the pattern string.
#'
#' @details The set of acceptable values for \code{conventions} are listed below:
##' \itemize{
##'  \item{\code{"names_english"}}{ Common English first names}
##'  \item{\code{"colors_english"}}{ Simple colors like red, yellow, and blue}
##'  \item{\code{"plants"}}{ Common plant names}
##'  \item{\code{"trees"}}{ Common tree names}
##'  \item{\code{"animals"}}{ Common animal names}
##'  \item{\code{"minerals"}}{ Common names for rocks and other minerals}
##'  \item{\code{"genus_mammals"}}{ Genus names for mammals}
##'  \item{\code{"occupations"}}{ Common occupations}
##'  \item{\code{"alphabet_greek"}} { Letters of the Greek alphabet}
##'  \item{\code{"alphabet_nato"}}{ Letters of the post-1956 NATO phonetic alphabet}
##'  \item{\code{"alphabet_icao"}}{ Letters of the 1947 ICAO phonetic alphabet}
##'  \item{\code{"deities_greek"}}{ Gods and goddesses of the Greek pantheon}
##'  \item{\code{"deities_roman"}}{ Gods and goddesses of the Roman pantheon}
##'  \item{\code{"deities_norse"}}{ Gods and goddesses of the Norse pantheon}
##'  \item{\code{"adjectives_english"}}{ Common adjectives, not otherwise specified}
##'  \item{\code{"gerunds_english"}}{ Common gerunds, not otherwise specified}
##'  \item{\code{"nouns_english"}}{ Common nouns, not otherwise specified}
##'  \item{\code{"numbers_X"}}{ A set of X digits}
##'  \item{\code{"letters"}}{ Single letters}
##' }
##'
#' @export
#'
#' @examples
#' codename(c("Dan",1234))
#'

#TODO: codenames must be composed of three types of text:
#1) Static text that is unchanging
#2) Text that takes one or more values in an obvious way ("Syria" -> "LVNT")
#3) Text that is crypotgraphically derived from a unique ID
#
# The final codeword should be easy for humans to read and remember.
# There should be a low risk of collisions.

codename <- function(x,
                     pattern = "%s %s - %s - %s // %s",
                     conventions = list("colors_english","animals", "numbers_3","test1",c("test2","test3"))) {

  #Helper function
  leading_zeroes <- function(x,
                             digits = max(nchar(x), na.rm = TRUE),
                             prefix = "",
                             suffix = ""){

    n_zeroes <- digits - nchar(x)
    output <- ifelse(!is.na(x), paste0(prefix, strrep("0", n_zeroes), x, suffix), NA)
    return(output)
  }

  # Define data path
  data_path <- paste(system.file(package = "CodenameR"), "Data/", sep = "/")

  # List all conventions
  convention_files <- dir(data_path, pattern = "[.]txt")

  # Declare object to hold the convention vectors
  convention_vectors <- list()

  #Loop over conventions
  for(con in conventions){

    #Derive filename
    file <- paste0(con,".txt")

    #Check for custom vector
    if(length(con) > 1){

      #If so, take it as is
      convention_vectors[[length(convention_vectors) + 1]] <- toupper(as.character(con))

      #Increment
      i <- 1 + 1

    } else {

      if(file %in% convention_files){

        #If the convention is in a file, then import
        convention_vectors[[length(convention_vectors) + 1]] <- scan(paste0(data_path, file), what = "character")

      } else if(grepl("numbers_", con)){

        #If it references a number, create that set of numbers
        charlen <- as.integer(unlist(strsplit(con, "_"))[2])
        convention_vectors[[length(convention_vectors) + 1]] <- leading_zeroes(1:(10^charlen - 1), charlen)

      } else if(grepl("letters", con)){

        #If it references a letter, create that set of letters
        convention_vectors[[length(convention_vectors) + 1]] <- LETTERS

      } else {

        #Otherwise, take it as is
        warning(sprintf("'%s' is not an existing naming convention. See ?codename().",
                        con))
        convention_vectors[[length(convention_vectors) + 1]] <- toupper(as.character(con))

      }

    }

  }

  # Define output object
  output <- c()

  #Loop over items to give codenames to
  for(i in x){

    # Set seed
    char2seed(digest::digest(i))

    # Select names
    temp_names <- lapply(convention_vectors, function(con_vec){

      sample(con_vec, 1, replace = TRUE)

    })

    #Store output
    output[length(output) + 1] <- do.call(sprintf, c(pattern, temp_names))

  }

  #Simple check for collisions
  if(length(unique(output)) != length(unique(x))){
    warning("Non-unique codenames detected. Increase potential variety.")
  }

  return(output)

}