mxmehl/uni-ba-socialagenda
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

added coding sample tests

Browse Source
This commit is contained in:
mxmehl
2015-01-15 20:24:40 +01:00
parent 0ea1d11100
commit a4b966965b
12 changed files with 567 additions and 366 deletions
Download Patch File Download Diff File Expand all files Collapse all files
.RData
BIN
View File
Binary file not shown.
.Rhistory
+358 -358
View File
@@ -1,261 +1,178 @@
# 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
all(test)
test <- NULL
View(c_errors)
c_errors <- read.csv("issuecomp-codingsample-error.csv", header = F, sep=",", colClasses="character")
names(c_errors) <- c("str_id", "code", "tags", "text")
for(r in 1:nrow(c_errors)) {
c_errcode <- as.character(c_errors$code[r])
c_errtags <- as.character(c_errors$tags[r])
c_errtext <- as.character(c_errors$text[r])
cat("===============\n\n[TWEET]: ",c_errtext,"\n[ISSUES]: ", c_errtags, "\n", sep="")
source("issuecomp-codingsample-function2.R")
}
# 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, curacro)
if(tags_found == 1) {
#cat("Matched", curtag, "with", curtext,"\n")
issues[d,curissue] <- issues[d,curissue] + 1
write(str_c(curdate,";\"",curid,"\""), curfile, append = TRUE)
status
for(r in 1:nrow(c_errors)) {
c_errcode <- as.character(c_errors$code[r])
c_errtags <- as.character(c_errors$tags[r])
c_errtext <- as.character(c_errors$text[r])
cat("===============\n\n[TWEET]: ",c_errtext,"\n[ISSUES]: ", c_errtags, "\n", sep="")
source("issuecomp-codingsample-function2.R")
}
if(c_errcode == "1") {
#cat("Which issue is incorrect?\n")
repeat {
c_tag <- readYN("Which issue is incorrect?: ")
c_tag <- unlist(str_split(c_tag, ";"))
for(i in 1:length(c_tag)) {
if(checkIssue(c_tag[i], c_issueheads)) {status[i] <- TRUE} else {cat("Issue",c_tag[i],"does not exist. Please try again.\n")}
}
if(all(status)) {
break
}
else {
#cat("Nothing found\n")
}
} # /for curtags
} # /for issuelist
} # /for tweets_curday
} # /for drange
smartPatternMatch("kerTips: Riker workplace tip: Flirt when no one else is looking. http", "IS", 2, TRUE)
smartPatternMatch("kerTips: Riker workplace tip: Flirt when no one else is looking. http", "is", 2, TRUE)
viewMatchingTweets("2014-01-06", "issue.iraq", id_folder)
# 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)
issues[issueheads] <- 0
for(d in 1:nrow(issues)) {
# Go through every day
curdate <- issues$date[d]
cat(as.character(curdate),"\n")
# Put all tweets from specific day in a temporary DF
tweets_curday <- tweets[tweets[, "created_at"] == curdate, ]
for(t in 1:nrow(tweets_curday)){
# Select tweet's text, make it lowercase and remove hashtag indicators (#)
curtext <- as.character(tweets_curday$text[t])
curtext <- str_replace_all(curtext, "#", "")
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(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, curacro)
if(tags_found == 1) {
#cat("Matched", curtag, "with", curtext,"\n")
issues[d,curissue] <- issues[d,curissue] + 1
write(str_c(curdate,";\"",curid,"\""), curfile, append = TRUE)
break
}
else {
#cat("Nothing found\n")
}
} # /for curtags
} # /for issuelist
} # /for tweets_curday
} # /for drange
source("issuecomp-functions.R")
# 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)
issues[issueheads] <- 0
for(d in 1:nrow(issues)) {
# Go through every day
curdate <- issues$date[d]
cat(as.character(curdate),"\n")
# Put all tweets from specific day in a temporary DF
tweets_curday <- tweets[tweets[, "created_at"] == curdate, ]
for(t in 1:nrow(tweets_curday)){
# Select tweet's text, make it lowercase and remove hashtag indicators (#)
curtext <- as.character(tweets_curday$text[t])
curtext <- str_replace_all(curtext, "#", "")
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(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, 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 {
#cat("Nothing found\n")
}
} # /for curtags
} # /for issuelist
} # /for tweets_curday
} # /for 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)
issues[issueheads] <- 0
for(d in 1:nrow(issues)) {
# Go through every day
curdate <- issues$date[d]
cat(as.character(curdate),"\n")
# Put all tweets from specific day in a temporary DF
tweets_curday <- tweets[tweets[, "created_at"] == curdate, ]
for(t in 1:nrow(tweets_curday)){
# Select tweet's text, make it lowercase and remove hashtag indicators (#)
curtext <- as.character(tweets_curday$text[t])
curtext <- str_replace_all(curtext, "#", "")
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(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, 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 {
#cat("Nothing found\n")
}
} # /for curtags
} # /for issuelist
} # /for tweets_curday
} # /for drange
source("issuecomp-functions.R")
viewMatchingTweets("2014-01-06", "issue.iraq", id_folder)
viewMatchingTweets("2014-01-07", "issue.iraq", id_folder)
viewMatchingTweets("2014-01-09", "issue.iraq", id_folder)
curtext <- "Willkürlich Menschen an ihrer #Versammlungsfreiheit zu hindern ist eindeutig rechtswidrig. http://t.co/A7IQfISIhP #Gefahrengebiet #Hamburg"
str_replace_all(curtext, "http://.+\\W", "")
str_replace_all(curtext, "http://.+?\\W", "")
str_replace_all(curtext, "http://.+?\\s", "")
str_replace_all(curtext, "http://.+?\\s", "")
curtext <- "test http://google.de haha http://nsa.gov eqiuhe"
str_replace_all(curtext, "http://.+?\\s", "")
str_replace_all(curtext, "http://.+?\\s", "URL")
str_replace_all(curtext, "http://.+?\\s", "URL ")
viewMatchingTweets("2014-01-09", "issue.iraq", id_folder)
# 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)
issues[issueheads] <- 0
for(d in 1:nrow(issues)) {
# Go through every day
curdate <- issues$date[d]
cat(as.character(curdate),"\n")
# Put all tweets from specific day in a temporary DF
tweets_curday <- tweets[tweets[, "created_at"] == curdate, ]
for(t in 1:nrow(tweets_curday)){
# 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, "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(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, 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 {
#cat("Nothing found\n")
}
} # /for curtags
} # /for issuelist
} # /for tweets_curday
} # /for drange
viewMatchingTweets("2014-01-09", "issue.iraq", id_folder)
viewMatchingTweets("2014-01-08", "issue.iraq", id_folder)
viewMatchingTweets("2014-01-10", "issue.iraq", id_folder)
curtext
str_replace_all(curtext, "http://.+?\\>", "URL ")
str_replace_all(curtext, "http://.+?\\<", "URL ")
curtext <- str_replace_all(curtext, "http://.+?\\b", "URL ")
str_replace_all(curtext, "http://.+?\\b", "URL ")
str_replace_all(curtext, "http://.+?\\s", "URL ")
curtext
curtext <- as.character(tweets_curday$text[t])
curtext
str_replace_all(curtext, "http://.+?\\s", "URL ")
str_replace_all(curtext, "http://.+?\\b", "URL ")
str_replace_all(curtext, "http://.+?\\<", "URL ")
str_replace_all(curtext, "http://.+?\\>", "URL ")
str_replace_all(curtext, "http://.+?\\s", "URL ")
str_replace_all(curtext, "$", " ")
curtext <- str_replace_all(curtext, "$", " ")
curtext
str_replace_all(curtext, "http://.+?\\s", "URL ")
viewMatchingTweets("2014-01-10", "issue.iraq", id_folder)
if(c_errcode == "1") {
#cat("Which issue is incorrect?\n")
repeat {
c_tag <- readYN("Which issue is incorrect?: ")
c_tag <- unlist(str_split(c_tag, ";"))
for(i in 1:length(c_tag)) {
if(checkIssue(c_tag[i], c_issueheads)) {status[i] <- TRUE} else {cat("Issue",c_tag[i],"does not exist. Please try again.\n")}
}
if(all(status)) {
break
}
}
}
wdq
for(r in 1:nrow(c_errors)) {
c_errcode <- as.character(c_errors$code[r])
c_errtags <- as.character(c_errors$tags[r])
c_errtext <- as.character(c_errors$text[r])
cat("===============\n\n[TWEET]: ",c_errtext,"\n[ISSUES]: ", c_errtags, "\n", sep="")
source("issuecomp-codingsample-function2.R")
}
source("issuecomp-codingsample-function2.R")
for(r in 1:nrow(c_errors)) {
c_errcode <- as.character(c_errors$code[r])
c_errtags <- as.character(c_errors$tags[r])
c_errtext <- as.character(c_errors$text[r])
cat("===============\n\n[TWEET]: ",c_errtext,"\n[ISSUES]: ", c_errtags, "\n", sep="")
source("issuecomp-codingsample-function2.R")
}
for(r in 1:nrow(c_errors)) {
c_errcode <- as.character(c_errors$code[r])
c_errtags <- as.character(c_errors$tags[r])
c_errtext <- as.character(c_errors$text[r])
cat("===============\n\n[TWEET]: ",c_errtext,"\n[ISSUES]: ", c_errtags, "\n", sep="")
source("issuecomp-codingsample-function2.R")
}
checkAllIssues <- function(string, issuelist) {
string <- unlist(str_split(string, ";"))
for(i in 1:length(string)) {
if(checkIssue(string[i], issuelist)) {
status[i] <- TRUE
}
else {
cat("Issue",string[i],"does not exist. Please try again.\n")
status[i] <- FALSE
}
}
}
test
checkAllIssues <- function(string, issuelist) {
string <- unlist(str_split(string, ";"))
for(i in 1:length(string)) {
if(checkIssue(string[i], issuelist)) {
status[i] <- TRUE
}
else {
cat("Issue",string[i],"does not exist. Please try again.\n")
status[i] <- FALSE
}
}
return(status)
}
test <- "issue.edathy"
checkAllIssues(test, c_issueheads)
test <- "issue.edathy"
checkAllIssues(test, c_issueheads)
rm(status)
checkAllIssues(test, c_issueheads)
checkAllIssues <- function(string, issuelist) {
status <- NULL
string <- unlist(str_split(string, ";"))
for(i in 1:length(string)) {
if(checkIssue(string[i], issuelist)) {
status[i] <- TRUE
}
else {
cat("Issue",string[i],"does not exist. Please try again.\n")
status[i] <- FALSE
}
}
return(status)
}
checkAllIssues(test, c_issueheads)
checkAllIssues("wdjqaowd", c_issueheads)
test <- checkAllIssues("wdjqaowd", c_issueheads)
test
test <- checkAllIssues("wdjqaow;wiqud", c_issueheads)
test
test <- checkAllIssues("wdjqaow;issue.edathy", c_issueheads)
test
checkAllIssues <- function(string, issuelist) {
status <- NULL
string <- unlist(str_split(string, ";"))
for(i in 1:length(string)) {
if(checkIssue(string[i], issuelist)) {
status[i] <- TRUE
}
else {
cat("Issue",string[i],"does not exist. Please try again.\n")
status[i] <- FALSE
}
}
return(status)
}
for(r in 1:nrow(c_errors)) {
c_errcode <- as.character(c_errors$code[r])
c_errtags <- as.character(c_errors$tags[r])
c_errtext <- as.character(c_errors$text[r])
cat("===============\n\n[TWEET]: ",c_errtext,"\n[ISSUES]: ", c_errtags, "\n", sep="")
source("issuecomp-codingsample-function2.R")
}
checkAllIssues <- function(string, issuelist) {
status <- NULL
for(i in 1:length(string)) {
if(checkIssue(string[i], issuelist)) {
status[i] <- TRUE
}
else {
cat("Issue",string[i],"does not exist. Please try again.\n")
status[i] <- FALSE
}
}
return(status)
}
for(r in 1:nrow(c_errors)) {
c_errcode <- as.character(c_errors$code[r])
c_errtags <- as.character(c_errors$tags[r])
c_errtext <- as.character(c_errors$text[r])
cat("===============\n\n[TWEET]: ",c_errtext,"\n[ISSUES]: ", c_errtags, "\n", sep="")
source("issuecomp-codingsample-function2.R")
}
for(r in 1:nrow(c_errors)) {
c_errcode <- as.character(c_errors$code[r])
c_errtags <- as.character(c_errors$tags[r])
c_errtext <- as.character(c_errors$text[r])
cat("===============\n\n[TWEET]: ",c_errtext,"\n[ISSUES]: ", c_errtags, "\n", sep="")
source("issuecomp-codingsample-function2.R")
}
View(c_issues)
View(tweets)
tweets$tagged <- NULL
View(c_tweets)
View(tweets)
# MATCH TWEETS ------------------------------------------------------------
id_folder <- "matched-ids"
unlink(id_folder, recursive = TRUE)
@@ -264,6 +181,8 @@ issues <- data.frame(date = drange)
issuelist <- xmlToList("issues.xml")
issueheads <- names(issuelist)
issues[issueheads] <- 0
tweets$issue <- ""
tweets$tags <- ""
for(d in 1:nrow(issues)) {
# Go through every day
curdate <- issues$date[d]
@@ -295,8 +214,14 @@ 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, curacro)
if(tags_found == 1) {
#cat("Matched", curtag, "with", curtext,"\n")
# Raise number of findings on this day for this issue by 1
issues[d,curissue] <- issues[d,curissue] + 1
# Add issue and first matched tag of tweet to tweets-DF
oldissue <- tweets[tweets[, "id_str"] == curid, "issue"]
tweets[tweets[, "id_str"] == curid, "issue"] <- str_c(oldissue, curissue, ";")
oldtag <- tweets[tweets[, "id_str"] == curid, "tags"]
tweets[tweets[, "id_str"] == curid, "tags"] <- str_c(oldtag, curtag, ";")
# Add information to file for function viewPatternMatching
write(str_c(curdate,";\"",curid,"\";",curtag), curfile, append = TRUE)
break
}
@@ -307,7 +232,10 @@ else {
} # /for issuelist
} # /for tweets_curday
} # /for drange
viewMatchingTweets("2014-01-10", "issue.iraq", id_folder)
date_start <- as.Date("2014-01-01")
date_end <- as.Date("2014-12-31")
drange <- as.integer(date_end - date_start)
drange <- date_start + days(0:drange)
# MATCH TWEETS ------------------------------------------------------------
id_folder <- "matched-ids"
unlink(id_folder, recursive = TRUE)
@@ -316,6 +244,8 @@ issues <- data.frame(date = drange)
issuelist <- xmlToList("issues.xml")
issueheads <- names(issuelist)
issues[issueheads] <- 0
tweets$issue <- ""
tweets$tags <- ""
for(d in 1:nrow(issues)) {
# Go through every day
curdate <- issues$date[d]
@@ -347,8 +277,14 @@ 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, curacro)
if(tags_found == 1) {
#cat("Matched", curtag, "with", curtext,"\n")
# Raise number of findings on this day for this issue by 1
issues[d,curissue] <- issues[d,curissue] + 1
# Add issue and first matched tag of tweet to tweets-DF
oldissue <- tweets[tweets[, "id_str"] == curid, "issue"]
tweets[tweets[, "id_str"] == curid, "issue"] <- str_c(oldissue, curissue, ";")
oldtag <- tweets[tweets[, "id_str"] == curid, "tags"]
tweets[tweets[, "id_str"] == curid, "tags"] <- str_c(oldtag, curtag, ";")
# Add information to file for function viewPatternMatching
write(str_c(curdate,";\"",curid,"\";",curtag), curfile, append = TRUE)
break
}
@@ -359,90 +295,8 @@ else {
} # /for issuelist
} # /for tweets_curday
} # /for drange
View(issues)
viewMatchingTweets("2014-12-18", "issue.edathy", id_folder)
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)
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)
viewMatchingTweets("2014-12-18", "issue.conservative", id_folder)
agrep("christ", "Jungparlamentarier gleich Schriftführerdienst hat", max.distance = list(all = 2), ignore.case = TRUE, fixed = FALSE)
agrep("\\bchrist\\b", "Jungparlamentarier gleich Schriftführerdienst hat", max.distance = list(all = 2), ignore.case = TRUE, fixed = FALSE)
agrep("\\bchrist\\b", "Bla Christ bla", max.distance = list(all = 2), ignore.case = TRUE, fixed = FALSE)
agrep("\\bchrist\\b", "Bla Christus bla", max.distance = list(all = 2), ignore.case = TRUE, fixed = FALSE)
agrep("\\bchrist\\b", "Bla Christu bla", max.distance = list(all = 2), ignore.case = TRUE, fixed = FALSE)
agrep("\\bchrist\\b", "Bla Christus bla", max.distance = list(all = 2), ignore.case = TRUE, fixed = FALSE)
agrep("\\bchrist\\b", "Bla Christus bla", max.distance = list(all = 3), ignore.case = TRUE, fixed = FALSE)
agrep("\\bchrist\\b", "Bla christus bla", max.distance = list(all = 3), ignore.case = TRUE, fixed = FALSE)
agrep("\\bchrist\\b", "Bla christus bla", max.distance = list(all = 2), ignore.case = TRUE, fixed = FALSE)
agrep("\\bchrist\\b", "Bla christen bla", max.distance = list(all = 3), ignore.case = TRUE, fixed = FALSE)
agrep("\\bchrist\\b", "Bla Antichrist bla", max.distance = list(all = 3), ignore.case = TRUE, fixed = FALSE)
agrep("\\bchrist\\b", "Bla Christian bla", max.distance = list(all = 3), ignore.case = TRUE, fixed = FALSE)
agrep("\\bchrist\\b", "Bla Christian bla", max.distance = list(all = 3), ignore.case = TRUE, fixed = FALSE, value=TRUE)
agrep("\\bchrist\\b", "Bla Christi bla", max.distance = list(all = 3), ignore.case = TRUE, fixed = FALSE, value=TRUE)
agrep("\\bchrist\\b", "Bla Christi bla", max.distance = list(all = 3), ignore.case = TRUE, fixed = FALSE)
agrep("\\bIS\\b", "Wir sind bei ISN Network", max.distance = list(all = 0), ignore.case = TRUE, fixed = FALSE)
agrep("\\bIS\\b", "Wir sind bei ISN Network", max.distance = list(all = 0), ignore.case = F, fixed = FALSE)
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)
issues[issueheads] <- 0
for(d in 1:nrow(issues)) {
# Go through every day
curdate <- issues$date[d]
cat(as.character(curdate),"\n")
# Put all tweets from specific day in a temporary DF
tweets_curday <- tweets[tweets[, "created_at"] == curdate, ]
for(t in 1:nrow(tweets_curday)){
# 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(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, 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 {
#cat("Nothing found\n")
}
} # /for curtags
} # /for issuelist
} # /for tweets_curday
} # /for drange
issues_melt <- melt(issues,id="date")
ggplot(issues_melt,aes(x=date,y=value,colour=variable,group=variable)) + geom_smooth(size=1,method="loess",formula = y ~ x, se=FALSE)
viewMatchingTweets("2014-12-18", "issue.conservative", id_folder)
pattern
agrep("\\bchrist\\b", "RT @christophheyes: Morgen in der Presse: Oppermann - Briefkasten gestohlen! Gabriel - Poesiealbum nicht mehr auffindbar! #edathy #hartmann", max.distance = list(all = 1), ignore.case = TRUE, fixed = FALSE)
smartPatternMatch
source("issuecomp-functions.R")
smartPatternMatch
View(tweets)
View(tweets)
# MATCH TWEETS ------------------------------------------------------------
id_folder <- "matched-ids"
unlink(id_folder, recursive = TRUE)
@@ -451,6 +305,8 @@ issues <- data.frame(date = drange)
issuelist <- xmlToList("issues.xml")
issueheads <- names(issuelist)
issues[issueheads] <- 0
tweets$issue <- ""
tweets$tags <- ""
for(d in 1:nrow(issues)) {
# Go through every day
curdate <- issues$date[d]
@@ -482,8 +338,14 @@ 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, curacro)
if(tags_found == 1) {
#cat("Matched", curtag, "with", curtext,"\n")
# Raise number of findings on this day for this issue by 1
issues[d,curissue] <- issues[d,curissue] + 1
# Add issue and first matched tag of tweet to tweets-DF
oldissue <- tweets[tweets[, "id_str"] == curid, "issue"]
tweets[tweets[, "id_str"] == curid, "issue"] <- str_c(oldissue, curissue, ";")
oldtag <- tweets[tweets[, "id_str"] == curid, "tags"]
tweets[tweets[, "id_str"] == curid, "tags"] <- str_c(oldtag, curtag, ";")
# Add information to file for function viewPatternMatching
write(str_c(curdate,";\"",curid,"\";",curtag), curfile, append = TRUE)
break
}
@@ -494,19 +356,157 @@ else {
} # /for issuelist
} # /for tweets_curday
} # /for drange
issues_melt <- melt(issues,id="date")
ggplot(issues_melt,aes(x=date,y=value,colour=variable,group=variable)) + geom_smooth(size=1,method="loess",formula = y ~ x, se=FALSE)
viewMatchingTweets("2014-12-18", "issue.conservative", id_folder)
viewMatchingTweets("2014-05-18", "issue.conservative", id_folder)
viewMatchingTweets("2014-05-1", "issue.conservative", id_folder)
viewMatchingTweets("2014-05-01", "issue.conservative", id_folder)
viewMatchingTweets("2014-05-02", "issue.conservative", id_folder)
viewMatchingTweets("2014-05-10", "issue.conservative", id_folder)
viewMatchingTweets("2014-05-10", "issue.middleeast", id_folder)
viewMatchingTweets("2014-05-10", "issue.iraw", id_folder)
viewMatchingTweets("2014-05-10", "issue.iraq", id_folder)
viewMatchingTweets("2014-08-10", "issue.iraq", id_folder)
viewMatchingTweets("2014-11-10", "issue.iraq", id_folder)
viewMatchingTweets("2014-12-10", "issue.iraq", id_folder)
View(issues)
viewMatchingTweets("2014-09-19", "issue.control", id_folder)
View(tweets)
View(c_errors)
View(tweets)
readYN <- function(question) {
n <- readline(prompt=question)
n <- as.character(n)
return(n)
}
checkIssue <- function(string, issuelist) {
status <- any(str_detect(string, issuelist))
return(status)
}
checkAllIssues <- function(string, issuelist) {
status <- NULL
for(i in 1:length(string)) {
if(checkIssue(string[i], issuelist)) {
status[i] <- TRUE
}
else {
cat("Issue",string[i],"does not exist. Please try again.\n")
status[i] <- FALSE
}
}
return(status)
}
View(tweets)
View(tweets)
write.csv(tweets, "tweets.csv")
save(tweets, file="tweets.RData")
write.csv(tweets, "tweets.csv")
save(tweets, file="tweets.RData")
c_tweets <- read.csv("tweets.csv")
View(c_tweets)
c_tweets$X <- NULL
# Read all issues from XML file
c_issues <- data.frame(date = drange)
c_issuelist <- xmlToList("issues.xml")
c_issueheads <- names(issuelist)
c_issues[issueheads] <- 0
source("issuecomp-codingsample-function.R")
rm(c_err, c_result, c_samid, c_samno,c_samtags,c_samissue,c_samtext,c_yn)
rm(c_samtag)
rm(tweets_curday,curacro, curchars, curdate,curfile,curid,curissue,curtag,curtags,curtext,d,date_end,date_start,drange,i,id_folder,oldissue,oldtag,s,t,tags_found)
c_errors <- read.csv("issuecomp-codingsample-error.csv", header = F, sep=",", colClasses="character")
View(c_errors)
names(c_errors) <- c("str_id", "code", "issue", "tags", "text")
View(c_errors)
for(r in 1:nrow(c_errors)) {
c_errcode <- as.character(c_errors$code[r])
c_errissue <- as.character(c_errors$issue[r])
c_errtags <- as.character(c_errors$tags[r])
c_errtext <- as.character(c_errors$text[r])
c_errid <- as.character(c_errors$str_id[r])
cat("===============\n\n[TWEET]: ",c_errtext,"\n[ISSUES]: ", c_errtags, "\n", sep="")
source("issuecomp-codingsample-function2.R")
}
for(r in 1:nrow(c_errors)) {
c_errcode <- as.character(c_errors$code[r])
c_errissue <- as.character(c_errors$issue[r])
c_errtags <- as.character(c_errors$tags[r])
c_errtext <- as.character(c_errors$text[r])
c_errid <- as.character(c_errors$str_id[r])
cat("===============\n\n[TWEET]: ",c_errtext,"\n[ISSUES]: ", c_errtags, "\n", sep="")
source("issuecomp-codingsample-function2.R")
}
c_curissue
c_curtags
c_errissue
c_errtags
c_errid
delrow <- NULL
for(r in 1:nrow(tweets)) {
if(format(tweets$created_at[r], "%Y") != "2014") {
delrow <- c(delrow, r)
}
curtext <- as.character(tweets$text[r])
curtext <- str_replace_all(curtext, "$", " ")
curtext <- str_replace_all(curtext, "http://.+?\\s", "URL ")
}
r
require(stringr)
View(tweets)
df <- data.frame(x= c("zeile1","zeile2"))
View(df)
df$x[1] <- "blabla"
View(df)
df <- data.frame(x= c("zeile1","zeile2"))
test <- "bla bla"
df$x[1] <- test
View(df)
df$x[1] <- as.character(test)
class(df$x)
df$x[1] <- as.factor(test)
head(tweet)
head(tweets)
df <- head(tweets)
View(df)
df$text[1] <- "test"
View(tweets)
View(df)
for(r in 1:nrow(tweets)) {
# if(format(tweets$created_at[r], "%Y") != "2014") {
# delrow <- c(delrow, r)
# }
curtext <- as.character(tweets$text[r])
curtext <- str_replace_all(curtext, "$", " ")
curtext <- str_replace_all(curtext, "http://.+?\\s", "URL ")
tweets$text[r] <- curtext
}
View(tweets)
View(c_tweets)
rm(delrow, r)
save(tweets, file="tweets_untagged.RData")
row.names(tweets) <- NULL
write.csv(tweets, "tweets.csv")
save(tweets, file="tweets.RData")
c_tweets <- read.csv("tweets.csv")
c_tweets$X <- NULL
View(c_tweets)
viewMatchingTweets
c_tweets <- read.csv("tweets.csv", colClasses="character")
c_tweets$X <- NULL
View(c_tweets)
View(c_issues)
c_errtags
for(r in 1:nrow(c_errors)) {
c_errcode <- as.character(c_errors$code[r])
c_errissue <- as.character(c_errors$issue[r])
c_errtags <- as.character(c_errors$tags[r])
c_errtext <- as.character(c_errors$text[r])
c_errid <- as.character(c_errors$str_id[r])
cat("===============\n\n[TWEET]: ",c_errtext,"\n[ISSUES]: ", c_errtags, "\n", sep="")
source("issuecomp-codingsample-function2.R")
}
curissue
c_curissue
str_join(c_curissue)
str_join(c_curissue,collapse = NULL)
str_join(c_curissue,sep=";",collapse = NULL)
paste(c_curissue,sep = "")
paste(c_curissue,sep = '')
length(paste(c_curissue,sep = ''))
str_join(c_curissue,sep=";",collapse = "")
str_join(c_curissue,sep=";",collapse = "w")
str_join(c_curissue,collapse = ";")
for(r in 1:nrow(c_errors)) {
c_errcode <- as.character(c_errors$code[r])
c_errissue <- as.character(c_errors$issue[r])
c_errtags <- as.character(c_errors$tags[r])
c_errtext <- as.character(c_errors$text[r])
c_errid <- as.character(c_errors$str_id[r])
cat("===============\n\n[TWEET]: ",c_errtext,"\n[ISSUES]: ", c_errtags, "\n", sep="")
source("issuecomp-codingsample-function2.R")
}
.gitignore
+3 -1
View File
@@ -1,4 +1,6 @@
tweets_complete.csv
current.txt
tweets.csv
tweets_untagged.csv
tweets_untagged.RData
.RData
matched-ids
issuecomp-analysis.R
+22 -3
View File
@@ -6,6 +6,8 @@ require(stringr)
source("issuecomp-functions.R")
load(file = "tweets_untagged.RData")
# Create date range
date_start <- as.Date("2014-01-01")
date_end <- as.Date("2014-12-31")
@@ -23,6 +25,8 @@ issues <- data.frame(date = drange)
issuelist <- xmlToList("issues.xml")
issueheads <- names(issuelist)
issues[issueheads] <- 0
tweets$issue <- ""
tweets$tags <- ""
for(d in 1:nrow(issues)) {
# Go through every day
@@ -36,8 +40,7 @@ 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!)
@@ -61,8 +64,16 @@ for(d in 1:nrow(issues)) {
# 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, curacro)
if(tags_found == 1) {
#cat("Matched", curtag, "with", curtext,"\n")
# Raise number of findings on this day for this issue by 1
issues[d,curissue] <- issues[d,curissue] + 1
# Add issue and first matched tag of tweet to tweets-DF
oldissue <- tweets[tweets[, "id_str"] == curid, "issue"]
tweets[tweets[, "id_str"] == curid, "issue"] <- str_c(oldissue, curissue, ";")
oldtag <- tweets[tweets[, "id_str"] == curid, "tags"]
tweets[tweets[, "id_str"] == curid, "tags"] <- str_c(oldtag, curtag, ";")
# Add information to file for function viewPatternMatching
write(str_c(curdate,";\"",curid,"\";",curtag), curfile, append = TRUE)
break
}
@@ -75,11 +86,19 @@ for(d in 1:nrow(issues)) {
} # /for tweets_curday
} # /for drange
rm(tweets_curday,curacro, curchars, curdate,curfile,curid,curissue,curtag,curtags,curtext,d,date_end,date_start,drange,i,id_folder,oldissue,oldtag,s,t,tags_found)
# SAVING ------------------------------------------------------------------
row.names(tweets) <- NULL
write.csv(tweets, "tweets.csv")
save(tweets, file="tweets.RData")
# VISUALS -----------------------------------------------------------------
# Level: days
issues_melt <- melt(issues,id="date")
ggplot(issues_melt,aes(x=date,y=value,colour=variable,group=variable)) + geom_line(size=1)
issuecomp-codingsample-correct.csv
+2
View File
@@ -0,0 +1,2 @@
"443032724505624576",0,"","","RT @Linksfraktion: Sevim Dagdelen: Optionspflicht abschaffen – ohne „Wenn“ und „Aber“ http://t.co/PXVz60RyDa"
"464039981766684672",0,"","","Hange spricht von einer Kutsche ohne Dach in der wir fahren und hoffen, dass es nicht regne #btADA"
1 443032724505624576 0 RT @Linksfraktion: Sevim Dagdelen: Optionspflicht abschaffen – ohne „Wenn“ und „Aber“ http://t.co/PXVz60RyDa
2 464039981766684672 0 Hange spricht von einer Kutsche ohne Dach in der wir fahren und hoffen, dass es nicht regne #btADA
issuecomp-codingsample-error.csv
+3
View File
@@ -0,0 +1,3 @@
"532463690013233152",1,"","","RT @cordhos: ! “@cducsubt: Paul Breitner vom @FCBayern - #Bundestag jetzt mit eigenem Fanclub @hahnflo @DoroBaer @dieAlbsteigerin http://t.…"
"516584367448403968",1,"","","Debate und critics in the parlamentarian assembly of the European Council about the elections in #Turkey @PACE_News @GeziParkii"
"516624274522918912",1,"","","Nach Bürgergespräch bin nun noch im Ratshof zur Ausstellungseröffnung - Wanderausstellung zum Bundestag."
1 532463690013233152 1 RT @cordhos: ! “@cducsubt: Paul Breitner vom @FCBayern - #Bundestag jetzt mit eigenem Fanclub @hahnflo @DoroBaer @dieAlbsteigerin http://t.…
2 516584367448403968 1 Debate und critics in the parlamentarian assembly of the European Council about the elections in #Turkey @PACE_News @GeziParkii
3 516624274522918912 1 Nach Bürgergespräch bin nun noch im Ratshof zur Ausstellungseröffnung - Wanderausstellung zum Bundestag.
issuecomp-codingsample-function.R
+39
View File
@@ -0,0 +1,39 @@
repeat {
c_samno <- sample(1:nrow(c_tweets), 1)
c_samtext <- as.character(c_tweets$text[c_samno])
c_samissue <- as.character(c_tweets$issue[c_samno])
c_samtags <- as.character(c_tweets$tags[c_samno])
c_samid <- as.character(c_tweets$id_str[c_samno])
repeat {
cat("===================\n\n[TWEET]: ",c_samtext,"\n", "[ISSUES]: ", c_samissue, sep="")
c_yn <- readYN("Is the categorization correct AND complete?\nEnter y or n: ")
# Check if input is correct
if(c_yn == "y" || c_yn == "n" || c_yn == "QUIT") {break} else {cat("Wrong input, please enter y or n (or QUIT if you want to exit safely).\n")}
}
# Exit codes:
# 0 = Correct tagging
# 1 = At least one tag was incorrect
# 2 = At least one tag was missing
# 3 = Both 1 and 2
if(c_yn == "y") {
c_result <- str_c("\"",c_samid,"\"",",0,","\"",c_samissue,"\",\"",c_samtags,"\",\"",c_samtext,"\"")
write(c_result, file = "issuecomp-codingsample-correct.csv", append = T)
}
else if(c_yn == "n") {
repeat {
c_err <- readYN("Enter 1 if a tag is incorrect, 2 if a tag is missing, and 3 if a tag is incorrect AND missing: ")
if(c_err == "1" || c_err == "2" || c_err == "3") {break} else {cat("Wrong input, please enter 1, 2 or 3.\n")}
}
c_result <- str_c("\"",c_samid,"\",",c_err,",\"",c_samissue,"\",\"",c_samtags,"\",\"",c_samtext,"\"")
write(c_result, file = "issuecomp-codingsample-error.csv", append = T)
}
else {
cat("Quitting now.")
break
}
}
issuecomp-codingsample-function2.R
+58
View File
@@ -0,0 +1,58 @@
# A tweet was falsely categorized
if(c_errcode == "1") {
repeat {
c_curissue <- readYN("Which issue is incorrect?: ")
if(c_curissue == "QUIT") {cat("Quitting this item without changes or entries.\n"); break}
c_curissue <- unlist(str_split(c_curissue, ";"))
status <- checkAllIssues(c_curissue, c_issueheads)
# Only continue if every given issue really exists (all "status" have to be TRUE)
if(all(status)) {
# Revert str_split
c_curissue <- str_join(c_curissue,collapse = ";")
# <ID>,<all issues>,<faulty issue(s),<all tags>,<tweet text>
c_result <- str_c("\"",c_errid,"\",\"",c_errissue,"\",\"",c_curissue,"\",\"",c_errtags,"\",\"",c_errtext,"\"")
write(c_result, file = "issuecomp-codingsample-error1.csv", append = T)
break
}
}
# A tweet should be categorized with an additional issue
} else if(c_errcode == "2") {
repeat {
c_curissue <- readYN("Which issue is missing?: ")
if(c_curissue == "QUIT") {cat("Quitting this item without changes or entries.\n"); break}
c_curissue <- unlist(str_split(c_curissue, ";"))
status <- checkAllIssues(c_curissue, c_issueheads)
# Only continue if every given issue really exists (all "status" have to be TRUE)
if(all(status)) {
# Revert str_split
c_curissue <- str_join(c_curissue,collapse = ";")
# <ID>,<all issues>,<faulty issue(s),<all tags>,<tweet text>
c_result <- str_c("\"",c_errid,"\",\"",c_errissue,"\",\"",c_curissue,"\",\"",c_errtags,"\",\"",c_errtext,"\"")
write(c_result, file = "issuecomp-codingsample-error2.csv", append = T)
break
}
}
# There is an issue missing AND a issue was wrong
} else if(c_errcode == "3") {
#cat("Which issue is incorrect and which one is missing?\n")
repeat {
c_tag <- readYN("Which issue is incorrect?: ")
c_tag <- unlist(str_split(c_tag, ";"))
for(i in 1:length(c_tag)) {
if(checkIssue(c_tag[i], c_issueheads)) {} else {cat("Issue",c_tag[i],"does not exist. Please try again.\n")}
}
}
# If this triggers the hell freezes...
} else {
cat("Neither 1, 2 or 3 as error code...")
}
issuecomp-codingsample.R
+75
View File
@@ -0,0 +1,75 @@
require(stringr)
require(XML)
# FUNCTIONS ---------------------------------------------------------------
readYN <- function(question) {
n <- readline(prompt=question)
n <- as.character(n)
return(n)
}
checkIssue <- function(string, issuelist) {
status <- any(str_detect(string, issuelist))
return(status)
}
checkAllIssues <- function(string, issuelist) {
status <- NULL
for(i in 1:length(string)) {
if(checkIssue(string[i], issuelist)) {
status[i] <- TRUE
}
else {
cat("Issue",string[i],"does not exist. Please try again.\n")
status[i] <- FALSE
}
}
return(status)
}
# SAMPLE OUT/INPUT --------------------------------------------------------
# Read CSV of all tweets (with tags, if available)
c_tweets <- read.csv("tweets.csv", colClasses="character")
c_tweets$X <- NULL
# Read all issues from XML file
c_issues <- data.frame(date = drange)
c_issuelist <- xmlToList("issues.xml")
c_issueheads <- names(issuelist)
c_issues[issueheads] <- 0
# Run through as many tweets as wished to mark them as correct or incorrect
source("issuecomp-codingsample-function.R")
rm(c_err, c_result, c_samid, c_samno,c_samtags,c_samissue,c_samtext,c_yn)
# Now go through tweets/tags marked as false
# Exit codes:
# 0 = Correct tagging
# 1 = At least one tag was incorrect
# 2 = At least one tag was missing
# 3 = Both 1 and 2
c_errors <- read.csv("issuecomp-codingsample-error.csv", header = F, sep=",", colClasses="character")
names(c_errors) <- c("str_id", "code", "issue", "tags", "text")
for(r in 1:nrow(c_errors)) {
c_errcode <- as.character(c_errors$code[r])
c_errissue <- as.character(c_errors$issue[r])
c_errtags <- as.character(c_errors$tags[r])
c_errtext <- as.character(c_errors$text[r])
c_errid <- as.character(c_errors$str_id[r])
cat("===============\n\n[TWEET]: ",c_errtext,"\n[ISSUES]: ", c_errtags, "\n", sep="")
source("issuecomp-codingsample-function2.R")
}
issuecomp-scraping.R
+6 -3
View File
@@ -176,19 +176,22 @@ tweets <- tweets[order(tweets$created_at), ]
# Finally delete every tweet not from 2014 (2013 or 2015)
delrow <- NULL
pb <- txtProgressBar(min = 0, max = nrow(tweets), style = 3)
for(r in 1:nrow(tweets)) {
if(format(tweets$created_at[r], "%Y") != "2014") {
delrow <- c(delrow, r)
}
setTxtProgressBar(pb, r)
curtext <- as.character(tweets$text[r])
curtext <- str_replace_all(curtext, "$", " ")
curtext <- str_replace_all(curtext, "http://.+?\\s", "URL ")
tweets$text[r] <- curtext
}
tweets <- tweets[-delrow, ]
rm(delrow, r)
# Convert dates to omit (unnecessary) time
tweets$created_at <- format(tweets$created_at, "%Y-%m-%d")
save(tweets, file="tweets.RData")
save(tweets, file="tweets_untagged.RData")
issues.xml
+1 -1
View File
@@ -87,7 +87,7 @@
</issue.conservative>
<issue.control>
<tag>pillepalle</tag>
<tag>der</tag>
<tag>schundluder</tag>
<tag>whatthefuck</tag>
</issue.control>
tweets.RData
BIN
View File
Binary file not shown.