* classification_template added to manually add a classification script

  template.  This template has a suggested **termco** based workflow that may be
  useful for classification projects.

Updated inst/extra_docs/02_classification.R

close #60
close #59

Author: Tyler Rinker

DESCRIPTION

@@ -4,13 +4,14 @@ Version: 0.5.4
 Authors@R: c(person("Tyler", "Rinker", email = "[email protected]", role = c("aut", "cre")), person("Steven",
              "Simpson", role = "ctb"))
 Maintainer: Tyler Rinker <[email protected]>
-Description: A suite of functions used to count terms and substrings in strings.  The tools can be used to build an expert rules, regular expression based text classification model.
+Description: A suite of functions used to count terms and substrings in strings.  The tools can be used to build an
+             expert rules, regular expression based text classification model.
 Depends: R (>= 3.4.0)
 Imports: ca, clipr, cowplot, data.table, dplyr (>= 0.4.3), ggplot2, ggraph, ggstance, gofastr (>= 0.3.0), graphics,
              grDevices, grid, gridExtra, igraph, jsonlite, methods, numform (>= 0.2.1), quanteda (>= 0.99.2), slam,
-             SnowballC, stats, stringi, textshape (>= 1.5.2), tidyr, tm, utils, wordcloud
+             SnowballC, stats, stringi, textclean, textshape (>= 1.5.2), tidyr, tm, utils, wordcloud
 Suggests: intergraph, knitr, lexicon, rmarkdown, qdapRegex, rgl, testthat
-Date: 2018-01-21
+Date: 2018-01-22
 License: MIT + file LICENSE
 LazyData: TRUE
 Roxygen: list(wrap = FALSE)

NAMESPACE

@@ -56,6 +56,7 @@ export(as_term_list)
 export(as_terms)
 export(assign_validation_task)
 export(classification_project)
+export(classification_template)
 export(classify)
 export(collapse_tags)
 export(colo)

NEWS

@@ -59,6 +59,10 @@ NEW FEATURES
 * `read_term_list`/`write_term_list` added to aid in the reading in/writing out
   and formating of term list files.
 
+* `classification_template` added to manually add a classification script
+  template.  This template has a suggested **termco** based workflow that may be
+  useful for classification projects.
+
 MINOR FEATURES
 
 * `important_terms` picks up a plot method corresponding to the `frequent_terms`

NEWS.md

@@ -59,6 +59,10 @@ termco 0.5.0 -
 * `read_term_list`/`write_term_list` added to aid in the reading in/writing out
   and formating of term list files.
 
+* `classification_template` added to manually add a classification script
+  template.  This template has a suggested **termco** based workflow that may be
+  useful for classification projects.
+
 **MINOR FEATURES**
 
 * `important_terms` picks up a plot method corresponding to the `frequent_terms`

R/classification_project.R

