#### Applications of word embeddings

Beyond this type of exploratory analysis, word embeddings can be very useful in analyses of large-scale text corpora in two different ways: to expand existing dictionaries and as a way to build features for a supervised learning classifier. 

The code below shows how to expand a dictionary of uncivil words. By looking for other words with semantic similarity to each of these terms, we can identify words that we may not have thought of in the first place, either because they're slang, new words or just misspellings of existing words.

Here we will use a different set of pre-trained word embeddings, which were computed on a large corpus of public Facebook posts on the pages of US Members of Congress that we collected from the Graph API.

```{r}
#library(devtools)
#install_github("mukul13/rword2vec")
library(rword2vec)
library(lsa)
```

```{r}
distance(file_name = "../data/FBvec.bin",
		search_word = "liberal",
		num = 10)
distance(file_name = "../data/FBvec.bin",
		search_word = "crooked",
		num = 10)
distance(file_name = "../data/FBvec.bin",
		search_word = "libtard",
		num = 10)
distance(file_name = "../data/FBvec.bin",
		search_word = "douchebag",
		num = 10)
distance(file_name = "../data/FBvec.bin",
		search_word = "idiot",
		num = 10)
```

We can also take the embeddings themselves as features at the word level and then aggregate to a document level as an alternative or complement to bag-of-word approaches.

Let's see how this would work by running a supervised learning classifier that can help us predict incivility in a corpus of public Facebook comments.

```{r}
library(quanteda)
fb <- read.csv("../data/incivility.csv", stringsAsFactors = FALSE)
fb %>% 
  corpus(text_field="comment_message") %>% 
  tokens(remove_url=TRUE) %>% 
  dfm() %>% 
  dfm_wordstem() %>% 
  dfm_remove(stopwords("english")) %>% 
  dfm_trim(min_docfreq = 2, verbose=TRUE) -> fbdfm
```

To get a sense of how easy or difficult this task is, first let's run a bag-of-words lasso classifier:

```{r}
set.seed(777)
training <- sample(1:nrow(fb), floor(.80 * nrow(fb)))
test <- (1:nrow(fb))[1:nrow(fb) %in% training == FALSE]

```

```{r}
library(glmnet)
require(doMC)
registerDoMC(cores=3)
lasso <- cv.glmnet(fbdfm[training,], fb$attacks[training], 
	family="binomial", alpha=1, nfolds=5, parallel=TRUE, intercept=TRUE)

## function to compute performance metrics
performance <- function(ypred, y){
	tab <- table(ypred, y)
	accuracy <- (tab[1,1]+tab[2,2])/sum(tab)
	precision <- (tab[2,2])/(tab[2,1]+tab[2,2])
	recall <- tab[2,2]/(tab[1,2]+tab[2,2])
	message("Accuracy = ", round(accuracy, 2), "\n",
	        "Precision = ", round(precision, 2), "\n",
	        "Recall = ", round(recall, 2))
}
# computing predicted values
preds <- predict(lasso, fbdfm[test,], type="class")
# confusion matrix
table(preds, fb$attacks[test])
# performance metrics
performance(preds, fb$attacks[test])
performance(preds==0, fb$attacks[test]==0)

```

Now let's try adding word embeddings as features. To do so, first we will convert the word embeddings to a data frame, and then we will match the features from each document with their corresponding embeddings.

```{r}
bin_to_txt("../data/FBvec.bin", "../data/FBvector.txt")

# extracting word embeddings for words in corpus
w2v <- readr::read_delim("../data/FBvector.txt", 
                  skip=1, delim=" ", quote="",
                  col_names=c("word", paste0("V", 1:100)))
# keeping only embeddings for words in corpus
fb %>% 
  corpus(text_field="comment_message") %>% 
  tokens(remove_url=TRUE, remove_punct=TRUE) %>% 
  dfm() %>% 
  dfm_remove(stopwords("english")) -> fbdfm
w2v <- w2v[w2v$word %in% featnames(fbdfm),]

# let's do one comment as an example
fb$comment_message[3] # raw text
# bag-of-words DFM
vec <- as.numeric(fbdfm[3,])
# which words are not 0s?
(doc_words <- featnames(fbdfm)[vec>0])
# let's extract the embeddings for those words
embed_vec <- w2v[w2v$word %in% doc_words, 2:101]
# a glimpse into the data
embed_vec[1:3, 1:10]
# and now we aggregate to the comment level
embed <- colMeans(embed_vec)
# instead of feature counts, now this is how we represent the comment:
round(embed,2)

## now the same thing but for all comments:
# creating new feature matrix for embeddings
embed <- matrix(NA, nrow=ndoc(fbdfm), ncol=100)
for (i in 1:ndoc(fbdfm)){
  if (i %% 100 == 0) message(i, '/', ndoc(fbdfm))
  # extract word counts
  vec <- as.numeric(fbdfm[i,])
  # keep words with counts of 1 or more
  doc_words <- featnames(fbdfm)[vec>0]
  # extract embeddings for those words
  embed_vec <- w2v[w2v$word %in% doc_words, 2:101]
  # aggregate from word- to document-level embeddings by taking AVG
  embed[i,] <- colMeans(embed_vec, na.rm=TRUE)
  # if no words in embeddings, simply set to 0
  if (nrow(embed_vec)==0) embed[i,] <- 0
}

```

Let's now try to replicate the lasso classifier we estimated earlier with this new feature set.

```{r}
library(glmnet)
require(doMC)
registerDoMC(cores=3)
lasso <- cv.glmnet(embed[training,], fb$attacks[training], 
	family="binomial", alpha=1, nfolds=5, parallel=TRUE, intercept=TRUE)

# computing predicted values
preds <- predict(lasso, embed[test,], type="class")
# confusion matrix
table(preds, fb$attacks[test])
# performance metrics
performance(preds, fb$attacks[test])
performance(preds==0, fb$attacks[test]==0)
```

We generally find quite good performance with a much smaller set of features. Of course, one downside of this approach is that it's very hard to interpret the coefficients we get from the lasso regression.

```{r}
best.lambda <- which(lasso$lambda==lasso$lambda.1se)
beta <- lasso$glmnet.fit$beta[,best.lambda]
head(beta)
 
## identifying predictive features
df <- data.frame(coef = as.numeric(beta),
				word = names(beta), stringsAsFactors=F)

df <- df[order(df$coef),]
head(df[,c("coef", "word")], n=30)
df <- df[order(df$coef, decreasing=TRUE),]
head(df[,c("coef", "word")], n=30)
```

