Заголовки — это краткие, точные резюме длинных фрагментов текста, часто сформулированные достаточно умно, чтобы одновременно представить текст и заинтересовать читателя. Интернет и появление множества средств массовой информации привели к тому, что журналисты и редакторы, пытающиеся удержать или привлечь внимание беспокойной читательской аудитории, поддались тенденции использования ярких, высокопарных заголовков.

Хотя использование кликбейтных историй и заголовков остается основой онлайн-новостей, я задаюсь вопросом, не страдают ли от таких опасений более авторитетные источники новостей, которые имеют доминирующее присутствие в печатных СМИ.

Здесь я опишу свои попытки ответить на этот вопрос, представив свои выводы в одной статье, The New York Times.

Получение данных

В газете New York Times есть замечательный, хорошо документированный API, который довольно прост в использовании. Регистрация для получения ключа API чрезвычайно проста и немедленна по сравнению с некоторыми другими платформами.

NYT предоставляет несколько различных API для получения различных типов информации. Для целей этого проекта я работал в основном с API поиска статей, но я настоятельно рекомендую попробовать и другие, просто из любопытства!

Я нашел заголовки, которые появлялись в газете National News Desk газеты New York Times за последние 5 лет.

# Automate the process by creating a loop to continually crawl data. # Sys.sleep is added to not hit the limit of 10 requests per min.
# 0:100 of the i for loop is used because the API only allows       # pagination of up to page 100. (Page starts from 0)
# Date is retrieved from most current dataframe and added to baseurl # to continue the extraction of the next 1000 results

for (j in 1:30){
  pages <- list()
   baseurl=paste0("http://api.nytimes.com/svc/search/v2/articlesearch.json?fq=news_desk:(%22National%22)&begin_date=20141124&end_date=",date,"&sort=newest&api-key=YOURPAPIKEY")
  
  for(i in 0:100){
    nytSearch <- fromJSON(paste0(baseurl, "&page=", i), flatten = TRUE) %>% data.frame() 
    message("Retrieving page ", i, ": Round ", j)
    pages[[i+1]] <- nytSearch 
    Sys.sleep(6) 
  }
  
  currentdf <- rbind_pages(pages)
  newdf <- cbind(currentdf$response.docs.snippet, 
                 currentdf$response.docs.pub_date,
                 currentdf$response.docs.document_type,
                 currentdf$response.docs.news_desk,
                 currentdf$response.docs.section_name,
                 currentdf$response.docs.type_of_material,
                 currentdf$response.docs.word_count,
                 currentdf$response.docs.headline.main,
                 currentdf$response.docs.headline.print_headline)
  allNYTSearch <- rbind(allNYTSearch, newdf)
  #extract date
   date=gsub("-", "", gsub("T.*", "",        currentdf$response.docs.pub_date[nrow(currentdf)]))
}

Поскольку каждый раз API отображает только 10 результатов (1 страницу) и допускает разбиение на страницы до 100, для каждого вызова вы можете иметь доступ только к первым 1000 результатов. Таким образом, мне пришлось автоматизировать процесс очистки, создав цикл, который извлекает последнюю дату из первых 1000 результатов и вводит ее во второй поисковый вызов.

Теперь самое интересное — создание классификатора, который будет использоваться для пометки этих заголовков в зависимости от того, кликабельны они или нет!

Создание наивного байесовского классификатора

Чтобы построить свой классификатор, я получил набор данных, содержащий 32 000 заголовков/заголовков, предварительно помеченных людьми-добровольцами. Этот набор данных содержит 16 000 кликбейтных заголовков и 16 000 не кликбейтных заголовков. После того, как документы были очищены, то есть удалены знаки препинания и стоп-слова, добавлен нижний регистр, я смог построить разные модели и сравнить их производительность. Ниже приведен список построенных моделей:

Модель 1: модель, содержащая термины в качестве единственных функций, закодированных как непрерывные (т. е. значения для каждого термина указывают частоту термина x в документе y).

Модель 2: модель, содержащая термины в качестве единственных признаков, но закодированная как двоичная. (т. е. значения для каждого термина указывают на наличие термина x в документе y)

Модель 3: Модель, содержащая непрерывные временные характеристики и POS-теги.

Модель 4: Модель, содержащая характеристики бинарных терминов и теги POS.

Модель 5: Модель, содержащая только теги POS и показатель тональности.

Прежде чем я расскажу о построении и производительности этих моделей, я хотел бы продемонстрировать, как теги POS и оценки тональности могут быть получены для каждого из заголовков.

