Diagnoza, Wataha czy Belfer?

Który jesienny serialowy hit był najczęściej komentowany w 2017 roku? Jakie to były komentarze?

Dzisiaj, w ostatnim poście w tym roku, zajmiemy się polskimi serialami z jesiennej ramówki. Na warsztat weźmiemy trzy tytuły: Diagnozę od TVN, Belfra od Canal+ oraz Watahę od HBO. Zobaczymy jak wyglądała obsługa seriali na Facebooku i jakie towarzyszyły im komentarze.

Uwaga: post (lub informacje na wykresach) mogą zdradzać fabułę seriali!

Kod jest na tyle uniwersalny, że wystarczy podać inne nazwy fanpage’y w części wczytującej dane aby uzyskać podobną analizę dla innych facebookowych stron – na przykład dla partii politycznych.

Pobranie danych

Skorzystamy z pakietu Rfacebook do pobrania danych. Skrypt nie jest długi, ale też niezbyt ciekawy jeśli chodzi o analizę – znajdziecie go w moim repo. To co się tam dzieje to pobranie po maksymalnie 2000 postów i komentarzy do nich z trzech fanpage’y: Diagnoza TVN, Belfer oraz Wataha, a następnie zapisanie danych do plików lokalnych (znajdziecie je również w repo).

W dalszym kroku wczytamy odpowiednie pakiety:

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")

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")

oraz same dane:

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

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

Przed przystąpieniem do analizy złączymy sobie obie tabele (będzie taka suma potrzebna):

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_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"))

Na początek zobaczmy jak wyglądała aktywność operatorów stron – ile postów było publikowanych w kolejnych dniach?

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) %>%

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")

Widzimy, że najwięcej produkowała strona poświęcona serialowi TVNu. Wyraźnie widać kiedy miała miejsce emisja serialu (od 5 września do 28 listopada, we wtorki o 21:30).

Dla porządku – druga seria Watahy miała emisję od 15 października do 19 listopada (niedziele wieczorem), przy czym w HBO GO odcinki były dostępne o tydzień wcześniej (pierwszy weekend to 2 odcinki, w telewizorze – tylko jeden).

Drugi sezon Belfra emitowany zaś był przez Canal+ od 22 października do 10 grudnia.

Widać to na powyższym wykresie: szczyt Diagnozy i Watahy przypada na okres emisji, Belfer przyspieszył z liczbą postów zbliżając się do finału sezonu.

Zobaczmy czy terminy publikacji postów łączą się z momentami emisji?

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) %>%

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")

}

)

Oczywiście, że tak. Belfer i Wataha to niedziele wieczorem, Diagnoza to wtorkowe wieczory.

Ciekawostkę widać w postach Watahy – sporo postów zostało opublikowanych w poniedziałki. Te posty to live-chat z aktorami lub podgrzewanie atmosfery pytaniami jak Wam się podobało?:

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_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)

