Final_Project_text_mining.Rmd

---
title: "National Research University Higher School of Economics"
subtitle: "Master's Programme 'Data Analytics and Social Statistics (DASS)'"
author: "Text Mining in R"
date: "Final Project"
output:
  pdf_document:
    latex_engine: xelatex
header-includes:
- \usepackage{fancyhdr}
- \usepackage{enumitem}
- \usepackage{lipsum}
- \usepackage{answers}
- \pagestyle{fancy}
- \fancyhf{}
- \setlength\headheight{35pt}
- \fancypagestyle{plain}{\pagestyle{fancy}}
- \usepackage{placeins}

pdf_document:
          includes:
            in_header: docstyle.sty
toc: true
toc_depth: 4
---
\vspace{12pt}
\begin{center}
\textit{The project was prepared by \textbf{Timofei Korovin}, DASS student}
\end{center}
\vspace{12pt}
\vspace{12pt}
\vspace{12pt}


\vspace*{\fill}
\begin{center}
\emph{Creation date:} 10/04/2025

\emph{The last change date:} 23/04/2025
\end{center}
---

```{r setup, include=FALSE}
options(repos = c(CRAN = "https://cran.rstudio.com"))
knitr::opts_chunk$set(echo = TRUE)
knitr::knit_hooks$set(plot = function (x, options) {
  float_correct <- function(f, y, opts)  {
    if (is.null(opts$regfloat) || opts$regfloat==FALSE)
      paste0(f(y, opts), "\n\n\\FloatBarrier\n")
    else
      f(y, opts)
  }
  if (!is.null(options$out.width) || !is.null(options$out.height) ||
      !is.null(options$out.extra) || options$fig.align != "default" ||
      !is.null(options$fig.subcap)) {
    if (is.null(options$fig.scap))
      options$fig.scap = NA
    return(float_correct(knitr:::hook_plot_tex, x, options))
  }
  return(float_correct(knitr:::hook_plot_md_base, x, options))
})
```

\newpage

\section{0.Introduction}

In this project, we will use text mining techniques to analyze books and their contents from gutenberg library. We will start with a exploratory analysis, then apply supervised machine learning techniques and finish with unsupervised machine learning techniques. 

\section{1. Data exploration}

```{r, include=FALSE}
install.packages("tidyverse")
install.packages("tidytext")
install.packages("SnowballC")
install.packages("udpipe")
install.packages("gutenbergr")
install.packages("stm")
install.packages("devtools")
install.packages("quanteda")

```

```{r, message=FALSE, warning=FALSE}
library(tidyverse)
library(tidytext)
library(SnowballC)
library(udpipe)
library(gutenbergr)
library(stm)
library(preText)
library(quanteda)
```

\subsection{Data extraction}

```{r, warning = FALSE, message = FALSE}
books_metadata <- gutenberg_metadata

filtered_books <- books_metadata %>%
  filter(
    language == "en",
    str_detect(author, "Baum, L. Frank"),
    str_detect(title, "[Oo]z"),
    has_text == TRUE
  ) %>% 
  distinct() %>%
  pull(gutenberg_id) %>%
  gutenberg_download(mirror = "http://mirror.csclub.uwaterloo.ca/gutenberg/", meta_fields = "title")

filtered_books <- filtered_books %>% 
  filter(text != "")
```

\subsection{Top 7 common and distinctive words}

```{r, warning = FALSE, message = FALSE}
preproccessed_books <- filtered_books %>%
  unnest_tokens(word, text) %>%
  anti_join(stop_words) %>%
  filter(str_detect(word,"\\d+", negate = T)) %>%
  mutate(word = wordStem(word))

preproccessed_books_tfidf <- preproccessed_books %>%
  count(title, word) %>%
  bind_tf_idf(word, title, n)

top_comanddist_words <- preproccessed_books_tfidf %>%
  group_by(title) %>% 
  filter(title != "The Tin Woodman of Oz\nA Faithful Story of the Astonishing Adventure Undertaken\nby the Tin Woodman, assisted by Woot the Wanderer, the\nScarecrow of Oz, and Polychrome, the Rainbow's Daughter") %>%
  slice_max(tf_idf, n = 7) %>% 
  ggplot() +
  geom_col(aes(
    x = word,
    y = tf_idf,
    fill = word 
  )) +
  coord_flip() +
  facet_wrap(vars(title), scales = "free") +
  theme(legend.position = "none") 

top_comanddist_words
```

