Reddit je jedna z nejpopulárnějších sociálních sítí na světě. Skládá se z mnoha (doslova tisíců) různých subredditů, tedy fór zaměřených na konkrétní témata. Členové subredditů do nich posílají své příspěvky, komentují příspěvky cizí, a — a to je pro naši analýzu nejdůležitější — navzájem si příspěvky hodnotí pomocí upvotů a downvotů.

V této ministudii prozkoumáváme, zda je možné určit ideální čas pro poslání příspěvku, je-li naším cílem maximalizovat pravděpodobnost získání co největšího počtu upvotů.

Získání dat

Jak to tak bývá, získat data bylo skoro tak složité, jako je analyzovat. Po několika neúspěšných pokusech jsme došli k následujícímu řešení:

  1. Pro všechny měsíce, které nás zajímají, nejdříve musíme ručně stáhnout data z Pushshift archivu. Každý soubor obsahuje všechny příspěvky z Redditu za daný měsíc a po rozbalení má kolem 30GB.

  2. Protože se tyto archivy nevlezou do paměti, je potřeba zpracovávat je řádek po řádku. Naštěstí jsou v json formátu, můžeme tedy použít krásnou command-line utilitku jq, pomocí které vyfiltrujeme potřebné subreddity.

cat 2018/05 | jq -c 'select(.subreddit == "de" or ...)' > 2018/limited_05

  1. Výsledkem je několik menších json souborů — co měsíc, to soubor — ve kterých je na každém řádku jeden záznam. Tyto soubory se již do paměti vlezou, převod z json do csv tabulky již proto můžeme provést v R.

  2. Nyní sice máme tabulku s detaily jednotlivých příspěvků, to nám však nestačí. Příspěvky jsou Pushshiftem archivovány vždy na konci měsíce, u mnohých tedy nemáme kompletní informaci o jejich výsledném skóre. Musíme proto využít Reddit API a u každého příspěvku se podle jeho id podívat, jaké skóre má v současnosti.

    Protože v R jsme žádný pěkný wrapper Reddit API nenašli, v této části jsme použili Pythonovskou knihovnu praw. Funkce stahující současná skóre příspěvků z konkrétního subredditu vypadá nějak takto:

def get_post_scores(inpath, outpath):
    df = pd.read_csv(inpath)
    df.assign(submission_object=pd.Series(reddit.info(list("t3_" + df["id"]))))

    # Když už děláme dotazy na API, uložíme i jiné detaily, kdyby náhodou
    df = df.assign(
        distinguished=
          safe_get("submission_object", "distinguished", lambda s: s.distinguished),
        num_comments=
          safe_get("submission_object", "num_comments", lambda s: s.num_comments),
        score=
          safe_get("submission_object", "score", lambda s: s.score),
        upvote_ratio=
          safe_get("submission_object", "upvote_ratio", lambda s: s.upvote_ratio)
    )

    df = df.drop(columns=["submission_object"])
    df.to_csv(outpath)
    return df

A máme hotovo! Výsledkem je pro každý subreddit jeden csv soubor s příspěvky za zkoumané období.

Zpracování a čištění dat

Pozn.: U každého příspěvku známe pouze počet jeho upvotů, tj. jeho konečné reálné skóre, které může být i záporné, neznáme. Přesto budeme “počet upvotů” a “skóre” v následujícím textu brát jako synonyma.

Abychom se z případných vzorců chování mohli dohadovat, co za nimi stojí, potřebujeme znát lokální čas poslání příspevku — co by nám bylo platné vědět, že někdo na r/brasil slavil velký úspěch v 19:00 UTC.

Reddit bohužel u příspěvků lokální čas autora neukládá a neukládá ani jeho polohu či jiné informace, které by mohly být použity k lokalizaci. Ke zkoumání se proto nejvíce hodí subreddity zaobírající se nějakou regionální problematikou a ještě lépe takové z nich, které jsou i v regionálním jazyce (aby nám je Američani ovlivňovali co nejméně).

Ke zkoumání jsme si proto vybrali mnoho regionálních subredditů, které jsme doplnili několika málo globálními, abychom zachovali určitou tematickou pestrost.

Toliko k úvodu. Níže můžete vidět kód, který se zaobírá načítáním jednotlivých souborů a určováním lokálních časů. U regionálních subredditů jsme lokální čas odhadli z toho globálního pomocí časové zóny daného regionu. U zbylých, globálních subredditů bylo určení časové zóny složitější — protože však je převážná většina uživatelů Redditu z USA, použili jsme v těchto případech časovou zónu America/New_York.