Data postu	Typ postu	Treść postu
2017-08-07 18:00:00	video	Wataha powraca w #MagiczneBieszczady w zimowej odsłonie. 15 października tylko w HBO i online w HBO GO.
2017-08-21 17:00:00	video	#MagiczneBieszczady zimą są jeszcze bardziej tajemnicze i niedostępne. Będą wyzwaniem czy raczej sprzymierzeńcem dla ukrywającego się w nich Rebrowa? Wataha powraca 15 października, tylko w HBO i HBO GO.
2017-09-11 13:16:37	video	Będziemy w śniegu po kolana, po pas, po szyję – obiecuje Leszek Lichota w nowym materiale z planu drugiego sezonu serialu Wataha. Zobacz przepiękne zimowe Bieszczady już 15 października w HBO i HBO GO.
2017-09-25 13:55:36	photo	Tak pięknie napisali o drugim sezonie Watahy Kaja i Janusz z Jakbyniepaczec v 2.0. – bardzo nam miło, dziękujemy :-* I nie możemy doczekać się Waszej opinii, opinii naszych Widzów :) Premiera już za 3 tygodnie!
2017-09-25 18:30:01	video	“Oficjalnie różnica między Polską a Ukrainą to godzina. Tak naprawdę to 25 lat.” Poznajcie wrażenia ekipy serialu ze zdjęć za naszą wschodnią granicą. http://www.hbo.pl/wataha/
2017-10-02 11:18:54	video	Najchętniej oglądany serial HBO powraca.
2017-10-02 18:00:00	link	Znów nas chwalą :) Tym razem Antyweb bardzo wysoko ocenił nowy sezon Watahy – niezmiernie nam miło, bardzo dziękujemy! A na premierę sezonu zapraszamy już za 2 tygodnie :)
2017-10-09 10:04:20	video	Odkodowany weekend w HBO! Zobacz premierę Watahy i wiele innych filmów i seriali.
2017-10-09 14:06:30	video	Wataha, sezon 2 – już za 6 dni w HBO i HBO GO.
2017-10-09 18:30:00	link	“Podczas zdjęć próbnych z Leszkiem porwałam mu koszulę, a on prawie złamał mi nogę” – czyli jak zaczęła się przygoda Anny Donchenko z serialem Wataha.
2017-10-16 14:42:27	photo	NA
2017-10-16 16:15:00	photo	Belfer + Wataha = <3 Dzięki za gratulacje CANAL+ Polska Trzymamy kciuki za premierę Belfra!
2017-10-16 20:02:19	video	Zapraszamy na Live Chat z Agą i Markowskim!
2017-10-23 15:57:32	video	Grzywa żyje! Zobacz ciąg dalszy jego konfrontacji z Rebrowem. Bartłomiej Topa zaprasza na odc. 3 już teraz online w HBO GO. http://www.hbo.pl/wataha/
2017-10-23 16:22:11	photo	NA
2017-10-23 20:05:57	video	Dołączcie do Live Chatu z Łuczakiem, Świtalskim i reżyserką Kasią Adamik.
2017-10-30 10:00:00	video	Leszek Lichota jeszcze na planie serialu powiedział “W drugim sezonie będzie na pewno więcej akcji, niż było w pierwszym”. Zgadzacie się? :)
2017-11-06 14:19:34	photo	To już dziś! :)
2017-11-06 20:18:09	video	Anita Jancia-Prokopowicz & Jan P. Matuszynski są z nami.
2017-11-13 14:13:11	photo	Mamy pytanie do wszystkich, którzy widzieli już cały drugi sezon Watahy: jak wam się podobało? Co było największym zaskoczeniem, a co przewidzieliście już wcześniej? Jakie alternatywne zakończenia obstawialiście? Czekamy na wasze komentarze :) UWAGA: BĘDĄ SPOILERY!!! ;)
2017-11-13 20:09:03	video	Rebrow, Dobosz, Zięba i Boczarska już tu są!
2017-11-20 16:16:57	photo	A kto by nie chciał?<8a>

Swoją drogą – okrągłe godziny publikacji wskazują na planowanie postów ;) Na fanpage’u Dane i Analizy też planuję posty, ale godziny są losowe.

A czy w komentarzach widać odzwierciedlenie terminu emisji?

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_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")

Widać :) Ciekawostką jest aktywność komentujących Watahę wiosną – czyżby zapowiedzi serialu? Jeśli przejrzymy dane to właśnie to widać:

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, 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)

Data postu	Treść postu
2017-04-15 18:00:00	Wataha wraca jesienią. Zobacz pierwszy zwiastun!
2017-06-01 21:35:32	Aleksandra Popławska i Leszek Lichota opowiedzą o nadchodzącym sezonie Watahy na Warsaw Comic Con. Możecie ich spotkać już w sobotę o 13.00. Będą niespodzianki ;)
2017-06-02 10:28:21	W strefie HBO na Warsaw Comic Con znajdziecie serialowe auto Watahy :) A już jutro spotkanie z Aleksandrą Popławską i Leszkiem Lichotą!
2017-06-03 15:00:00	Ucieczka nigdy się nie kończy. Wataha, sezon 2, jesień 2017. Tylko w HBO i HBO GO.
2017-06-04 11:25:26	Z dzikich Bieszczad na Żelazny Tron! Aleksandra Popławska, Leszek Lichota oraz producenci serialu spotkali się wczoraj z fanami na Warsaw Comic Con.
2017-07-12 14:21:28	Leszek Lichota (Wiktor Rebrow) zdradza kilka informacji o nowym sezonie Watahy!
2017-07-28 13:25:36	Najchętniej oglądany serial HBO powraca. Wataha, sezon 2 – premiera 15 października tylko w HBO i online w HBO GO.

Sprawdźmy czy w czasie trwania sezonu zmieniała się aktywność (rozumiana jako liczba komentarzy na post) widzów?

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) >= 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")