On the resulted graph top 7 most common and disctinctive words are displayed for each book. 

\subsection{Top 7 common and distinctive bigrams}

```{r, warning = FALSE, message = FALSE}
bigrams <- filtered_books %>%
  unnest_tokens(bigram, text, token = "ngrams", n = 2)

bigrams_separated <- bigrams %>%
  separate(bigram, into = c("word1", "word2"), sep = " ")

preprosecced_bigrams <- bigrams_separated %>%
  filter(
    !str_detect(word1, "\\d"),
    !str_detect(word2, "\\d"),
    !word1 %in% stop_words$word,
    !word2 %in% stop_words$word
  ) %>%
  unite(bigram, word1, word2, sep = " ")

bigrams_tfidf <- preprosecced_bigrams %>%
  count(title, bigram) %>%
  bind_tf_idf(bigram, title, n)

top_common_distinctive_bigrams <- bigrams_tfidf %>%
  group_by(title) %>%
  filter(title != "The Tin Woodman of Oz\nA Faithful Story of the Astonishing Adventure Undertaken\nby the Tin Woodman, assisted by Woot the Wanderer, the\nScarecrow of Oz, and Polychrome, the Rainbow's Daughter") %>%
  slice_max(tf_idf, n = 7, with_ties = FALSE) %>%
  ggplot() +
  geom_col(aes(
    x = bigram,
    y = tf_idf,
    fill = bigram 
  )) + 
  coord_flip() +
  facet_wrap(vars(title), scales = "free") +
  theme(legend.position = "none")
  
  

top_common_distinctive_bigrams
```

On the resulted graph top 7 most common and disctinctive bigrams are displayed for each book. 

\subsection{Top 7 nouns and verbs}

To accomplish this task, we should lemmatize our data so we will be able to sort out our lemmas depending on which part of speech it belongs to. 

```{r, warning = FALSE, message = FALSE}
dl <- udpipe_download_model("english")
english_model <- udpipe_load_model(dl$file_model)


text1 <- filtered_books %>%
  mutate(text = iconv(text, from = "", to = "UTF-8")) %>%
  filter(!is.na(text), text != "") %>%
  select(doc_id = title, text)


annotated <- udpipe_annotate(english_model, x = text1$text, doc_id = text1$doc_id, parallel.cores = 12L)

annotated_df <- as.data.frame(annotated)

```

We have used udpipe model to annotate our texts. After that we saved it in a data frame format for further exploration. 
The next step is to preproccess our lemmas. After that, we will filter nouns and verbs only to calculate tf/idf for each lemma. Finally, we will visualize top nouns and top verbs. 

```{r, warning = FALSE}
annnotated_preprocessed_lemmas <- annotated_df %>% 
  filter(!upos %in% c("PUNCT", "SYM", "X", "NUM")) %>% 
  mutate(lemma = str_to_lower(lemma)) %>% 
  anti_join(stop_words, by = c("lemma" = "word"))

nouns_only <- annnotated_preprocessed_lemmas %>% 
  filter(upos == "NOUN")
  
nouns_only_tfidf <- nouns_only %>% 
  count(doc_id, lemma) %>% 
  bind_tf_idf(lemma, doc_id, n)

top7_nouns_all_books <- nouns_only_tfidf %>%
  group_by(doc_id) %>%
  slice_max(tf_idf, n = 7) %>%
  ungroup() %>% 
  ggplot() +
  geom_col(aes(
    x = lemma,
    y = tf_idf,
    fill = lemma 
  )) + 
  coord_flip() +
  facet_wrap(vars(doc_id), scales = "free") +
  theme(legend.position = "none")

top7_nouns_all_books

verbs_only <- annnotated_preprocessed_lemmas %>% 
  filter(upos == "VERB")

verbs_only_tfidf <- verbs_only %>% 
  count(doc_id, lemma) %>% 
  bind_tf_idf(lemma, doc_id, n)

top7_verbs_all_books <- verbs_only_tfidf %>%
  group_by(doc_id) %>%
  filter(doc_id != "The Tin Woodman of Oz\nA Faithful Story of the Astonishing Adventure Undertaken\nby the Tin Woodman, assisted by Woot the Wanderer, the\nScarecrow of Oz, and Polychrome, the Rainbow's Daughter") %>%
  slice_max(tf_idf, n = 7, with_ties = FALSE) %>%
  ungroup() %>% 
  ggplot() +
  geom_col(aes(
    x = lemma,
    y = tf_idf,
    fill = lemma 
  )) + 
  coord_flip() +
  facet_wrap(vars(doc_id), scales = "free") +
  theme(legend.position = "none")

top7_verbs_all_books

```

