purge hist

.gitattributes

@@ -0,0 +1,3 @@
+* text=auto
+
+*.rmd linguist-language=R

.gitignore

@@ -0,0 +1,8 @@
+# IDE/Tools
+.Rhistory
+.RData
+.bak
+.vscode
+doc
+Meta
+!inst/doc

DESCRIPTION

@@ -0,0 +1,36 @@
+Package: LinguisticMarkers
+Version: 0.1.0
+Date: 2021-04-29
+Title: Linguistic Markers 
+Description: Tools to calculate linguistic markers.
+Authors@R:
+    person(
+        given = "Mark",
+        family = "Newman",
+        role = c("aut", "cre"),
+        email = "[email protected]",
+        comment = c(ORCID = "0000-0001-6155-438X"))
+Maintainer: Mark Newman <[email protected]>
+Depends:
+    R (>= 4.0.0)
+Imports:
+    dplyr,
+    readr,
+    stringr,
+    tidyr,
+	tidytext
+Suggests:
+    gutenbergr,
+    kableExtra,
+    knitr,
+    rmarkdown,
+    testthat
+License: MIT + file LICENSE
+URL: https://github.com/markanewman/LinguisticMarkers
+BugReports: https://github.com/markanewman/LinguisticMarkers/issues
+RoxygenNote: 7.1.1
+Roxygen: list(markdown = TRUE)
+VignetteBuilder:
+    knitr
+Encoding: UTF-8
+LazyData: true

LICENSE

@@ -0,0 +1,21 @@
+MIT License
+
+Copyright (c) 2021 Mark Newman
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

NAMESPACE

@@ -0,0 +1,13 @@
+# Generated by roxygen2: do not edit by hand
+
+export(calculate_markers)
+importFrom(dplyr,group_by)
+importFrom(dplyr,select)
+importFrom(dplyr,summarise)
+importFrom(readr,read_csv)
+importFrom(stringr,fixed)
+importFrom(stringr,str_starts)
+importFrom(tidyr,pivot_wider)
+importFrom(tidytext,unnest_tokens)
+importFrom(utils,setTxtProgressBar)
+importFrom(utils,txtProgressBar)

NEWS.md

@@ -0,0 +1,5 @@
+# LinguisticMarkers 0.0.1
+
+## General
+
+* Initial Commit

R/calculate_markers.R

@@ -0,0 +1,29 @@
+#' @title calculate_markers
+#'
+#' @description Calculate the linguistic markers for a corpus
+#'
+#' @export
+#' 
+#' @param corpus A \code{\link[base]{data.frame}} containing the text to process.
+#' @param file The marker file. All marker files are external to the library for licensing purposes. See the vignettes for help.
+#' @param id The name of the PK column for the \code{corpus}.
+#' @param text The names of text column in \code{corpus} to process.
+#' @param show_progress Should a progress bar be shown?
+#' @return the annotated corpus
+#'
+#' @author Mark Newman, \email{[email protected]}
+#'
+calculate_markers <-
+  function(corpus, file, id = 'id', text = 'text', show_progress = interactive()) {
+    if(!is.data.frame(corpus)) { stop('corpus is not a data.frame') }
+    if(!(id %in% colnames(corpus))) { stop('id column not found in corpus') }
+    if(!(text %in% colnames(corpus))) { stop('text column not found in corpus') }
+
+    mdf <- load_markers(file)
+    tc <- tidy_corpus(corpus, id, text)
+    results <- match_markers(tc, mdf, show_progress)
+    results <- group_markers(results)
+    cn <- colnames(results)
+    cn[1] <- id
+    colnames(results) = cn
+    results }

R/group_markers.R

@@ -0,0 +1,26 @@
+#' @importFrom dplyr group_by summarise select
+group_markers <-
+  function(corpus) {
+    groups <- dplyr::group_by(corpus, id)
+    cats <- colnames(corpus)[-(1:5)]
+    counts <- 
+      dplyr::summarise(
+        groups,
+        WordCount = length(word),
+        WordCountUnique = length(unique(word)),
+        MarkerCount = sum(!is.na(Marker)),
+        MarkerCountUnique = length(unique(ID[!is.na(Marker)])),
+        .groups = 'keep')
+    for(cat in cats) {
+      g1 <- groups[,c('id', 'ID', cat)]
+      colnames(g1) <- c('id', 'ID','value')
+      c1 <- dplyr::summarise(
+        g1,
+        count = sum(value),
+        unique = length(unique(ID[value == 1])),
+        .groups = 'keep')
+      colnames(c1) <- c('id', cat, paste0(cat, 'Unique'))
+      counts <- merge(counts, c1)
+      rm(g1, c1)
+    }
+    counts }

R/load_markers.R

