Diagnoza, Wataha czy Belfer?

rm(list = ls())

library(tidyverse)
library(lubridate)
library(tidytext)
library(forcats)

# to niżej na potrzeby ładniejszych tabelek :)
library(knitr)
library(kableExtra)
options(knitr.table.format = "html")

fb_posts <- readRDS("fb_posts.RDS")
fb_comments <- readRDS("fb_comments.RDS")

fb_data <- left_join(fb_comments,
                     fb_posts %>% select(id, created_time),
                     by = c("post_id" = "id")) %>%
   rename(post_created_time = created_time) %>%
   mutate(comment_created_time = ymd_hms(comment_created_time) %>% with_tz(tzone = "Europe/Warsaw")) %>%
   mutate(post_created_time = ymd_hms(post_created_time) %>% with_tz(tzone = "Europe/Warsaw"))

fb_posts %>%
   filter(year(created_time) == 2017) %>%
   mutate(day = date(created_time)) %>%
   count(from_name, day) %>%
   ggplot() +
   geom_point(aes(day, n, color = from_name), alpha = 0.5, show.legend = FALSE) +
   geom_smooth(aes(day, n, color = from_name), se = FALSE) +
   labs(title = "Liczba postów publikowanych na fanpage seriali,\ndzień po dniu",
        x = "Data", y = "Liczba postów", color = "") +
   theme(legend.position = "bottom")

fb_posts %>%
   filter(year(created_time) == 2017) %>%
   by(.$from_name,
      function(x) {
         x %>%
            count(created_weekday, created_hour) %>%
            ggplot() +
            geom_tile(aes(created_weekday, created_hour, fill = n), color = "gray50") +
            scale_y_continuous(breaks = seq(0, 23, 3), trans = "reverse") +
            scale_fill_distiller(palette = "RdYlGn") +
            labs(title = paste(unique(x$from_name), "- kiedy publikowane są posty?"),
                 x = "Dzień tygodnia", y = "Godzina", fill = "Liczba postów") +
            theme(legend.position = "bottom")
      }
   )

fb_posts %>%
   filter(year(created_time) == 2017, from_name=="Wataha", created_weekday == "Pn") %>%
   select(created_time, type, message) %>%
   arrange(created_time) %>%
   kable() %>%
   kable_styling(bootstrap_options =c("striped", "hover", "condensed"), full_width = F)

fb_data %>%
   filter(year(post_created_time) == 2017) %>%
   mutate(day = date(comment_created_time)) %>%
   count(post_from_name, day) %>%
   ggplot() +
   geom_point(aes(day, n, color = post_from_name), alpha = 0.5, show.legend = FALSE) +
   geom_smooth(aes(day, n, color = post_from_name), se = FALSE) +
   scale_y_log10() +
   labs(title = "Liczba komentarzy publikowanych na fanpage seriali,\ndzień po dniu",
        x = "Data", y = "Liczba komentarzy (skala logarytmiczna)", color = "") +
   theme(legend.position = "bottom")

fb_posts %>%
   filter(year(created_time) == 2017, from_name=="Wataha", month(created_time) >= 4, month(created_time) <= 7) %>%
   select(created_time, message) %>%
   arrange(created_time) %>%
   kable() %>%
   kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F)

fb_posts %>%
   filter(year(created_time) == 2017, month(created_time) >= 9) %>%
   mutate(day = date(created_time)) %>%
   group_by(from_name, day) %>%
   summarise(p = sum(comments_count)/n()) %>%
   ungroup() %>%
   ggplot() +
   geom_point(aes(day, p, color = from_name), alpha = 0.5, show.legend = FALSE) +
   geom_smooth(aes(day, p, color = from_name), se = FALSE) +
   labs(title = "Liczba komentarzy/post publikowanych na fanpage seriali,\ndzień po dniu",
        x = "Data", y = "Liczba komentarzy/post", color = "") +
   theme(legend.position = "bottom")

fb_posts %>%
   filter(year(created_time) == 2017, month(created_time) >= 11, from_name == "Wataha") %>%
   mutate(day = date(created_time)) %>%
   group_by(day) %>%
   mutate(p = sum(comments_count)/n()) %>%
   ungroup() %>% 
   select(day, message, p) %>% 
   arrange(day) %>%
   # kolorowanie kolumny p
   mutate(p = cell_spec(p, "html", color = ifelse(p > 200, "red", "black"))) %>%
   kable() %>%
   kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F)

fb_data %>%
   mutate(comment_created_hour = hour(comment_created_time),
          comment_created_weekday = wday(comment_created_time, label = TRUE) %>%
             factor(levels = c("Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"),
                    labels = c("Pn", "Wt", "Śr", "Cz", "Pt", "Sb", "Nd"))) %>%
   by(.$post_from_name,
      function(x) {
         x %>%
            count(comment_created_weekday, comment_created_hour) %>%
            ungroup() %>%
            ggplot() +
            geom_tile(aes(comment_created_weekday, comment_created_hour, fill = n), color = "gray50", show.legend = FALSE) +
            scale_fill_distiller(palette = "RdYlGn") +
            scale_y_reverse() +
            labs(title = paste(unique(x$post_from_name), "- kiedy pojawiają się komentarze?"),
                 x = "", y = "Godzina")
      }
   )