ground_truth$POS_number <- rep(NA, nrow(ground_truth)) 
ground_truth$POS_adj <- rep(NA, nrow(ground_truth))
ground_truth$POS_adv <- rep(NA, nrow(ground_truth))
ground_truth$POS_verb <- rep(NA, nrow(ground_truth))
for (i in 1:nrow(ground_truth)){ 
  sent_token_annotator <- Maxent_Sent_Token_Annotator()
  s = as.String(ground_truth$Title[i])
  a1 <- annotate(s, sent_token_annotator)
  
  word_token_annotator <- Maxent_Word_Token_Annotator()
  a2 <- annotate(s, word_token_annotator, a1)
  
  pos_tag_annotator <- Maxent_POS_Tag_Annotator()
  a3 <- annotate(s, pos_tag_annotator, a2)
  a3w <- subset(a3, type == "word")
  tags <- sapply(a3w$features, `[[`, "POS")
  ground_truth$POS_number[i] <- sum(tags %in% c("CD")) #sum of cardinal number
  ground_truth$POS_adj [i] <- sum(tags %in% c("JJ", "JJR", "JJS")) #sum of adjectives
  ground_truth$POS_adv [i] <- sum(tags %in% c("RB", "RBR", "RBS")) #sum of adverbs
  ground_truth$POS_verb [i] <- sum(tags %in% c("VB", "VBD", "VBG", "VBN", "VBP", "VBZ")) #sum of verbs
  print(i)
  gc()
}

POS означает тегирование части речи. Короче говоря, мы используем методы обработки естественного языка, чтобы определить, является ли термин в тексте глаголом, прилагательным, существительным и так далее. Это отличается от метода мешка слов, где порядок слов не имеет значения, и, следовательно, контекст, в котором используется термин, может быть потерян. Мой подход к тегам POS заключается в том, чтобы рассчитать частоту для четырех типов тегов: глаголов, прилагательных, количественных чисел и наречий. Используя пакет openNLP, я суммировал теги POS, которые были идентифицированы как глаголы, прилагательные, количественные числительные и наречия соответственно.

Что касается оценок тональности, я использовал пакет syuzhet в R. В приведенном ниже коде показано, как можно легко получить оценки тональности с помощью функции get_sentiment.

library(syuzhet)
ground_truth$Words<- as.character(ground_truth$Words)
ground_truth$sentiment_score <- get_sentiment(ground_truth$Words)

Позвольте мне теперь вернуться к тому, как я построил классификаторы.

В приведенном ниже коде показано, как строится простая наивная байесовская модель на основе терминов в качестве признаков. Первая часть кода демонстрирует, как строится матрица терминов документа с уменьшенным количеством функций, а вторая часть кода показывает, как строится модель.

##################### PART ONE ##############################
####################### Making the DTM  ######################
ground_truth$Title <- as.character(ground_truth$Title)
ground_truth$Words <- as.character(ground_truth$Words)
ground_truth$type <- factor(ground_truth$type)
ground_truth$Title <- gsub("[^a-zA-Z0-9]", " ", ground_truth$Title)
ground_truth$Words <- gsub("[^a-zA-Z0-9]", " ", ground_truth$Words)
myCorpus <- Corpus(VectorSource(ground_truth$Words))
dtm <- DocumentTermMatrix(myCorpus, control=list(removePunctuation = TRUE,
                                                 removeNumbers = TRUE,
                                                 tolower = TRUE,
                                                 stemming = FALSE,
                                                 stopwords = stopwords("English"),
                                                 minDocFreq=1,
                                                 minWordLength = 1))
dim(dtm)  #ideally we will want to reduce the features to about 2000 (now its at 23160)
#####feature selection - using frequency ####
findFreqTerms(dtm,100)
# List unique words sorted by decreasing frequency
term.freq <- apply(dtm, 2, sum)
barplot(sort(term.freq,decreasing=TRUE))
#what are the most freq and infreq terms?
term.freq <- sort(term.freq, decreasing=TRUE)
head(term.freq, n=10)
tail(term.freq, n=50)
terms_kept <- names(term.freq)[term.freq>19] # drop infrequent
terms_kept <- setdiff(terms_kept, c("will", "can", "make", "know", "based")) # drop too frequent
length(terms_kept)
dtm_reduced <- dtm[,terms_kept]
dim(dtm_reduced)  #dimensions has been greatly reduced.
################## PART TWO ###########################
################## build classifer model #################
library(e1071)
df <- as.data.frame(as.matrix(dtm_reduced))
class.labels <- c(rep("NCB",nrow(non_clickbait)),rep("CB",nrow(clickbait)))
df <- cbind(class.labels,df)
set.seed(1234)
train.ind <- rbinom(nrow(df), size=1, prob=0.9)
training.data <- df[train.ind==1,]
testing.data  <- df[train.ind==0,]
# train the model
mybayes <- naiveBayes(class.labels ~ ., data=training.data)
# compare the predicted and the actual
testing <- predict(mybayes, testing.data, type = c("class", "raw"))
mybayes_table <-table(testing, testing.data$class.labels, dnn=list('predicted','actual'))

Прежде чем мы перейдем к построению пяти различных моделей, описанных ранее, я хотел использовать некоторые базовые описательные статистические данные, чтобы посмотреть, как отличаются кликбейтные заголовки и не кликбейтные заголовки.

Кажется, что кликбейтные заголовки, как правило, имеют более высокие оценки тональности и чаще используют числа и глаголы, но они не сильно отличаются от не кликбейтных заголовков по частоте используемых прилагательных.

Построение модели и производительность модели

Возвращаясь к нашим пяти моделям, я хотел продемонстрировать, как мы можем легко преобразовать нашу матрицу dtm с непрерывными функциями в бинарные. Код ниже показывает, как это можно сделать.