Nie widać znaczącej zmiany dla seriali TVNu i Canal+, ale Wataha zanotowała spory wzrost – czyżby zakończenie wywołało takie dyskusje?

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_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)

Data postu	Treść postu	Wskaźnik p
2017-11-01	Kobieca twarz Watahy, Aleksandra Popławska opowiada o swojej roli w serialu i o tym, jak zmieniła się jej postać w stosunku do pierwszego sezonu.	17
2017-11-05	Sytuacja się zagęszcza, czy odcinek 5 przyniesie odpowiedzi na coraz więcej pojawiających się pytań?	224
2017-11-06	Anita Jancia-Prokopowicz & Jan P. Matuszynski są z nami.	5
2017-11-06	To już dziś! :)	5
2017-11-08	Takie BHP ;) Finałowy odcinek Watahy już w niedzielę w HBO GO! http://www.hbo.pl/wataha/	164
2017-11-11	NA	54
2017-11-12	Kto stoi za morderstwami w Bieszczadach? Zobacz już teraz finałowy odcinek Watahy! Cały sezon online w HBO GO.	395.5
2017-11-12	Dziś o 20:10 w HBO premiera 5 odcinka nowego sezonu Watahy, a niecierpliwi już teraz w HBO GO mogą oglądać cały sezon serialu. hbogo.pl/redirect/-93620	395.5
2017-11-13	Rebrow, Dobosz, Zięba i Boczarska już tu są!	367.5
2017-11-13	Mamy pytanie do wszystkich, którzy widzieli już cały drugi sezon Watahy: jak wam się podobało? Co było największym zaskoczeniem, a co przewidzieliście już wcześniej? Jakie alternatywne zakończenia obstawialiście? Czekamy na wasze komentarze :) UWAGA: BĘDĄ SPOILERY!!! ;)	367.5
2017-11-19	Finałowy odcinek Watahy już za chwilę w HBO, cały sezon dostępny w HBO GO.	174
2017-11-20	A kto by nie chciał?<8a>	63
2017-11-22	Złotousty Łuczak, będziecie za nim tęsknić? ;) Cały drugi sezon Watahy w HBO GO!	296
2017-11-24	NA	31.5
2017-11-24	Jeśli ktoś jeszcze nie widział 2 sezonu Watahy, ta recenzja Krzysztofa Połaskiego z Telemagazyn.pl będzie istotnym argumentem za obejrzeniem serialu :)	31.5

Moje przypuszczenia wydają się być prawdziwe. Co ciekawe – po zakończeniu emisji HBO zaprzestało komunikacji z fanami (ostatni post jest z 24.11), zupełnie inaczej niż TVN i Canal+.

Zobaczmy w którym dniu tygodnia i o jakiej godzinie pojawiają się komentarze – czy ma to związek z emisją? Czy popularne jest oglądanie serialu z jednoczesnym komentowaniem go na Facebooku?

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(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")

}

)

Sprawdza się idealnie, a w przypadku Watahy mamy dodatkowo sporą aktywność w poniedziałki (to już rozszyfrowaliśmy wyżej).

Sprawdźmy jak szybko pojawiaja sie komentarze?

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(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")

Największy pik jest dla wszystkich seriali w okolicach 6-12 godzin od publikacji postu. Czyżby dyskusje od rana, następnego dnia po emisji?

Ciekawe są komcie w Belfrze zostawione po miesiącu od emisji – zobaczmy te posty, dla których średnia czasu reakcji użytkowników była największa:

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 = 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)