Above are two visualizations, the first for the top 7 nouns, the second for the top 7 verbs for each book.

\subsection{Top 20 nouns for 1 book with WordCloud visualization}

The algorithm is pretty much the same. We filter nouns for one book only, than calculate tf/idf for each lemma within corpus. After that we detect 20 nouns with the highest tf-value and plot it using world cloud package. 

```{r, echo=FALSE}
install.packages("wordcloud")
library(wordcloud)
library(RColorBrewer)
```


```{r,warning = FALSE}
book_name <- unique(nouns_only$doc_id)[1]

book_data <- nouns_only_tfidf %>%
  filter(doc_id == book_name)

top20_nouns <- book_data %>%
  group_by(doc_id) %>%
  slice_max(tf_idf, n = 20) %>%
  ungroup()
  
wordcloud(
  words = top20_nouns$lemma,   
  freq = top20_nouns$tf,   
  min.freq = min(top20_nouns$tf),  
  scale = c(4, 0.7),           
  random.order = FALSE,        
  colors = brewer.pal(8, "Spectral") 
)

```
\section{2. Supervised ML}

In this section we will build Logistic Regression model, as well as Random Forest model to predict whether the exact line belongs to the 'The Wonderful Wizard of Oz' or 'The Marvelous Land of Oz' book. We will evaluate each model and conclude if these algorithms can help us to accomplish this task. 

\subsection{Data extraction}

```{r, include=FALSE}
install.packages(c("tidyverse", "tidytext", "udpipe", "gutenbergr", "rsample", "glmnet", "yardstick"))
library(tidyverse)
library(tidytext)
library(udpipe)
library(gutenbergr)
library(rsample)
library(glmnet)
library(yardstick)
```

First we extract books from Gutenberg library using the following criteria: the title is whether 'The Wonderful Wizard of Oz' or 'The Marvelous Land of Oz; the book is written in English; the context of the books is available in the library. 

```{r, warning = FALSE, message=FALSE}
oz <- gutenberg_metadata %>% 
  filter(
    title %in% c('The Wonderful Wizard of Oz', 'The Marvelous Land of Oz'),
    has_text,
    language == "en") %>% 
  pull(gutenberg_id) %>% 
  gutenberg_download(meta_fields = "title", mirror = "http://mirror.csclub.uwaterloo.ca/gutenberg/")

```

After that we filter empty strings from the resulted dataset. 

```{r}
oz <- oz %>% 
  filter(text != "")
```

\subsection{Target variable creation}

With the help of mutate() function we will create a new variable, which will show from which book the line is. 

```{r}
oz <- oz %>% 
  mutate(
    is_wizard = case_when(
      title == 'The Wonderful Wizard of Oz' ~ 1L,
      title == 'The Marvelous Land of Oz' ~ 0L
    ),
    line_id = row_number()
  )
```

We have created new variable. Now we can look at its distribution.

```{r}
oz %>% 
  count(is_wizard)
```

We have pretty balanced data and almost equal number of cases for both classes. Thus, we should not encounter any problems with imbalanced classes during model building. 

\subsection{Lemmatezaiton}

Now, we will lemmatize our data. 

```{r, message=FALSE, warning=FALSE}
dl <- udpipe_download_model("english")
english_model <- udpipe_load_model(dl$file_model)

text <- oz %>% 
  select(doc_id = line_id, text)

oz_preprocessed <- udpipe(text, english_model, parallel.cores = 12L)

```