df <-
  # Načítání jednotlivých souborů + specifikace časové zóny
  list(
    # Globální
    c(sub = "czech", tz = "Europe/Prague"),
    c(sub = "japan", tz = "Japan"),
    c(sub = "singapore", tz = "Singapore"),
    c(sub = "de", tz = "Europe/Berlin"),
    c(sub = "germany", tz = "Europe/Berlin"),
    c(sub = "California", tz = "US/Pacific"),
    c(sub = "brasil", tz = "America/Sao_Paulo"),

    # Lokální
    c(sub = "Overwatch", tz = "America/New_York"),
    c(sub = "teenagers", tz = "America/New_York"),
    c(sub = "gonewild", tz = "America/New_York"),
    c(sub = "leagueoflegends", tz = "America/New_York")
  ) %>%
  map(read_scores) %>%
  reduce(bind_rows) %>%
  filter(!is.na(score)) %>%

  # Přidání dne a hodiny, kdy byl příspěvek poslán (v lokálním čase)
  group_by(tz) %>%
  mutate(
    created_local = with_tz(created_utc, tzone = first(tz)),
    wday_local =
     factor(
       wday(created_local, label = TRUE),
       levels = as.character(wday(c(2:7, 1), label = TRUE))
     ),
    hour_local = hour(created_local),
    month_local = month(created_local),
    upvotes = score,
  ) %>%
  ungroup() %>%
  select(-score, -created_local) %>%

  # Seřazení subredditů podle velikosti
  mutate(
    subreddit =
      factor(
        subreddit,
        levels = subreddit %>% table() %>% sort(decreasing = TRUE) %>% names()
      )
  )

df
## # A tibble: 891,507 x 24
##    id    title created_utc         retrieved_on        over_18 pinned stickied
##    <chr> <chr> <dttm>              <dttm>              <lgl>   <lgl>  <lgl>   
##  1 7nci… "Wha… 2018-01-01 01:51:54 2018-02-13 00:07:41 FALSE   FALSE  FALSE   
##  2 7ndv… "Pro… 2018-01-01 07:03:11 2018-02-13 00:19:00 FALSE   FALSE  FALSE   
##  3 7nii… "Ple… 2018-01-01 23:36:29 2018-02-13 00:58:05 FALSE   FALSE  FALSE   
##  4 7np8… "Wha… 2018-01-02 20:41:48 2018-02-13 01:54:48 FALSE   FALSE  FALSE   
##  5 7npl… "Nee… 2018-01-02 21:35:13 2018-02-13 01:58:03 FALSE   FALSE  FALSE   
##  6 7nqm… "Hel… 2018-01-03 00:05:43 2018-02-13 02:06:43 FALSE   FALSE  FALSE   
##  7 7nvk… "Hi … 2018-01-03 16:08:05 2018-02-13 02:48:16 FALSE   FALSE  FALSE   
##  8 7o1u… "IGF… 2018-01-04 09:15:36 2018-02-13 03:41:16 FALSE   FALSE  FALSE   
##  9 7o5c… "Why… 2018-01-04 19:25:36 2018-02-13 04:10:37 FALSE   FALSE  FALSE   
## 10 7o5g… "Why… 2018-01-04 19:39:30 2018-02-13 04:11:23 FALSE   FALSE  FALSE   
## # … with 891,497 more rows, and 17 more variables: url <chr>, subreddit <fct>,
## #   subreddit_id <chr>, is_self <lgl>, is_video <lgl>,
## #   author_comment_karma <dbl>, author_link_karma <dbl>, author_id <chr>,
## #   author_name <chr>, distinguished <chr>, num_comments <dbl>,
## #   upvote_ratio <dbl>, tz <chr>, wday_local <ord>, hour_local <int>,
## #   month_local <dbl>, upvotes <dbl>

Pro kontrolu můžeme u každého ze subredditů vizualizovat počet příspěvků v závislosti na dni v týdnu a hodině. Jak je vidět, všechny křivky mají podobný posun, což naznačuje, že jsme ve většině případů časovou zónu odhadli správně. Je ale dobré pamatovat, že tato čísla — zvláště u globálních subredditů — je nutné brát s velkou rezervou. Pozor také na to, že jsme pro různé subreddity použili různé škálování osy \(y\).