@@ -0,0 +1,32 @@
+#' @importFrom readr read_csv
+#' @importFrom tidyr pivot_wider
+load_markers <-
+  function(file) {
+    if(!file.exists(file)) { stop('QA: marker file does not exist') }
+
+    markers_raw <- readr::read_csv(file, col_types = 'iclc')
+    xcn <- c('ID', 'Marker', 'Fixed', 'Category')
+    acn = colnames(markers_raw)
+    if(!all(xcn == acn)) { stop('QA: marker file has bad columns') }
+
+    markers_raw$xx = 1L
+    markers <-
+      tidyr::pivot_wider(
+        markers_raw,
+        names_from = 'Category',
+        values_from = xx,
+        values_fill = 0L)
+    markers_raw$xx <- NULL
+
+    markers <- as.data.frame(markers)
+    tmp <- data.frame(
+      ID = max(markers$ID) + 1L,
+      Marker = as.character(NA),
+      Fixed = T)
+    cats <- unique(markers_raw$Category)
+    for(cat in cats) {
+      tmp[1, cat] <- 0L
+    }
+    markers <- rbind(markers, tmp)
+
+    markers}

R/match_markers.R

@@ -0,0 +1,38 @@
+#' @importFrom stringr str_starts fixed
+#' @importFrom utils setTxtProgressBar txtProgressBar
+match_markers <-
+  function(corpus, markers, show_progress) {
+    if(show_progress) { pb <- utils::txtProgressBar(max = nrow(markers), style = 3) }
+    t1 <- vector(mode = 'list', length = nrow(markers))
+    cnt_full <- nrow(corpus)
+    for(i in 1:nrow(markers)) {
+      if(show_progress) { utils::setTxtProgressBar(pb, i) }
+
+      if(!markers$Fixed[i]) {
+        indx <- stringr::str_starts(corpus$word, stringr::fixed(markers$Marker[i]))
+      } else if (is.na(markers$Marker[i])) {
+        indx <- rep(T, times = nrow(corpus))
+      } else {
+        indx <- corpus$word == markers$Marker[i]
+      }
+
+      cnt_proc <- nrow(corpus)
+      matches <- corpus[indx,]
+      corpus <- corpus[!indx,]
+      if(cnt_proc != nrow(matches) + nrow(corpus)) {
+        stop('QA: row counts out of sync mid processing')
+      }
+      matches <- cbind(matches, markers[rep(i, times = nrow(matches)),])
+      rownames(matches) <- NULL
+      t1[[i]] <- matches
+      rm(indx, matches, cnt_proc)
+    }
+    if(show_progress) { close(pb); rm(pb) }
+
+    corpus <- do.call(rbind, t1)
+
+    if(cnt_full != nrow(corpus)) {
+      stop('QA: row counts out of sync')
+    }
+    rm(i, t1, cnt_full)
+    corpus }

R/tidy_corpus.R

@@ -0,0 +1,8 @@
+#' @importFrom tidytext unnest_tokens
+tidy_corpus <-
+  function(corpus, id, text) {
+    corpus <- corpus[,c(id, text)]
+    colnames(corpus) <- c('id', 'text')
+    t1 <- tidytext::unnest_tokens(corpus, word, text)
+    rownames(t1) <- NULL
+    t1 }

README.md

@@ -0,0 +1,40 @@
+# Linguistic Markers
+
+![R](https://img.shields.io/badge/R-4.0.x-blue)
+![MIT license](https://img.shields.io/badge/License-MIT-green.svg)
+
+Linguistic markers are frequently used in a variety of acedemic papers.
+They tend to be lists of words that have known meening in _some_ context.
+**WARNING**: It is not a good idea to use markers out of context.
+Make sure you look at the origional paper to figure out if you are using a context that is reasonably close.
+
+This project aims to
+* Create a `R` package facilitating the calculation of markers
+* Create a series of vignettes describing the setup and use if the markers in `R`
+
+# Marker Lists
+
+Below is a list of all the markers I have found so far.
+When you use them, make sure to cite them.
+The top of the vignette will have the [BibTxT](http://www.bibtex.org/) citation.
+
+* [x] [Natural Emotion](https://doi.org/10.1038/s41467-020-18349-0)
+* [ ] [LIWC](https://liwc.wpengine.com/)
+* [ ] [Metadiscourse](https://doi.org/10.1016/j.jslw.2004.02.001)
+* [ ] [General Inquirer](https://doi.org/10.1145/1461551.1461583)
+
+# Installation
+
+* Current version (from CRAN)
+
+None yet.
+
+* Latest development version from GitHub
+
+```{r}
+pkgs <- installed.packages()
+if (!('devtools' %in% pkgs)) { install.packages('devtools') }
+if ('LinguisticMarkers' %in% pkgs) { remove.packages('LinguisticMarkers') }
+
+devtools::install_github(repo = 'markanewman/LinguisticMarkers', upgrade = 'never')
+```