Medium Article Text Visualization & LASSO Model

Time Series Medium Articles

medium %>%
  group_by(year_month) %>%
  summarize(total = n()) %>%
  ggplot(aes(year_month, total, color = factor(year(year_month)))) +
  geom_point(show.legend = F) +
  geom_smooth(method = "lm") +
  labs(color = NULL, x = NULL, y = "# of articles", title = "# of Medium Articles Along With Time")

Tags

medium_tags <- medium %>%
  pivot_longer(
    cols = starts_with("tag"),
    names_to = "tag",
    values_to = "tag_or_not"
  ) %>% 
  mutate(tag = str_remove(tag, pattern = "tag_")) 


medium_tags %>% 
  group_by(tag) %>%
  summarize(percent = mean(tag_or_not)) %>%
  mutate(tag = fct_reorder(tag, percent)) %>%
  ggplot(aes(percent, tag)) +
  geom_col() +
  scale_x_continuous(labels = scales::percent) +
  labs(x = NULL, title = "Medium Article Tag Percentage") +
  theme(
    axis.text = element_text(size = 13)
  )

medium_tags %>%
  group_by(year = year(year_month), month = month(year_month), tag) %>%
  summarize(avg_tag = mean(tag_or_not)) %>%
  mutate(tag = fct_reorder(tag, avg_tag, .desc = TRUE)) %>%
  ggplot(aes(make_date(year = year, month = month), avg_tag, color = tag)) +
  geom_line(size = 1) +
  scale_y_continuous(labels = scales::percent) +
  labs(x = NULL, y = "Mean Percentage of Articles with Tag", 
       title = "Time Series Percentage of Articles with Tag")

Reading time along with claps

medium_tags %>%
  filter(reading_time <= 60) %>%
  ggplot(aes(factor(reading_time), claps, fill = factor(reading_time))) +
  geom_boxplot() +
  scale_y_log10(labels = scales::comma) +
  coord_flip() +
  theme(
    legend.position = "none"
  ) +
  labs(x = "reading time (minutes)", y = "claps (log-scale)", title = "# of Claps with Reading Time") 

Tags with claps

medium_tags %>%
  filter(tag_or_not == 1) %>%
  mutate(tag = fct_reorder(tag, claps, median, na.rm = TRUE)) %>%
  ggplot(aes(tag, claps, fill = tag)) +
  geom_boxplot() +
  scale_y_log10(labels = scales::comma) +
  coord_flip() +
  labs(y = "claps (log10 scale)", title = "Tags and Claps")

Authors with claps

medium_tags %>%
  filter(tag_or_not == 1) %>%
  group_by(author, tag) %>%
  summarize(avg_claps = mean(claps)) %>%
  #arrange(desc(avg_claps)) %>%
  distinct() %>%
  ungroup() %>%
  right_join(medium) %>% View()


top10_authors <- medium_tags %>%
  group_by(author) %>%
  summarize(avg_claps = mean(claps)) %>%
  arrange(desc(avg_claps)) %>%
  head(10) %>%
  select(author) %>%
  pull()

medium_tags %>%
  filter(author %in% top10_authors, tag_or_not == 1) %>%
  count(author, tag, sort = T)

## # A tibble: 15 x 3
##    author            tag                         n
##    <chr>             <chr>                   <int>
##  1 Fran ois Chollet  artificial_intelligence     2
##  2 Andrej Karpathy   artificial_intelligence     1
##  3 Andrej Karpathy   machine_learning            1
##  4 Anything App      ai                          1
##  5 Georges Abi-Heila data                        1
##  6 Kai Stinchcombe   ai                          1
##  7 Michael Jordan    artificial_intelligence     1
##  8 Michael Jordan    data_science                1
##  9 Michael Jordan    machine_learning            1
## 10 Radu Raicea       artificial_intelligence     1
## 11 Sophia Ciocca     artificial_intelligence     1
## 12 Sophia Ciocca     machine_learning            1
## 13 Xiaohan Zeng      machine_learning            1
## 14 YK Sugi           data_science                1
## 15 YK Sugi           data_visualization          1

