» Workshop Code Matthew L. Jockers

###############################################################
# Matthew L. Jockers
# mjockers@unl.edu
# Text Analysis and Topic Modeling in the Humanities Workshop
# University of Wisconsin-Milwaukee
# April 19, 2013
###############################################################


###############################################################
# SESSION ONE (9:00-10:15)
###############################################################

#############################################
# 1.1 The R computing environment--what is R
#############################################

#############################################
# 1.2 R console vs. RStudio show both quickly
#############################################

#############################################
# 1.3 Vectors and basic math in R
#############################################

# Explain the assignment operator "<-"
myvar<-1
myvar
length(myvar)
# Notice that myvar is displayed with a [1]. R uses vectors to store most everything. a vector is simply a list of items.  in this case myvar is a vector of one item  

# now we create a new vector with 4 itmes using the "c" function
myvar<-c(1,2,4,6) # the "c" function means "combine"
myvar
length(myvar)
class(myvar) # show numeric class

#vectors can contain different types of data.  
myvar<-c('a', 'b', 'c')
class(myvar) # show character class

# But Vectors cannot hold values with different data types in the same vector
myvar<-c("a", "b", 1, 2, 3)
myvar
# Notice that R has converted the numbers to characters.

# R has lots of handy shortcuts
myvar<-5:25
myvar

# Accessing items in a vector can get confusing.  think about each item as having a numerical index from 1 to n
# in the sequence we just created, the first item in the vector list is the number 5.  We can access items in a vector by putting their index number inside square brackets, like this
myvar[1]
# and if we want to see the first three items
myvar[1:3]
# ? huh ?  Yes, this can be a bit confusing, especially when we use numbers as items in the vector.

# consider this instead

myvar<-c("This", "is", "a", "test", ".")
myvar[1:3]
myvar[3:5]

# Cool.  Now back to numbers for a minute.  With items in vectors, we can do vector math. . . 

myvar<-c(1,2,4,6)
myvar+10
#notice that R "recycles" the 10 over each value in the vector.  this is very handy and very important.  

# it can get even more fun when you have two vectors, like this
myvar1<-c(1,2,4,6)
myvar2<-c(10, 20,40,60)

# you can add them "index" wise across vectors.
myvar1+myvar2

# you can also use R as a calculator. . . 

1+1

2-3

3*3

8675309/3

# that's enough for now . . . let's play with some text

#############################################
# 1.4 Text manipulation in R
#############################################

# Load Plain text of Moby Dick from Project Gutenberg using the scan function

text<-scan("http://www.gutenberg.org/cache/epub/2701/pg2701.txt", what="character", sep="\n")
class(text) # text is a character vector

# what is that \n thingy?
length(text) #[1] 18874

text[1:3]
#explain line based chunking when using \n

# Explore how the text is ingested as lines.
text[1:407] #Introductory material and boilerplate
text[408] #start of first chapter
text[18577] #beginning of the final boilerplate
class(text)
str(text)

# Demonstrate the use of the which function as a way to find items in vector
start<-which(text == "CHAPTER 1. Loomings.")
start
end<-which(text == "End of Project Gutenberg's Moby Dick; or The Whale, by Herman Melville")
end
start<-408
end<-18577

# instead of this: novel.lines<- text[408:(18577-1)]
# we can use the start and end variables
# Now we can easily isolate the main text of the novel
novel.lines<- text[start:(end-1)] # why the -1
length(novel.lines)
novel.lines[1]

# so now we've got 18169 lines.  
# we want a single string of text
# so we can use paste to glue all of the lines together

novel<-paste(novel.lines, collapse=" ")
length(novel)
# huh?  What happened here. . . .

# now we want to begin doing some analysis, let's convert all to lowercase

novel.lower <-tolower(novel)
class(novel.lower)
novel.lower # check it out y'all

moby.words<-strsplit(novel.lower, "\\W") # huh?  wassup with that \\W, man?
class(moby.words) # a list, what the heck is a list?
length(moby.words) # well, it is a list of one, and the one happens to be a vector
# we can access the item(s) in a list using double brackets
# Here I'll show the entire vector of words that is in item 1
moby.words[[1]] 

# and we can see how many items are in the vector in the first list item, like this
length(moby.words[[1]])

# Well, in this case the list seems extraneous.  In fact it is.
# We only have a list here because that is the way that strsplit outputs
# its results.  So let's get rid of it.

moby.word.vector<-unlist(moby.words)
length(moby.word.vector) # hey, that's the same as this: length(moby.words[[1]])

# if you look at the vector of words you'll see some odd "blanks"
moby.word.vector[1:20]
# ? huh. . . when we use \\W, punctuation gets stripped and these remindered of where the punc chars were get left as a residue.

# we can figure out the POSITIONS of these blanks using which
which(moby.word.vector=="")

# and we can figure out which are not blanks by using the not equals operator !=
not.blanks<-which(moby.word.vector!="")
# so, not.blanks is now a vector of the "positions" of items in the moby.word.vector that are not blanks. 

# so we can overwrite the existing moby.word.vector with a pared down version that omits the blanks, like this
moby.word.vector<- moby.word.vector[not.blanks]

# once we have all the words in a vector, we can do some cool searching:
whales<-which(moby.word.vector=="whale")
whale.hits<-length(whales)
whale.hits/length(moby.word.vector) # relative frequency of whales
# compare to "the"
the<-which(moby.word.vector=="the")
the.hits<-length(the)
the.hits/length(moby.word.vector)

# we can make the percentages easier to read
100*(the.hits/length(moby.word.vector))
100*(whale.hits/length(moby.word.vector))

# we can figure out how many unique words there are in the novel
length(unique(moby.word.vector)) # that's big!

# we can even create an entire frequency list for all the words
moby.freqs<-table(moby.word.vector)
sorted.moby.freqs<-sort(moby.freqs , decreasing=TRUE)
sorted.moby.freqs[1:10]
sorted.moby.rel.freqs<-100*(sorted.moby.freqs/sum(sorted.moby.freqs))
sorted.moby.rel.freqs[1:10]
plot(sorted.moby.rel.freqs[1:10], type="b", xlab="Top Ten Words In Moby Dick by Rel Freq", ylab="Percentage of Full Text", xaxt="n")
axis(1, 1:10, labels=names(sorted.moby.rel.freqs[1:10]))

