Give important and frequent terms a grouping.var argument

[trinker]

n of each group

[trinker]

will affect the plot methods

[trinker]

frequent_terms <- function(text.var, n = 20, grouping.var = NULL, 
    stopwords = stopwords::stopwords("english"), min.freq = NULL, min.char = 4, 
    max.char = Inf, stem = FALSE, language = "porter", strip = TRUE,
    strip.regex = "[^a-z' ]", alphabetical = FALSE, ...) {

    if (is.data.frame(text.var)) stop("`text.var` is a `data.frame`; please pass a vector")

    text.var <- stringi::stri_trans_tolower(text.var)

    ## remove nonascii characters
    text.var <- iconv(text.var, "latin1", "ASCII", sub = "")

    ## regex strip of non-word/space characters
    if (isTRUE(strip)) text.var <- gsub(strip.regex, " ", text.var)

    if(is.null(grouping.var)) {
        G <- "all"
    } else {
        if (is.list(grouping.var)) {
            m <- unlist(as.character(substitute(grouping.var))[-1])
            G <- sapply(strsplit(m, "$", fixed=TRUE), function(x) {
                x[length(x)]
            })
        } else {
            G <- as.character(substitute(grouping.var))
            G <- G[length(G)]
        }
    }

    if(is.null(grouping.var)){
        grouping <- rep("all", length(text.var))
    } else {
        if (isTRUE(grouping.var)) {
            grouping <- seq_along(text.var)
        } else {
            if (is.list(grouping.var) & length(grouping.var)>1) {
                grouping <- grouping.var
            } else {
                grouping <- unlist(grouping.var)
            }
        }
    }

    if(!missing(group.names)) {
        G <- group.names
    }

    DF <- data.frame(text.var, check.names = FALSE, stringsAsFactors = FALSE)
    DF[G] <- grouping

    DF <- data.table::data.table(DF)

    DF <- DF[, list(text.var = paste(text.var, collapse = ' ')), by = G]

    grp <- DF[, G, with = FALSE]

    outs <- lapply(seq_len(nrow(DF)),  function(i){

        cnts <- frequent_terms_helper(DF[['text.var']][i], n = n, stopwords = stopwords, 
            min.freq = min.freq, min.char = min.char, max.char = max.char, 
            stem = stem, language = language, strip = strip, 
            strip.regex = strip.regex, alphabetical = alphabetical
        )
# browser()

        out <- as.data.frame(
            dplyr::bind_cols(grp[rep(i, nrow(cnts)), ], cnts),
            check.names = FALSE,
            stringsAsFactors = FALSE
        )

        n.words <- attributes(out)[["n.words"]]

        if (isTRUE(alphabetical)){
            out <- out[order(out[["term"]]), ]
        }

        if (n < 1) {
            n <- round(n * nrow(out), 0)
        }

        if (n > nrow(out)) {
            n <- nrow(out)
        }

        if (is.null(min.freq)) {
            out2 <- out[out[["frequency"]] >= out[["frequency"]][n], ]
        } else {
            out2 <- out[out[["frequency"]] >= min.freq, ]
            n <- nrow(out2)
        }

        class(out2) <- c('frequent_terms', class(out))
        attributes(out2)[["n"]] <- n
        attributes(out2)[["full"]] <- out
        attributes(out2)[["n.words"]] <- n.words
        attributes(out2)[["group.var"]] <- G
        out2        

    })

}

text.var <- termco::presidential_debates_2012$dialogue
alphabetical <- FALSE
grouping.var <- termco::presidential_debates_2012$person
language <- "porter"
max.char <- Inf
min.char <- 4
min.freq <- NULL
n <- 20
stem <- FALSE
stopwords <- stopwords::stopwords("english")
strip <- TRUE
strip.regex <- "[^a-z' ]"

frequent_terms_helper <- function(text.var, n = 20, 
    stopwords = stopwords::stopwords("english"), min.freq = NULL, min.char = 4, 
    max.char = Inf, stem = FALSE, language = "porter", strip = TRUE,
    strip.regex = "[^a-z' ]", alphabetical = FALSE, ...) {

    y <- unlist(stringi::stri_extract_all_words(text.var))
    n.words <- sum(stringi::stri_count_words(text.var), na.rm = TRUE)

    ## stemming
    if (isTRUE(stem)) {
        y <- SnowballC::wordStem(y, language = language)
        if (! is.null(stopwords)) stopwords <- SnowballC::wordStem(stopwords, language = language)
    }

    ## exclude less than the min character cut-off
    y <- y[nchar(y) > min.char - 1]

    ## exclude more than the max character cut-off
    y <- y[nchar(y) < max.char + 1]

    ## data frame of counts
    y <- sort(table(y), TRUE)

    ## stopword removal
    if (!is.null(stopwords)){
        y <- y[!names(y) %in% stopwords]
    }

    out <- data.frame(term = names(y), frequency = c(unlist(y, use.names=FALSE)),
        stringsAsFactors = FALSE, row.names=NULL)

    attributes(out)[["n.words"]] <- n.words

    out
}