---
title: "Workshop"
author: "Ben Schmidt"
date: "June 2018"
output: html_document
---

## This document

This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents.
For more details on using R Markdown see <http://rmarkdown.rstudio.com>.

When you click the **Knit** button a document will be generated that includes
both content as well as the output of any embedded R code chunks within the document.
You can customize this to produce a variety of formats.

It combines descriptive text with code. Code blocks are delimited: they begin with three backticks, and end with three backticks. You can run any code block by pressing the green arrow in the upper right corner; you can also run any individual line of code by putting the cursor on it and pressing "control-enter." Your command will be sent down to the screen below.

In this document, I'm going to write code that explores the "Rate My Professors" website (and other sources as described.) To work with a different document, you should change and edit the code. Don't worry about breaking things! If you screw it up badly, remember that you can just go back to the website to get a clean version.

### Code blocks.

So: here is the first code block. It installs packages (i.e., additional code libraries extending what R can do) that we'll need to work with. Run it, again, by pressing the green arrow; or by copying the lines directly down to the console window below.

```{r, eval=FALSE}
install.packages("ggplot2")
install.packages("tidyr")
install.packages("dplyr")
install.packages("devtools")
devtools::install_github("bmschmidt/wordVectors", ref="lite")
```

Once you've run this block on your computer once, it's safe to delete it.

Now that this software is installed, you need to *load* it so we can work with it. The next block 

```{r progress=FALSE}
library(wordVectors)
library(ggplot2)
library(tidyr)
library(dplyr)
model = read.vectors("RMP.bin")
```

# Looking at a model

You won't get much out of looking at a model, but you can do it!

To confirm you've loaded a model, look at it here:

```{r}
model
```

First, let's just look at a vector. Here's what the model for "science" looks like.

```{r}
model[["bossy"]]
```

# Similarity

The most basic thing that you can do in a vector model is to look at an individual vector. So we'll try it: but this is just a starting point.


Nearly as basic, but more useful, is finding words that are used in a similar *context*.

```{r}
model %>% closest_to("becaus", n=100)
```

So: let's try to look at some individual lists of words. So let's choose a seed word: I'm going to pick "unprofessional," because I know it's interesting in reviews.

```{r}
model %>% closest_to("unprofessional")
```


Let's go with the flow here. I think it's funny that students mis-spell "unproffesional," of all words: so let's look at more words like that.

```{r}
model %>% closest_to(~"unproffesional", n=50)
```


So now we can start to build up a more elaborate list. Note the funny little carat in front of the word "unproffesional"; this is a special trick that lets us do math inside an expression with words. So now we can start to define a new vector by adding together 

```{r}
model %>% closest_to(~ "unproffesional" + "incosiderate" + "degrating" + "disrespectfull" + 1/4*"beligerant", n=50)
```

## Plotting

Visualization is a good way to work through documents like this. We can start to see how these words relate to each other by looking at the best 2d projection of the high dimensional space using principal components analysis.

This requires a program that has two different parts, though we can still build it in one chain; first to build up a list of words; and then to
plot the portions of the full model that have those words.

The chart shows the neighborhood around the word "religion" spread out in space. Roughly, I'd say that the left-to-right dimension seems to correspond to 
religion-as-revealed-truth vs religion-as-culture; top-to-bottom is roughly, Christianity vs everything else.

```{r}
model %>% 
  closest_to(~"religion", n=50) %>% 
  pull(word) %>%
  as.list %>% 
  # The next line is tricky if you haven't seen it; basically, the dot lets you reverse the order of arguments in a chain.
  extract_vectors(model, .) %>%
  plot(method="pca")
```


We can use these plots to look at the local structure of any slice that we like.

```{r}
model %>% 
  closest_to(~"history", n=50) %>% 
  pull(word) %>%
  as.list %>% 
  # The next line is tricky if you haven't seen it; basically, the dot lets you reverse the order of arguments in a chain.
  extract_vectors(model, .) %>%
  plot(method="pca")
```


## Comparing similarities.

OK: here's where humanities and science vector models really start to differ. I think we want to compare two *different* models.

Let's first look at the words near to "history" into a 
```{r}
history_words = model %>% 
  closest_to(~"history", n=50) %>% 
  pull(word)

model %>% extract_vectors(as.list(history_words)) %>% 
  plot(method="pca")
```

How is the word history used differently in a different model?

We can load in a new model, and run *almost* the same code; note that here I change the word to 'model2'. 

I'm going to use "GloVe", which is a general-purpose model trained using a slightly different algorithm from word2vec. This block is exactly the same as the one above, except that it reads this other model instead.

```{r}
model2 = read.vectors("glove.bin")

history_words = model2 %>% 
  closest_to(~"history", n=50) %>% 
  pull(word) %>% 
  as.list

model2 %>% extract_vectors(history_words) %>% 
  plot(method="pca")
```

But remember those similarity scores? We can actually compare these two models directly. I have to pass a few more arguments to the functions here to get cleanly formatted outputs.