###############################################################
# BREAK TIME: (10:15-10:30)
###############################################################


###############################################################
# SESSION TWO (10:30-12:00)

#############################################
# 2.1 Downloading and exploring the exercise corpus
#############################################

# http://www.matthewjockers.net/wp-content/uploads/2013/04/uwm-workshop.zip

# setwd or Session->Set Working Dir->Choose Dir
setwd("~/Documents/Workshops/Wisconsin/uwm-workshop")

# Load a directory of files for analysis
corpusDir<-"data/corpus"
files<-dir(path=corpusDir, pattern=".*txt")
files #explain what we are seeing here

# Load and examine the metadata file
metadata<-read.csv("data/metadata.csv", stringsAsFactors=F)
dim(metadata)
class(metadata)
head(metadata)
# what is a data.frame?
# show how a dataframe is accessed
metadata[1:2, 1:4]

# show short cut for column names
metadata$author
metadata[,4]

#show colnames function
colnames(metadata)

# Summary:  So we have a vector of file names that we sucked out of a directory and we have a data.frame that we loaded from a .csv file (e.g. an excel file) that contains metadata about the files in the directory. We now want to create a topic model of all the files in that directory and we then want to be able to say something interesting about the topics in this corpus.

#############################################
# 2.2 What is Latent Dirichlet Allocation (LDA) anyhow?
#############################################
# LDA buffet story.

#############################################
# 2.3 Text Chunking
#############################################

# load a text from the directory--Dorian Gray
novel.lines<-scan(file.path(corpusDir, files[33]), what="character", sep="\n")
novel<-paste(novel.lines, collapse=" ")
novel.lower <-tolower(novel)
wilde.words<-strsplit(novel.lower, "\\W") # tokenize
wilde.words.vector<-unlist(wilde.words)
not.blanks<- which(wilde.words.vector!="") # remove blanks
wilde.words.vector<- wilde.words.vector[not.blanks]
length(wilde.words.vector)
# [1] 80294
# We want to chunk this into n 1000 word chunks.
chunk.size<-1000 # set a chunk variable
num.chunks<-length(wilde.words.vector)/chunk.size
num.chunks
x <- seq_along(wilde.words.vector)
# create a list where each item is a chunk vector
chunks <- split(wilde.words.vector, ceiling(x/chunk.size))
# What have we done here? ceiling is a rounding function.
? ceiling #see
class(chunks)

#inspect the first 1500 values
ceiling(x/chunk.size)[1:1500]

# what about split
? split

#examine the result
str(chunks)

# so now we need to convert this list of vectors into a list of contiguous text chunks
# so consider that this first chunk
chunks[[1]]
# contains a vector of words from the first 1000 words chunk.  But instead of a vector, we need a string of continues words, like this:
paste(chunks[[1]], collapse=" ")

#############################################
# 2.4 lapply
#############################################

# we can apply this paste function over and over again using lapply, a special function for iterating over list items.
# let's learn lapply.
# lapply is a function that takes a list as an argument (i.e. our chunks list)
# and then returns a new list having applied a function to each item in the list
chunks.as.strings<-lapply(chunks, paste, collapse=" ")
# here we use lappy to apply the "paste" function to each item in the list and we provide the additional collapse argument and an optional argument to the function

# so now this
chunks.as.strings[[1]]
# is the same as this:
paste(chunks[[1]], collapse=" ")
# but we also have 
chunks.as.strings[[2]]
# and so on.

# so now we have a list of text chunks as strings of text.  
# we want to send these to a topic model but before we can do that we have to get them out of the list format

chunk.vector<-unlist(chunks.as.strings)
length(chunk.vector)

#############################################
# 2.5 A Toy Model
#############################################

# Now we will run a topic model just for fun
# Let's see if we can find 5 topics in Dorian Gray
# I'll explain all of this later, so just play along for now.
library(lda)
doclines<-lexicalize(chunk.vector) 
set.seed(8675309)
K <- 5
num.iterations<-250
result <- lda.collapsed.gibbs.sampler(doclines$documents, K, doclines$vocab, num.iterations, 0.1, 0.1, compute.log.likelihood=TRUE)
top.words <- top.topic.words(result$topics, 25, by.score=TRUE)

# let's see what we've got
top.words
# tada, it's garbage!  The problem is that we have lot's of high frequency words that
# are screwing up the topical-ness of our topic model.
# so we need to get rid of these danged stop words.

#############################################
# 2.6 What is a stoplist
#############################################

# Here is a typical stop list
english.stoplist<-read.csv("/Users/mjockers/Documents/Workshops/Wisconsin/data/english.stop.txt", stringsAsFactors=F)
english.stoplist<-unique(english.stoplist[,1])

# our goal is to scan each chunk and remove words that are in the stoplist.
# remember chunks? 
str(chunks)
# it is  a list containing a series of word vectors.  
# we need to go back to the point just before we glued all of those words in each vector together with the following command
# chunks.as.strings<-lapply(chunks, paste, collapse=" ")
# before gluing in all together, we need to remove the stopwords from each chunk
# we can use lapply again here too, but we need a custom function to apply


#############################################
# 2.7 A Function
#############################################

# Explain this function
mywhich<-function(word.vector, stoplist){
  word.vector[-which(word.vector %in% stoplist)]
}
# Now apply the function over each item in the chunks list
chunks.without.stops<-lapply(chunks, mywhich, english.stoplist)

#now we need to collapse the chunks just like in the past
chunks.as.strings<-lapply(chunks.without.stops, paste, collapse=" ")

# and convert to a text cector from a list
chunk.vector<-unlist(chunks.as.strings)
length(chunk.vector)


#############################################
# 2.8 A Toy Model again
#############################################
# Now run the LDA again, over the new list
# Let's see if we can find 5 topics in Dorian Gray
# I'll explain all of this later, so just play along for now.
library(lda)
doclines<-lexicalize(chunk.vector) 
set.seed(8675309)
K <- 5
num.iterations<-250
result <- lda.collapsed.gibbs.sampler(doclines$documents, K, doclines$vocab, num.iterations, 0.1, 0.1, compute.log.likelihood=TRUE)
top.words <- top.topic.words(result$topics, 25, by.score=TRUE)

