EDA.Rmd

---
title: "TBS-ATI Exploratory Work"
output: html_notebook
---

```{r, message = FALSE}
library(tidytext)
library(tidyverse)
library(igraph)
library(ggraph)
library(widyr)
library(tm)
library(wordcloud)
library(topicmodels)
library(textmineR)
library(ggwordcloud)
# library(udpipe) # Not used

options(dplyr.summarise.inform=F) 
```


# Data Audit

```{r}
clean_ati <- function(dfr) {
  dfr %>%
    mutate(owner = sub("\\|.*", "", owner_org_title)) %>%
    mutate(disposition = sub("/.*", "", disposition) %>% trimws() %>% tolower()) %>%
    mutate(
      month = factor(month, levels = 1:12, labels = month.abb)
      ,year = factor(year)
      ,umd_number = factor(umd_number)
      ,owner = sub("Department of ", "", owner)
      ,owner = sub(" Canada", "", owner)
      ,owner = trimws(owner)
    ) %>%
    filter(year != "2020" | month != "Oct") %>%
    select(-summary_fr)
}

ati = read_csv("ati.csv") %>% clean_ati()
# ati_nil = read_csv("ati-nil.csv")

head(ati)
```

Top 9 departments
```{r}
ownersTop9 = ati %>% group_by(owner) %>% count() %>% ungroup() %>% top_n(9, n) %>% pull(owner)
```



```{r}
ati %>% summarize_all(function(x) length(unique(x)))
```


```{r}
ati %>% count(year)
```

```{r}
ati %>% count(month)
```



```{r}
with(ati, table(year, month))
```


```{r}
ati %>% count(disposition) %>% arrange(desc(n))
```


```{r}
summary(ati$pages)
```

```{r}
ati %>% filter(pages > 1000) %>% select(request_number, pages) %>% arrange(desc(pages))
```

## Thesaurus
```{r}
thes = read_csv("CST20200630.csv", col_names = c("word", "verb", "category"))
thes %>% group_by(verb) %>% count() %>% arrange(desc(n))
```



# NLP

## Custom stop words
```{r}
newWords = read_csv("stop_words_custom.csv") %>% pull(word)
stopWordList = data.frame(word = newWords, lexicon = "CUSTOM") %>%
      bind_rows(stop_words)
```


## Words as tokens

```{r}
count_unigrams <- function(dataset, stopWords) {
  dataset %>%
    mutate(ID = row_number()) %>% 
    select(ID, owner, summary_en) %>%
    unnest_tokens(word, summary_en) %>%
    anti_join(stopWords, by = "word")
}

ati_words = ati %>% 
  filter(owner %in% ownersTop9) %>%
  count_unigrams(stopWordList) %>%
  group_by(owner) %>% 
  count(word)
```



```{r}
ati_words %>% 
  arrange(desc(n)) %>%
  mutate(word = factor(word, levels = rev(unique(word)))) %>% 
  top_n(10, n) %>%
  ggplot(aes(x = word, y = n)) + 
  geom_col(show.legend = FALSE) +
  coord_flip() + 
  facet_wrap(~owner, scales = "free_y")
```
Lots of years in there, but I think we should leave them. Probably relevant. 

The single numbers (ie. 1), however, should be removed. 

### All departments, top words
```{r}
ati %>% 
  count_unigrams(stopWordList) %>%
  count(word) %>%
  arrange(desc(n)) %>%
  write_csv("word-list-desc.csv")
```


### Total words used within a department
```{r}
owner_words = ati_words %>% summarize(total = sum(n))
```


Distribution of words used by frequency
```{r}
ati_words %>% 
  left_join(owner_words, by = "owner") %>%
  ggplot(aes(n/total, fill = owner)) +
  geom_histogram(show.legend = F, bins = 30) +
  xlim(NA, 0.002) +
  facet_wrap(~owner, scales = "free_y")
```
Looks like typical frequency distribution following Zipf's Law

### TF-IDF

Bind scores to DF
```{r}
(ati_tf = ati_words %>% bind_tf_idf(word, owner, n))
```

View highest TF-IDF words
```{r}
ati_tf %>% arrange(desc(tf_idf))
```

