Заголовки — это краткие, точные резюме длинных фрагментов текста, часто сформулированные достаточно умно, чтобы одновременно представить текст и заинтересовать читателя. Интернет и появление множества средств массовой информации привели к тому, что журналисты и редакторы, пытающиеся удержать или привлечь внимание беспокойной читательской аудитории, поддались тенденции использования ярких, высокопарных заголовков.
Хотя использование кликбейтных историй и заголовков остается основой онлайн-новостей, я задаюсь вопросом, не страдают ли от таких опасений более авторитетные источники новостей, которые имеют доминирующее присутствие в печатных СМИ.
Здесь я опишу свои попытки ответить на этот вопрос, представив свои выводы в одной статье, 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 и его удивительных возможностях.