# let's see what we've got
top.words
# So, these topics are better, but still not the best we could hope for due
# to the presence  of a lots of character names.

###########################################################################
# LUNCH BREAK (12:00-1:30)
###########################################################################

###########################################################################
# SESSION 3 (1:30-2:45)

#############################################
# 3.1 A better stoplist	
#############################################

# lets load a much larger stoplist that has character names 
long.stoplist<-read.csv("data/stoplist.csv", stringsAsFactors=F)
long.stoplist<-unique(long.stoplist[,1])
length(long.stoplist)

#############################################
# 3.2 A slightly better model
#############################################

chunks.without.stops<-lapply(chunks, mywhich, long.stoplist)

#now we need to collapse the chunks just like in the past
chunks.as.strings<-lapply(chunks.without.stops, paste, collapse=" ")

# and convert to a text cector from a list
chunk.vector<-unlist(chunks.as.strings)

library(lda)
doclines<-lexicalize(chunk.vector) 
set.seed(8675309)
K <- 10
num.iterations<-250
result <- lda.collapsed.gibbs.sampler(doclines$documents, K, doclines$vocab, num.iterations, 0.1, 0.1, compute.log.likelihood=TRUE)
top.words <- top.topic.words(result$topics, 25, by.score=TRUE)

# let's see what we've got
top.words

# Well, this is getting better and maybe at the level of a single novel
# we might even want to keep the character names in.  But once we move 
# from a single text to a corpus, we really don't want character based topics.  
# visit 
# http://www.matthewjockers.net/2013/04/12/secret-recipe-for-topic-modeling-themes/ 
# to show how topics w just english stopwords have lots of character names.
# explain why this is a problem

#############################################
# 3.3 POS tagging
#############################################

novel.lines<-scan(file.path(corpusDir, files[33]), what="character", sep="\n")
text.blob<-paste(novel.lines, collapse=" ")
library(openNLP)
tagged_text <- tagPOS(text.blob)  # takes 2 minutes
# need a new function
tagged.words<-unlist(strsplit(tagged_text," "))
# Now chunk the full list
chunk.size<-1000 # set a chunk variable
num.chunks<-length(tagged.words)/chunk.size
x <- seq_along(tagged.words)
# create a list where each item is a chunk vector
chunks <- split(tagged.words, ceiling(x/chunk.size))

#############################################
# 3.4 new functions
#############################################
# New Function
SelectTaggedWords <- function(Words,tagID) {
  Words[ grep(tagID,Words) ]
}

tagged.words.select.list<-lapply(chunks, SelectTaggedWords, "/NN$")

# New Function
RemoveTags <- function(Words) {
  sub("/[A-Z]{2,3}","",Words)
}

words.select.list<-lapply(tagged.words.select.list, RemoveTags)

# New Function
RemoveNonChar <- function(Words) {
  gsub("[^[:alnum:][:space:]']","",Words)
}

text.word.vector <- lapply(words.select.list, RemoveNonChar)
chunks.without.stops<-lapply(text.word.vector, mywhich, english.stoplist)

#############################################
# 3.5 re-modeling
#############################################

#now we need to collapse the chunks just like in the past
chunks.as.strings<-lapply(chunks.without.stops, paste, collapse=" ")

# and convert to a text cector from a list
chunk.vector<-unlist(chunks.as.strings)

library(lda)
doclines<-lexicalize(chunk.vector) 
set.seed(8675309)
K <- 20
num.iterations<-250
result <- lda.collapsed.gibbs.sampler(doclines$documents, K, doclines$vocab, num.iterations, 0.1, 0.1, compute.log.likelihood=TRUE)
top.words <- top.topic.words(result$topics, 5, by.score=TRUE)

# let's see what we've got
top.words
# [,1]       [,2]      [,3]      [,4]     [,5]         [,6]         [,7]        [,8]     
# [1,] "pleasure" "lamp"    "gold"    "hansom" "murder"     "experience" "companion" "bag"    
# [2,] "worship"  "women"   "silver"  "horse"  "crime"      "art"        "grass"     "train"  
# [3,] "one"      "street"  "silk"    "driver" "laboratory" "impulse"    "wind"      "coat"   
# [4,] "coffee"   "curtain" "ceiling" "lace"   "action"     "instinct"   "daisy"     "servant"
# [5,] "spirit"   "ice"     "damask"  "cell"   "method"     "nothing"    "happiness" "uncle"  
# [,9]      [,10]    [,11]     [,12]   [,13]     [,14]       [,15]      [,16]      
# [1,] "art"     "blood"  "love"    "life"  "sir"     "music"     "accident" "mother"   
# [2,] "artist"  "cap"    "theatre" "man"   "picture" "principle" "sort"     "son"      
# [3,] "painter" "poison" "night"   "thing" "screen"  "advantage" "town"     "gentleman"
# [4,] "picture" "race"   "act"     "time"  "key"     "carpet"    "fellow"   "marriage" 
# [5,] "fellow"  "collar" "voice"   "room"  "tea"     "host"      "omen"     "child"    
# [,17]        [,18]      [,19]         [,20]    
# [1,] "book"       "picture"  "world"       "husband"
# [2,] "type"       "canvas"   "consolation" "tragedy"
# [3,] "paper"      "portrait" "yesterday"   "dear"   
# [4,] "music"      "prayer"   "globe"       "woman"  
# [5,] "background" "mouth"    "caprice"     "lady" 

###############################################################
# BREAK (2:45-3:00)
###############################################################

###############################################################
# SESSION 4 (3:00-4:30)
###############################################################

# now let's switch to a pre POS tagged corpus and make thematic clouds
# This Requires POS tagging all of the texts. Sicne this takes several hours 
#  i did it in advance.  Here is the code required to do it on your own

# library(openNLP)
# for(i in 13:length(files)){
  # text<-scan(file.path(corpusDir, files[i]), what="character", sep="\n")
  # text.blob<-paste(text, collapse=" ")
  # tagged_text <- tagPOS(text.blob) 
  # write(tagged_text, paste("data/taggedCorpus/",files[i], sep=""))