@@ -39,8 +39,8 @@ classification_project <- function (path = "new", open = is.global(2)){
     cat(paste(rproj, collapse = "\n"), file = file.path(path, ".Rproj"))
 
     cat(paste(dat_clean, collapse = "\n"), file = file.path(path, "scripts", "01_data_cleaning.R"))
-    script <- system.file("extra_docs/02_classification.R", package = "termco")
-    file.copy(script, file.path(path, "scripts"), TRUE, TRUE)
+    classification_template(path = 'scripts/02_classification.R', file.ext = 'csv',
+        categories.file = 'categories/categories.R')
 
     verify <- all(c(dirs, ".Rproj") %in% dir(path, all.files = TRUE)) &&
         all(file.exists(file.path(path, c("categories/categories.R",

R/classification_template.R

@@ -0,0 +1,69 @@
+#' Generate a Basic Classification Analysis Template
+#'
+#' Generates a basic template for a classification using \pkg{termco} tools.
+#'
+#' @param path Path to classification template script.
+#' @param file.ext A supported file extension for the text data.  This dictates
+#' the packages used in the template for reading in data.  Currently,
+#' '.csv' (\pkg{readr})and '.fst' (\pkg{fst}) are supported.  This can be
+#' manually changed after the template is created.
+#' @param categories.file A path to the categories (term list) file.  Defaults
+#' to \file{'scripts/02_classification.R'}.
+#' @param verbose logical.  If \code{TRUE} a message is printed if the template
+#' inclusion was successful.
+#' @param \ldots ignored.
+#' @export
+#' @examples
+#' \dontrun{
+#' classification_template()
+#' }
+classification_template <- function(
+    path = 'scripts/02_classification.R', file.ext = 'fst',
+    categories.file = 'categories/categories.R', verbose = TRUE, ...
+){
+
+
+    if (dirname(path) != '.' && !dir.exists(dirname(path))) {
+        dir.create(dirname(path), recursive = TRUE)
+    }
+
+    if (path == Sys.getenv("R_HOME")) stop("path can not be `R_HOME`")
+    if (file.exists(path)) {
+        message(paste0("\"", path, "\" already exists:\nDo you want to overwrite?\n"))
+        ans <- utils::menu(c("Yes", "No"))
+        if (ans == "2") {
+            stop("template write aborted")
+        } else {
+            unlink(path, recursive = TRUE, force = FALSE)
+        }
+    }
+
+    script <- system.file("extra_docs/02_classification.R", package = "termco")
+
+    read_package <- switch(file.ext,
+        csv = 'readr',
+        fst = 'fst',
+        {
+            warning('not a supported file.ext; either "csv" or "fst"\n Using \'csv\'; this can be manually changed after file is created')
+            'csv'
+        }
+    )
+
+
+    out <- textclean::mgsub(
+        readLines(script),
+        c('{{read_package}}', '{{read_file_type}}', '{{categories_file}}'),
+        c(read_package, file.ext, categories.file)
+    )
+
+    cat(out, file = path, sep = '\n')
+
+
+    if (file.exists(path) && verbose) {
+        message(sprintf('\'%s\' exists!\nLooks like everything went according to plan!', path))
+    }
+
+    if (!file.exists(path)) {
+        warning(sprintf('\'%s\' does not appear to exist\nLooks like something went wrong', path))
+    }
+}

R/probe_colo_plot_list.R

@@ -68,21 +68,25 @@ probe_colo_plot_list <- function(terms, data.name, copy2clip = getOption("termco
 #' \code{probe_colo_plot} - Make the plots of \code{probe_colo_plot_list}
 #' directly to an external \file{.pdf} file.
 #' @param data A vector of character strings.
-#' @param file A  \file{.pdf} file to plot to.
+#' @param file A  path for the \file{.pdf} file to plot to.
 #' @param width The width of the graphics region in inches.
 #' @param height The height of the graphics region in inches.
 #' @param \ldots Other arguments passed to frequent terms.
 #' @family probe functions
 #' @export
 #' @rdname probe_colo__plot
-probe_colo_plot <- function(terms, data, file = "Rplots.pdf", width = 5.5, height = 7, ...){
+probe_colo_plot <- function(terms, data,
+    file = sprintf('%scolo_term_plots.pdf', ifelse(dir.exists('plots/'), 'plots', '')),
+    width = 5.5, height = 7, ...){
 
     terms <- stringi::stri_escape_unicode(terms)
 
     grDevices::pdf(file=file, width = width, height = height)
+
     for(i in terms){
        print(graphics::plot(search_term_collocations(data, i, ...)) + ggplot2::ggtitle(i))
        Sys.sleep(1)
     }
+
     grDevices::dev.off()
 }

R/read_term_list.R

@@ -67,7 +67,7 @@
 #' )
 #'
 #' ## writing to the console (not that useful)
-#' write_term_list(discoure_markers)
+#' write_term_list(discoure_markers, path = '')
 #'
 #' trpl_list <- list(
 #'     list(
@@ -81,7 +81,7 @@
 #' )
 #'
 #' ## writing to the console (not that useful)
-#' write_term_list(trpl_list)
+#' write_term_list(trpl_list, path = '')
 #'
 #' ## Writing to an external file
 #' temp <- tempdir()
@@ -101,7 +101,7 @@
 #'     stringi::stri_unescape_unicode() %>%
 #'     cat(file = 'testing.json')
 #' }
-read_term_list <- function(path, indices = NULL, term.list, ...){
+read_term_list <- function(path = 'categories/categories.R', indices = NULL, term.list, ...){
 
     obj <- 'unspecified_termco_obj1234'
 
@@ -198,7 +198,7 @@ read_term_list <- function(path, indices = NULL, term.list, ...){
 
 #' @rdname read_term_list
 #' @export
-source_term_list <- function(path, indices = NULL, ...){
+source_term_list <- function(path = 'categories/categories.R', indices = NULL, ...){
 
     read_term_list(path = path, collapse = FALSE, indices = indices, ...)
 
@@ -344,7 +344,7 @@ search_open_or <- function(x, ...){
 }
 
 ## json write double backslashes
-write_model <- function(term.list, path, ...) {
+write_model <- function(term.list, path = 'categories/model_categories.json', ...) {
 
     df <- textshape::tidy_list(lapply(term.list, textshape::tidy_list, 'tag', 'regex'), 'iteration')
 
@@ -369,15 +369,30 @@ write_model <- function(term.list, path, ...) {
 
 #' Title
 #'
-#' \code{write_term_list} - Write-out a term list out to a file.
+#' \code{write_term_list} - Write-out a term list to a file.
 #'
 #' @rdname read_term_list
 #' @export
-write_term_list <- function(term.list, path = "", ...){
+write_term_list <- function(term.list, path = 'categories/categories.R', ...){
 
     stopifnot(is.list(term.list))
     stopifnot(!is.list(term.list[[1]][[1]]))
 
+    if (!is.null(path) && path != '' && dirname(path) != '.' && !dir.exists(dirname(path))) {
+        dir.create(dirname(path), recursive = TRUE)
+    }
+
+    if (!is.null(path) && path == Sys.getenv("R_HOME")) stop("path can not be `R_HOME`")
+    if (!is.null(path) && file.exists(path)) {
+        message(paste0("\"", path, "\" already exists:\nDo you want to overwrite?\n"))
+        ans <- utils::menu(c("Yes", "No"))
+        if (ans == "2") {
+            stop("template write aborted")
+        } else {
+            unlink(path, recursive = TRUE, force = FALSE)
+        }
+    }
+
     if (!is.list(term.list[[1]])) {
 
         cat(sprintf(list1, paste(unlist(unname(Map(function(x, y){

R/term_list_template.R

@@ -16,10 +16,14 @@
 #' @export
 #' @examples
 #' cats <- c("Summons", "Justification", "Exclamation", "Empty")
-#' term_list_template(cats)
-#' term_list_template(cats, hierarchical = FALSE)
-term_list_template <- function(categories = NULL, path = NULL, hierarchical = TRUE,
-    overwrite = FALSE, copy2clip = getOption("termco.copy2clip"), ...) {
+#' term_list_template(cats, path = '')
+#' term_list_template(cats, hierarchical = FALSE, path = '')
+term_list_template <- function(categories = NULL, path = 'categories/categories.R',
+    hierarchical = TRUE, overwrite = FALSE, copy2clip = getOption("termco.copy2clip"), ...) {
+
+    if (!is.null(path) && path != '' && dirname(path) != '.' && !dir.exists(dirname(path))) {
+        dir.create(dirname(path), recursive = TRUE)
+    }
 
     if (!is.null(path) && path == Sys.getenv("R_HOME")) stop("path can not be `R_HOME`")
     if (!is.null(path) && file.exists(path)) {

README.Rmd

@@ -63,6 +63,7 @@ Most of the functions *count*, *search*, *plot* terms, and *covert* between outp
 | `match_word`                 | search        | Extract words from a text matching a regular expression | 
 | `search_term_collocations`   | search       | Wrapper for `search_term` + `frequent_terms`      |
 | `classification_project`     | modeling     | Make a classification modeling project template   |
+| `classification_template`    | modeling     | Make a classification analysis script template   |
 | `as_dtm`/`as_tdm`            | modeling     | Coerce `term_count` object into `tm::DocumentTermMatrix`/`tm::TermDocumentMatrix` |
 | `split_data`                 | modeling     | Split data into `train` & `test` sets             |
 | `evaluate`                   | modeling     | Check accuracy of model against human coder       |