dtm.bin <- weightBin(dtm_reduced)
df2 <- as.data.frame(as.matrix(dtm.bin))
df2 <- cbind(class.labels,df2)
#convert term indicator to categorical using boolean
for(j in 2:NCOL(df2)){
  df2[,j] <- df2[,j]>0 
}

Теперь мы можем легко добавить в df2 наш фрейм данных, содержащий термины в двоичном виде, теги POS и/или оценки тональности для построения наших различных моделей. Вот один пример:

########### model with binary features + POS info + sentiment score 
df5 <- cbind(ground_truth$sentiment,ground_truth$POS_number,ground_truth$POS_adj,ground_truth$POS_adv,ground_truth$POS_verb,df2)
training.data5 <- df5[train.ind==1,]
testing.data5  <- df5[train.ind==0,]
# train the model
mybayes5 <- naiveBayes(class.labels ~ ., data=training.data5) 
# compare the predicted and the actual
testing5 <- predict(mybayes5, testing.data5, type = "class")
mybayes5_table <-table(testing5, testing.data5$class.labels, dnn=list('predicted','actual'))

Теперь, когда мы построили наши модели, нам нужно решить, какую модель развернуть в нашем наборе данных NYTimes. Чтобы определить, какую модель я в конечном итоге буду использовать для классификации текста, извлеченного из New York Times, мне нужно оценить производительность каждой из моделей. На основе статистики, взятой из матрицы путаницы, я рассчитал точность, прецизионность и чувствительность каждой из моделей.

На приведенной ниже диаграмме показаны показатели производительности пяти моделей, которые я выбрал для этой статьи. Очевидно, что модель, построенная на основе признаков бинарных терминов, лишь превосходила остальные по всем аспектам. Выбрав нашу модель, мы можем теперь перейти к классификации наших заголовков!

Кликбейт или не-кликбейт?

С классификатором, обученным на полном наборе данных, я применил его к заголовкам, извлеченным из API New York Times, и вот результаты~!

Очевидно, что даже для такой крупной новостной компании, как The New York Times, тактика использования кликабельных заголовков для привлечения читателей очевидна.

Что меня удивило, так это то, что в их печатных СМИ было больше кликбейтных заголовков, чем в онлайн-СМИ. Это означает, что для одной и той же статьи, как правило, дается два заголовка, и тот, который дается в печатной форме (т. е. физическая газета), с большей вероятностью будет считаться кликбейтом по сравнению с его онлайн-аналогом. Будет интересно посмотреть, каков коэффициент конверсии и коррелирует ли он с какой-либо конкретной темой, например, с политикой и спортом.

Наконец, мы смотрим на заголовки, чтобы увидеть, есть ли тенденция использовать кликбейтные заголовки в каком-либо регионе и новых источниках чаще, чем в других.

Надеюсь, вам понравился этот небольшой проект, а мне понравилось работать над ним!

P.S. Фрагмент кода для графиков показан ниже:

############# Figure 1 ################ 
ggplot(data=agg.df, aes(x=time, y=cb_perc, group=year, color=year2)) +
geom_point()+
ggtitle("Percentage of ClickBait Titles in National News Over Time") +
geom_smooth(method=lm)+
theme_minimal()
############# Figure 2 ################
ggplot(data=agg_small.df, aes(x=time)) + 
  geom_point(aes(y = cb_perc, color = "online")) +
  geom_point(aes(y = cb_print_perc, color = "print")) +
  geom_line(aes(y = cb_perc, color = "online")) +
  geom_line(aes(y = cb_print_perc, color = "print")) +
  ggtitle("Percentage of ClickBait Titles in National News: Print VS Online") +
  xlab('Time') +
  ylab('Percent')+
  geom_smooth(aes(y = cb_perc), color = "royalblue1", method=lm) +
  geom_smooth(aes(y = cb_print_perc), color = "salmon", method=lm) +
  scale_colour_manual(name="", values = c("online"="royalblue1", "print"="salmon")) +
  theme_minimal()
############# Figure 3A ################
ggplot(data=region.df, aes(x=Region, y=cb_perc, fill=Region)) + 
  geom_bar(stat = "identity") +
  scale_fill_brewer(palette = "PuBuGn") +
  geom_text(aes(x = Region, y = cb_perc, label = all), angle=270, nudge_y=2.5)+
  coord_flip()+
  ggtitle("Percentage of ClickBait Headlines per Region")+
  theme_minimal()
############# Figure 3B ################
ggplot(data=world.dfsmall, aes(x=Source, y=cb_perc, fill=Source)) + 
  geom_bar(stat = "identity") +
  scale_fill_brewer(palette = "OrRd") +
  geom_text(aes(x = Source, y = cb_perc, label = all), angle=270, nudge_y=2.5)+
  coord_flip()+
  ggtitle("Percentage of ClickBait Headlines per News Source")+
  theme_minimal()

Все графики сделаны с помощью ggplot. Я настоятельно рекомендую потратить время, чтобы узнать о ggplot и его удивительных возможностях.