# }
###############################################################

#############################################
# 4.1 ingesting the entire corpus
#############################################
inputDir<-"data/taggedCorpus"
files<-dir(path=inputDir, pattern=".*txt")
chunk.size<-1000 #number of words per chunk
long.stoplist<-read.csv("data/stoplist.csv", stringsAsFactors=F)
long.stoplist<-unique(long.stoplist[,1])

# Let's take all of the functions we wrote above and move them into a 
# new file called pos.functions.r
# once they are in this other file, we can call them up using the "source" function.

source("code/pos.functions.r")
topic.df<-NULL
for(i in 1:length(files)){
  tagged_text<-scan(file.path(inputDir, files[i]), what="character", sep="\n")
  tagged_words <- unlist(strsplit(tagged_text," ")) 
  tagged_words <- c(SelectTaggedWords(tagged_words,"/NN$")) # SELECT POS TAG TYPES TO KEEP 
  tagged_words_less <- RemoveTags(tagged_words)
  word.vector <- RemoveNonChar(tagged_words_less)
  #remove the blanks
  text.word.vector<- word.vector[which(word.vector!="")]
  #remove stopwords
  text.word.vector<-text.word.vector[-which(text.word.vector %in% long.stoplist)]
  num.chunks<-length(text.word.vector)/chunk.size
  max<-length(text.word.vector)/num.chunks
  x <- seq_along(text.word.vector)
  chunks <- split(text.word.vector, ceiling(x/max))
  # Here I introduce a way to deal with small chunks at the end
  if(length(chunks[[length(chunks)]]) <= 500){
    chunks[[length(chunks)-1]]<-c(chunks[[length(chunks)-1]], chunks[[length(chunks)]])
    chunks[[length(chunks)]]<-NULL
  }
  chunks<-lapply(chunks, paste, collapse=" ")
  chunks.df<-do.call(rbind, chunks)
  chunks.df<-cbind(files[i],chunks.df)
  topic.df<-rbind(topic.df, chunks.df)
}

#############################################
# 4.2 Modeling the entire corpus
#############################################
library(lda)
doclines<-lexicalize(topic.df[,2]) 
set.seed(8675309)
K <- 50
num.iterations<-250
result <- lda.collapsed.gibbs.sampler(doclines$documents, K, doclines$vocab, num.iterations, 0.1, 0.1, compute.log.likelihood=TRUE)
top.words <- top.topic.words(result$topics, 10, by.score=TRUE)

# View top words
top.words

#############################################
# 4.3 Visualizing topics as clouds
#############################################

library(wordcloud)
result.dir<-"topicCloudsFromTagged/"
for(i in 1:nrow(result$topics)){
  cloud.data<-sort(result$topics[i,], decreasing=T)[1:50]
  png(paste(result.dir, i,".png", sep=""), width = 12, height = 12, units="in", res=300)
  print(wordcloud(names(cloud.data), freq=cloud.data, scale=c(4,.10), min.freq=1, rot.per=0, random.order=F))
  dev.off()
}

#############################################
# 4.4 Topic data analysis
#############################################

# after looking at the clouds, we decide we are interested in 
# topic 25 which has to do with depictions of slavery


# First let's get the proportional data from the model
topic.proportions <- t(result$document_sums) / colSums(result$document_sums)

# topic.proportions is a matrix with 932 rows: one for each 1000 word text segment
# and 50 columns, one for each topic.  To make life easier, let's create a column header row
colnames(topic.proportions)<-paste("Topic",1:50, sep="_")


# But there is no info in the matrix about which file chunk is which.
# but we have that data in the first column of topic.df and we can get it out like this
thefilenames<-topic.df[, 1]

# so now we need to assign each chunk a unique number 
chunk.ids<-ave(final.df[,3], final.df$thefilenames, FUN = seq_along)

# we can then "bind" all of this "column" data 
# to the the topic.proportions matrix, like this
final.df<-cbind.data.frame(thefilenames, chunk.ids, topic.proportions)

# show the result like this. . . .
final.df[1:25, 1:5]

# now the file names can act like "keys" in a relational database and allow us to lookup the metadata about those files in the metadata table we loaded earlier. for example,
metadata<-read.csv("data/metadata.for.tagged.csv", stringsAsFactors=F)

# but first we need to fix the file extensions since we switched to the .txt files
metadata$filename<-gsub(".xml", ".txt", metadata$filename)

# and now we can figure out which files are which using "which"
metadata[which(metadata$filename == "1008.txt"), ]

# so let's say we are interested in the slavery topic, topic 25.  

# We can identify the book with the largest use of the theme like this
max.slavery<-final.df[which(final.df$Topic_25 == max(final.df$Topic_25)), "thefilenames"]

# so, which book is it?
metadata[which(metadata$filename == max.slavery),]

# now let's plot the presence of slavery across the entire novel
plot(final.df[which(final.df$thefilenames == max.slavery), "Topic_25"], type="l")

# and finally, let's calculate and plot the mean usage of the theme across all the novels in the corpus.
#############################################
# 4.5 Basic Plotting
#############################################
mean.slavery<-aggregate(final.df$Topic_25, by=list(thefilenames), mean)

#plot it
barplot(mean.slavery$x,names.arg=mean.slavery$Group.1, las=2)

# now export the image.  this makes us wonder about text 500.txt
metadata[which(metadata$filename == "500.txt"),]

# X filename date                     author                             title
# 41 41  500.txt 1867 Child, Lydia Maria Francis A Romance of the Republic. (1867)
# nation
# 41 American

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

318

319

320

321

322

323

324

325

326

327

328

329

330

331

332

333

334

335

336

337

338

339

340

341

342

343

344

345

346

347

348

349

350

351

352

353

354

355

356

357

358

359

360

361

362

363

364

365

366

367

368

369

370

371

372

373

374

375

376

377

378

379

380

381

382

383

384

385

386

387

388

389

390

391

392

393

394

395

396

397

398

399

400

401

402

403

404

405

406

407

408

409

410

411

412

413

414

415

416

417

418

419

420

421

422

