better matching, less bugs, more fun
This commit is contained in:
@@ -1,3 +1,4 @@
|
|||||||
tweets_complete.csv
|
tweets_complete.csv
|
||||||
current.txt
|
current.txt
|
||||||
.RData
|
.RData
|
||||||
|
matched-ids
|
||||||
|
|||||||
+22
-46
@@ -4,6 +4,8 @@ require(ggplot2)
|
|||||||
require(reshape2)
|
require(reshape2)
|
||||||
require(stringr)
|
require(stringr)
|
||||||
|
|
||||||
|
source("issuecomp-functions.R")
|
||||||
|
|
||||||
# Create date range
|
# Create date range
|
||||||
date_start <- as.Date("2014-01-01")
|
date_start <- as.Date("2014-01-01")
|
||||||
date_end <- as.Date("2014-12-31")
|
date_end <- as.Date("2014-12-31")
|
||||||
@@ -13,6 +15,10 @@ drange <- date_start + days(0:drange)
|
|||||||
|
|
||||||
# MATCH TWEETS ------------------------------------------------------------
|
# MATCH TWEETS ------------------------------------------------------------
|
||||||
|
|
||||||
|
id_folder <- "matched-ids"
|
||||||
|
unlink(id_folder, recursive = TRUE)
|
||||||
|
dir.create(id_folder)
|
||||||
|
|
||||||
issues <- data.frame(date = drange)
|
issues <- data.frame(date = drange)
|
||||||
issuelist <- xmlToList("issues.xml")
|
issuelist <- xmlToList("issues.xml")
|
||||||
issueheads <- names(issuelist)
|
issueheads <- names(issuelist)
|
||||||
@@ -30,22 +36,34 @@ for(d in 1:nrow(issues)) {
|
|||||||
# Select tweet's text, make it lowercase and remove hashtag indicators (#)
|
# Select tweet's text, make it lowercase and remove hashtag indicators (#)
|
||||||
curtext <- as.character(tweets_curday$text[t])
|
curtext <- as.character(tweets_curday$text[t])
|
||||||
curtext <- str_replace_all(curtext, "#", "")
|
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!)
|
# Now test each single issue (not tag!)
|
||||||
for(i in 1:length(issuelist)) {
|
for(i in 1:length(issuelist)) {
|
||||||
curtags <- as.character(issuelist[[i]])
|
curtags <- as.character(issuelist[[i]])
|
||||||
curissue <- names(issuelist)[i]
|
curissue <- names(issuelist)[i]
|
||||||
|
curfile <- str_c(id_folder,"/",curissue,".csv")
|
||||||
|
|
||||||
# Now test all tags of a single issue
|
# Now test all tags of a single issue
|
||||||
for(t in 1:length(curtags)) {
|
for(s in 1:length(curtags)) {
|
||||||
curtag <- str_c("\\W", curtags[t], "\\W")
|
curtag <- curtags[s]
|
||||||
curchars <- nchar(curtag, type = "chars") - 4
|
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)
|
# 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) {
|
if(tags_found == 1) {
|
||||||
#cat("Matched", curtag, "with", curtext,"\n")
|
#cat("Matched", curtag, "with", curtext,"\n")
|
||||||
issues[d,curissue] <- issues[d,curissue] + 1
|
issues[d,curissue] <- issues[d,curissue] + 1
|
||||||
|
write(str_c(curdate,";\"",curid,"\";",curtag), curfile, append = TRUE)
|
||||||
break
|
break
|
||||||
}
|
}
|
||||||
else {
|
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 -----------------------------------------------------------------
|
# 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_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)
|
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 ----------------------------------------------------
|
# POSSIBLY USEFUL CODE ----------------------------------------------------
|
||||||
|
|||||||
+33
-6
@@ -26,20 +26,47 @@ convertLogical0 <- function(var) {
|
|||||||
return(var)
|
return(var)
|
||||||
}
|
}
|
||||||
|
|
||||||
smartPatternMatch <- function(string, pattern, chars) {
|
smartPatternMatch <- function(string, pattern, chars, acronym) {
|
||||||
if(chars < 5) {
|
pattern <- str_c("\\b", pattern, "\\b")
|
||||||
found <- agrep(pattern, string, max.distance = list(all = 0), ignore.case = TRUE, fixed = FALSE)
|
|
||||||
|
if(chars <= 4) {
|
||||||
|
found <- agrep(pattern, string, max.distance = list(all = 0), ignore.case = !acronym, fixed = FALSE)
|
||||||
}
|
}
|
||||||
else if(chars > 7) {
|
else if(chars >= 8) {
|
||||||
found <- agrep(pattern, string, max.distance = list(all = 2), ignore.case = TRUE, fixed = FALSE)
|
found <- agrep(pattern, string, max.distance = list(all = 2), ignore.case = !acronym, fixed = FALSE)
|
||||||
}
|
}
|
||||||
else {
|
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)
|
found <- convertLogical0(found)
|
||||||
return(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
|
## ERROR HANDLING
|
||||||
|
|
||||||
# Check for empty API returns (0 or 1 or 2)
|
# Check for empty API returns (0 or 1 or 2)
|
||||||
|
|||||||
+3
-3
@@ -62,9 +62,9 @@
|
|||||||
|
|
||||||
<issue.iraq>
|
<issue.iraq>
|
||||||
<tag>irak</tag>
|
<tag>irak</tag>
|
||||||
<tag>isis</tag>
|
<tag>ISIS</tag>
|
||||||
<tag>is</tag>
|
<tag>IS</tag>
|
||||||
<tag>kalifat</tag>
|
<tag>Kalifat</tag>
|
||||||
</issue.iraq>
|
</issue.iraq>
|
||||||
|
|
||||||
<issue.ebola>
|
<issue.ebola>
|
||||||
|
|||||||
Reference in New Issue
Block a user