```{r}
all_history = model %>% closest_to("history", n=Inf)
all_history_model2 = model2 %>% closest_to(~ "history", n=Inf)

all_history %>% 
  inner_join(all_history_model2, by=c("word")) %>% # Merge them together
  arrange(-(similarity.x^2 + similarity.y^2)) %>% # sort by decreasing size of the combined similarities
  head(100) %>% # Take only the top 100 items
  filter(word!="history") %>%
  ggplot() + geom_text(aes(x=similarity.x,y=similarity.y,label=word))  

```


# Extracting Vectors

There's no working "king" - "man" + "woman" in most modern-day language corpora, but there are some equivalents.

```{r}

model %>% closest_to(~"dude" - "man" + "woman")
# Trigger warning?
```

```{r}
donald = read.vectors("donald.bin")
model %>% closest_to(~ - ("man" - "woman"), n = 25)
```


# The good stuff: semantic similarity.

OK, so here's a script that's worth pocketing and running again and again.
It first builds up a list of words that are close to two semantic vectors
(good-bad and man-woman)

```{r}
model %>% 
  closest_to(list(~"he" - "she", ~"good" - "bad"), n = 500, merge.method = "magnitude") %>%
  spread(comparison,similarity) %>% 
  ggplot() + 
  geom_text() + 
  aes(x=`he - she`, y=`good - bad`, label=word)


```


This particular one is a little weird, since it's a lot of words. We can filter those out, although this is the kind of custom code that might not be useful for you!

```{r}

model %>% 
  closest_to(list(~"he" - "she", ~ "good" - "bad"), n = 500, merge.method = "magnitude") %>%
  spread(comparison,similarity) %>% 
  filter(!grepl("[A-Z]", word)) %>%
  ggplot() +
  geom_text() +
  aes(x=`he - she`, y=`good - bad`, label=word)


```


# Rejection: eliminating dimensions

We can use a process called vector rejection to squash out the vector space so it loses its knowledge of vector spaces. This lets us compare between two different versions of the same vectorspace to see how different words shift.

```{r}
genderless = model %>% reject(~"male" - "female")
```


# Alignment

I don't plan on getting to this! But it's interesting to think about, and can be fun to run on your own. It assumes you've doownloaded more than one of the Hansard chunks.

```{r}
# install.packages("abind")

# Read in Hansard topics with 19th century dates.

models = read_group(list.files(".",pattern = "^19[0-9]+"))

models[[3]] %>% nearest_to("navy")

aligned = align_models(models,shared_vocab_only = TRUE)


stanford_plot = function(model_set, word, n=20, transform_type = c("mds","pca")) {
  # This is a crazy peron amount of code!
  library(ggplot2)
  if (!requireNamespace("ggplot2")) {stop("You need ggplot for this function: run 'install.packages(ggplot2)'")}
  model_set = Filter(function(model) {length(intersect(word,rownames(model))) > 0}, model_set)
  small_list = lapply(model_set, function(model) {
    model %>% closest_to(model[[word]],n)
  }) %>% bind_rows %>% select(word) %>% unlist %>% unique

  just_this_word = lapply(model_set, function(mat) {
    mat[rownames(mat) %in% word,,drop=F]
  })
  for (i in 1:length(just_this_word)) {
    this_name = names(model_set)[i]
    if (is.null(this_name)) {this_name = i}
    rownames(just_this_word[[i]]) = paste(rownames(just_this_word[[i]]),this_name,sep="\n")
  }

  just_this_word = just_this_word %>% do.call(rbind,.) %>% new("VectorSpaceModel",.)


  minify = function(matrix,lookup) matrix[match(lookup,rownames(matrix)),]

  reduced = lapply(model_set,function(mat) {
    mat %>% minify(small_list[!small_list %in% word])
  }) %>% abind::abind(along=3) %>%
    apply(c(1,2),function(point) {mean(point,na.rm=T)}) %>% as.matrix
  rownames(reduced) = small_list[!small_list %in% word]

  if (transform_type=="mds") {
    both = rbind(just_this_word,reduced)
    neighbors = cmdscale(cosineDist(both,both))
    newness = tibble::as_data_frame(neighbors) %>%
      dplyr::transmute(MDS1=V1,MDS2=V2,word=rownames(neighbors),type=ifelse(grepl("\\n",word),"reference","neighbor"))
  } else if (transform_type=="pca") {
    rot = prcomp(reduced)$rotation[,1:2]
    neighbors = reduced %*% rot %>% as.data.frame
    reference = just_this_word %*% rot %>% as.data.frame
    neighbors$type = "neighbor"
    reference$type = "reference"
    newness = rbind(neighbors,reference)
    newness$word = rownames(newness)
  }

  newness$base_word = gsub("\\n.*","",newness$word)
  aesthetic = aes(x=PC1,y=PC2,label=word)
  if (transform_type=="mds") {
      aesthetic = aes(x=MDS1,y=MDS2,label=word)
  }
  
  ggplot2::ggplot(newness) + aesthetic +
    geom_text(data = newness[newness$type=="neighbor",],alpha=.3) +
    geom_text(data = newness[newness$type=="reference",], color="black") +
    geom_path(data = newness[newness$type=="reference",],
              aes(group=base_word),col='red',arrow = grid::arrow())
}


stanford_plot(aligned, word = c("navy"), 15, transform_type = "pca")

```
