##############################################################################
# Knihovny a nastaveni pracovniho adresare
##############################################################################

setwd("C:/Users/Bootcha/Desktop/skola/TM/2019/2")

# install.packages("tidyverse")
library(tidyverse)

# install.packages("tidytext")
library(tidytext)

# install.packages("gutenbergr")
library(gutenbergr)

# install.packages("ggplot2")
library(ggplot2)

# install.packages("wordcloud")
library(wordcloud)

# install.packages("reshape2")
library(reshape2)

# install.packages("igraph")
library(igraph)

# install.packages("ggraph")
library(ggraph)

# install.packages("grid")

# install.packages("widyr")
library(widyr)

# install.packages("tm")
library(tm)

# install.packages("topicmodels")
library(topicmodels)

##############################################################################
# Zaklady - ulozeni textu v R
###############################################################################

# string

text <- c("I don’t like sand. It’s coarse	and rough and irritating, and it gets everywhere.",
          "No. I am your father.",
          "Use the force, Luke.",
          "These are not the droids your looking for.",
          "Do. Or do not. There is no try.")

# tidytext - jeden token (slovo, n-gram, veta, odstavec) na radek

text_df <- data_frame(line = 1:5, text = text)

text_tt <- text_df %>%
  unnest_tokens(word, text)

text_tt

# document-term matrix

text_dtm <- text_tt %>%
  group_by(line) %>%
  count(word) %>%
  cast_dtm(line, word, n)

text_dtm

inspect(text_dtm)

Terms(text_dtm)

#tidy(text_dtm)

# n-gramy
text_bigram <- text_df %>%
  unnest_tokens(bigram, text, token = "ngrams", n = 2)

text_bigram

###############################################################################
# Sentiment
###############################################################################

# slovniky se sentimentem
sentiments

# AFINN - Finn Arup Nielsen (http://www2.imm.dtu.dk/pubdb/views/publication_details.php?id=6010)
# bing - Bing Liu and collaborators (https://www.cs.uic.edu/~liub/FBS/sentiment-analysis.html)
# nrc - Saif Mohammad and Peter Turney (http://saifmohammad.com/WebPages/NRC-Emotion-Lexicon.htm)

get_sentiments("afinn") # -5..5 (vetsi cislo -> pozitivnejsi slovo)

get_sentiments("bin") # kategorie: positive/negative

get_sentiments("bin") %>%
  count(sentiment)

get_sentiments("nrc") # kategorie: positive, negative, anger, anticipation, disgust, fear, joy, sadness, surprise, trust

get_sentiments("nrc") %>%
  count(sentiment)

text_tt %>%
  inner_join(get_sentiments("afinn"))

text_tt %>%
  inner_join(get_sentiments("bin"))

text_tt %>%
  inner_join(get_sentiments("nrc"))

# slovnik s tzv. stop words
stop_words

text_tt %>%
  anti_join(stop_words)

# vlastni stop words
custom_stop_words <- bind_rows(data_frame(word = c("sand"), lexicon = c("custom")),
                               stop_words)

text_tt %>%
  anti_join(custom_stop_words)

###############################################################################
# Knihy - Jules Verne
###############################################################################

# 103 - Around the World in Eighty Days
# 3748 - A Journey into the Interior of the Earth
# 164 - Twenty Thousand Leagues under the Sea

verne_src <- gutenberg_download(c(103, 3748, 164))

verne <- verne_src %>%
  mutate(book = case_when(gutenberg_id == 103 ~ "Around the World in Eighty Days",
                          gutenberg_id == 3748 ~ "A Journey into the Interior of the Earth",
                          gutenberg_id == 164 ~ "Twenty Thousand Leagues under the Sea"
  )) %>%
  group_by(book) %>%
  mutate(linenumber = row_number(),
         chapter = cumsum(str_detect(text, regex("^chapter [\\divxlc]", ignore_case = TRUE)))) %>%
  ungroup()

# pred odstranenim stop-words
tidy_verne <- verne %>%
  unnest_tokens(word, text) %>%
  mutate(word = str_extract(word, "[a-z0-9']+"))

tidy_verne %>%
  count(word, sort=TRUE)

# po odstraneni stop-words
tidy_verne <- tidy_verne %>%
  anti_join(stop_words)

tidy_verne %>%
  count(word, sort=TRUE)

tidy_verne %>%
  count(word, sort = TRUE) %>%
  filter(n > 200) %>%
  mutate(word = reorder(word, n)) %>%
  ggplot(aes(word, n)) +
  geom_col() +
  xlab(NULL) +
  coord_flip()

#################################################
# sentiment
#################################################

tidy_verne %>%
  inner_join(get_sentiments("bing")) %>%
  count(word, sentiment, sort = TRUE) %>%
  group_by(sentiment) %>%
  top_n(10) %>%
  ungroup() %>%
  mutate(word = reorder(word, n)) %>%
  ggplot(aes(word, n, fill = sentiment)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~sentiment, scales = "free_y") +
  labs(y = "Contribution to sentiment",
       x = NULL) +
  coord_flip()