\subsection{Preprocessing our data}

After lemmatization it is possible to filter out unnecessary part of speech, remove stop words and convert the whole text to lowercase. 

```{r, message=FALSE, warning=FALSE}
oz_preprocessed <- oz_preprocessed %>% 
  mutate(lemma = str_to_lower(lemma)) %>% 
  anti_join(stop_words, by = c("lemma" = "word")) %>% 
  filter(!upos %in% c("PUNCT", "SYM", "X", "NUM"))
```

\subsection{Splitting data on train and test samples}

Before training our model, we should split our data on two samples: train and test. 
```{r}
set.seed(1234L)
oz_split <- initial_split(oz)
oz_training <- training(oz_split)
oz_testing <- testing(oz_split)
```

\subsection{Creation of feature matricies for both samples}

```{r}
sparse_train_data <- oz_preprocessed %>% 
  mutate(doc_id = as.integer(doc_id)) %>% 
  anti_join(oz_testing, by = c("doc_id" = "line_id")) %>% 
  count(doc_id, lemma) %>% 
  cast_sparse(doc_id, lemma, n)

lemma_vocab <- colnames(sparse_train_data)

sparse_test_data <- oz_preprocessed %>% 
  mutate(doc_id = as.integer(doc_id)) %>% 
  anti_join(oz_training, by = c("doc_id" = "line_id")) %>% 
  filter(lemma %in% lemma_vocab) %>%
  count(doc_id, lemma) %>%
  complete(doc_id, lemma = lemma_vocab, fill = list(n = 0)) %>%
  cast_sparse(doc_id, lemma, n)


sparse_test_data <- sparse_test_data[, lemma_vocab]

```

\subsection{Pulling out target variable for train sample}

```{r}
y <- oz_training %>%
  filter(line_id %in% rownames(sparse_train_data)) %>% 
  pull(is_wizard)

```

\subsection{Regularized Logistic Regression model}

```{r}
library(broom)
library(tidytext)

model <- cv.glmnet(sparse_train_data, y, family = "binomial")


coefficients <- model$glmnet.fit %>% 
  tidy() %>%
  filter(lambda == model$lambda.1se)  

coefficients

```

For some reason, our model does not display coefficients for our lemma's. Probably, the problem is with model itself. So we cannot complete this task, since we our model simply doesn't work. Let's try to use Random Forest to accomplish the same task. 

\subsection{Random Forest model}

```{r}
install.packages("ranger")
library(ranger)
set.seed(1234)

rf_model <- ranger(
  dependent.variable.name = NULL,
  x = as.data.frame(as.matrix(sparse_train_data)),  
  y = as.factor(y), 
  num.trees = 1000,
  probability = TRUE
)

predictions1 <- predict(rf_model, data = as.data.frame(as.matrix(sparse_test_data)))

predicted_class1 <- ifelse(predictions1$predictions[,2] > 0.5, 1, 0)

y_test1 <- oz_testing %>%
  filter(line_id %in% rownames(sparse_test_data)) %>%
  pull(is_wizard)


```
\subsection{Predictions on the test sample and Model Evaluaiton}

```{r}
results <- tibble(
  truth = as.factor(y_test1),
  prediction = as.factor(predicted_class1)
)

conf_mat(results, truth = truth, estimate = prediction)

metrics <- bind_rows(
  yardstick::accuracy(results, truth = truth, estimate = prediction),
  yardstick::recall(results, truth = truth, estimate = prediction),
  yardstick::precision(results, truth = truth, estimate = prediction),
  yardstick::f_meas(results, truth = truth, estimate = prediction))

metrics
```

The random forest model demonstrated moderate performance on the test data. 

1)The overall accuracy reached 50.1%, indicating that the model correctly classified about half of the observations, which almost equal to the random prediction rate. 

2) Of all positive class observations, the model correctly finds 61% of them (Recall).

3) Of all the observations that the model classified as positive, only 53.8% were actually correct (we also saw that in confusion matrix, where significant amount false positives were present). 