Data postu	Średnia liczba godzin od publikacji postu do publikacji komentarza	Treść postu
2016-03-12 04:09:03	188	Odliczamy! https://www.youtube.com/watch?v=QJBo2ZAtWBA
2016-03-12 04:10:51	187	NA
2016-03-12 04:16:11	180	NA
2016-07-29 20:00:00	62	Czy wiesz, że: • aktorzy do ostatniego odcinka nie wiedzieli, kto popełnił morderstwo • serial prawie w całości nakręcony jest ze steadicamu (system stabilizacji kamery, mechanicznie izolujący ruch kamery od operatora. Pozwala uzyskać bardzo płynne ujęcia, nawet, gdy operator porusza się szybko po nierównym podłożu) • zdjęcia trwały blisko 100 dni i kręcone były równolegle przez dwie ekipy, m.in. w Chełmnie, Chełmży, Kwidzynie i Warszawie
2016-07-30 15:11:20	49	Przed Wami drugi teaser!
2017-03-20 11:30:01	29	Kilka zdjęć ze spotkania twórców z fanami serialu, przy okazji premiery “Belfra” na DVD. http://kulturalnipl.bloog.pl/id,359962785,title,Belfer-spotkanie-z-tworcami-filmu,index.html?smoybbtticaid=618d21
2016-09-02 20:17:43	19	Czy wiesz, że: • serial składa się z 10 odcinków, z których każdy trwa ok. 55 minut • CANAL+ rozpoczął już prace nad drugim sezonem serialu „Belfer”. Scenariusz piszą Monika Powalisz, Jakub Żulczyk i Bartek Ignaciuk, pod kierunkiem Wojciecha Bockenheima
2016-10-30 23:31:47	15	Kto według Ciebie zabił Asię?
2016-11-09 16:55:36	13	“- Co było dla pana najtrudniejsze w pracy nad „Belfrem”? Tajemnica. Sam sobie tę pętlę założyłem na szyję. Przez cały okres zdjęciowy musiałem oszukiwać obsadę aktorską. Oszukać w taki sposób, żeby aktorzy dali mi to, czego od nich potrzebuję, ale nie domyślali się, co mi dają.” http://www.wirtualnemedia.pl/artykul/lukasz-palkowski-niepewnosc-i-napiecie-na-planie-belfra-dobrze-wplynely-na-jakosc-serialu-wywiad
2017-02-21 18:37:12	11	Zapraszamy do śledzenia naszego profilu na Insta! :) https://www.instagram.com/belfer.serial/

Post, który żył najdłużej

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)

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)

Data postu	Data komentarza	Treść komentarza
2016-03-12 04:09:03	2016-06-29 15:22:09	Coś więcej o obsadzie? Koo zagra Magdalena Cielecka? :)
2016-03-12 04:09:03	2016-12-02 22:11:53	The 1st post of The Belfer xd

…został pewnie gdzieś odkopany. Ma tylko dwa komentarze – jeden ponad 3 miesiące po publikacji, drugi – prawie 9 miesięcy. Stąd wysoka średnia.

Przeanalizujmy treść – rozkład czasów jest ciekawy, ale dość przewidywalny:

posty pojawiają się wtedy, kiedy odcinek jest w telewizorze
ludzie reagują online na wydarzenia odcinków
często też dyskutują następnego dnia po emisji, od rana

# 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")

# 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")

Podzielmy posty na poszczególne słowa:

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 <- 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)

i sprawdźmy jakie były najpopularniejsze na każdym z fanpage’y:

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_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 = "")

Tutaj nie ma zaskoczenia – każdy z seriali ma swoje unikatowe słowa (głównie związane z imionami bohaterów lub aktorami grającymi w serialu). Wataha i Belfer zapraszają na premierę nowego odcinka serialu w drugim sezonie, Diagnoza zachęca do komentowania pytając o wrażenia. Kolory są wynikiem sumowania liczby wystąpień poszczególnych słów, lepszy obraz dałoby liczenie wartości względnych (na przykład dzieląc liczbę wystąpień słowa przez liczbę wszystkich postów).

Zróbmy to samo z komentarzami. Rozbijamy je na pojedyncze słowa:

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 <- 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)

i sprawdzamy, które są najpopularniejsze:

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 %>%

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 = "")

Mamy żal, że to koniec (szkoda), pochwałę serialu lub odcinka (świetny, mega) i oczekiwanie na kolejny. Plus standardowy zestaw związany z treścią.

Przeanalizujmy te same dane w nieco innym ujęciu. Przygotujemy dla każdego słowa wskaźnik mówiący jak bardzo dane słowo jest popularne w komentarzach. Niech będzie to średnia wartość z iloczynu popularności słowa (jak często wystąpiło we wszystkich komentarzach na fanpage’u) i popularności przy danym poście. Tym razem rozdzielmy to dodatkowo na poszczególne seriale:

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 %>%

# 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 = "")

}

)

Widać, że głównie grają tutaj słowa związane z treścią. W Belfrze& widzom brakowało w drugim sezonie Kusia (postać z pierwszego sezonu), porównywany jest sezon pierwszy z drugim. Bigramy (pary słów występujące obok siebie) dadzą lepszy obraz.