423

424

425

426

427

428

429

430

431

432

433

434

435

436

437

438

439

440

441

442

443

444

445

446

447

448

449

450

451

452

453

454

455

456

457

458

459

460

461

462

463

464

465

466

467

468

469

470

471

472

473

474

475

476

477

478

479

480

481

482

483

484

485

486

487

488

489

490

491

492

493

494

495

496

497

498

499

500

501

502

503

504

505

506

507

508

509

510

511

512

513

514

515

516

517

518

519

520

521

522

523

524

525

526

527

528

529

530

531

532

533

534

535

536

537

538

539

540

541

542

543

544

545

546

547

548

549

550

551

552

553

554

555

556

557

558

559

560

561

562

563

564

565

566

567

568

569

570

571

572

573

574

575

576

577

578

579

580

581

582

583

584

585

586

587

588

589

590

591

592

593

594

595

596

597

598

599

600

601

602

603

604

605

606

607

608

609

610

611

612

613

614

615

616

617

618

619

620

621

622

623

624

625

626

627

628

629

630

631

632

633

634

635

636

637

638

639

640

641

642

643

644

645

646

647

648

649

650

651

652

653

654

655

656

657

658

659

660

661

662

663

664

###############################################################

# Matthew L. Jockers

# mjockers@unl.edu

# Text Analysis and Topic Modeling in the Humanities Workshop

# University of Wisconsin-Milwaukee

# April 19, 2013

###############################################################

# SESSION ONE (9:00-10:15)

###############################################################

#############################################

# 1.1 The R computing environment--what is R

#############################################

# 1.2 R console vs. RStudio show both quickly

#############################################

# 1.3 Vectors and basic math in R

#############################################

# Explain the assignment operator "<-"

myvar<-1

myvar

length(myvar)

# Notice that myvar is displayed with a [1]. R uses vectors to store most everything. a vector is simply a list of items. in this case myvar is a vector of one item

# now we create a new vector with 4 itmes using the "c" function

myvar<-c(1,2,4,6) # the "c" function means "combine"

myvar

length(myvar)

class(myvar) # show numeric class

#vectors can contain different types of data.

myvar<-c('a', 'b', 'c')

class(myvar) # show character class

# But Vectors cannot hold values with different data types in the same vector

myvar<-c("a", "b", 1, 2, 3)

myvar

# Notice that R has converted the numbers to characters.

# R has lots of handy shortcuts

myvar<-5:25

myvar

# Accessing items in a vector can get confusing. think about each item as having a numerical index from 1 to n

# in the sequence we just created, the first item in the vector list is the number 5. We can access items in a vector by putting their index number inside square brackets, like this

myvar[1]

# and if we want to see the first three items

myvar[1:3]

# ? huh ? Yes, this can be a bit confusing, especially when we use numbers as items in the vector.

# consider this instead

myvar<-c("This", "is", "a", "test", ".")

myvar[1:3]

myvar[3:5]

# Cool. Now back to numbers for a minute. With items in vectors, we can do vector math. . .

myvar<-c(1,2,4,6)

myvar+10

#notice that R "recycles" the 10 over each value in the vector. this is very handy and very important.

# it can get even more fun when you have two vectors, like this

myvar1<-c(1,2,4,6)

myvar2<-c(10, 20,40,60)

# you can add them "index" wise across vectors.

myvar1+myvar2

# you can also use R as a calculator. . .

1+1

2-3

3*3

8675309/3

# that's enough for now . . . let's play with some text

#############################################

# 1.4 Text manipulation in R

#############################################

# Load Plain text of Moby Dick from Project Gutenberg using the scan function

text<-scan("http://www.gutenberg.org/cache/epub/2701/pg2701.txt", what="character", sep="\n")

class(text) # text is a character vector

# what is that \n thingy?

length(text) #[1] 18874

text[1:3]

#explain line based chunking when using \n

# Explore how the text is ingested as lines.

text[1:407] #Introductory material and boilerplate

text[408] #start of first chapter

text[18577] #beginning of the final boilerplate

class(text)

str(text)

# Demonstrate the use of the which function as a way to find items in vector

start<-which(text == "CHAPTER 1. Loomings.")

start

end<-which(text == "End of Project Gutenberg's Moby Dick; or The Whale, by Herman Melville")

end

start<-408

end<-18577

# instead of this: novel.lines<- text[408:(18577-1)]

# we can use the start and end variables

# Now we can easily isolate the main text of the novel

novel.lines<- text[start:(end-1)] # why the -1

length(novel.lines)

novel.lines[1]

# so now we've got 18169 lines.

# we want a single string of text

# so we can use paste to glue all of the lines together

novel<-paste(novel.lines, collapse=" ")

length(novel)

# huh? What happened here. . . .

# now we want to begin doing some analysis, let's convert all to lowercase

novel.lower <-tolower(novel)

class(novel.lower)

novel.lower # check it out y'all

moby.words<-strsplit(novel.lower, "\\W") # huh? wassup with that \\W, man?

class(moby.words) # a list, what the heck is a list?

length(moby.words) # well, it is a list of one, and the one happens to be a vector

# we can access the item(s) in a list using double brackets

# Here I'll show the entire vector of words that is in item 1

moby.words[[1]]

# and we can see how many items are in the vector in the first list item, like this

length(moby.words[[1]])

# Well, in this case the list seems extraneous. In fact it is.

# We only have a list here because that is the way that strsplit outputs

# its results. So let's get rid of it.

moby.word.vector<-unlist(moby.words)

length(moby.word.vector) # hey, that's the same as this: length(moby.words[[1]])

# if you look at the vector of words you'll see some odd "blanks"

moby.word.vector[1:20]

# ? huh. . . when we use \\W, punctuation gets stripped and these remindered of where the punc chars were get left as a residue.

# we can figure out the POSITIONS of these blanks using which

which(moby.word.vector=="")

# and we can figure out which are not blanks by using the not equals operator !=

not.blanks<-which(moby.word.vector!="")

# so, not.blanks is now a vector of the "positions" of items in the moby.word.vector that are not blanks.

# so we can overwrite the existing moby.word.vector with a pared down version that omits the blanks, like this