Pozn.: Subreddity jsou na tomto grafu i na dalších grafech seřazeny podle celkového počtu příspěvků (r/gonewild nejvíce, r/czech nejméně).

df %>%
  ggplot(aes(hour_local)) +
  geom_bar(aes(fill = wday_local), position = "dodge") +
  facet_grid(rows = vars(subreddit), scales = "free_y") +
  labs(
    title = "Počet příspěvků v závislosti na dni v týdnu a hodině",
    x = "Hodina (lokální čas)",
    y = "Počet příspěvků",
    fill = "Den v týdnu (lokální čas)"
  )

Pro úplnost uvádíme průměrný počet příspěvků v subredditu za měsíc.

df %>% 
  group_by(subreddit) %>% 
  count(month_local) %>% 
  summarise(mean_monhtly_posts = mean(n))
## # A tibble: 11 x 2
##    subreddit       mean_monhtly_posts
##    <fct>                        <dbl>
##  1 gonewild                    39413.
##  2 teenagers                   26296.
##  3 leagueoflegends             25507.
##  4 Overwatch                   22352.
##  5 de                           4827 
##  6 brasil                       4556 
##  7 singapore                    2083 
##  8 germany                       771.
##  9 japan                         733.
## 10 California                    661.
## 11 czech                         184.

Analýza

Koněčně se dostáváme k samotné analýze. Naší první \(H_0\) bude “průměrné skóre příspěvku není závislé na dni v týdnu, kdy byl poslán”, což v našem případě znamená, že průměrné skóre příspěvků z konkrétního dne se nebude zvlášť lišit od očekávaného průměrného skóre, tj. čísla

\[\mu_r = \frac{\sum_{p \in r} \text{skóre příspěvku } p}{\text{počet příspěvků v } r},\] kde \(r\) slouží k parametrizaci zkoumaného subredditu.

Tuto odlišnost a její signifikanci budeme určovat pomocí \(t\)-testu. Funkce run_t_test níže nejprve spočítá všechna \(\mu_r\) a poté určí \(t\)-hodnoty a \(p\)-hodnoty průměrného skóre u skupin, které jsou dány parametrem grouping. U \(H_0\) výše bude grouping nastaven na den v týdnu.

run_t_test <- function(df, grouping) {
  # Párování subreddit — průměrný počet upvotů
  upvotes_mean_df <-
    df %>%
    group_by(subreddit) %>%
    summarise(
      upvotes_sd = sd(upvotes),
      upvotes_mean = mean(upvotes)
    )
  
  df %>%
    group_by(subreddit, {{ grouping }}) %>%
    left_join(upvotes_mean_df, by = c(subreddit = "subreddit")) %>%
    summarise(
      # Má vzorek upvotes statisticky významně odlišný průměr od mu?
      t_test =
        list(t.test(
          upvotes,
          mu = first(upvotes_mean)
        )),
      p_value = t_test %>% map_dbl(~ .x$p.value),
      t_estimate = t_test %>% map_dbl(~ .x$estimate),
      t_null = t_test %>% map_dbl(~ .x$null.value),
      t_value = t_test %>% map_dbl(~ .x$statistic),
      upvotes_mean = first(upvotes_mean)
    ) %>%
    ungroup()
}

Abychom se nemuseli pořád jen koukat na čísla, výsledky vizualizujeme; modře vyznačíme dny (popř. časy, či jiné skupiny), u nichž bývá skóre nadprůměrné, červeně ty, kde je tomu naopak. O dnech (skupinách), kde je \(p\)-hodnota menší než stanovená hladina význmanosti \(\alpha\), nemůžeme s jistotou říci nic — změníme tedy jejich hodnotu na neutrální nulu.

plot_matrix <- function(df, grouping, alpha = 0.05) {
  df %>%
    mutate(difference = if_else(p_value <= alpha, t_estimate - t_null, 0)) %>%
    ggplot(aes({{ grouping }}, subreddit, fill = difference)) +
    geom_tile() +
    scale_fill_gradient2()
}

Nyní se již dostáváme k samotné vizualizaci výsledků. Použijeme \(\alpha = 0.05\) — jinými slovy, jsme ochotni riskovat, že v pěti procentech případů uděláme chybu prvního druhu.

