Home Assignment 4

Student ID: 1A182901-2

---

1. Set up environment

rm(list=ls(all=TRUE))
setwd("~/Desktop/R/polimetrics")
library(quanteda)
library(readtext)
library(stm)
library(ggplot2)
library(wordcloud)
library(cowplot)

2. Import Data

myText <- readtext("~/Desktop/r/polimetrics/UK/*.txt",
                   docvarsfrom = "filenames", dvsep = " ", docvarnames = c("Party", "Year"))
mycorpus <- corpus(myText, docid_field = "doc_id")
docnames(mycorpus) <- gsub(".txt", "", docnames(mycorpus ))
myDfm <- dfm(mycorpus , remove = stopwords("english"), tolower = TRUE, stem = TRUE,
             remove_punct = TRUE, remove_numbers=TRUE)

3. Wordfish

reswf <- textmodel_wordfish(myDfm, dir = c(3, 1))
df_wf <- data.frame(v_wf = reswf$theta,
                    title = reswf$docs,
                    year = docvars(myDfm)$Year)
##Graph
par(mfrow=c(1,1),mar=c(5.1, 4.1, 4.1, 2.1))
gr_wf <- ggplot(df_wf,aes(y=reorder(title,v_wf),x=v_wf))
gr_wf_res <- gr_wf +
  geom_point() + 
  ggtitle("Wordfish Result") +
  ylab("") + 
  xlab("") + 
  theme_light() + 
  theme(legend.position="none",plot.title = element_text(hjust = 0.5))
gr_wf_res

4. STM with wf score

mycorpus2 <- mycorpus
mycorpus2$documents$wf <- df_wf$v_wf
myDfm2 <- dfm(mycorpus2 , remove = stopwords("english"), tolower = TRUE, stem = TRUE,
             remove_punct = TRUE, remove_numbers=TRUE)
#STM
Dfm_stm <- convert(myDfm2, to = "stm", docvars = docvars(mycorpus2))
Dfm_stm$meta$Year <- as.character(Dfm_stm$meta$Year)
stmFitted1 <- stm(Dfm_stm$documents,
                 Dfm_stm$vocab,
                 K = 6,
                 max.em.its = 50,
                 prevalence = ~ wf + Year,
                 data = Dfm_stm$meta,
                 init.type = "Spectral")
prep <- estimateEffect(1:6 ~ wf + Year, 
                       stmFitted1, 
                       meta = Dfm_stm$meta, 
                       uncertainty = "Global")

4.1. Justify “K=6”

K <-c(5,6,7)
storage  <- searchK(Dfm_stm$documents,
                    Dfm_stm$vocab,
                    K,
                    max.em.its = 75,
                    N = floor(0.2 * length(Dfm_stm$documents)),
                    prevalence = ~ Year + wf,
                    data = Dfm_stm$meta,
                    init.type = "Spectral")

par(mfrow=c(1,1),mar=c(5.1, 4.1, 4.1, 2.1))
plot(storage$results$semcoh,
     storage$results$exclus,
     xlab= "Semantic coherence",
     ylab= "Exclusivity",
     col= "blue",
     pch = 19,
     cex = 1,
     lty = "solid",
     lwd = 2)
text(storage$results$semcoh,
     storage$results$exclus,
     labels=storage$results$K,
     cex= 1,
     pos=2)

• As the plot of semantic coherence and exclusivity, K equal to 6 was the suggested setup.

4.2. Top Topics

par(mfrow=c(1,1),mar=c(5.1, 4.1, 4.1, 2.1))
plot(stmFitted1, type = "summary", labeltype = c("frex"))

par(mfrow=c(1,1),mar=c(0, 1, 0, 1))
plot(stmFitted1, type = "labels", labeltype = c("frex"))

• As the FREX result of those six topics, some of the topics could be represented as specific issues.
  1. Topic 4 might be the liberal democratic topic.
  2. Topic 5 might be the labor topic.
  3. Topic 6 might be the conservative topic.
• I chose to plot topic 4 and topic 6 across wordfish score as the following.

par(mfrow=c(2,1),mar=c(5.1, 4.1, 4.1, 2.1))
plot(prep, "wf", method = "continuous", topics = 4,
     model = stmFitted1, printlegend = FALSE, xaxt = "n", xlab = "wf")
seq <- seq(from = as.numeric("-2"), to = as.numeric("2"))
axis(1, at = seq)