verne_sentiment <- tidy_verne %>%
  inner_join(get_sentiments("bing")) %>%
  count(book, index = linenumber %/% 80, sentiment) %>%
  spread(sentiment, n, fill = 0) %>%
  mutate(sentiment = positive - negative)

ggplot(verne_sentiment, aes(index, sentiment, fill = book)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~book, ncol = 1, scales = "free_x")

# porovnani sentimentu
eighty <- tidy_verne %>%
  filter(book == "Around the World in Eighty Days") %>%
  mutate(index = linenumber %/% 80)

eighty_afinn <- eighty %>%
  inner_join(get_sentiments("afinn")) %>%
  group_by(index) %>%
  summarise(sentiment = sum(score)) %>%
  mutate(method = "afinn")

eighty_bing_and_nrc <- bind_rows(eighty %>%
                                   inner_join(get_sentiments("bing")) %>%
                                   mutate(method = "bing"),
                                 eighty %>%
                                   inner_join(get_sentiments("nrc")) %>%
                                   filter(sentiment %in% c("positive", "negative")) %>%
                                   mutate(method = "nrc")) %>%
  count(method, index, sentiment) %>%
  spread(sentiment, n, fill = 0) %>%
  mutate(sentiment = positive - negative)

bind_rows(eighty_afinn,
          eighty_bing_and_nrc) %>%
  ggplot(aes(index, sentiment, fill = method)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~method, ncol = 1, scales = "free_y")

# word clouds
tidy_verne %>%
  count(word) %>%
  with(wordcloud(word, n, max.words = 100))

tidy_verne %>%
  inner_join(get_sentiments("bing")) %>%
  count(word, sentiment, sort = TRUE) %>%
  acast(word ~ sentiment, value.var = "n", fill = 0) %>%
  comparison.cloud(colors = c("firebrick1", "darkolivegreen3"),
                   max.words = 50)

#################################################
# term frequency
#################################################

verne_words <- verne %>%
  unnest_tokens(word, text) %>%
  mutate(word = str_extract(word, "[a-z0-9']+")) %>%
  count(book, word, sort = TRUE)

total_words <- verne_words %>%
  group_by(book) %>%
  summarize(total = sum(n))

verne_words <- left_join(verne_words, total_words)

verne_words

ggplot(verne_words, aes(n/total, fill = book)) +
  geom_histogram(show.legend = FALSE) +
  xlim(NA, 0.001) +
  facet_wrap(~book, ncol = 1, scales = "free_y")

# tf-idf
verne_words <- verne_words %>%
  bind_tf_idf(word, book, n)

verne_words

verne_words %>%
  arrange(desc(tf_idf))

verne_words %>%
  arrange(desc(tf_idf)) %>%
  mutate(word = factor(word, levels = rev(unique(word)))) %>%
  group_by(book) %>%
  top_n(15) %>%
  ungroup %>%
  ggplot(aes(word, tf_idf, fill = book)) +
  geom_col(show.legend = FALSE) +
  labs(x = NULL, y = "tf-idf") +
  facet_wrap(~book, ncol = 3, scales = "free") +
  coord_flip()

# zipf's law
freq_by_rank <- verne_words %>%
  group_by(book) %>%
  mutate(rank = row_number(),
         `term frequency` = n/total)

freq_by_rank

freq_by_rank %>%
  ggplot(aes(rank, `term frequency`, color = book)) +
  geom_line(size = 1.1, alpha = 0.8, show.legend = FALSE) +
  # geom_abline(intercept = -0.57, slope = -1.14, color = "gray50", linetype = 2) +
  scale_x_log10() +
  scale_y_log10()

# lm(log10(`term frequency`) ~ log10(rank), data = freq_by_rank)

#################################################
# n-gramy
#################################################

verne_bigrams <- verne %>%
  unnest_tokens(word, text, token = "ngrams", n = 2) %>%
  mutate(word = str_extract(word, "[a-z0-9']+ [a-z0-9']+"))  %>%
  na.omit()

verne_bigrams

verne_bigrams %>%
  count(word, sort = TRUE)

# odstraneni stop-words
bigrams_separated <- verne_bigrams %>%
  separate(word, c("word1", "word2"), sep = " ")

bigrams_filtered <- bigrams_separated %>%
  filter(!word1 %in% stop_words$word) %>%
  filter(!word2 %in% stop_words$word)

bigram_counts <- bigrams_filtered %>%
  count(word1, word2, sort = TRUE)

bigram_counts

bigrams_united <- bigrams_filtered %>%
  unite(bigram, word1, word2, sep = " ")

bigrams_united

# tf-idf
bigram_tf_idf <- bigrams_united %>%
  count(book, bigram) %>%
  bind_tf_idf(bigram, book, n) %>%
  arrange(desc(tf_idf))

bigram_tf_idf

bigram_tf_idf %>%
  arrange(desc(tf_idf)) %>%
  group_by(book) %>%
  top_n(12, tf_idf) %>%
  ungroup() %>%
  mutate(bigram = reorder(bigram, tf_idf)) %>%
  ggplot(aes(bigram, tf_idf, fill = book)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~ book, ncol = 1, scales = "free") +
  coord_flip() +
  labs(y = "tf-idf of bigram to novel",
       x = "")