4) F1 score (57%), which represents  mean between precision and recall, indicates that the balance between recall and precision is not that high (recall was slightly higher). 

5) Overall, the model is not capable of detecting classes well.

Now lets move to the next model - multiclass model - where we will try to develop a model that will predict whether the line is from one of three books of Oz. 

\subsection{Multiclass supervised model}

\subsection{Data extraction}

For this particular task we need to extract three books: "The Wonderful Wizard of Oz", "The Marvelous Land of Oz", "The Magic of Oz". Other filter remains the same. 
Also we will create a target variable right away. 

```{r}
library(gutenbergr)
library(dplyr)
library(tidytext)
library(stringr)
library(Matrix)
library(glmnet)
library(rsample)
library(yardstick)
library(tibble)

oz_3_books <- gutenberg_metadata %>% 
  filter(
    title %in% c("The Wonderful Wizard of Oz", "The Marvelous Land of Oz", "The Magic of Oz"),
    has_text,
    language == "en"
  ) %>%
  pull(gutenberg_id) %>%
  gutenberg_download(meta_fields = "title", mirror = "http://mirror.csclub.uwaterloo.ca/gutenberg/") %>%
  filter(text != "") %>%
  mutate(name = case_when(
    title == "The Wonderful Wizard of Oz" ~ 0L,
    title == "The Marvelous Land of Oz" ~ 1L,
    title == "The Magic of Oz" ~ 2L
  )) %>%
  mutate(line_id = row_number())

```
Also lets study the distribution of the target variable 

```{r}
table(oz_3_books$name)
```
As it can be seen, we have more data for the 2nd class (i.e., The Magic of Oz). However, the difference between classes is not that crucial. We suggest that balance in our target variable has been maintained.

\subsection{Data preprocessing}

Now we can preprocess our data as well as prepare our data for matrix of features creation. 

```{r}
oz_3_books_preprocessed <- oz_3_books %>%
  unnest_tokens(word, text) %>%
  anti_join(stop_words, by = "word") %>%
  filter(!str_detect(word, "\\d+"))

unique_lines <- oz_3_books_preprocessed %>%
  distinct(line_id)

oz_3_books_filtered <- oz_3_books %>%
  semi_join(unique_lines, by = "line_id") %>%
  mutate(row_id = row_number())

sparse_data <- oz_3_books_preprocessed %>%
  semi_join(unique_lines, by = "line_id") %>%
  mutate(row_id = match(line_id, oz_3_books_filtered$line_id)) %>%
  count(row_id, word) %>%
  cast_sparse(row_id, word, n)

```

\subsection{Model building}

Next steps are data split, extraction of the target variable for both samples and features matrices creation. 

```{r}

set.seed(123)
split <- initial_split(oz_3_books_filtered)
train_data <- training(split)
test_data <- testing(split)

sparse_train <- sparse_data[train_data$row_id, ]
sparse_test <- sparse_data[test_data$row_id, ]

y_train <- train_data$name
y_test <- test_data$name

```

Now we can build our multi-class model 

```{r}
multi_model <- cv.glmnet(x = sparse_train,
                          y = y_train,
                          family = "multinomial",
                          maxit = 1000000)

predictions <- predict(
  multi_model,
  newx = sparse_test,
  s = "lambda.min",
  type = "class"
)

predictions_test <- as.vector(predictions)

results2 <- tibble(
  truth = factor(y_test),
  prediction = factor(predictions_test))

conf_mat(results2, truth = truth, estimate = prediction)

metrics2 <- bind_rows(
  yardstick::accuracy(results2, truth = truth, estimate = prediction),
  yardstick::recall(results2, truth = truth, estimate = prediction),
  yardstick::precision(results2, truth = truth, estimate = prediction),
  yardstick::f_meas(results2, truth = truth, estimate = prediction))

metrics2
```
Confusion matrix shows us that overall our model preforms quite well when recognizing our classes. The best prediction results demonstrate 2nd class(probably since we had more data for this particular class). 

However, lets also study base metrics:

1) About 77.7% of all model predictions were indeed correct (could be better though, however we think that this happens since we have some sort of imbalance in the target variable)

2) The small gap between precision and recall (precision is higher) indicates that the model tends to be more conservative in its predictions.