title("Topic 4")
abline(h=0, col="blue")

plot(prep, "wf", method = "continuous", topics = 6,
     model = stmFitted1, printlegend = FALSE, xaxt = "n", xlab = "wf")
seq <- seq(from = as.numeric("-2"), to = as.numeric("2"))
axis(1, at = seq)

title("Topic 6")
abline(h=0, col="blue")

• As the wordfish position LIBDEM - LAB - CONS, the result showed contradictory patterns between topic 4 and topic 6.
  • LIBDEM represented more topic 4, which including the terms of liberal democracy, and the proposion decreased gradually as wordfish score increased.
  • On the other hand, the CONS in 1992 and 1997 talked more propotion of topic 6.

4.3. 92 versus 97

par(mfrow=c(1,1),mar=c(5.1, 4.1, 4.1, 2.1))
plot(prep,
     covariate = "Year", 
     topics = c(1, 2, 3, 4, 5,6),
     model = stmFitted1, method = "difference",
     cov.value1 = "97", 
     cov.value2 = "92",
     xlim = c(-1, 1),
     xlab = "More 1992     ...    More 1997",
     main = "Effect of 92 vs. 97",
     labeltype = "custom",
     custom.labels = c('Topic 1','Topic2', 'Topic 3','Topic 4', 'Topic 5','Topic 6'))

• Despite some difference of positions, all 6 topics were not significantly presented only in 1992 or 1997.

5. STM with only Year

Dfm_stm2 <- convert(myDfm, to = "stm", docvars = docvars(mycorpus))
Dfm_stm2$meta$Year <- as.character(Dfm_stm2$meta$Year)
stmFitted2 <- stm(Dfm_stm2$documents,
                  Dfm_stm2$vocab,
                  K = 6,
                  max.em.its = 50,
                  prevalence = ~ Year,
                  data = Dfm_stm2$meta,
                  init.type = "Spectral")
prep2 <- estimateEffect(1:6 ~ Year, 
                       stmFitted2, 
                       meta = Dfm_stm2$meta, 
                       uncertainty = "Global")
stmFitted2_content <- stm(Dfm_stm2$documents,
                         Dfm_stm2$vocab,
                         K = 6, 
                         max.em.its = 75, 
                         prevalence = ~ Year, 
                         content = ~ Year,  
                         data = Dfm_stm2$meta, 
                         init.type = "Spectral")

5.1. Check K

K <-c(5,6,7)
storage2  <- searchK(Dfm_stm2$documents,
                    Dfm_stm2$vocab,
                    K,
                    max.em.its = 75,
                    N = floor(0.2 * length(Dfm_stm2$documents)),
                    prevalence = ~ Year,
                    data = Dfm_stm2$meta,
                    init.type = "Spectral")

par(mfrow=c(1,1),mar=c(5.1, 4.1, 4.1, 2.1))
plot(storage2$results$semcoh,
     storage2$results$exclus,
     xlab= "Semantic coherence",
     ylab= "Exclusivity",
     col= "blue",
     pch = 19,
     cex = 1,
     lty = "solid",
     lwd = 2)
text(storage2$results$semcoh,
     storage2$results$exclus,
     labels=storage2$results$K,
     cex= 1,
     pos=2)

• As the graph above, K equal to 6 was still the suggested setup.

5.2. Result

par(mfrow=c(1,1),mar=c(5.1, 4.1, 4.1, 2.1))
plot(stmFitted2, type = "summary", labeltype = c("frex"))

par(mfrow=c(2,1),mar=c(1,1,1,1))
plot(stmFitted2_content, type = "perspectives", topics = 4,main = "Topic4")
plot(stmFitted2_content, type = "perspectives", topics = 6,main = "Topic6")

• The comparison between 1992 and 1997 in topic 4 and 6 showed the following patterns.
  1. The representative words were similar to the previous discussion including wordfish score.
  2. The word “school” was used more often in 1997, in both topic 4 and topic 6.
  3. Most of the representative words appeared in both 1992 and 1997 manifesto.

par(mfrow=c(1,1),mar=c(5.1, 4.1, 4.1, 2.1))
plot(stmFitted2, type = "perspectives", labeltype = c("frex"), topics = c(4, 6))

• Comparing Topic 4 and Topic 6, the pattern of Topic 4 as a democratic topic was more significant. On the other hand, the topic 6 did not show clear issue.

---