Distribution of words by TF-IDF score
```{r}
ati_tf %>%
  ungroup() %>%
  arrange(desc(tf_idf)) %>%
  mutate(word = factor(word, levels = rev(unique(word)))) %>% 
  group_by(owner) %>%
  top_n(10, tf_idf) %>% 
  ggplot(aes(x=word, y=tf_idf, fill = owner)) +
  geom_col(show.legend = FALSE) +
  labs(x = NULL, y = "tf-idf") +
  facet_wrap(~owner, scales = "free") +
  coord_flip()
```


## Bigrams
```{r}
count_bigrams <- function(dataset, stopWords) {
  dataset %>%
    mutate(ID = row_number()) %>% 
    select(ID, owner, summary_en) %>%
    unnest_tokens(bigram, summary_en, token = "ngrams", n = 2) %>%
    separate(bigram, c("word1", "word2"), sep = " ") %>%
    filter(!word1 %in% stopWords$word,
           !word2 %in% stopWords$word)
  # %>%
  #   group_by(owner) %>% 
  #   count(word1, word2, sort = TRUE)
}
```



```{r}
ati_bigrams = ati %>% 
  filter(owner %in% ownersTop9) %>%
  count_bigrams(stop_words) %>%
  group_by(owner) %>%
  count(word1, word2, sort = TRUE)

ati_bi_united = ati_bigrams %>% unite(bigram, word1, word2, sep = " ")
ati_bi_united
```


### TF-IDF scores
```{r}
ati_bi_tf = ati_bi_united %>%
  count(owner, bigram, wt = n) %>%
  bind_tf_idf(bigram, owner, n) %>%
  arrange(desc(tf_idf))

ati_bi_tf
```


```{r}
visualize_tfidf <- function(tfidf, topN = 10) {
  names(tfidf)[2] = "word"
  
  tfidf %>%
    ungroup() %>%
    arrange(desc(tf_idf)) %>%
    mutate(word = factor(word, levels = rev(unique(word)))) %>% 
    group_by(owner) %>%
    top_n(topN, tf_idf) %>% 
    ggplot(aes(x=word, y=tf_idf, fill = owner)) +
    geom_col(show.legend = FALSE) +
    labs(x = NULL, y = "tf-idf") +
    facet_wrap(~owner, scales = "free") +
    coord_flip()
}

ati_bi_tf %>%
  visualize_tfidf()
```

Graph of bigrams
```{r}
set.seed(2020)

a <- grid::arrow(type = "closed", length = unit(.15, "inches"))

ati_bigrams %>%
  filter(owner == "Justice") %>%
  filter(n > 10) %>%
  graph_from_data_frame() %>% 
  ggraph(layout = "fr") +
  geom_edge_link(aes(edge_alpha = n), show.legend = FALSE,
                 arrow = a, end_cap = circle(.07, 'inches')) +
  geom_node_point(color = "lightblue", size = 5) +
  geom_node_text(aes(label = name), vjust = 1, hjust = 1) +
  theme_void()
```


```{r}
ati_bi_united %>%
  filter(owner == "Justice")
```


### Correlations (not necessarily together)
```{r}
ati_tidy = ati %>% 
  filter(owner %in% ownersTop9) %>%
  count_unigrams(stopWordList)

ati_tidy
```

Most common word pairings
```{r}
word_pairs <- ati_tidy %>%
  pairwise_count(word, ID, sort = TRUE)

word_pairs
```


Normalized by commonality of words themselves
```{r}
minN = 20
thisOwner = "Justice"

topWords = ati_words %>% filter(owner == thisOwner) %>% filter(n >= minN) %>% pull(word)

word_pairs_cor <- ati_tidy %>%
  filter(owner == thisOwner) %>%
  filter(word %in% topWords) %>%
  pairwise_cor(word, ID, sort = TRUE)

word_pairs_cor
```


## Wordcloud by Department
```{r}
ati_wc = ati_words %>% 
  filter(owner == thisOwner) %>%
  filter(n >= minN)

wordcloud(ati_wc$word, ati_wc$n, max.words = 100, random.order=FALSE, rot.per=0.35, colors=brewer.pal(8, "Dark2"))
```

# Topic Modelling

Justice only
```{r}
ati_sub_topics = ati %>% filter(owner == thisOwner)
```


## Using {topicmodels}

