Расчет верхних триграмм

У меня есть тестовый файл заголовков статей (test$title) и их общее количество репостов в социальных сетях (test$total_shares). Я могу найти наиболее часто используемые триграммы, используя команду:

library(tau)
trigrams = textcnt(test$title, n = 3, method = "string")
trigrams = trigrams[order(trigrams, decreasing = TRUE)]
head(trigrams, 20)

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

Я могу найти средние доли любой конкретной триграммы, используя grep, например

HowTo <- filter(test, grepl('how to create', ignore.case = TRUE, title))

Затем используйте:

summary(HowTo)

чтобы увидеть средние доли заголовков с этой триграммой.

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

Вот пример набора данных. https://d380wq8lfryn3c.cloudfront.net/wp-content/uploads/2017/06/16175029/test4.csv

Я склонен удалять символы, отличные от ascii, из заголовков, используя

test$title <- sapply(test$title,function(row) iconv(row, from = "UTF-8", to = "ASCII", sub=""))

person Steve Rayson    schedule 16.06.2017    source источник


Ответы (1)


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

О, забыл сказать. Если использовать textcnt(), как вы, будут созданы триграфы, состоящие из конца одного заголовка и начала следующего. Я предположил, что это нежелательно, и нашел способ обойти это.

library(tau)
library(magrittr)

test0 <- read.csv(paste0("https://d380wq8lfryn3c.cloudfront.net/",
                  "wp-content/uploads/2017/06/16175029/test4.csv"),
                  header=TRUE, stringsAsFactors=FALSE)

test0[7467,] #problematic line

test <- test0
# test <- head(test0, 20)
test$title <- iconv(test$title, from="UTF-8", to="ASCII", sub=" ")
test$title <- test$title %>% 
  tolower %>% 
  gsub("[,/]", " ", .) %>%    #replace , and / with space
  gsub("[^a-z ]", "", .) %>%  #keep only letters and spaces
  gsub(" +", " ", .) %>%      #shrink multiple spaces to one
  gsub("^ ", "", .) %>%       #remove leading spaces
  gsub(" $", "", .)           #remove trailing spaces

test[7467,] #problematic line resolved

trigrams <- sapply(test$title, 
  function(s) names(textcnt(s, n=3, method="string")))
names(trigrams) <- test$total_shares

trigrams <- do.call(c, trigrams)
trigrams.df <- data.frame(trigrams, shares=as.numeric(names(trigrams)))

# aggregate shares by trigram. The number of shares of identical trigrams
# are summarized using some function (sum, mean, median etc.)
trigrams_share <- aggregate(shares ~ trigrams, data=trigrams.df, sum)

# more than one statistic can be calculated
trigrams_share <- aggregate(shares ~ trigrams, data=trigrams.df,
  FUN=function(x) c(mean=mean(x), sum=sum(x), nhead=length(x)))
trigrams_share <- do.call(data.frame, trigrams_share)
trigrams_share[[1]] <- as.character(trigrams_share[[1]])

# top five trigrams by average number of shares,
# of those that was found in three or more hedlines
trigrams_share <- trigrams_share[order(
  trigrams_share[2], decreasing=TRUE), ]
head(trigrams_share[trigrams_share[["shares.nhead"]] >= 3, ], 5)
#                           trigrams shares.mean shares.sum shares.nhead
# 37588                the secret to    42852.75     171411            4
# 43607                    will be a    24779.00     123895            5
# 44945        your career elearning    23012.00      92048            4
# 31454            raises million to    21378.67      64136            3
# 6419  classroom elearning industry    18812.38     150499            8

В случае, если соединение должно прерваться

# dput(head(test0, 20)):

test <- structure(list(
title = c("Top 3 Myths About BYOD In The Classroom - eLearning Industry", 
"The Emotional Weight of Being Graded, for Better or Worse", 
"Online learning startup Coursera raises $64M at an $800M valuation",
"LinkedIn doubles down on education with LinkedIn Learning, updates desktop site",
"Create Your eLearning Resume - eLearning Industry", 
"The Disruption of Digital Learning: Ten Things We Have Learned", 
"'Top universities to offer full degrees online in five years' - BBC News", 
"Schools will teach 'soft skills' from 2017, but assessing them presents a challenge",
"Top 5 Lead-Generating Ideas for Your Content Marketing", 
"'Top universities to offer full degrees online in five years' - BBC News",
"The long-distance learners of Aleppo - BBC News", 
"eLearning Solutions for Business", 
"6 Top eLearning Course Reviewer Tools And Selection Criteria - eLearning Industry",
"eLearning Elevated", 
"When Teachers and Technology Let Students Be Masters of Their Own Learning", 
"Aviation Technical English online elearning course", 
"How the Pioneers of the MOOC Got It Wrong", 
"Study challenges cost and price myths of online education", 
"10 Easy Ways to Integrate Technology in Your Classroom", 
"7 e-learning trends for educational institutions in 2017"
), total_shares = c(13646L, 12120L, 8328L, 5945L, 5853L, 5108L, 
4944L, 3570L, 3104L, 2841L, 2463L, 2227L, 2218L, 2210L, 2200L, 
2117L, 2039L, 1876L, 1861L, 1779L)), .Names = c("title", "total_shares"
), row.names = c(NA, 20L), class = "data.frame")
person AkselA    schedule 17.06.2017
comment
Круто, было весело решить задачу. Если вы считаете это достойным, вы можете пометить ответ как принятый. - person AkselA; 18.06.2017
comment
Спасибо, это отлично работает и дает мне общее количество акций на триграмм. В идеале я хотел бы иметь среднее значение и медиану, так как общее количество долей, конечно, может быть искажено количеством использований. Есть ли простой способ увидеть количество вхождений вместе со средним значением и медианой для каждой триграммы? - person Steve Rayson; 18.06.2017
comment
Я немного обновил код. Он работает в основном так же, я добавил еще один вызов grep() для разрешения нескольких сложных строк, остальное — попытка сделать его немного более легким для чтения. - person AkselA; 18.06.2017
comment
Спасибо, я очень ценю вашу работу. Это работает мечта. - person Steve Rayson; 18.06.2017