fb_data %>%
   mutate(delta_time = as.numeric(comment_created_time - post_created_time)/3600) %>%
   filter(delta_time > 0) %>%
   ggplot() +
   geom_density(aes(delta_time, fill = post_from_name), alpha = 0.5) +
   scale_x_continuous(breaks = c(1/60, 5/60, 1/4, 1/2, 1, 2, 3, 6, 12, 24, 2*24, 5*24, 10*24, 30*24),
                      labels = c("1m", "5m", "15m", "30m", "1h", "2h", "3h", "6h", "12h", "1d", "2d", "5d", "10d", "30d"),
                      trans = "log10") +
   labs(title = "Czas jaki mija od publikacji posta do publikacji komentarza",
        x = "", y = "Gestość prawdopodobieństwa", fill = "Fanpage") +
   theme(legend.position = "bottom")

fb_data %>%
   mutate(delta_time = as.numeric(comment_created_time - post_created_time)/3600) %>%
   filter(post_from_name == "Belfer") %>%
   group_by(post_id, post_created_time) %>%
   summarize(m_delta_time = round(mean(delta_time)/24)) %>%
   ungroup() %>%
   top_n(10, m_delta_time) %>%
   left_join(fb_posts %>% select(id, message), by = c("post_id"="id")) %>%
   select(-post_id) %>%
   arrange(desc(m_delta_time)) %>%
   kable() %>%
   kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F)

fb_data %>%
   mutate(delta_time = as.numeric(comment_created_time - post_created_time)/3600) %>%
   filter(post_from_name == "Belfer") %>%
   group_by(post_id, post_created_time) %>%
   summarize(m_delta_time = mean(delta_time)) %>%
   ungroup() %>%
   top_n(1, m_delta_time) %>%
   select(post_id) %>%
   left_join(fb_data, by = "post_id") %>%
   select(post_created_time, comment_created_time, comment_message) %>%
   kable() %>%
   kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F)

# słowniki
pl_stop_words <- read_lines("../!polimorfologik/polish_stopwords.txt")

# to smieci
pl_stop_words <- c(pl_stop_words,
                   "canal", "http", "https", "www.hbo.pl", "hbo", "diagnoza.tvn.pl", "html", "youtu.be", "bit.ly", "www.wirtualnemedia.pl", "magicznebieszczady")

# słowa które powtarzają się bardzo często w komentarzach, a niewiele wnoszą
seriale_slownik <- c("czekam", "doczekać", "serial", "odcinek", "mogę", "sezon", "już", "się", "pozdrawiam",
                     "czekamy", "super", "sie", "serialem", "serialu", "premiera", "juz", "odcinka", "oglądam",
                     "odcinki", "sezonu", "sezonie", "najlepszy", "gratulacje", "obejrzeć", "obejrzec", "niecierpliwością",
                     "odcinków", "oglądać", "odcinku", "czekać", "serii", "seria", "seriali", "the", "best")

fb_posts_messages <- fb_posts %>%
   select(from_name, message) %>%
   unnest_tokens(word, message, token = "words", drop = FALSE) %>%
   select(-message) %>%
   filter(!is.na(word)) %>%
   filter(!word %in% pl_stop_words) %>%
   filter(is.na(as.numeric(word))) %>%
   filter(nchar(word) > 2)

fb_posts_messages %>%
   count(from_name, word) %>%
   ungroup() %>%
   group_by(from_name) %>%
   top_n(20, n) %>%
   ungroup() %>%
   arrange(desc(word)) %>%
   mutate(word = fct_inorder(word)) %>%
   ggplot() +
   geom_tile(aes(from_name, word, fill = n), color = "gray50", show.legend = FALSE) +
   scale_fill_distiller(palette = "RdYlGn") +
   labs(title = "Najpopularniejsze słowa w postach",
        x = "", y = "")

fb_comments_messages <- fb_comments %>%
   select(post_from_name, post_id, comment_message) %>%
   unnest_tokens(word, comment_message, token = "words", drop = FALSE) %>%
   select(-comment_message) %>%
   filter(!is.na(word)) %>%
   filter(!word %in% pl_stop_words) %>%
   filter(is.na(as.numeric(word))) %>%
   filter(nchar(word) > 2) %>%
   filter(!word %in% seriale_slownik)