Surprisingly, top 10 authors who obtained the largest numbers of claps only have only published at least 2 articles on Medium. That is to say, they might be invited to write something on the platform but are not regular bloggers.

medium_tags %>%
  filter(tag_or_not == 1) %>%
  unnest_tokens(word, title) %>%
  anti_join(stop_words) %>%
  group_by(word) %>%
  summarize(total = n()) %>%
  arrange(desc(total)) %>%
  filter(
    str_detect(word, "[a-z]")
  ) %>%
  head(25) %>%
  mutate(word = fct_reorder(word, total)) %>%
  ggplot(aes(total, word, fill = word)) +
  geom_col(show.legend = F) +
  labs(x = "word count", y = "title word", title = "Top 25 Most Frequent Article Title Words")

medium_tags %>%
  filter(tag_or_not == 1) %>%
  unnest_tokens(word, subtitle) %>%
  anti_join(stop_words) %>%
  group_by(word) %>%
  summarize(total = n()) %>%
  arrange(desc(total)) %>%
  filter(
    str_detect(word, "[a-z]")
  ) %>%
  head(25) %>%
  mutate(word = fct_reorder(word, total)) %>%
  filter(!is.na(word)) %>%
  ggplot(aes(total, word, fill = word)) +
  geom_col(show.legend = F) +
  labs(x = "word count", y = "subtitle word", title = "Top 25 Most Frequent Article Subtitle Words")

Images and Claps

medium %>%
  mutate(image = factor(image)) %>%
  ggplot(aes(image, claps, fill = image)) +
  geom_boxplot() +
  scale_y_log10(labels = scales::comma) +
  theme(
    legend.position = "none"
  ) +
  labs(x = "contains image or not", y = "# of claps", title = "# of Claps with Whether Articles Containing Image or Not")

The following graph and LASSO model is adopted from David Robinson’s code with some slight modification.

medium_tags_graph <- medium_tags %>%
  filter(tag_or_not == 1) %>%
  mutate(article_id = row_number()) %>%
  select(title, tag, article_id, claps) %>% 
  unnest_tokens(word, title) %>%
  anti_join(stop_words) %>%
  add_count(word) %>% 
  filter(n > 500, str_detect(word, "[a-z]"))

word_cor <- medium_tags_graph %>%
  pairwise_cor(word, article_id, sort = TRUE)

vertices <- medium_tags_graph %>% 
  group_by(word) %>%
  summarize(median_claps = median(claps),
            geometric_mean_claps = exp(mean(log(claps + 1))) - 1,
            occurences = n()) %>%
  arrange(desc(median_claps)) %>%
  filter(word %in% word_cor$item1 |
         word %in% word_cor$item2)

word_cor %>% 
  head(50) %>% 
  graph_from_data_frame(vertices = vertices) %>%
  ggraph(layout = "fr") +
  geom_edge_link() +
  geom_node_point(aes(size = occurences,
                      color = geometric_mean_claps)) +
  geom_node_text(aes(label = name), repel = TRUE) +
  scale_color_gradient2(low = "red", high = "blue", midpoint = 20) +
  theme_void() +
  labs(title = "Claps with Titles",
       subtitle = "Color shows the geometric mean of # of claps on articles with this word in the title",
       size = "# of occurrences",
       color = "claps")

LASSO Model

sparse_matrix <- medium_tags_graph %>%
  distinct(article_id, word, claps) %>%
  cast_sparse(article_id, word)

claps <- medium_tags_graph$claps[match(rownames(sparse_matrix), as.character(medium_tags_graph$article_id))]

lasso_model <- cv.glmnet(sparse_matrix, log(claps + 1))

tidy(lasso_model$glmnet.fit) %>%
  filter(term %in% c("ai", "learning", "world", "deep", "google", "marketing")) %>% 
  ggplot(aes(lambda, estimate, color = term)) +
  geom_line(size = 1) +
  scale_x_log10()