moby.word.vector<- moby.word.vector[not.blanks]

# once we have all the words in a vector, we can do some cool searching:

whales<-which(moby.word.vector=="whale")

whale.hits<-length(whales)

whale.hits/length(moby.word.vector) # relative frequency of whales

# compare to "the"

the<-which(moby.word.vector=="the")

the.hits<-length(the)

the.hits/length(moby.word.vector)

# we can make the percentages easier to read

100*(the.hits/length(moby.word.vector))

100*(whale.hits/length(moby.word.vector))

# we can figure out how many unique words there are in the novel

length(unique(moby.word.vector)) # that's big!

# we can even create an entire frequency list for all the words

moby.freqs<-table(moby.word.vector)

sorted.moby.freqs<-sort(moby.freqs , decreasing=TRUE)

sorted.moby.freqs[1:10]

sorted.moby.rel.freqs<-100*(sorted.moby.freqs/sum(sorted.moby.freqs))

sorted.moby.rel.freqs[1:10]

plot(sorted.moby.rel.freqs[1:10], type="b", xlab="Top Ten Words In Moby Dick by Rel Freq", ylab="Percentage of Full Text", xaxt="n")

axis(1, 1:10, labels=names(sorted.moby.rel.freqs[1:10]))

###############################################################

# BREAK TIME: (10:15-10:30)

###############################################################

# SESSION TWO (10:30-12:00)

#############################################

# 2.1 Downloading and exploring the exercise corpus

#############################################

# http://www.matthewjockers.net/wp-content/uploads/2013/04/uwm-workshop.zip

# setwd or Session->Set Working Dir->Choose Dir

setwd("~/Documents/Workshops/Wisconsin/uwm-workshop")

# Load a directory of files for analysis

corpusDir<-"data/corpus"

files<-dir(path=corpusDir, pattern=".*txt")

files #explain what we are seeing here

# Load and examine the metadata file

metadata<-read.csv("data/metadata.csv", stringsAsFactors=F)

dim(metadata)

class(metadata)

head(metadata)

# what is a data.frame?

# show how a dataframe is accessed

metadata[1:2, 1:4]

# show short cut for column names

metadata$author

metadata[,4]

#show colnames function

colnames(metadata)

# Summary: So we have a vector of file names that we sucked out of a directory and we have a data.frame that we loaded from a .csv file (e.g. an excel file) that contains metadata about the files in the directory. We now want to create a topic model of all the files in that directory and we then want to be able to say something interesting about the topics in this corpus.

#############################################

# 2.2 What is Latent Dirichlet Allocation (LDA) anyhow?

#############################################

# LDA buffet story.

#############################################

# 2.3 Text Chunking

#############################################

# load a text from the directory--Dorian Gray

novel.lines<-scan(file.path(corpusDir, files[33]), what="character", sep="\n")

novel<-paste(novel.lines, collapse=" ")

novel.lower <-tolower(novel)

wilde.words<-strsplit(novel.lower, "\\W") # tokenize

wilde.words.vector<-unlist(wilde.words)

not.blanks<- which(wilde.words.vector!="") # remove blanks

wilde.words.vector<- wilde.words.vector[not.blanks]

length(wilde.words.vector)

# [1] 80294

# We want to chunk this into n 1000 word chunks.

chunk.size<-1000 # set a chunk variable

num.chunks<-length(wilde.words.vector)/chunk.size

num.chunks

x <- seq_along(wilde.words.vector)

# create a list where each item is a chunk vector

chunks <- split(wilde.words.vector, ceiling(x/chunk.size))

# What have we done here? ceiling is a rounding function.

? ceiling #see

class(chunks)

#inspect the first 1500 values

ceiling(x/chunk.size)[1:1500]

# what about split

? split

#examine the result

str(chunks)

# so now we need to convert this list of vectors into a list of contiguous text chunks

# so consider that this first chunk

chunks[[1]]

# contains a vector of words from the first 1000 words chunk. But instead of a vector, we need a string of continues words, like this:

paste(chunks[[1]], collapse=" ")

#############################################

# 2.4 lapply

#############################################

# we can apply this paste function over and over again using lapply, a special function for iterating over list items.

# let's learn lapply.

# lapply is a function that takes a list as an argument (i.e. our chunks list)

# and then returns a new list having applied a function to each item in the list

chunks.as.strings<-lapply(chunks, paste, collapse=" ")

# here we use lappy to apply the "paste" function to each item in the list and we provide the additional collapse argument and an optional argument to the function

# so now this

chunks.as.strings[[1]]

# is the same as this:

paste(chunks[[1]], collapse=" ")

# but we also have

chunks.as.strings[[2]]

# and so on.

# so now we have a list of text chunks as strings of text.

# we want to send these to a topic model but before we can do that we have to get them out of the list format

chunk.vector<-unlist(chunks.as.strings)

length(chunk.vector)

#############################################

# 2.5 A Toy Model

#############################################

# Now we will run a topic model just for fun

# Let's see if we can find 5 topics in Dorian Gray

# I'll explain all of this later, so just play along for now.

library(lda)

doclines<-lexicalize(chunk.vector)

set.seed(8675309)

K <- 5

num.iterations<-250

result <- lda.collapsed.gibbs.sampler(doclines$documents, K, doclines$vocab, num.iterations, 0.1, 0.1, compute.log.likelihood=TRUE)

top.words <- top.topic.words(result$topics, 25, by.score=TRUE)

# let's see what we've got

top.words

# tada, it's garbage! The problem is that we have lot's of high frequency words that

# are screwing up the topical-ness of our topic model.

# so we need to get rid of these danged stop words.

#############################################

# 2.6 What is a stoplist

#############################################

# Here is a typical stop list

english.stoplist<-read.csv("/Users/mjockers/Documents/Workshops/Wisconsin/data/english.stop.txt", stringsAsFactors=F)

english.stoplist<-unique(english.stoplist[,1])

# our goal is to scan each chunk and remove words that are in the stoplist.

# remember chunks?

str(chunks)

# it is a list containing a series of word vectors.

# we need to go back to the point just before we glued all of those words in each vector together with the following command

# chunks.as.strings<-lapply(chunks, paste, collapse=" ")