Podzielmy więc komentarze na bigramy:

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 <- 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)

Najpopularniejsze bigramy w komentarzach dla wszystkich seriali razem to:

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() %>%

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 = "")

Oczywiście aktorzy i bohaterowie, pochwała gry aktorskiej.

Najpopularniejsze bigramy w komentarzach w podziale na seriale:

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() %>%

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 = "")

}

)

Belfer: najpopularniejszy jest Partyk Pniewski (aktor grający w serialu). Widzowie widzą nawiązania do Twin Peaks (ale to chyba raczej w pierwszym sezonie niż w drugim). Narzekają na zbyt oczywiste słabe zakończenie (czy scenarzyści trzeciego sezonu to czytają?). Pojawia się Sebastian Fabijański (który w pierwszym sezonie grał Adriana Kusia). Z jednej strony to dobra robota, a z drugiej – szkoda czasu.

Diagnoza: tutaj gwiazdą jest grająca główną bohaterkę Maja Ostaszewska. Nie wiem dlaczego pojawia się tytuł innego serialu TVN – Druga szansa (sprawdziłem, Ostaszewska gra tam), ale po zerknięciu w treść komentarzy widać obawy, aby Diagnoza nie okazała się tak nudna jak Druga szansa (albo wręcz przeciwnie – żeby właśnie taka była, bo to mój ulubiony serial). W komentarzach widać sugestie, że to Artman popełnił błąd lekarski i wrobił Annę Leśniewską. Co ciekawe – nie pojawia się w pierwszej 40 Maciej Zakościelny.

Wataha: tutaj głównie zachwyty nad grą aktorską. Niesamowite na swój sposób.

Które określenia występują przy wszystkich serialach?

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_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 = "")

Na koniec zobaczmy czy są osoby komentujące wszystkie trzy seriale:

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 = "")

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 = "")

Oczywiście że tak. Lista ułożona jest od największej sumy napisanych komentarzy – pani Agnieszka Aga napisała ich łącznie najwięcej, widać że wolała dyskusję związane z Diagnozą. Lucy Raźniak wybrała Belfra.

Jakie z tego wszystkiego płyną wnioski?

Stacje telewizyjne starają się prowokować dyskusje podczas emisji kolejnych odcinków seriali. To już naturalne, że oglądamy telewizję z komórką w ręku i na bieżąco komentujemy to co widać na ekranie (ciekawe byłoby dodanie do danych z Facebooka danych z Twittera)
Posty publikowane są głównie w chwili emisji serialu, ale też (robiło to HBO) jakiś czas po – takie podsumowanie odcinków, rozmowy z aktorami, zachęty (trailer, teaser) kolejnego odcinka
W trakcie sezonu zaangażowanie użytkowników (liczba komentarzy do postów) jest mniej więcej stałe
W dwóch przypadkach mamy prowadzenie fanpage po zakończeniu emisji (nie wiem dlaczego HBO tego nie robi z Watahą) – czyżby podprowadzenie pod kolejny sezon? Wiadomo już, że na wiosnę wróci Diagnoza, nie bardzo wiadomo co będzie z Belfrem
Posty żyją do 12 godzin od publikacji. Kiedy emisja jest wieczorem rozmowy w komentarzach trwają jeszcze rano kolejnego dnia
Treść postów jak i komentarzy jest skupiona głównie na bohaterach i aktorach odgrywających role w serialu. Co ciekawe – mało jest słów krytycznych, przeważają pochlebne słowa. A pewnie jest tak, że jak się komuś nie podoba serial to nie udziela się po prostu w dyskusji? Co innego mogłoby wystąpić w przypadku fanpage serwisów informacyjnych lub partii politycznych
Jeśli miałbym pisać serial kręcony z tygodnia na tydzień – bardzo dokładnie analizowałbym opinie pojawiające się w social mediach. Szczególnie w przypadku seriali z zagadką – z komentarzy można dowiedzieć się o tropach jakimi podążają widzowie i… je odpowiednio mylić ;-)
Oczywiście są osoby, które oglądają i komentują wszystkie seriale
Mając informacje o tym kto komentuje można zbudować profil widza, ale to już temat na oddzielną zabawę.

Diagnoza, Wataha czy Belfer?

Pobranie danych

Jakie z tego wszystkiego płyną wnioski?

Dodaj komentarz Anuluj pisanie odpowiedzi