3) Overall, the model demonstrates quite good performance in terms of all major metrics. 


\section{3. Unsupervised Topic Modeling}

In this part of our project we will extract books from Gutenberg Library that have word "detective" in their titles and build a topic model using their text. 

```{r}
library(tidyverse)
library(tidytext)
library(SnowballC)
library(udpipe)
library(gutenbergr)
library(stm)
library(preText)
library(quanteda)
```

\subsection{Data extraction} 

Firstly, we extract our books and its texts. 

```{r, warning=FALSE, message=FALSE}
detective_download <- gutenberg_metadata %>% 
  filter(
    str_detect(title, "[Dd]etective"),
    language == "en",
    str_detect(rights, "Public domain in the USA"),
    has_text
  ) %>% 
  pull(gutenberg_id) %>% 
  gutenberg_download(mirror = "http://mirror.csclub.uwaterloo.ca/gutenberg/", meta_fields = "title")

detective_download <- detective_download %>% 
  left_join(
    gutenberg_metadata %>% 
      select(gutenberg_id, title)
  )
```

\subsection{Combining lines into a single document}

For our further analysis it is necessary to combine all the lines for each document into one single vector.

```{r}
detective_strings <- map_chr(unique(detective_download$gutenberg_id), ~detective_download %>% filter(gutenberg_id == .x) %>% pull(text) %>% paste(collapse = " ")
                                 )
```

Also lets see how many documents we have after the previous step.

```{r}
length(detective_strings)
```
\subsection{Preprocessing of our documents}

```{r}

detective_factorial <- factorial_preprocessing(
  detective_strings,
  use_ngrams = T,
  infrequent_term_threshold = 0.2,
  verbose = F,
  parallel = T,
  cores = 12L
)

```
\subsection{Estimating effects of preprocessing steps}

Now we can use Pretext function to estimate the effect of each preprocessing step.

```{r}
detective_pretext <- preText(
 detective_factorial,
  distance_method = "cosine",
  verbose = F,
  parallel = T,
  cores = 12L
)

```
Let's visualize the results.

```{r}
preText_score_plot(detective_pretext)
```

According to the score plot the best combination of preprocessing steps would be N-L-S, in other words, Numbers removal, Lowercasing and Stemming. However, we can see that the difference between this combination and other is not that significant. Lets also study conditional effects of our steps using regression coefficients plot. 

```{r}
regression_coefficient_plot(detective_pretext)
```

According to the regression coefficient plot all of the steps have coefficients close to zero, which means they don't significantly change the mean Pretext Score. 

\subsection{Final Preprocessing}

We suggest that we will hold all basic steps of preprocessing. 

```{r}
detective_preprocessed <- detective_download %>% 
  filter(text != "") %>% 
  unnest_tokens(word, text) %>% 
  anti_join(stop_words) %>% 
  filter(str_detect(word, "\\d+", negate = T)) %>% 
  mutate(word = wordStem(word)) %>% 
  count(gutenberg_id, word) %>% 
  cast_dfm(gutenberg_id, word, n) %>% 
  dfm_trim(min_termfreq = 7)
```

\subsection{Model Building}

Firstly, we will build a model that contains 5 topics and study its results. 

```{r}
detective_5_topics <- stm(detective_preprocessed, K = 5, verbose = F)

```

\subsection{5 topics model interpretation}

```{r}
labelTopics(detective_5_topics)
```

We suggest that the first topic is most likely related to classic detectives, since there are words like juve, fandor, cleek, fantoma (characters of the classic detectives). Second one most likely related to the Adventure detectives/children detectives. The third topiс is more of a family drama, which also a classic detective story, with investigations taking place within the family.  The fourth topic, from our point of view, is more related to crime chronicles. The fifth topic is probably related to satiric detective (since character names such as Philo Gubb are present in the results). 

Overall, the results of the topic modeling show that the model successfully identified the main genres of detective stories, which can be considered a strong outcome.

Lets also look at the share of each topic within the whole corpus.

```{r}
plot(detective_5_topics, type = "summary")
```

As it can be seen on the graph, first topic has the biggest share within corpus and fourth - the smallest. 