# before gluing in all together, we need to remove the stopwords from each chunk

# we can use lapply again here too, but we need a custom function to apply

#############################################

# 2.7 A Function

#############################################

# Explain this function

mywhich<-function(word.vector, stoplist){

word.vector[-which(word.vector %in% stoplist)]

}

# Now apply the function over each item in the chunks list

chunks.without.stops<-lapply(chunks, mywhich, english.stoplist)

#now we need to collapse the chunks just like in the past

chunks.as.strings<-lapply(chunks.without.stops, paste, collapse=" ")

# and convert to a text cector from a list

chunk.vector<-unlist(chunks.as.strings)

length(chunk.vector)

#############################################

# 2.8 A Toy Model again

#############################################

# Now run the LDA again, over the new list

# Let's see if we can find 5 topics in Dorian Gray

# I'll explain all of this later, so just play along for now.

library(lda)

doclines<-lexicalize(chunk.vector)

set.seed(8675309)

K <- 5

num.iterations<-250

result <- lda.collapsed.gibbs.sampler(doclines$documents, K, doclines$vocab, num.iterations, 0.1, 0.1, compute.log.likelihood=TRUE)

top.words <- top.topic.words(result$topics, 25, by.score=TRUE)

# let's see what we've got

top.words

# So, these topics are better, but still not the best we could hope for due

# to the presence of a lots of character names.

###########################################################################

# LUNCH BREAK (12:00-1:30)

###########################################################################

# SESSION 3 (1:30-2:45)

#############################################

# 3.1 A better stoplist

#############################################

# lets load a much larger stoplist that has character names

long.stoplist<-read.csv("data/stoplist.csv", stringsAsFactors=F)

long.stoplist<-unique(long.stoplist[,1])

length(long.stoplist)

#############################################

# 3.2 A slightly better model

#############################################

chunks.without.stops<-lapply(chunks, mywhich, long.stoplist)

#now we need to collapse the chunks just like in the past

chunks.as.strings<-lapply(chunks.without.stops, paste, collapse=" ")

# and convert to a text cector from a list

chunk.vector<-unlist(chunks.as.strings)

library(lda)

doclines<-lexicalize(chunk.vector)

set.seed(8675309)

K <- 10

num.iterations<-250

result <- lda.collapsed.gibbs.sampler(doclines$documents, K, doclines$vocab, num.iterations, 0.1, 0.1, compute.log.likelihood=TRUE)

top.words <- top.topic.words(result$topics, 25, by.score=TRUE)

# let's see what we've got

top.words

# Well, this is getting better and maybe at the level of a single novel

# we might even want to keep the character names in. But once we move

# from a single text to a corpus, we really don't want character based topics.

# visit

# http://www.matthewjockers.net/2013/04/12/secret-recipe-for-topic-modeling-themes/

# to show how topics w just english stopwords have lots of character names.

# explain why this is a problem

#############################################

# 3.3 POS tagging

#############################################

novel.lines<-scan(file.path(corpusDir, files[33]), what="character", sep="\n")

text.blob<-paste(novel.lines, collapse=" ")

library(openNLP)

tagged_text <- tagPOS(text.blob) # takes 2 minutes

# need a new function

tagged.words<-unlist(strsplit(tagged_text," "))

# Now chunk the full list

chunk.size<-1000 # set a chunk variable

num.chunks<-length(tagged.words)/chunk.size

x <- seq_along(tagged.words)

# create a list where each item is a chunk vector

chunks <- split(tagged.words, ceiling(x/chunk.size))

#############################################

# 3.4 new functions

#############################################

# New Function

SelectTaggedWords <- function(Words,tagID) {

Words[ grep(tagID,Words) ]

}

tagged.words.select.list<-lapply(chunks, SelectTaggedWords, "/NN$")

# New Function

RemoveTags <- function(Words) {

sub("/[A-Z]{2,3}","",Words)

}

words.select.list<-lapply(tagged.words.select.list, RemoveTags)

# New Function

RemoveNonChar <- function(Words) {

gsub("[^[:alnum:][:space:]']","",Words)

}

text.word.vector <- lapply(words.select.list, RemoveNonChar)

chunks.without.stops<-lapply(text.word.vector, mywhich, english.stoplist)

#############################################

# 3.5 re-modeling

#############################################

#now we need to collapse the chunks just like in the past

chunks.as.strings<-lapply(chunks.without.stops, paste, collapse=" ")

# and convert to a text cector from a list

chunk.vector<-unlist(chunks.as.strings)

library(lda)

doclines<-lexicalize(chunk.vector)

set.seed(8675309)

K <- 20

num.iterations<-250

result <- lda.collapsed.gibbs.sampler(doclines$documents, K, doclines$vocab, num.iterations, 0.1, 0.1, compute.log.likelihood=TRUE)

top.words <- top.topic.words(result$topics, 5, by.score=TRUE)

# let's see what we've got

top.words

# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]

# [1,] "pleasure" "lamp" "gold" "hansom" "murder" "experience" "companion" "bag"

# [2,] "worship" "women" "silver" "horse" "crime" "art" "grass" "train"

# [3,] "one" "street" "silk" "driver" "laboratory" "impulse" "wind" "coat"

# [4,] "coffee" "curtain" "ceiling" "lace" "action" "instinct" "daisy" "servant"

# [5,] "spirit" "ice" "damask" "cell" "method" "nothing" "happiness" "uncle"

# [,9] [,10] [,11] [,12] [,13] [,14] [,15] [,16]

# [1,] "art" "blood" "love" "life" "sir" "music" "accident" "mother"

# [2,] "artist" "cap" "theatre" "man" "picture" "principle" "sort" "son"

# [3,] "painter" "poison" "night" "thing" "screen" "advantage" "town" "gentleman"

# [4,] "picture" "race" "act" "time" "key" "carpet" "fellow" "marriage"

# [5,] "fellow" "collar" "voice" "room" "tea" "host" "omen" "child"

# [,17] [,18] [,19] [,20]

# [1,] "book" "picture" "world" "husband"

# [2,] "type" "canvas" "consolation" "tragedy"

# [3,] "paper" "portrait" "yesterday" "dear"

