language style matching

language_style_matching.R

## http://faculty.wcas.northwestern.edu/eli-finkel/documents/InPress_IrelandSlatcherEastwickScissorsFinkelPennebaker_PSci.pdf

if (!require("pacman")) install.packages("pacman"); library(pacman)
p_load_current_gh('trinker/textcorpus')
p_load(tidyverse)

language_style_matching <- function(x, grouping.var, personal.pronouns, ...){

  
    m <- termco::token_count(x, grouping.var, list(pp=unique(tolower(function.words))), keep.punctuation = FALSE, group.names = 'group')
    m[['rate']] <- m[['pp']]/m[['n.tokens']]

    out <- outer(m[['rate']], m[['rate']], lms)

    dimnames(out) <- list(m[['group']], m[['group']])
    class(out) <- c('symmat', 'matrix')
    out
}

print.symmat <- function(x, digits = 2, ...){
    class(x) <- 'matrix'
    print(round(x, digits))
}

personal.pronouns <- c("I", "me", "we", "us", "you", "you", "she", "he", "her", "him", 
"it", "they", "them")


v_outer_fun <- function(x, FUN, ...){

    nc <- ncol(x)
    mat <- matrix(rep(NA, nc^2), nc)
    for (i in 1:nc) {
        for (j in 1:nc) {
            mat[i, j] <- FUN(.subset2(x, i), .subset2(x, j))
        }
    }
    dimnames(mat) <- list(colnames(x), colnames(x))
    class(mat) <- c("v_outer", class(mat))
    mat
}


lms <- function(x, y) 1 - (abs(x -y)/(x + y))




presidential_debates$corpus %>%
    select(-order) %>%
    distinct() %>%
    {split(., .$id)} %>%
    lapply(function(x) language_style_matching(x$text, x$author))