### DTM creation - Justice only
```{r}
ati_dtm_uni = ati_sub_topics %>%
  count_unigrams(stopWordList) %>%
  group_by(ID, owner) %>% 
  count(word) %>%
  cast_dtm(ID, word, n)

ati_dtm_bi = ati_sub_topics %>% 
  count_bigrams(stopWordList) %>%
  unite(bigram, word1, word2, sep = " ") %>%
  group_by(ID, owner) %>% 
  count(bigram) %>% 
  cast_dtm(ID, bigram, n)
```


```{r}
ati_lda <- LDA(ati_dtm_uni, k = 9, control = list(seed = 1234))
```

Explore LDA model
```{r}
ati_topics <- tidy(ati_lda, matrix = "beta")
ati_topics
```

Viz
```{r}
ati_top_terms <- ati_topics %>%
  group_by(topic) %>%
  top_n(10, beta) %>%
  ungroup() %>%
  arrange(topic, -beta)

ati_top_terms %>%
  mutate(term = reorder_within(term, beta, topic)) %>%
  ggplot(aes(term, beta, fill = factor(topic))) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~ topic, scales = "free") +
  coord_flip() +
  scale_x_reordered()
```

## Extract themes from topics using textmineR

### Unigrams and Bigrams

Create the DTM
```{r}
ati_dtm = CreateDtm(doc_vec = ati_sub_topics$summary_en, # character vector of documents
                    doc_names = ati_sub_topics$request_number, # document names, optional
                    ngram_window = c(1, 2), # minimum and maximum n-gram length
                    stopword_vec = c(stopWordList$word, 
                                     stopwords::stopwords(source = "smart")), # this is the default value
                    lower = TRUE, # lowercase - this is the default value
                    remove_punctuation = TRUE, # punctuation - this is the default
                    remove_numbers = TRUE # numbers - this is the default
                    )
```


Fit LDA model and summarize topics
```{r}
# Dtm2Tcm(ati_dtm)
ati_topics2 <- ati_dtm %>% 
  FitLdaModel(k = 9, iterations = 20, burnin = 5) %>%
  SummarizeTopics()
```


Viz
```{r}
words = ati_topics2$top_terms_phi[1] %>% gsub("_", ",", .) %>% strsplit(",") %>% unlist() %>% trimws()
wordcloud(words, random.order=FALSE, rot.per=0.35, colors=brewer.pal(8, "Dark2"))
```
Using ggplot
```{r}
ati_topics2 %>%
  mutate(word = gsub("_", ",", top_terms_phi)) %>%
  separate(word, into = letters, sep = ",", remove = T) %>%
  select(-c(topic, top_terms_gamma, top_terms_phi, prevalence, coherence)) %>%
  pivot_longer(cols = a:z, names_to = "junk", values_to = "word") %>%
  select(-junk) %>%
  filter(!is.na(word)) %>%
  group_by(label_1, word) %>%
  count() %>%
  ggplot(aes(
    label = word, size = n,
    color = factor(sample.int(10, nrow(.), replace = TRUE))
    )) +
  geom_text_wordcloud_area() +
  scale_size_area(max_size = 20) +
  # theme_minimal() +
  facet_wrap(~label_1)
```


## Extract themes from topics using udpipe

Set a beta cutoff and find terms above it
```{r}
# minBeta = 0.01
# top_terms_grouped = ati_topics %>% 
#   filter(beta > minBeta) %>%
#   group_by(topic) %>%
#   arrange(topic)
```


Keep only summaries that contain those terms
```{r}
# IDs2keep = ati %>% 
#   filter(owner %in% ownersTop9) %>%
#   count_unigrams(stopWordList) %>%
#   filter(word %in% top_terms_grouped$term) %>%
#   pull(ID) %>%
#   unique()
# %>% nest()
```


Create nested df with a model for each topic
```{r}
# en <- udpipe::udpipe_download_model("english")
# model <- udpipe_load_model(en)
# 
# udp_model <- function(dfr) {
#   udpipe::udpipe_annotate(model, as.character(dfr$term)) %>%
#     as.data.frame()
# }
# doc_dfs <- top_terms_grouped$data %>%
#   map(udp_model)

```


Testing
```{r}
# dd = udpipe::udpipe_annotate(model, ati$summary_en[1:100]) %>% as.data.frame()
# topics = keywords_rake(x = dd, term = "lemma", group = "doc_id", relevant = dd$upos %in% c("NOUN", "ADJ"))
# topics

# doc_df = doc_dfs[[1]]

```