У меня есть большой фрейм данных, состоящий из твитов, и словарь ключевых слов, загруженный в виде списка, в котором слова и основы слова связаны с эмоцией (kw_Emo). Мне нужно найти способ подсчитать, сколько раз каждое твит слово или слово из kw_Emo присутствует в каждом твите. В kw_Emo основы слова отмечены звездочкой (*). Например, одним словом ствола является ador*, что означает, что мне нужно учитывать наличие adorable, adore, adoring или любой шаблон букв, который начинается с ador… ,
Из предыдущего обсуждения Stack Overflow (см. Предыдущий вопрос в моем профиле) мне очень помогло следующее решение, но оно учитывает только точные совпадения символов (например, только ador, а не adorable):
Загрузить соответствующий пакет.
library(stringr)
Определите и удалите * из основ слова в kw_Emo.
for (x in 1:length(kw_Emo)) {
if (grepl("[*]", kw_Emo[x]) == TRUE) {
kw_Emo[x] <- substr(kw_Emo[x],1,nchar(kw_Emo[x])-1)
}
}
Создайте новые столбцы, по одному для каждого слова / слова из kw_Emo, со значением по умолчанию 0.
for (x in 1:length(keywords)) {
dataframe[, keywords[x]] <- 0}
Разделить каждый твит на вектор слов, посмотреть, равно ли ключевое слово какому-либо, добавить +1 к соответствующему столбцу слов / словесных основ.
for (x in 1:nrow(dataframe)) {
partials <- data.frame(str_split(dataframe[x,2], " "), stringsAsFactors=FALSE)
partials <- partials[partials[] != ""]
for(y in 1:length(partials)) {
for (z in 1:length(keywords)) {
if (keywords[z] == partials[y]) {
dataframe[x, keywords[z]] <- dataframe[x, keywords[z]] + 1
}
}
}
}
Есть ли способ изменить это решение для учета словесных основ? Мне интересно, возможно ли сначала использовать строковый шаблон, чтобы заменить вхождения слова «основа» точными символами, а затем использовать это решение с точным соответствием. Например, что-то вроде stringr::str_replace_all(x, "ador[a-z]+", "ador"). Но я не уверен, как это сделать с моим большим словарем и множеством основ слов. Может быть, цикл удаления [*], который по существу идентифицирует все основы слова, можно как-то адаптировать?
Вот воспроизводимый образец моего фрейма данных с именем TestTweets с текстом для анализа в столбце с именем clean_text:
dput(droplevels(head(TestTweets, 20)))
structure(list(Time = c("24/06/2016 10:55:04", "24/06/2016 10:55:04",
"24/06/2016 10:55:04", "24/06/2016 10:55:04", "24/06/2016 10:55:04",
"24/06/2016 10:55:04", "24/06/2016 10:55:04", "24/06/2016 10:55:04",
"24/06/2016 10:55:04", "24/06/2016 10:55:04", "24/06/2016 10:55:04",
"24/06/2016 10:55:04", "24/06/2016 10:55:04", "24/06/2016 10:55:04",
"24/06/2016 10:55:04", "24/06/2016 10:55:04", "24/06/2016 10:55:04",
"24/06/2016 10:55:04", "24/06/2016 10:55:03", "24/06/2016 10:55:03"
), clean_text = c("mayagoodfellow as always making sense of it all for us ive never felt less welcome in this country brexit httpstcoiai5xa9ywv",
"never underestimate power of stupid people in a democracy brexit",
"a quick guide to brexit and beyond after britain votes to quit eu httpstcos1xkzrumvg httpstcocniutojkt0",
"this selfinflicted wound will be his legacy cameron falls on sword after brexit euref httpstcoegph3qonbj httpstcohbyhxodeda",
"so the uk is out cameron resigned scotland wants to leave great britain sinn fein plans to unify ireland and its o",
"this is a very good summary no biasspinagenda of the legal ramifications of the leave result brexit httpstcolobtyo48ng",
"you cant make this up cornwall votes out immediately pleads to keep eu cash this was never a rehearsal httpstco",
"no matter the outcome brexit polls demonstrate how quickly half of any population can be convinced to vote against itself q",
"i wouldnt mind so much but the result is based on a pack of lies and unaccountable promises democracy didnt win brexit pro",
"so the uk is out cameron resigned scotland wants to leave great britain sinn fein plans to unify ireland and its o",
"absolutely brilliant poll on brexit by yougov httpstcoepevg1moaw",
"retweeted mikhail golub golub\r\n\r\nbrexit to be followed by grexit departugal italeave fruckoff czechout httpstcoavkpfesddz",
"think the brexit campaign relies on the same sort of logic that drpepper does whats the worst that can happen thingsthatarewellbrexit",
"am baffled by nigel farages claim that brexit is a victory for real people as if the 47 voting remain are fucking smu",
"not one of the uks problems has been solved by brexit vote migration inequality the uks centurylong decline as",
"scotland should never leave eu calls for new independence vote grow httpstcorudiyvthia brexit",
"the most articulate take on brexit is actually this ft reader comment today httpstco98b4dwsrtv",
"65 million refugees half of them are children maybe instead of fighting each other we should be working hand in hand ",
"im laughing at people who voted for brexit but are complaining about the exchange rate affecting their holiday\r\nremain",
"life is too short to wear boring shoes brexit")), .Names = c("Time",
"clean_text"), row.names = c(NA, 20L), class = c("tbl_df", "tbl",
"data.frame"))
Вот kw_Emo:
kw_Emo <- c("abusi*", "accept", "accepta*", "accepted",
"accepting", "accepts", "ache*", "aching", "active*", "admir*",
"ador*", "advantag*", "adventur*", "advers*", "affection*", "afraid",
"aggravat*", "aggress*", "agoniz*", "agony", "agree", "agreeab*",
"agreed", "agreeing", "agreement*", "agrees", "alarm*", "alone",
"alright*", "amaz*", "amor*", "amus*", "anger*", "angr*", "anguish*",
"annoy*", "antagoni*", "anxi*", "aok", "apath*", "appall*", "appreciat*",
"apprehens*", "argh*", "argu*", "arrogan*", "asham*", "assault*",
"asshole*", "assur*", "attachment*", "attract*", "aversi*", "avoid*",
"award*", "awesome", "awful", "awkward*", "bashful*", "bastard*",
"battl*", "beaten", "beaut*", "beloved", "benefic*", "benevolen*",
"benign*", "best", "better", "bitch*", "bitter*", "blam*", "bless*",
"bold*", "bonus*", "bore*", "boring", "bother*", "brave*", "bright*",
"brillian*", "broke", "burden*", "calm*", "cared", "carefree",
"careful*", "careless*", "cares", "casual", "casually", "certain*",
"challeng*", "champ*", "charit*", "charm*", "cheer*", "cherish*",
"chuckl*", "clever*", "comed*", "comfort*", "commitment*", "complain*",
"compliment*", "concerned", "confidence", "confident", "confidently",
"confront*", "confus*", "considerate", "contempt*", "contented*",
"contentment", "contradic*", "convinc*", "cool", "courag*", "crap",
"crappy", "craz*", "create*", "creati*", "credit*", "cried",
"cries", "critical", "critici*", "crude*", "cry", "crying", "cunt*",
"cut", "cute*", "cutie*", "cynic", "danger*", "daring", "darlin*",
"daze*", "dear*", "decay*", "defeat*", "defect*", "definite",
"definitely", "degrad*", "delectabl*", "delicate*", "delicious*",
"deligh*", "depress*", "depriv*", "despair*", "desperat*", "despis*",
"destruct*", "determina*", "determined", "devastat*", "difficult*",
"digni*", "disadvantage*", "disagree*", "disappoint*", "disaster*",
"discomfort*", "discourag*", "dishearten*", "disillusion*", "dislike",
"disliked", "dislikes", "disliking", "dismay*", "dissatisf*",
"distract*", "distraught", "distress*", "distrust*", "disturb*",
"divin*", "domina*", "doom*", "dork*", "doubt*", "dread*", "dull*",
"dumb*", "dump*", "dwell*", "dynam*", "eager*", "ease*", "easie*",
"easily", "easiness", "easing", "easy*", "ecsta*", "efficien*",
"egotis*", "elegan*", "embarrass*", "emotion", "emotional", "empt*",
"encourag*", "energ*", "engag*", "enjoy*", "enrag*", "entertain*",
"enthus*", "envie*", "envious", "excel*", "excit*", "excruciat*",
"exhaust*", "fab", "fabulous*", "fail*", "fake", "fantastic*",
"fatal*", "fatigu*", "favor*", "favour*", "fear", "feared", "fearful*",
"fearing", "fearless*", "fears", "feroc*", "festiv*", "feud*",
"fiery", "fiesta*", "fine", "fired", "flatter*", "flawless*",
"flexib*", "flirt*", "flunk*", "foe*", "fond", "fondly", "fondness",
"fool*", "forgave", "forgiv*", "fought", "frantic*", "freak*",
"free", "freeb*", "freed*", "freeing", "freely", "freeness",
"freer", "frees*", "friend*", "fright*", "frustrat*", "fuck",
"fucked*", "fucker*", "fuckin*", "fucks", "fume*", "fuming",
"fun", "funn*", "furious*", "fury", "geek*", "genero*", "gentle",
"gentler", "gentlest", "gently", "giggl*", "giver*", "giving",
"glad", "gladly", "glamor*", "glamour*", "gloom*", "glori*",
"glory", "goddam*", "gorgeous*", "gossip*", "grace", "graced",
"graceful*", "graces", "graci*", "grand", "grande*", "gratef*",
"grati*", "grave*", "great", "grief", "griev*", "grim*", "grin",
"grinn*", "grins", "grouch*", "grr*", "guilt*", "ha", "haha*",
"handsom*", "happi*", "happy", "harass*", "hated", "hateful*",
"hater*", "hates", "hating", "hatred", "hazy", "heartbreak*",
"heartbroke*", "heartfelt", "heartless*", "heartwarm*", "heh*",
"hellish", "helper*", "helpful*", "helping", "helpless*", "helps",
"hesita*", "hilarious", "hoho*", "homesick*", "honour*", "hope",
"hoped", "hopeful", "hopefully", "hopefulness", "hopeless*",
"hopes", "hoping", "horr*", "hostil*", "hug", "hugg*", "hugs",
"humiliat*", "humor*", "humour*", "hurra*", "idiot", "ignor*",
"impatien*", "impersonal", "impolite*", "importan*", "impress*",
"improve*", "improving", "inadequa*", "incentive*", "indecis*",
"ineffect*", "inferior*", "inhib*", "innocen*", "insecur*", "insincer*",
"inspir*", "insult*", "intell*", "interest*", "interrup*", "intimidat*",
"invigor*", "irrational*", "irrita*", "isolat*", "jaded", "jealous*",
"jerk", "jerked", "jerks", "joke*", "joking", "joll*", "joy*",
"keen*", "kidding", "kind", "kindly", "kindn*", "kiss*", "laidback",
"lame*", "laugh*", "lazie*", "lazy", "liabilit*", "libert*",
"lied", "lies", "like", "likeab*", "liked", "likes", "liking",
"livel*", "LMAO", "LOL", "lone*", "longing*", "lose", "loser*",
"loses", "losing", "loss*", "lost", "lous*", "love", "loved",
"lovely", "lover*", "loves", "loving*", "low*", "luck", "lucked",
"lucki*", "luckless*", "lucks", "lucky", "ludicrous*", "lying",
"mad", "maddening", "madder", "maddest", "madly", "magnific*",
"maniac*", "masochis*", "melanchol*", "merit*", "merr*", "mess",
"messy", "miser*", "miss", "missed", "misses", "missing", "mistak*",
"mock", "mocked", "mocker*", "mocking", "mocks", "molest*", "mooch*",
"mood", "moodi*", "moods", "moody", "moron*", "mourn*", "nag*",
"nast*", "neat*", "needy", "neglect*", "nerd*", "nervous*", "neurotic*",
"nice*", "numb*", "nurtur*", "obnoxious*", "obsess*", "offence*",
"offens*", "ok", "okay", "okays", "oks", "openminded*", "openness",
"opportun*", "optimal*", "optimi*", "original", "outgoing", "outrag*",
"overwhelm*", "pained", "painf*", "paining", "painl*", "pains",
"palatabl*", "panic*", "paradise", "paranoi*", "partie*", "party*",
"passion*", "pathetic*", "peculiar*", "perfect*", "personal",
"perver*", "pessimis*", "petrif*", "pettie*", "petty*", "phobi*",
"piss*", "piti*", "pity*", "play", "played", "playful*", "playing",
"plays", "pleasant*", "please*", "pleasing", "pleasur*", "poison*",
"popular*", "positiv*", "prais*", "precious*", "pressur*", "prettie*",
"pretty", "prick*", "pride", "privileg*", "prize*", "problem*",
"profit*", "promis*", "protested", "protesting", "proud*", "puk*",
"radian*", "rage*", "raging", "rancid*", "rape*", "raping", "rapist*",
"readiness", "ready", "reassur*", "reek*", "regret*", "reject*",
"relax*", "relief", "reliev*", "reluctan*", "remorse*", "repress*",
"resent*", "resign*", "resolv*", "restless*", "revigor*", "reward*",
"rich*", "ridicul*", "rigid*", "risk*", "ROFL", "romanc*", "romantic*",
"rotten", "rude*", "sad", "sadde*", "sadly", "sadness", "sarcas*",
"satisf*", "savage*", "scare*", "scaring", "scary", "sceptic*",
"scream*", "screw*", "selfish*", "sentimental*", "serious", "seriously",
"seriousness", "severe*", "shake*", "shaki*", "shaky", "share",
"shared", "shares", "sharing", "shit*", "shock*", "shook", "shy*",
"sigh", "sighed", "sighing", "sighs", "silli*", "silly", "sincer*",
"skeptic*", "smart*", "smil*", "smother*", "smug*", "snob*",
"sob", "sobbed", "sobbing", "sobs", "sociab*", "solemn*", "sorrow*",
"sorry", "soulmate*", "special", "splend*", "stammer*", "stank",
"startl*", "stink*", "strain*", "strange", "strength*", "stress*",
"strong*", "struggl*", "stubborn*", "stunk", "stunned", "stuns",
"stupid*", "stutter*", "succeed*", "success*", "suck", "sucked",
"sucker*", "sucks", "sucky", "sunnier", "sunniest", "sunny",
"sunshin*", "super", "superior*", "support", "supported", "supporter*",
"supporting", "supportive*", "supports", "suprem*", "sure*",
"surpris*", "suspicio*", "sweet", "sweetheart*", "sweetie*",
"sweetly", "sweetness*", "sweets", "talent*", "tantrum*", "tears",
"teas*", "tehe", "temper", "tempers", "tender*", "tense*", "tensing",
"tension*", "terribl*", "terrific*", "terrified", "terrifies",
"terrify", "terrifying", "terror*", "thank", "thanked", "thankf*",
"thanks", "thief", "thieve*", "thoughtful*", "threat*", "thrill*",
"ticked", "timid*", "toleran*", "tortur*", "tough*", "traged*",
"tragic*", "tranquil*", "trauma*", "treasur*", "treat", "trembl*",
"trick*", "trite", "triumph*", "trivi*", "troubl*", "TRUE", "trueness",
"truer", "truest", "truly", "trust*", "truth*", "turmoil", "ugh",
"ugl*", "unattractive", "uncertain*", "uncomfortabl*", "uncontrol*",
"uneas*", "unfortunate*", "unfriendly", "ungrateful*", "unhapp*",
"unimportant", "unimpress*", "unkind", "unlov*", "unpleasant",
"unprotected", "unsavo*", "unsuccessful*", "unsure*", "unwelcom*",
"upset*", "uptight*", "useful*", "useless*", "vain", "valuabl*",
"valuing", "vanity", "vicious*", "vigor*", "vigour*", "villain*",
"violat*", "virtuo*", "vital*", "vulnerab*", "vulture*", "warfare*",
"warm*", "warred", "weak*", "wealth*", "weapon*", "weep*", "weird*",
"welcom*", "well*", "wept", "whine*", "whining", "willing", "wimp*",
"win", "winn*", "wins", "wisdom", "wise*", "witch", "woe*", "won",
"wonderf*", "worr*", "worse*", "worship*", "worst", "wow*", "yay",
"yays","yearn*","stench*")
Код, использованный из ответа MRau, который мне не помог:
ind_stem <- grep("[*]", kw_Emo)
kw_stem <- gsub("[*]", "", kw_Emo[ind_stem])
kw_word <- kw_Emo[-ind_stem]
tweets <- strsplit(TestTweets[, "clean_text"], "\\s+")
for (kws in kw_stem) {
count_i <- unlist(lapply(tweets, function(x) length(grep(kws, x))))
TestTweets <- cbind(TestTweets, count_i)
colnames(TestTweets)[ncol(TestTweets)] <- paste0(kws, "*")
}
for (kww in kw_word) {
count_i <- unlist(lapply(tweets, function(x) length(grep(paste0("^", kww, "$"), x))))
TestTweets <- cbind(TestTweets, count_i)
colnames(TestTweets)[ncol(TestTweets)] <- kww
}