# [4,] "music" "prayer" "globe" "woman"

# [5,] "background" "mouth" "caprice" "lady"

###############################################################

# BREAK (2:45-3:00)

###############################################################

# SESSION 4 (3:00-4:30)

###############################################################

# now let's switch to a pre POS tagged corpus and make thematic clouds

# This Requires POS tagging all of the texts. Sicne this takes several hours

# i did it in advance. Here is the code required to do it on your own

# library(openNLP)

# for(i in 13:length(files)){

# text<-scan(file.path(corpusDir, files[i]), what="character", sep="\n")

# text.blob<-paste(text, collapse=" ")

# tagged_text <- tagPOS(text.blob)

# write(tagged_text, paste("data/taggedCorpus/",files[i], sep=""))

# }

###############################################################

#############################################

# 4.1 ingesting the entire corpus

#############################################

inputDir<-"data/taggedCorpus"

files<-dir(path=inputDir, pattern=".*txt")

chunk.size<-1000 #number of words per chunk

long.stoplist<-read.csv("data/stoplist.csv", stringsAsFactors=F)

long.stoplist<-unique(long.stoplist[,1])

# Let's take all of the functions we wrote above and move them into a

# new file called pos.functions.r

# once they are in this other file, we can call them up using the "source" function.

source("code/pos.functions.r")

topic.df<-NULL

for(i in 1:length(files)){

tagged_text<-scan(file.path(inputDir, files[i]), what="character", sep="\n")

tagged_words <- unlist(strsplit(tagged_text," "))

tagged_words <- c(SelectTaggedWords(tagged_words,"/NN$")) # SELECT POS TAG TYPES TO KEEP

tagged_words_less <- RemoveTags(tagged_words)

word.vector <- RemoveNonChar(tagged_words_less)

#remove the blanks

text.word.vector<- word.vector[which(word.vector!="")]

#remove stopwords

text.word.vector<-text.word.vector[-which(text.word.vector %in% long.stoplist)]

num.chunks<-length(text.word.vector)/chunk.size

max<-length(text.word.vector)/num.chunks

x <- seq_along(text.word.vector)

chunks <- split(text.word.vector, ceiling(x/max))

# Here I introduce a way to deal with small chunks at the end

if(length(chunks[[length(chunks)]]) <= 500){

chunks[[length(chunks)-1]]<-c(chunks[[length(chunks)-1]], chunks[[length(chunks)]])

chunks[[length(chunks)]]<-NULL

}

chunks<-lapply(chunks, paste, collapse=" ")

chunks.df<-do.call(rbind, chunks)

chunks.df<-cbind(files[i],chunks.df)

topic.df<-rbind(topic.df, chunks.df)

}

#############################################

# 4.2 Modeling the entire corpus

#############################################

library(lda)

doclines<-lexicalize(topic.df[,2])

set.seed(8675309)

K <- 50

num.iterations<-250

result <- lda.collapsed.gibbs.sampler(doclines$documents, K, doclines$vocab, num.iterations, 0.1, 0.1, compute.log.likelihood=TRUE)

top.words <- top.topic.words(result$topics, 10, by.score=TRUE)

# View top words

top.words

#############################################

# 4.3 Visualizing topics as clouds

#############################################

library(wordcloud)

result.dir<-"topicCloudsFromTagged/"

for(i in 1:nrow(result$topics)){

cloud.data<-sort(result$topics[i,], decreasing=T)[1:50]

png(paste(result.dir, i,".png", sep=""), width = 12, height = 12, units="in", res=300)

print(wordcloud(names(cloud.data), freq=cloud.data, scale=c(4,.10), min.freq=1, rot.per=0, random.order=F))

dev.off()

}

#############################################

# 4.4 Topic data analysis

#############################################

# after looking at the clouds, we decide we are interested in

# topic 25 which has to do with depictions of slavery

# First let's get the proportional data from the model

topic.proportions <- t(result$document_sums) / colSums(result$document_sums)

# topic.proportions is a matrix with 932 rows: one for each 1000 word text segment

# and 50 columns, one for each topic. To make life easier, let's create a column header row

colnames(topic.proportions)<-paste("Topic",1:50, sep="_")

# But there is no info in the matrix about which file chunk is which.

# but we have that data in the first column of topic.df and we can get it out like this

thefilenames<-topic.df[, 1]

# so now we need to assign each chunk a unique number

chunk.ids<-ave(final.df[,3], final.df$thefilenames, FUN = seq_along)

# we can then "bind" all of this "column" data

# to the the topic.proportions matrix, like this

final.df<-cbind.data.frame(thefilenames, chunk.ids, topic.proportions)

# show the result like this. . . .

final.df[1:25, 1:5]

# now the file names can act like "keys" in a relational database and allow us to lookup the metadata about those files in the metadata table we loaded earlier. for example,

metadata<-read.csv("data/metadata.for.tagged.csv", stringsAsFactors=F)

# but first we need to fix the file extensions since we switched to the .txt files

metadata$filename<-gsub(".xml", ".txt", metadata$filename)

# and now we can figure out which files are which using "which"

metadata[which(metadata$filename == "1008.txt"), ]

# so let's say we are interested in the slavery topic, topic 25.

# We can identify the book with the largest use of the theme like this

max.slavery<-final.df[which(final.df$Topic_25 == max(final.df$Topic_25)), "thefilenames"]

# so, which book is it?

metadata[which(metadata$filename == max.slavery),]

# now let's plot the presence of slavery across the entire novel

plot(final.df[which(final.df$thefilenames == max.slavery), "Topic_25"], type="l")

# and finally, let's calculate and plot the mean usage of the theme across all the novels in the corpus.

#############################################

# 4.5 Basic Plotting

#############################################

mean.slavery<-aggregate(final.df$Topic_25, by=list(thefilenames), mean)

#plot it

barplot(mean.slavery$x,names.arg=mean.slavery$Group.1, las=2)

# now export the image. this makes us wonder about text 500.txt

metadata[which(metadata$filename == "500.txt"),]

# X filename date author title

# 41 41 500.txt 1867 Child, Lydia Maria Francis A Romance of the Republic. (1867)

# nation

# 41 American