# sentiment
bigrams_separated %>%
  filter(word1 == "not") %>%
  count(word1, word2, sort = TRUE)

not_words <- bigrams_separated %>%
  filter(word1 == "not") %>%
  inner_join(get_sentiments("afinn"), by = c(word2 = "word")) %>%
  count(word2, score, sort = TRUE) %>%
  ungroup()

not_words

not_words %>%
  mutate(contribution = n * score) %>%
  arrange(desc(abs(contribution))) %>%
  head(20) %>%
  mutate(word2 = reorder(word2, contribution)) %>%
  ggplot(aes(word2, n * score, fill = n * score > 0)) +
  geom_col(show.legend = FALSE) +
  xlab("Words preceded by \"not\"") +
  ylab("Sentiment score * number of occurrences") +
  coord_flip()

negation_words <- c("not", "no", "never", "without")

negated_words <- bigrams_separated %>%
  filter(word1 %in% negation_words) %>%
  inner_join(get_sentiments("afinn"), by = c(word2 = "word")) %>%
  count(word1, word2, score, sort = TRUE) %>%
  ungroup()

negated_words %>%
  mutate(contribution = n * score,
         word2 = reorder(paste(word2, word1, sep = "__"), contribution)) %>%
  group_by(word1) %>%
  top_n(12, abs(contribution)) %>%
  ggplot(aes(word2, contribution, fill = n * score > 0)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~ word1, scales = "free") +
  scale_x_discrete(labels = function(x) gsub("__.+$", "", x)) +
  xlab("Words preceded by negation term") +
  ylab("Sentiment score * # of occurrences") +
  coord_flip()

# networks
bigram_counts

bigram_graph <- bigram_counts %>%
  filter(n > 10) %>%
  graph_from_data_frame()

bigram_graph

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

ggraph(bigram_graph, 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()

# korelace
verne_section_words <- verne %>%
  filter(book == "Around the World in Eighty Days") %>%
  mutate(section = row_number() %/% 10) %>%
  filter(section > 0) %>%
  unnest_tokens(word, text) %>%
  filter(!word %in% stop_words$word)

verne_section_words

word_pairs <- verne_section_words %>%
  pairwise_count(word, section, sort = TRUE)

word_pairs

word_pairs %>%
  filter(item1 == "fogg")

word_cors <- verne_section_words %>%
  group_by(word) %>%
  filter(n() >= 20) %>%
  pairwise_cor(word, section, sort = TRUE)

word_cors

word_cors %>%
  filter(correlation > .25) %>%
  graph_from_data_frame() %>%
  ggraph(layout = "fr") +
  geom_edge_link(aes(edge_alpha = correlation), show.legend = FALSE) +
  geom_node_point(color = "lightblue", size = 5) +
  geom_node_text(aes(label = name), repel = TRUE) +
  theme_void()

#################################################
# topic models
#################################################

by_chapter <- verne %>%
  group_by(book) %>%
  mutate(chapter = cumsum(str_detect(text, regex("^chapter ", ignore_case = TRUE)))) %>%
  ungroup() %>%
  filter(chapter > 0) %>%
  unite(document, book, chapter)

by_chapter_word <- by_chapter %>%
  unnest_tokens(word, text)

word_counts <- by_chapter_word %>%
  anti_join(stop_words) %>%
  count(document, word, sort = TRUE) %>%
  ungroup()

word_counts

chapters_dtm <- word_counts %>%
  cast_dtm(document, word, n)

chapters_dtm

chapters_lda <- LDA(chapters_dtm, k = 3, control = list(seed = 1234))
chapters_lda

chapter_topics <- tidy(chapters_lda, matrix = "beta")
chapter_topics

top_terms <- chapter_topics %>%
  group_by(topic) %>%
  top_n(5, beta) %>%
  ungroup() %>%
  arrange(topic, -beta)

top_terms

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

chapters_gamma <- tidy(chapters_lda, matrix = "gamma")
chapters_gamma

chapters_gamma <- chapters_gamma %>%
  separate(document, c("title", "chapter"), sep = "_", convert = TRUE)

chapters_gamma

chapters_gamma %>%
  mutate(title = reorder(title, gamma * topic)) %>%
  ggplot(aes(factor(topic), gamma)) +
  geom_boxplot() +
  facet_wrap(~ title)

###############################################################################
# Topic models
###############################################################################

data("AssociatedPress")
AssociatedPress

# Latent Dirichlet allocation
ap_lda <- LDA(AssociatedPress, k = 2, control = list(seed = 1234))

# word-topic
ap_topics <- tidy(ap_lda, matrix = "beta")
ap_topics

ap_top_terms <- ap_topics %>%
  group_by(topic) %>%
  top_n(10, beta) %>%
  ungroup() %>%
  arrange(topic, -beta)

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

# document-topic
ap_documents <- tidy(ap_lda, matrix = "gamma")
ap_documents