fb_comments_messages %>%
   count(post_from_name, word) %>%
   ungroup() %>%
   group_by(post_from_name) %>%
   top_n(20, n) %>%
   ungroup() %>%
   arrange(desc(word)) %>%
   mutate(word = fct_inorder(word)) %>%
   ggplot() +
   geom_tile(aes(post_from_name, word, fill = n), color = "gray50") +
   scale_fill_distiller(palette = "RdYlGn") +
   labs(title = "Najpopularniejsze słowa w komentarzach",
        x = "", y = "")

fb_comments_messages %>%
   # ile różnych słóW występuje przy komentarzach do konkretnego posta?
   group_by(post_id) %>%
   mutate(n_words_in_posts = n()) %>%
   ungroup() %>%
   # ile jest różnych słów w komciach dla danej strony?
   group_by(post_from_name, word) %>%
   mutate(n_times_word = n()) %>%
   ungroup() %>%
   # p = popularność słowa na stronie / ile słów przy komciu
   mutate(p = n_times_word/n_words_in_posts) %>%
   # średnia wartość p dla strony i słowa
   group_by(post_from_name, word) %>%
   summarise(p = mean(p)) %>%
   ungroup() %>%
   by(.$post_from_name,
      function(x) {
         x %>%
            top_n(20, p) %>%
            arrange(p) %>%
            mutate(word = fct_inorder(word)) %>%
            ggplot() +
            geom_col(aes(word, p), fill = "lightgreen", color = "gray50") +
            coord_flip() +
            labs(title = paste(unique(x$post_from_name), "- najpopularniejsze słowa w komentarzach"),
                 x = "", y = "")
      }
   )

fb_comments_messages_bigrams <- fb_comments %>%
   select(post_from_name, comment_message) %>%
   unnest_tokens(word, comment_message, token = "ngrams", n = 2, drop = FALSE) %>%
   select(-comment_message) %>%
   separate(word, c("word1", "word2"), sep = " ") %>%
   filter(!word1 %in% pl_stop_words) %>%
   filter(!word1 %in% seriale_slownik) %>%
   filter(is.na(as.numeric(word1))) %>%
   filter(nchar(word1) > 2) %>%
   filter(!word2 %in% pl_stop_words) %>%
   filter(!word2 %in% seriale_slownik) %>%
   filter(is.na(as.numeric(word2))) %>%
   filter(nchar(word2) > 2) %>%
   mutate(word = paste(word1, word2, sep = " ")) %>%
   select(-word1, -word2)

fb_comments_messages_bigrams %>%
   count(post_from_name, word) %>%
   ungroup() %>%
   top_n(40, n) %>%
   arrange(n) %>%
   mutate(word = fct_inorder(word)) %>%
   ggplot() +
   geom_tile(aes(post_from_name, word, fill = n), color = "gray50") +
   scale_fill_distiller(palette = "RdYlGn") +
   labs(title = "Najpopularniejsze bigramy w komentarzach", x = "", y = "")

fb_comments_messages_bigrams %>%
   count(post_from_name, word) %>%
   ungroup() %>%
   by(.$post_from_name,
      function(x) {
         x %>%
            top_n(40, n) %>%
            arrange(n) %>%
            mutate(word = fct_inorder(word)) %>%
            ggplot() +
            geom_col(aes(word, n), fill = "lightgreen", color = "gray50") +
            coord_flip() +
            labs(title = paste(unique(x$post_from_name), "- najpopularniejsze bigramy w komentarzach"), x = "", y = "")
      }
   )

fb_comments_messages_bigrams %>%
   count(post_from_name, word) %>%
   ungroup() %>%
   spread(post_from_name, n) %>%
   na.omit() %>%
   mutate(s = Belfer + `Diagnoza TVN` + Wataha) %>%
   top_n(30, s) %>%
   arrange(s) %>%
   mutate(word = fct_inorder(word)) %>%
   select(-s) %>%
   gather(key, val, -word) %>%
   ggplot() +
   geom_tile(aes(key, word, fill = val), color = "gray50") +
   scale_fill_distiller(palette = "RdYlGn") +
   labs(title = "Najpopularniejsze bigramy w komentarzach\nwystępujace na wszystkich stronach", x = "", y = "")

fb_data %>%
   count(post_from_name, comments_from_name, sort = TRUE) %>%
   ungroup() %>%
   spread(post_from_name, n) %>%
   rowwise() %>%
   mutate(comm_sum = sum(Belfer, `Diagnoza TVN`, Wataha)) %>%
   ungroup() %>%
   filter(!is.na(comm_sum)) %>%
   arrange(comm_sum) %>%
   mutate(comments_from_name = fct_inorder(comments_from_name)) %>%
   select(-comm_sum) %>%
   gather(serial, val, -comments_from_name) %>%
   ggplot() +
   geom_tile(aes(serial, comments_from_name, fill = val), color = "gray50", show.legend = FALSE) +
   scale_fill_distiller(palette = "RdYlGn") +
   labs(title = "Komentujący wszystkie seriale", x = "", y = "")