\subsection{Training models with 10, 30 and 50 topics}

```{r}
detective_10_topics <- stm(detective_preprocessed, K = 10, verbose = F)
detective_30_topics <- stm(detective_preprocessed, K = 30, verbose = F)
detective_50_topics <- stm(detective_preprocessed, K = 50, verbose = F)
```

Now we can compare models that we have built 

\subsection{Model Comparasion}

```{r}
heldout <- make.heldout(detective_preprocessed)

tibble(
  K = c(5, 10, 30, 50),
  semantic_coherence = c(
    mean(semanticCoherence(detective_5_topics, detective_preprocessed)),
    mean(semanticCoherence(detective_10_topics, detective_preprocessed)),
    mean(semanticCoherence(detective_30_topics, detective_preprocessed)),
    mean(semanticCoherence(detective_50_topics, detective_preprocessed))
  ),
  exclusivity = c(
    mean(exclusivity(detective_5_topics)),
    mean(exclusivity(detective_10_topics)),
    mean(exclusivity(detective_30_topics)),
    mean(exclusivity(detective_50_topics))
  ),
  heldout_likelihood = c(
    eval.heldout(detective_5_topics, heldout$missing)[[1]],
    eval.heldout(detective_10_topics, heldout$missing)[[1]],
    eval.heldout(detective_30_topics, heldout$missing)[[1]],
    eval.heldout(detective_50_topics, heldout$missing)[[1]]
  ),
  residuals = c(
    checkResiduals(detective_5_topics, detective_preprocessed)[[1]],
    checkResiduals(detective_10_topics, detective_preprocessed)[[1]],
    checkResiduals(detective_30_topics, detective_preprocessed)[[1]],
    checkResiduals(detective_50_topics, detective_preprocessed)[[1]]
  )
)
```

The 5-topic model shows the best semantic coherence and relatively good exclusivity and residuals. The 50-topic model shows better rates of likelihood and exclusivity, but loses in semantic coherence (topics become less interpretable).The 10-topic model is a compromise, but semantic coherence is also somewhat low. 

The model with five topics, from our point of view, is the most balanced option: it has the best semantic coherence of topics with acceptable values of other metrics. However, if we aim at max exclusivity and likelihood, the model with 30 and 50 topics can be considered. But in this case the topics will be less meaningful as well as less interpretable. And from our point of view, if our task was to detect different genres of detectives, the semantic coherence metric would be the key indicator. 

\subsection{Lee's and Mimno's algorithm to choose number of topics}

Here we will use Lee and Mimno algorithm, that automatically decide how many topic the model should use. 

```{r, include=FALSE}
install.packages("geometry")
install.packages("Rtsne")
install.packages("rsvd")
```


```{r, warning=FALSE, message=FALSE}
library(geometry)
library(Rtsne)
library(rsvd)

detective_lee_mimno <- stm(detective_preprocessed, K = 0, verbose = F)
labelTopics(detective_lee_mimno)
```

The algorithm detected 77 topics. Lets also visualize the share of each topic within the whole corpus.  

```{r}
plot(detective_lee_mimno, type = "summary")
```

Visualization is heavily overloaded, so we will try to output the result in the form of a table. 

```{r}
topic_proportions <- detective_lee_mimno %>%
  tidy(matrix = "gamma") %>%
  group_by(topic) %>%
  summarise(mean_gamma = mean(gamma)) %>%
  arrange(desc(mean_gamma))

topic_proportions
```

Lets choose topic by random and interpret it.

We have chosen Topic 63. From our point of view, it reflects non-classical detective stories with a strong emphasis on the sleuth characters and social conflicts (money, status, morality). To conclude, our interpretation is pretty approximate. As we said above, the more topics there are, the less semantic coherence there is. 

\section{Conclusion}

To summarize, our project included three parts: a small exploratory analysis where we found the most frequent words, bigrams, nouns and adjectives; then we used supervised techniques to guess from which specific book a particular line is from; then we used unsupervised techniques for topic modeling tasks. Overall, we found it to be a rewarding experience and an interesting assignment, despite some failures in constructing logistic regression for binary classification, otherwise we completed all the tasks.