bumped to next version, added code of conduct, ran goodpractice::gp()…

… and made fixes
trinker · Jun 6, 2018 · de2fed4 · de2fed4
1 parent aba16ab
commit de2fed4
Show file tree

Hide file tree

Showing 55 changed files with 794 additions and 599 deletions.
diff --git a/.Rbuildignore b/.Rbuildignore
@@ -23,3 +23,4 @@ inst/maintenance.R
 Thumbs.db
 inst/make_data
 inst/supporting_docs
+^CODE_OF_CONDUCT\.md$
diff --git a/CODE_OF_CONDUCT.md b/CODE_OF_CONDUCT.md
@@ -0,0 +1,25 @@
+# Contributor Code of Conduct
+
+As contributors and maintainers of this project, we pledge to respect all people who 
+contribute through reporting issues, posting feature requests, updating documentation,
+submitting pull requests or patches, and other activities.
+
+We are committed to making participation in this project a harassment-free experience for
+everyone, regardless of level of experience, gender, gender identity and expression,
+sexual orientation, disability, personal appearance, body size, race, ethnicity, age, or religion.
+
+Examples of unacceptable behavior by participants include the use of sexual language or
+imagery, derogatory comments or personal attacks, trolling, public or private harassment,
+insults, or other unprofessional conduct.
+
+Project maintainers have the right and responsibility to remove, edit, or reject comments,
+commits, code, wiki edits, issues, and other contributions that are not aligned to this 
+Code of Conduct. Project maintainers who do not follow the Code of Conduct may be removed 
+from the project team.
+
+Instances of abusive, harassing, or otherwise unacceptable behavior may be reported by 
+opening an issue or contacting one or more of the project maintainers.
+
+This Code of Conduct is adapted from the Contributor Covenant 
+(http://contributor-covenant.org), version 1.0.0, available at 
+http://contributor-covenant.org/version/1/0/0/
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,9 +1,12 @@
 Package: textshape
 Title: Tools for Reshaping Text
-Version: 1.5.3
-Authors@R: c(person("Tyler", "Rinker", email = "tyler.rinker@gmail.com", role = c("aut", "cre")), person("Joran",
-             "Elias", role = "ctb"), person("Matthew", "Flickinger", role = "ctb"), person('Paul', 'Foster', role =
-             "ctb"))
+Version: 1.6.0
+Authors@R: c(
+        person("Tyler", "Rinker", email = "tyler.rinker@gmail.com", role = c("aut", "cre")), 
+        person("Joran", "Elias", role = "ctb"), 
+        person("Matthew", "Flickinger", role = "ctb"), 
+        person('Paul', 'Foster', role = "ctb")
+    )
 Maintainer: Tyler Rinker <tyler.rinker@gmail.com>
 Description: Tools that can be used to reshape and restructure text data.
 Depends: R (>= 3.4.0)
@@ -27,7 +30,6 @@ Collate:
     'flatten.R'
     'from_to.R'
     'mtabulate.R'
-    'set_output.R'
     'split_index.R'
     'split_match.R'
     'split_match_regex_to_transcript.R'

diff --git a/NEWS b/NEWS
@@ -17,7 +17,7 @@ And constructed with the following guidelines:
 * Bug fixes and misc changes bumps the patch
 
 
-textshape 1.5.1 -
+textshape 1.5.1 - 1.6.0
 ----------------------------------------------------------------
 
 BUG FIXES
@@ -31,18 +31,13 @@ NEW FEATURES
   using the concatenated list/atomic vector names as the names of the single
   tiered list.
 
-* `unnest_text` added to located and unnest nested text columns in a data.frame.
-
-MINOR FEATURES
+* `unnest_text` added to located and un-nest nested text columns in a data.frame.
 
 IMPROVEMENTS
 
 * `tidy_dtm`/`tidy_tdm` did not order unnamed matrices as expected (e.g.,
   `{1, 2, ..., 1}` was ordered as `{1, 10, 2, ...}`).  This has been corrected.
 
-CHANGES
-
-
 
 
 

diff --git a/NEWS.md b/NEWS.md
@@ -17,7 +17,7 @@ And constructed with the following guidelines:
 * Bug fixes and misc changes bumps the patch
 
 
-textshape 1.5.1 -
+textshape 1.5.1 - 1.6.0
 ----------------------------------------------------------------
 
 **BUG FIXES**
@@ -31,18 +31,13 @@ textshape 1.5.1 -
   using the concatenated list/atomic vector names as the names of the single
   tiered list.
 
-* `unnest_text` added to located and unnest nested text columns in a data.frame.
-
-**MINOR FEATURES**
+* `unnest_text` added to located and un-nest nested text columns in a data.frame.
 
 **IMPROVEMENTS**
 
 * `tidy_dtm`/`tidy_tdm` did not order unnamed matrices as expected (e.g.,
   `{1, 2, ..., 1}` was ordered as `{1, 10, 2, ...}`).  This has been corrected.
 
-**CHANGES**
-
-
 
 
 

diff --git a/R/bind_list.R b/R/bind_list.R
@@ -40,7 +40,14 @@
 #' }
 bind_list <- function(x, id.name= "id", content.name = "content", ...){
 
-    warning("Deprecated, use textshape::tidy_list() instead.", call. = FALSE)
+    warning(
+        paste0(
+            "Deprecated, use textshape::tidy_list() instead.\n`bind_list()` ", 
+            "will be removed in the next version."
+        ), 
+        call. = FALSE
+    )
+
 
     if (is.data.frame(x[[1]])){
         bind_list_df(x = x, id.name = id.name)
@@ -60,7 +67,7 @@ bind_list_df <- function (x, id.name = "id"){
     if (is.null(names(x))) {
         names(x) <- seq_along(x)
     }
-    list.names <- rep(names(x), sapply(x, nrow))
+    list.names <- rep(names(x), sapply2(x, nrow))
     x <- lapply(x, data.table::as.data.table)
     x[['fill']] <- TRUE    
     out <- data.frame(list.names, do.call(rbind, x),
@@ -74,7 +81,7 @@ bind_list_vector <- function(x, id.name= "id", content.name = "content"){
         names(x) <- seq_along(x)
     }
     dat <- data.frame(
-        rep(names(x), sapply(x, length)),
+        rep(names(x), sapply2(x, length)),
         unlist(x, use.names = FALSE),
         stringsAsFactors = FALSE,
         check.names = FALSE,

diff --git a/R/bind_table.R b/R/bind_table.R
@@ -18,9 +18,16 @@
 #' }
 bind_table <- function(x, id.name= "id", content.name = "content", ...){
 
-    warning("Deprecated, use textshape::tidy_table() instead.", call. = FALSE)
+    warning(
+        paste0(
+            "Deprecated, use textshape::tidy_table() instead.\n`bind_table()` ", 
+            "will be removed in the next version."
+        ), 
+        call. = FALSE
+    )
 
     stopifnot(is.table(x))
+
     out <- data.table::data.table(x = names(x), y = unname(c(x)))
     data.table::setnames(out, c(id.name, content.name))
     out

diff --git a/R/bind_vector.R b/R/bind_vector.R
@@ -18,9 +18,16 @@
 #' }
 bind_vector <- function(x, id.name= "id", content.name = "content", ...){
 
-    warning("Deprecated, use textshape::tidy_vector() instead.", call. = FALSE)
+    warning(
+        paste0(
+            "Deprecated, use textshape::tidy_vector() instead.\n`bind_vector()` ", 
+            "will be removed in the next version."
+        ), 
+        call. = FALSE
+    )
 
     stopifnot(is.atomic(x))
+
     if (is.null(names)) {
         out <- data.table::as.data.table(x)
         data.table::setnames(out, id.name)

diff --git a/R/change_index.R b/R/change_index.R
@@ -1,12 +1,13 @@
 #' Indexing of Changes in Runs
 #'
-#' Find the indices of changes in runs in a vector.  This function pairs well with
-#' \code{split_index} and is the default for the \code{indices} in all \code{split_index}
-#' functions that act on atomic vectors.
+#' Find the indices of changes in runs in a vector.  This function pairs well 
+#' with \code{split_index} and is the default for the \code{indices} in all 
+#' \code{split_index} functions that act on atomic vectors.
 #'
 #' @param x A vector.
 #' @param \ldots ignored.
-#' @return Returns a vector of integer indices of where a vector initially changes.
+#' @return Returns a vector of integer indices of where a vector initially 
+#' changes.
 #' @export
 #' @seealso \code{\link[textshape]{split_index}}
 #' @examples

diff --git a/R/cluster_matrix.R b/R/cluster_matrix.R
@@ -5,7 +5,8 @@
 #' @param x A matrix.
 #' @param dim The dimension to reorder (cluster); must be set to "row", "col", 
 #' or "both".
-#' @param method The agglomeration method to be used (see \code{\link[stats]{hclust}}).
+#' @param method The agglomeration method to be used (see 
+#' \code{\link[stats]{hclust}}).
 #' @param \ldots ignored.
 #' @return Returns a reordered matrix.
 #' @export
@@ -28,7 +29,12 @@
 #'          scale_fill_viridis(name = expression(r[xy])) +
 #'          theme(
 #'              axis.text.y = element_text(size = 8)   ,
-#'              axis.text.x = element_text(size = 8, hjust = 1, vjust = 1, angle = 45),   
+#'              axis.text.x = element_text(
+#'                  size = 8, 
+#'                  hjust = 1, 
+#'                  vjust = 1, 
+#'                  angle = 45
+#'              ),   
 #'              legend.position = 'bottom',
 #'              legend.key.height = grid::unit(.1, 'cm'),
 #'              legend.key.width = grid::unit(.5, 'cm')
@@ -50,7 +56,12 @@
 #'          scale_fill_viridis(name = expression(r[xy])) +
 #'          theme(
 #'              axis.text.y = element_text(size = 8)   ,
-#'              axis.text.x = element_text(size = 8, hjust = 1, vjust = 1, angle = 45),   
+#'              axis.text.x = element_text(
+#'                  size = 8, 
+#'                  hjust = 1, 
+#'                  vjust = 1, 
+#'                  angle = 45
+#'              ),   
 #'              legend.position = 'bottom',
 #'              legend.key.height = grid::unit(.1, 'cm'),
 #'              legend.key.width = grid::unit(.5, 'cm')               

diff --git a/R/column_to_rownames.R b/R/column_to_rownames.R
@@ -17,9 +17,11 @@
 #' column_to_rownames(state_dat)
 #' column_to_rownames(state_dat, 'state.name')
 column_to_rownames <- function(x, loc = 1){
+
     x <- as.data.frame(x, check.names = FALSE, stringsAsFactors = FALSE)
     if (!is.numeric(loc)) loc <- which(names(x) %in% loc)[1]
     rownames(x) <- x[[loc]]
     x[[loc]] <- NULL
     x
+
 }
diff --git a/R/combine.R b/R/combine.R
@@ -53,13 +53,7 @@ combine.data.frame <- function(x, text.var = TRUE, ...) {
     nms <- colnames(x)
     z <- data.table::data.table(data.frame(x, stringsAsFactors = FALSE))
 
-    if (isTRUE(text.var)) {
-        text.var <- names(which.max(sapply(as.data.frame(z), function(y) {
-            if(!is.character(y) && !is.factor(y)) return(0)
-            mean(nchar(as.character(y)))
-        }))[1])
-        if (length(text.var) == 0) stop("Could not detect ` text.var`.  Please supply `text.var` explicitly.")
-    }
+    text.var <- detect_text_column(x, text.var)
 
     group.vars <- nms[!nms %in% text.var]
 

diff --git a/R/duration.R b/R/duration.R
@@ -1,7 +1,7 @@
 #' Duration of Turns of Talk
 #'
-#' \code{duration} - Calculate duration (start and end times) for duration of turns
-#' of talk measured in words.
+#' \code{duration} - Calculate duration (start and end times) for duration of 
+#' turns of talk measured in words.
 #'
 #' @param x A \code{\link[base]{data.frame}} or character vector with a text
 #' variable or a numeric vector.
@@ -54,7 +54,7 @@ duration.default <- function(x, grouping.var = NULL, ...) {
     } else {
         if (is.list(grouping.var)) {
             m <- unlist(as.character(substitute(grouping.var))[-1])
-            m <- sapply(strsplit(m, "$", fixed=TRUE), function(x) {
+            m <- sapply2(strsplit(m, "$", fixed=TRUE), function(x) {
                     x[length(x)]
                 }
             )
@@ -95,15 +95,12 @@ duration.data.frame <- function(x, text.var = TRUE, ...) {
     nms <- colnames(x)
     z <- data.table::data.table(data.frame(x, stringsAsFactors = FALSE))
 
-    if (isTRUE(text.var)) {
-        text.var <- names(which.max(sapply(as.data.frame(z), function(y) {
-            if(!is.character(y) && !is.factor(y)) return(0)
-            mean(nchar(as.character(y)), na.rm = TRUE)
-        }))[1])
-        if (length(text.var) == 0) stop("Could not detect ` text.var`.  Please supply `text.var` explicitly.")
-    }
+    text.var <- detect_text_column(x, text.var)
 
-    express1 <- parse(text=paste0("word.count := stringi::stri_count_words(", text.var, ")"))
+    express1 <- parse(
+        text=paste0("word.count := stringi::stri_count_words(", text.var, ")")
+    )
+
     z[, eval(express1)][,
         'word.count' := ifelse(is.na(word.count), 0, word.count)][,
         'end' := cumsum(word.count)]
@@ -112,7 +109,9 @@ duration.data.frame <- function(x, text.var = TRUE, ...) {
 
     colord <- c(nms[!nms %in% text.var], "word.count", "start", "end", text.var)
     data.table:: setcolorder(z, colord)
+
     z[]
+
 }
 
 

diff --git a/R/flatten.R b/R/flatten.R
@@ -9,7 +9,8 @@
 #' nested list.
 #' @param \ldots ignored.
 #' @return Returns a flattened list.
-#' @author StackOverflow user @@Michael and Paul Foster and Tyler Rinker <tyler.rinker@@gmail.com>.
+#' @author StackOverflow user @@Michael and Paul Foster and Tyler 
+#' Rinker <tyler.rinker@@gmail.com>.
 #' @export
 #' @note The order of the list is sorted alphabetically.  Pull requests for the
 #' option to return the original order would be appreciated.
@@ -52,7 +53,8 @@
 #' \dontrun{
 #' ## dictionary from quanteda
 #' require(quanteda); library(textreadr); library(dplyr)
-#' mydict <- textreadr::download("https://provalisresearch.com/Download/LaverGarry.zip") %>%
+#' mydict <- https://provalisresearch.com/Download/LaverGarry.zip" %>%
+#'     textreadr::download(") %>%
 #'     unzip(exdir = tempdir()) %>%
 #'     `[`(1) %>%
 #'     quanteda::dictionary(file = .)
@@ -101,14 +103,6 @@ fix_names <- function(x) {
 }
 
 
-# fix_names <- function(x) UseMethod('fix_names')
-#
-# fix_names.list <- function(x) {
-#   names(x) <- gsub('\\.', 'unlikelystringtodupe', names(x))
-#   lapply(x, fix_names)
-# }
-#
-# fix_names.default <- function(x) x
 
 
 
diff --git a/R/from_to.R b/R/from_to.R
@@ -107,20 +107,17 @@ from_to_summarize <- function(x, from.var, id.vars = NULL, text.var = TRUE,
         w <- unique(z[, c(from.var, id.vars), with=FALSE])
     }
 
-    if (isTRUE(text.var)) {
-        text.var <- names(which.max(sapply(as.data.frame(z), function(y) {
-            if(!is.character(y) && !is.factor(y)) return(0)
-            mean(nchar(as.character(y)), na.rm = TRUE)
-        }))[1])
-        if (length(text.var) == 0) stop("Could not detect ` text.var`.  Please supply `text.var` explicitly.")
-    }
+    text.var <- detect_text_column(x, text.var)
 
-    express1 <- parse(text=paste0("word.count := stringi::stri_count_words(", text.var, ")"))
+    express1 <- parse(
+        text=paste0("word.count := stringi::stri_count_words(", text.var, ")")
+    )
 
     z <- z[, eval(express1)][,
         'word.count' := ifelse(is.na(word.count), 0, word.count)][]
 
-    out <- from_to(z, from.var)[, list(word.count = sum(word.count)), c('from', 'to')]
+    out <- from_to(z, from.var)[, 
+        list(word.count = sum(word.count)), c('from', 'to')]
 
     if (!is.null(id.vars)) {
        out <- merge(out, w, all.x=TRUE, by.x = 'from', by.y = from.var)