better matching, less bugs, more fun
This commit is contained in:
@@ -1,3 +1,4 @@
|
||||
tweets_complete.csv
|
||||
current.txt
|
||||
.RData
|
||||
matched-ids
|
||||
|
||||
+22
-46
@@ -4,6 +4,8 @@ require(ggplot2)
|
||||
require(reshape2)
|
||||
require(stringr)
|
||||
|
||||
source("issuecomp-functions.R")
|
||||
|
||||
# Create date range
|
||||
date_start <- as.Date("2014-01-01")
|
||||
date_end <- as.Date("2014-12-31")
|
||||
@@ -13,6 +15,10 @@ drange <- date_start + days(0:drange)
|
||||
|
||||
# MATCH TWEETS ------------------------------------------------------------
|
||||
|
||||
id_folder <- "matched-ids"
|
||||
unlink(id_folder, recursive = TRUE)
|
||||
dir.create(id_folder)
|
||||
|
||||
issues <- data.frame(date = drange)
|
||||
issuelist <- xmlToList("issues.xml")
|
||||
issueheads <- names(issuelist)
|
||||
@@ -30,22 +36,34 @@ for(d in 1:nrow(issues)) {
|
||||
# Select tweet's text, make it lowercase and remove hashtag indicators (#)
|
||||
curtext <- as.character(tweets_curday$text[t])
|
||||
curtext <- str_replace_all(curtext, "#", "")
|
||||
curtext <- str_replace_all(curtext, "$", " ")
|
||||
curtext <- str_replace_all(curtext, "http://.+?\\s", "URL ")
|
||||
curid <- as.character(tweets_curday$id_str[t])
|
||||
|
||||
# Now test each single issue (not tag!)
|
||||
for(i in 1:length(issuelist)) {
|
||||
curtags <- as.character(issuelist[[i]])
|
||||
curissue <- names(issuelist)[i]
|
||||
curfile <- str_c(id_folder,"/",curissue,".csv")
|
||||
|
||||
# Now test all tags of a single issue
|
||||
for(t in 1:length(curtags)) {
|
||||
curtag <- str_c("\\W", curtags[t], "\\W")
|
||||
curchars <- nchar(curtag, type = "chars") - 4
|
||||
for(s in 1:length(curtags)) {
|
||||
curtag <- curtags[s]
|
||||
curchars <- nchar(curtag, type = "chars")
|
||||
|
||||
# Check if tag is an acronym. If so, ignore.case will be deactivated in smartPatternMatch
|
||||
if(curchars <= 4) {
|
||||
curacro <- checkAcronym(string = curtag, chars = curchars)
|
||||
} else {
|
||||
curacro <- FALSE
|
||||
}
|
||||
|
||||
# Match current tweet with tag. If >= 5 letters allow 1 changed letter, if >=8 letters allow 2 (Levenshtein distance)
|
||||
tags_found <- smartPatternMatch(curtext, curtag, curchars)
|
||||
tags_found <- smartPatternMatch(curtext, curtag, curchars, curacro)
|
||||
if(tags_found == 1) {
|
||||
#cat("Matched", curtag, "with", curtext,"\n")
|
||||
issues[d,curissue] <- issues[d,curissue] + 1
|
||||
write(str_c(curdate,";\"",curid,"\";",curtag), curfile, append = TRUE)
|
||||
break
|
||||
}
|
||||
else {
|
||||
@@ -59,44 +77,6 @@ for(d in 1:nrow(issues)) {
|
||||
|
||||
|
||||
|
||||
# WEEKLY INTERVALS --------------------------------------------------------
|
||||
|
||||
|
||||
|
||||
## Do not use days but week intervals
|
||||
|
||||
wrange <- (as.integer(date_end - date_start) / 7)
|
||||
wrange <- floor(wrange) - 1
|
||||
wrange <- date_start + weeks(0:wrange)
|
||||
issues_week <- data.frame(week = wrange)
|
||||
issues_week[issueheads] <- 0
|
||||
|
||||
|
||||
for(w in 1:nrow(issues_week)) {
|
||||
curweek <- issues_week$week[w]
|
||||
currange <- curweek + days(0:6)
|
||||
|
||||
day <- 1
|
||||
|
||||
|
||||
for(d in 1:nrow(issues)) {
|
||||
curday <- issues$date[d]
|
||||
|
||||
if(curweek == curday) {
|
||||
for(c in 2:ncol(issues)) {
|
||||
curissue <- names(issues)[c]
|
||||
d2 <- d + 6
|
||||
curvalue <- sum(issues[d:d2,curissue])
|
||||
issues_week[w, curissue] <- curvalue
|
||||
|
||||
} # /for issues columns
|
||||
} # /if day matches first day of week
|
||||
|
||||
} # /for issues rows
|
||||
} # /for issues_week
|
||||
|
||||
|
||||
|
||||
|
||||
# VISUALS -----------------------------------------------------------------
|
||||
|
||||
@@ -105,10 +85,6 @@ issues_melt <- melt(issues,id="date")
|
||||
ggplot(issues_melt,aes(x=date,y=value,colour=variable,group=variable)) + geom_line(size=1)
|
||||
ggplot(issues_melt,aes(x=date,y=value,colour=variable,group=variable)) + geom_smooth(size=1,method="loess",formula = y ~ x, se=FALSE)
|
||||
|
||||
# Level: weeks
|
||||
issues_week_melt <- melt(issues_week,id="week")
|
||||
ggplot(issues_week_melt,aes(x=week,y=value,colour=variable,group=variable)) + geom_line(size=1)
|
||||
ggplot(issues_week_melt,aes(x=week,y=value,colour=variable,group=variable)) + geom_smooth(size=1,method="loess",formula = y ~ x, se=FALSE)
|
||||
|
||||
|
||||
# POSSIBLY USEFUL CODE ----------------------------------------------------
|
||||
|
||||
+33
-6
@@ -26,20 +26,47 @@ convertLogical0 <- function(var) {
|
||||
return(var)
|
||||
}
|
||||
|
||||
smartPatternMatch <- function(string, pattern, chars) {
|
||||
if(chars < 5) {
|
||||
found <- agrep(pattern, string, max.distance = list(all = 0), ignore.case = TRUE, fixed = FALSE)
|
||||
smartPatternMatch <- function(string, pattern, chars, acronym) {
|
||||
pattern <- str_c("\\b", pattern, "\\b")
|
||||
|
||||
if(chars <= 4) {
|
||||
found <- agrep(pattern, string, max.distance = list(all = 0), ignore.case = !acronym, fixed = FALSE)
|
||||
}
|
||||
else if(chars > 7) {
|
||||
found <- agrep(pattern, string, max.distance = list(all = 2), ignore.case = TRUE, fixed = FALSE)
|
||||
else if(chars >= 8) {
|
||||
found <- agrep(pattern, string, max.distance = list(all = 2), ignore.case = !acronym, fixed = FALSE)
|
||||
}
|
||||
else {
|
||||
found <- agrep(pattern, string, max.distance = list(all = 1), ignore.case = TRUE, fixed = FALSE)
|
||||
found <- agrep(pattern, string, max.distance = list(all = 1), ignore.case = !acronym, fixed = FALSE)
|
||||
}
|
||||
found <- convertLogical0(found)
|
||||
return(found)
|
||||
}
|
||||
|
||||
viewMatchingTweets <- function(date, issue, folder) {
|
||||
file <- str_c(folder,"/",issue,".csv")
|
||||
df <- read.csv(file, sep = ";", colClasses="character", header = FALSE)
|
||||
for(r in 1:nrow(df)) {
|
||||
curdate <- as.character(df[r,1])
|
||||
if(curdate == date) {
|
||||
curid <- as.character(df[r,2])
|
||||
curtag <- as.character(df[r,3])
|
||||
cat(tweets$text[tweets$id_str == curid]," - ",curtag,"\n")
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
checkAcronym <- function(string, chars) {
|
||||
curtag_up <- str_replace_all(string = curtag, pattern = "[[:lower:]]", replacement = "")
|
||||
curchars_up <- nchar(curtag_up, type = "chars")
|
||||
if(curchars_up == curchars) {
|
||||
return(TRUE)
|
||||
}
|
||||
else {
|
||||
return(FALSE)
|
||||
}
|
||||
}
|
||||
|
||||
## ERROR HANDLING
|
||||
|
||||
# Check for empty API returns (0 or 1 or 2)
|
||||
|
||||
+3
-3
@@ -62,9 +62,9 @@
|
||||
|
||||
<issue.iraq>
|
||||
<tag>irak</tag>
|
||||
<tag>isis</tag>
|
||||
<tag>is</tag>
|
||||
<tag>kalifat</tag>
|
||||
<tag>ISIS</tag>
|
||||
<tag>IS</tag>
|
||||
<tag>Kalifat</tag>
|
||||
</issue.iraq>
|
||||
|
||||
<issue.ebola>
|
||||
|
||||
Reference in New Issue
Block a user