df %>%
  run_t_test(wday_local) %>%
  plot_matrix(wday_local) +
  labs(
    title = "Ve které dny se (ne)vyplatí posílat příspěvky?",
    subtitle = "p-hodnota < 0.05",
    x = "Den",
    y = "Subreddit",
    fill = "Δ skóre"
  )

Náš test v datech nenalezl skoro nic zajímavého, není ale nutno věšet hlavu. Můžeme se podívat, jak to vypadá s výhodností časů během dne — \(H_0\) je “průměrné skóre příspěvku není závislé na hodině, kdy byl poslán”. Zde informací vytěžíme podstatně více.

df %>%
  run_t_test(hour_local) %>%
  plot_matrix(hour_local) +
  labs(
    title = "Ve které hodiny se (ne)vyplatí posílat příspěvky?",
    subtitle = "p-hodnota < 0.05",
    x = "Hodina",
    y = "Subreddit",
    fill = "Δ skóre"
  )

Závěr a diskuze

O závislosti skóre na dnech jsme zjistili až překvapivě málo — zdá se, že jsou tyto závislosti slabší, než jsme předpokládali, a bylo by proto vhodné použít citlivější metody, popřípadě najít vhodnější a bohatší data. Závislost skóre na času dopadla podstatně lépe, přesto je však vidět, že i zde by se hodilo mít více dat, zvláště pro menší subreddity. Získat tato naštěstí data nebude problém, všechna jsou uložena v Pushishift archivu.

Ty nejúspěšnější časy jsou mezi šestou a devátou hodinou ranní, kdy se nejpíše většina uživatelů Redditu probouzí a cestuje do práce či do školy; tento jev je zvláště markantní u r/teenagers. Je však pravděpodobné, že úspěšnost těchto časů závisí i na dalších faktorech.

Zdá se nám totiž, že úspěšnost příspěvku v závislosti na čase nepřímoúměrně odpovídá počtu příspěvků, které jsou v tento čas na subreddit poslány. Dá se předpokládat, že v časy, kdy je na subredditu málo příspěvků, je jednoduché dostat se na subredditovou frontpage; díky toho si pak příspěvku všimne více uživatelů, kteří jej pozitivně ohodnotí a spustí tak smyčku pozitivní zpětné vazby.

Bylo by zajímavé zkusit tento efekt pozitivní zpětné vazby odfiltrovat a zjistit, zda role času souvisí i s něčím jiným než jen s počtem uživatelů (a cestou do práce) — například zda existuje nějaká vazba mezi preferovanými časy a tématy.

Pro zajímavost nyní přikládáme vizualizace bez jakéhokoli omezení p-hodnoty a snažíme se z nich vyčíst, jakým směrem se ubírat s budoucí analýzou.

df %>%
  run_t_test(wday_local) %>%
  plot_matrix(wday_local, 1) +
  labs(
    title = "Ve které dny se (ne)vyplatí posílat příspěvky?",
    subtitle = "p-hodnota neomezená",
    x = "Den",
    y = "Subreddit",
    fill = "Δ skóre"
  )

Přestože tomuto obrázků již z podstaty nemůžeme věřit, zdá se, že víkendy by mohly mít na úspěšnost příspěvku vliv. Zvláště zajímavý je potenciální rozdíl mezi r/gonewild a zbytkem subredditů. Věříme, že přidáním dalších dat by se nám podařilo tento signál zaznamenat i pomocí jednoduchého \(t\)-testu.

U seskupování podle časů bychom si s více daty zase mohli doplnit obrázek, který se rýsoval už na grafech výše:

df %>%
  run_t_test(hour_local) %>%
  plot_matrix(hour_local, 1) +
  labs(
    title = "Ve které hodiny se (ne)vyplatí posílat příspěvky?",
    subtitle = "p-hodnota neomezená",
    x = "Hodina",
    y = "Subreddit",
    fill = "Δ skóre"
  )

A konečně, kdybychom měli více dat, dávalo by rovněž smysl podívat se na závislost skóre na dni a času.

Nejsme si ale jistí, zda jsme vůbec schopni nashromáždit tolik dat, aby tato 2D analýza dávala smysl. V takovém případě bychom mohli rozdělit den na méně než 24 dílů, například na ráno, poledne, večer, a noc, a tím tak nároky na data omezit. Riskovali bychom však, že do analýzy zaneseme své biasy.