better matching, less bugs, more fun

This commit is contained in:
2015-01-12 23:52:24 +01:00
parent efcdfae80e
commit 9e29a03d80
5 changed files with 561 additions and 557 deletions
+502 -502
View File
File diff suppressed because it is too large Load Diff
+1
View File
@@ -1,3 +1,4 @@
tweets_complete.csv
current.txt
.RData
matched-ids
+22 -46
View File
@@ -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
View File
@@ -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
View File
@@ -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>