legolda: Color Topic Models of the Lego Dat Set

#' Generate a Pallete Function from a Color Vector
#' 
#' @param vec A vector to convert ot a function 
#' @param fname A string. The name of the function
#'   that is created 
#' @return Writes a file to a local R directory. Assumes 
#'  that the function is called from a package directory.
#' @export
write_palette_function <- function(vec){
  vec_names <- names(vec)
  cat("Generating function 'topic_palette' \n")
  sink(here::here("R", "topic-palette.R"))
  cat("# Note: This file is generated by the 'vec_2_fucntion")
  cat("#' Generated Topic Palette \n")
  cat("#' ")
  cat("#' @export \n")
  cat("topic_palette <- function() { \n \n")
  cat("# Palette colors \n")
  cat("pal <- c(")
  cat(stringr::str_c(paste0("'", vec, "'", collapse = ", ")))
  cat(") \n")
  cat("topic_names <- c(")  
  cat(stringr::str_c(paste0("'", vec_names, "'", collapse = ", ")))
  cat(") \n")
  cat("names(pal) <- topic_names \n")    
  cat("pal \n")
  cat("}") 
  sink()
}



# The remaining files rely on this one 
 
#' Generate a Color from a Topic
#'
#' Generate a function that returns the topic palette 
#' with a color associated with each topic. Function assumes
#' that it is called within legolda directory.
#'
#' @param lda_models A list of models of class LDA 
#' @param set_colors The set_colors data frame generated by 'load_data'
#' @param model_num The mode
generate_topic_palette <- function(lda_model, set_colors) {

  # Get top 2 colors for each topic
  class(lda_model) <- "LDA"
 
  # Total frequency used in relevance score
  word_freq <- set_colors %>%
    count(rgba) %>%
    mutate(percent = n / nrow(set_colors))

  # Get the top two colors
  top_colors <- top_terms(lda_model, lambda = 0.5, nterms = 2, word_freq) %>% 
    mutate(topic_name = forcats::fct_inorder(factor(topic_name)))

  # Blend two hex colors  
  blend <- function(df, scale = 100){ 
    pos <- df$beta[2] * scale
    colorRampPalette(c(df$term[1], df$term[2]))(100)[2]
  }

  # Generate palette that is a blend of the top two  
  topic_pal <- top_colors %>% split(.$topic) %>% 
    purrr::map(blend) %>% unlist
  
  write_palette_function(topic_pal)
  devtools::load_all()
}


 
#' A Color Palette from the Lego Dataset
#'
#' Returns a palette with 10 colors
#' @export
pal21 <- function() {
  c("#9B9A5AFF", "#CC702AFF", "#078BC9FF", "#F8BB3DFF",
    "#4B9F4AFF", "#A95500FF", "#D09168FF", "#9FC3E9FF", 
    "#F08F1CFF", "#CFE2F7FF")
}