SCM

SCM Repository

[tm] Annotation of /pkg/R/corpus.R
ViewVC logotype

Annotation of /pkg/R/corpus.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 57 - (view) (download)
Original Path: trunk/R/textmin/R/textdoccol.R

1 : feinerer 17 # Author: Ingo Feinerer
2 :    
3 : feinerer 49 setGeneric("TextDocCol", function(object, inputType = "CSV", stripWhiteSpace = FALSE, toLower = FALSE) standardGeneric("TextDocCol"))
4 :     setMethod("TextDocCol",
5 : feinerer 42 c("character"),
6 : feinerer 56 function(object, inputType = "PLAIN", stripWhiteSpace = FALSE, toLower = FALSE) {
7 : feinerer 22 # Add a new type for each unique input source format
8 : feinerer 56 type <- match.arg(inputType,c("PLAIN", "CSV", "RCV1", "REUT21578", "REUT21578_XML", "NEWSGROUP", "RIS"))
9 : feinerer 22 switch(type,
10 : feinerer 56 # Plain text
11 :     "PLAIN" = {
12 :     filelist <- dir(object, full.names = TRUE)
13 :     filenameIDs <- list(FileNames = filelist, IDs = 1:length(filelist))
14 :     tdl <- sapply(filelist,
15 :     function(file, FileNameIDs = filenameIDs) {
16 :     id <- FileNameIDs$IDs[grep(file, FileNameIDs$FileNames)]
17 :     origin <- dirname(file)
18 :     new("PlainTextDocument", FileName = file, Cached = 0, Author = "Unknown", DateTimeStamp = date(),
19 :     Description = "", ID = id, Origin = origin, Heading = "")
20 :     })
21 :     tdcl <- new("TextDocCol", .Data = tdl)
22 :     },
23 : feinerer 37 # Text in a special CSV format
24 :     # For details on the file format see the R documentation file
25 :     # The first argument is a directory with .csv files
26 :     "CSV" = {
27 : feinerer 56 filelist <- dir(object, pattern = "\\.csv", full.names = TRUE)
28 : feinerer 39 tdl <- sapply(filelist,
29 : feinerer 37 function(file) {
30 :     m <- as.matrix(read.csv(file, header = FALSE))
31 :     l <- vector("list", dim(m)[1])
32 :     for (i in 1:dim(m)[1]) {
33 :     author <- ""
34 : feinerer 42 datetimestamp <- date()
35 : feinerer 37 description <- ""
36 :     id <- as.integer(m[i,1])
37 :     corpus <- as.character(m[i,2:dim(m)[2]])
38 :     if (stripWhiteSpace)
39 :     corpus <- gsub("[[:space:]]+", " ", corpus)
40 :     if (toLower)
41 :     corpus <- tolower(corpus)
42 :     origin <- "CSV"
43 :     heading <- ""
44 :    
45 : feinerer 49 l[[i]] <- new("PlainTextDocument", .Data = corpus, Author = author, DateTimeStamp = datetimestamp,
46 :     Description = description, ID = id, Origin = origin, Heading = heading)
47 : feinerer 37 }
48 :     l
49 :     })
50 : feinerer 39 if (length(filelist) > 1)
51 : feinerer 49 tdcl <- new("TextDocCol", .Data = unlist(tdl, recursive = FALSE))
52 : feinerer 39 else
53 : feinerer 49 tdcl <- new("TextDocCol", .Data = tdl)
54 : feinerer 37 },
55 : feinerer 22 # Read in text documents in XML Reuters Corpus Volume 1 (RCV1) format
56 : feinerer 37 # The first argument is a directory with the RCV1 XML files
57 : feinerer 51 "RCV1" = {
58 : feinerer 56 filelist <- dir(object, pattern = "\\..xml", full.names = TRUE)
59 : feinerer 39 tdl <- sapply(filelist,
60 : feinerer 37 function(file) {
61 :     tree <- xmlTreeParse(file)
62 : feinerer 49 xmlApply(xmlRoot(tree), parseNewsItemPlain, stripWhiteSpace, toLower)
63 : feinerer 37 })
64 : feinerer 39 if (length(filelist) > 1)
65 : feinerer 49 tdcl <- new("TextDocCol", .Data = unlist(tdl, recursive = FALSE))
66 : feinerer 39 else
67 : feinerer 49 tdcl <- new("TextDocCol", .Data = tdl)
68 : feinerer 22 },
69 : feinerer 23 # Read in text documents in Reuters-21578 XML (not SGML) format
70 :     # Typically the first argument will be a directory where we can
71 :     # find the files reut2-000.xml ... reut2-021.xml
72 : feinerer 51 "REUT21578" = {
73 : feinerer 56 filelist <- dir(object, pattern = "\\..xml", full.names = TRUE)
74 : feinerer 39 tdl <- sapply(filelist,
75 : feinerer 24 function(file) {
76 :     tree <- xmlTreeParse(file)
77 : feinerer 49 xmlApply(xmlRoot(tree), parseReutersPlain, stripWhiteSpace, toLower)
78 : feinerer 24 })
79 : feinerer 39 if (length(filelist) > 1)
80 : feinerer 49 tdcl <- new("TextDocCol", .Data = unlist(tdl, recursive = FALSE))
81 : feinerer 39 else
82 : feinerer 49 tdcl <- new("TextDocCol", .Data = tdl)
83 : feinerer 40 },
84 : feinerer 49 "REUT21578_XML" = {
85 : feinerer 56 filelist <- dir(object, pattern = "\\..xml", full.names = TRUE)
86 : feinerer 49 tdl <- sapply(filelist,
87 :     function(file) {
88 :     parseReutersXML(file)
89 :     })
90 : feinerer 51 tdcl <- new("TextDocCol", .Data = tdl)
91 : feinerer 49 },
92 : feinerer 56 "NEWSGROUP" = {
93 :     filelist <- dir(object, full.names = TRUE)
94 :     tdl <- sapply(filelist,
95 :     function(file) {
96 :     parseMail(file)
97 :     })
98 :     new("TextDocCol", .Data = tdl)
99 :     },
100 : feinerer 40 # Read in HTML documents as used by http://ris.bka.gv.at/vwgh
101 :     "RIS" = {
102 : feinerer 56 filelist <- dir(object, pattern = "\\..html", full.names = TRUE)
103 : feinerer 40 tdl <- sapply(filelist,
104 :     function(file) {
105 : feinerer 41 # Ignore warnings from misformed HTML documents
106 : feinerer 51 suppressWarnings(RISDoc <- parseRISPlain(file, stripWhiteSpace, toLower))
107 : feinerer 41 if (!is.null(RISDoc)) {
108 :     l <- list()
109 :     l[[length(l) + 1]] <- RISDoc
110 :     l
111 :     }
112 : feinerer 40 })
113 : feinerer 49 tdcl <- new("TextDocCol", .Data = tdl)
114 : feinerer 24 })
115 : feinerer 21 tdcl
116 :     })
117 :    
118 : feinerer 42 # Parse an Austrian RIS HTML document
119 : feinerer 51 parseRISPlain <- function(file, stripWhiteSpace = FALSE, toLower = FALSE) {
120 : feinerer 40 author <- ""
121 : feinerer 42 datetimestamp <- date()
122 : feinerer 40 description <- ""
123 :    
124 :     tree <- htmlTreeParse(file)
125 :     htmlElem <- unlist(tree$children$html$children)
126 : feinerer 41
127 :     if (is.null(htmlElem))
128 :     stop(paste("Empty document", file, "cannot be processed."))
129 :    
130 : feinerer 40 textElem <- htmlElem[which(regexpr("text.value", names(htmlElem)) > 0)]
131 :     names(textElem) <- NULL
132 :    
133 :     corpus <- paste(textElem, collapse = " ")
134 : feinerer 41
135 :     year <- substring(corpus, regexpr("..../../", corpus), regexpr("..../../", corpus) + 3)
136 :     senat <- substring(corpus, regexpr("..../../", corpus) + 5, regexpr("..../../", corpus) + 6)
137 :     number <- substring(corpus, regexpr("..../../", corpus) + 8, regexpr("..../../", corpus) + 11)
138 :    
139 :     id <- as.integer(paste(year, senat, number, sep = ""))
140 :    
141 :     if (is.na(id))
142 :     stop(paste("Cannot extract 'Geschaeftszahl' out of malformed document", file))
143 : feinerer 40 origin <- ""
144 :    
145 :     if (stripWhiteSpace)
146 :     corpus <- gsub("[[:space:]]+", " ", corpus)
147 :     if (toLower)
148 :     corpus <- tolower(corpus)
149 :    
150 :     heading <- ""
151 :    
152 : feinerer 49 new("PlainTextDocument", .Data = corpus, Author = author, DateTimeStamp = datetimestamp,
153 :     Description = description, ID = id, Origin = origin, Heading = heading)
154 : feinerer 40 }
155 :    
156 : feinerer 23 # Parse a <newsitem></newsitem> element from a well-formed RCV1 XML file
157 : feinerer 49 parseNewsItemPlain <- function(node, stripWhiteSpace = FALSE, toLower = FALSE) {
158 : feinerer 17 author <- "Not yet implemented"
159 : feinerer 42 datetimestamp <- xmlAttrs(node)[["date"]]
160 : feinerer 17 description <- "Not yet implemented"
161 :     id <- as.integer(xmlAttrs(node)[["itemid"]])
162 : feinerer 36 origin <- "Reuters Corpus Volume 1 XML"
163 : feinerer 18 corpus <- unlist(xmlApply(node[["text"]], xmlValue), use.names = FALSE)
164 : feinerer 21
165 :     if (stripWhiteSpace)
166 :     corpus <- gsub("[[:space:]]+", " ", corpus)
167 :     if (toLower)
168 :     corpus <- tolower(corpus)
169 :    
170 : feinerer 18 heading <- xmlValue(node[["title"]])
171 : feinerer 17
172 : feinerer 49 new("PlainTextDocument", .Data = corpus, Author = author, DateTimeStamp = datetimestamp,
173 :     Description = description, ID = id, Origin = origin, Heading = heading)
174 : feinerer 19 }
175 : feinerer 23
176 :     # Parse a <REUTERS></REUTERS> element from a well-formed Reuters-21578 XML file
177 : feinerer 49 parseReutersPlain <- function(node, stripWhiteSpace = FALSE, toLower = FALSE) {
178 : feinerer 36 # The <AUTHOR></AUTHOR> tag is unfortunately NOT obligatory!
179 :     if (!is.null(node[["TEXT"]][["AUTHOR"]]))
180 :     author <- xmlValue(node[["TEXT"]][["AUTHOR"]])
181 :     else
182 :     author <- ""
183 :    
184 : feinerer 42 datetimestamp <- xmlValue(node[["DATE"]])
185 : feinerer 36 description <- ""
186 : feinerer 23 id <- as.integer(xmlAttrs(node)[["NEWID"]])
187 :    
188 : feinerer 36 origin <- "Reuters-21578 XML"
189 : feinerer 23
190 :     # The <BODY></BODY> tag is unfortunately NOT obligatory!
191 :     if (!is.null(node[["TEXT"]][["BODY"]]))
192 :     corpus <- xmlValue(node[["TEXT"]][["BODY"]])
193 :     else
194 :     corpus <- ""
195 :    
196 :     if (stripWhiteSpace)
197 :     corpus <- gsub("[[:space:]]+", " ", corpus)
198 :     if (toLower)
199 :     corpus <- tolower(corpus)
200 :    
201 :     # The <TITLE></TITLE> tag is unfortunately NOT obligatory!
202 :     if (!is.null(node[["TEXT"]][["TITLE"]]))
203 :     heading <- xmlValue(node[["TEXT"]][["TITLE"]])
204 :     else
205 :     heading <- ""
206 :    
207 : feinerer 49 topics <- unlist(xmlApply(node[["TOPICS"]], function(x) xmlValue(x)), use.names = FALSE)
208 :    
209 :     new("PlainTextDocument", .Data = corpus, Cached = 1, Author = author, DateTimeStamp = datetimestamp,
210 :     Description = description, ID = id, Origin = origin, Heading = heading, LocalMetaData = list(Topics = topics))
211 : feinerer 23 }
212 : feinerer 49
213 : feinerer 56 # Set up metadata for a well-formed Reuters-21578 XML file
214 : feinerer 49 parseReutersXML<- function(file) {
215 :     new("XMLTextDocument", FileName = file, Cached = 0, Author = "REUTERS", DateTimeStamp = date(),
216 :     Description = "Reuters21578 file containing several news articles", ID = as.integer(0),
217 :     Origin = "Reuters-21578 XML", Heading = "Reuters21578 news articles")
218 :     }
219 :    
220 : feinerer 56 parseMail <- function(file) {
221 :     mail <- readLines(file)
222 :     author <- gsub("From: ", "", grep("^From:", mail, value = TRUE))
223 :     datetimestamp <- gsub("Date: ", "", grep("^Date:", mail, value = TRUE))
224 :     id <- as.integer(file)
225 :     origin <- gsub("Path: ", "", grep("^Path:", mail, value = TRUE))
226 :     heading <- gsub("Subject: ", "", grep("^Subject:", mail, value = TRUE))
227 :     newsgroup <- gsub("Newsgroups: ", "", grep("^Newsgroups:", mail, value = TRUE))
228 :    
229 :     new("NewsgroupDocument", FileName = file, Cached = 0, Author = author, DateTimeStamp = datetimestamp,
230 :     Description = "", ID = id, Origin = origin, Heading = heading, Newsgroup = newsgroup)
231 :     }
232 :    
233 :     setGeneric("loadFileIntoMem", function(object, ...) standardGeneric("loadFileIntoMem"))
234 : feinerer 49 setMethod("loadFileIntoMem",
235 : feinerer 56 c("PlainTextDocument"),
236 :     function(object, ...) {
237 :     if (Cached(object) == 0) {
238 :     corpus <- readLines(FileName(object))
239 :     Corpus(object) <- corpus
240 :     Cached(object) <- 1
241 :     return(object)
242 :     } else {
243 :     return(object)
244 :     }
245 :     })
246 :     setMethod("loadFileIntoMem",
247 : feinerer 49 c("XMLTextDocument"),
248 : feinerer 56 function(object, ...) {
249 :     if (Cached(object) == 0) {
250 :     file <- FileName(object)
251 : feinerer 49 doc <- xmlTreeParse(file)
252 :     class(doc) <- "list"
253 : feinerer 56 Corpus(object) <- doc
254 :     Cached(object) <- 1
255 : feinerer 49 return(object)
256 :     } else {
257 :     return(object)
258 :     }
259 :     })
260 : feinerer 56 setMethod("loadFileIntoMem",
261 :     c("NewsgroupDocument"),
262 :     function(object, ...) {
263 :     if (Cached(object) == 0) {
264 :     mail <- readLines(FileName(object))
265 :     Cached(object) <- 1
266 :     index <- grep("^Lines:", mail)
267 :     Corpus(object) <- mail[(index + 1):length(mail)]
268 :     return(object)
269 :     } else {
270 :     return(object)
271 :     }
272 :     })
273 : feinerer 49
274 : feinerer 54 setGeneric("tm_transform", function(object, FUN, ...) standardGeneric("tm_transform"))
275 :     setMethod("tm_transform",
276 : feinerer 49 c("TextDocCol"),
277 :     function(object, FUN, ...) {
278 : feinerer 56 result <- as(lapply(object, FUN, ..., GlobalMetaData = GlobalMetaData(object)), "TextDocCol")
279 :     result@GlobalMetaData <- GlobalMetaData(object)
280 :     return(result)
281 : feinerer 49 })
282 :    
283 :     setGeneric("toPlainTextDocument", function(object, FUN, ...) standardGeneric("toPlainTextDocument"))
284 :     setMethod("toPlainTextDocument",
285 :     c("PlainTextDocument"),
286 :     function(object, FUN, ...) {
287 :     return(object)
288 :     })
289 :     setMethod("toPlainTextDocument",
290 :     c("XMLTextDocument"),
291 :     function(object, FUN, ...) {
292 : feinerer 56 if (Cached(object) == 0)
293 : feinerer 49 object <- loadFileIntoMem(object)
294 :    
295 : feinerer 56 corpus <- Corpus(object)
296 : feinerer 49
297 :     # As XMLDocument is no native S4 class, restore valid information
298 :     class(corpus) <- "XMLDocument"
299 :     names(corpus) <- c("doc","dtd")
300 :    
301 :     return(xmlApply(xmlRoot(corpus), FUN, ...))
302 :     })
303 :    
304 : feinerer 55 setGeneric("stemTextDocument", function(object, ...) standardGeneric("stemTextDocument"))
305 : feinerer 49 setMethod("stemTextDocument",
306 :     c("PlainTextDocument"),
307 :     function(object) {
308 : feinerer 56 if (Cached(object) == 0)
309 :     object <- loadFileIntoMem(object)
310 :    
311 : feinerer 49 require(Rstem)
312 :     splittedCorpus <- unlist(strsplit(object, " ", fixed = TRUE))
313 :     stemmedCorpus <- wordStem(splittedCorpus)
314 : feinerer 56 Corpus(object) <- paste(stemmedCorpus, collapse = " ")
315 :     return(object)
316 : feinerer 49 })
317 :    
318 : feinerer 55 setGeneric("removeStopWords", function(object, stopwords, ...) standardGeneric("removeStopWords"))
319 : feinerer 53 setMethod("removeStopWords",
320 : feinerer 49 c("PlainTextDocument", "character"),
321 :     function(object, stopwords) {
322 : feinerer 56 if (Cached(object) == 0)
323 :     object <- loadFileIntoMem(object)
324 :    
325 : feinerer 49 require(Rstem)
326 :     splittedCorpus <- unlist(strsplit(object, " ", fixed = TRUE))
327 :     noStopwordsCorpus <- splittedCorpus[!splittedCorpus %in% stopwords]
328 : feinerer 56 Corpus(object) <- paste(noStopwordsCorpus, collapse = " ")
329 :     return(object)
330 : feinerer 49 })
331 :    
332 : feinerer 54 setGeneric("tm_filter", function(object, FUN, ...) standardGeneric("tm_filter"))
333 :     setMethod("tm_filter",
334 : feinerer 49 c("TextDocCol"),
335 :     function(object, FUN, ...) {
336 : feinerer 57 sapply(object, FUN, ..., GlobalMetaData = GlobalMetaData(object))
337 : feinerer 49 })
338 :    
339 :     setGeneric("filterREUT21578Topics", function(object, topics, ...) standardGeneric("filterREUT21578Topics"))
340 :     setMethod("filterREUT21578Topics",
341 :     c("PlainTextDocument", "character"),
342 : feinerer 55 function(object, topics) {
343 : feinerer 56 if (Cached(object) == 0)
344 : feinerer 49 object <- loadFileIntoMem(object)
345 :    
346 : feinerer 56 if (any(LocalMetaData(object)$Topics %in% topics))
347 : feinerer 49 return(TRUE)
348 :     else
349 :     return(FALSE)
350 :     })
351 : feinerer 52
352 : feinerer 55 setGeneric("filterIDs", function(object, IDs, ...) standardGeneric("filterIDs"))
353 : feinerer 53 setMethod("filterIDs",
354 :     c("TextDocument", "numeric"),
355 :     function(object, IDs) {
356 : feinerer 56 if (ID(object) %in% IDs)
357 : feinerer 53 return(TRUE)
358 :     else
359 :     return(FALSE)
360 :     })
361 :    
362 : feinerer 52 setGeneric("attachData", function(object, data) standardGeneric("attachData"))
363 :     setMethod("attachData",
364 :     c("TextDocCol","TextDocument"),
365 :     function(object, data) {
366 :     data <- as(list(data), "TextDocCol")
367 :     object@.Data <- as(c(object@.Data, data), "TextDocCol")
368 :     return(object)
369 :     })
370 :    
371 :     setGeneric("attachMetaData", function(object, name, metadata) standardGeneric("attachMetaData"))
372 :     setMethod("attachMetaData",
373 :     c("TextDocCol"),
374 :     function(object, name, metadata) {
375 : feinerer 56 object@GlobalMetaData <- c(GlobalMetaData(object), new = list(metadata))
376 :     names(object@GlobalMetaData)[length(names(GlobalMetaData(object)))] <- name
377 : feinerer 52 return(object)
378 :     })
379 : feinerer 53
380 :     setGeneric("setSubscriptable", function(object, name) standardGeneric("setSubscriptable"))
381 :     setMethod("setSubscriptable",
382 :     c("TextDocCol"),
383 :     function(object, name) {
384 : feinerer 56 if (!is.character(GlobalMetaData(object)$subscriptable))
385 : feinerer 53 object <- attachMetaData(object, "subscriptable", name)
386 :     else
387 : feinerer 56 object@GlobalMetaData$subscriptable <- c(GlobalMetaData(object)$subscriptable, name)
388 : feinerer 53 return(object)
389 :     })
390 :    
391 :     setMethod("[",
392 :     signature(x = "TextDocCol", i = "ANY", j = "ANY", drop = "ANY"),
393 :     function(x, i, j, ... , drop) {
394 :     if(missing(i))
395 :     return(x)
396 :    
397 :     object <- x
398 :     object@.Data <- x@.Data[i, ..., drop = FALSE]
399 : feinerer 56 for (m in names(GlobalMetaData(object))) {
400 :     if (m %in% GlobalMetaData(object)$subscriptable) {
401 :     object@GlobalMetaData[[m]] <- GlobalMetaData(object)[[m]][i, ..., drop = FALSE]
402 : feinerer 53 }
403 :     }
404 :     return(object)
405 :     })
406 :    
407 :     setMethod("c",
408 :     signature(x = "TextDocCol"),
409 :     function(x, ..., recursive = TRUE){
410 :     args <- list(...)
411 :     if(length(args) == 0)
412 :     return(x)
413 :     return(as(c(as(x, "list"), ...), "TextDocCol"))
414 :     })
415 : feinerer 54
416 :     setMethod("length",
417 :     signature(x = "TextDocCol"),
418 :     function(x){
419 :     return(length(as(x, "list")))
420 :     })
421 :    
422 :     setMethod("show",
423 :     signature(object = "TextDocCol"),
424 :     function(object){
425 :     cat("A text document collection with", length(object), "text document")
426 :     if (length(object) == 1)
427 :     cat("\n")
428 :     else
429 :     cat("s\n")
430 :     })
431 :    
432 :     setMethod("summary",
433 :     signature(object = "TextDocCol"),
434 :     function(object){
435 :     show(object)
436 :     if (length(GlobalMetaData(object)) > 0) {
437 :     cat("\nThe global metadata consists of", length(GlobalMetaData(object)), "tag-value pair")
438 :     if (length(GlobalMetaData(object)) == 1)
439 :     cat(".\n")
440 :     else
441 :     cat("s.\n")
442 :     cat("Available tags are:\n")
443 :     cat(names(GlobalMetaData(object)), "\n")
444 :     }
445 :     })
446 : feinerer 55
447 :     setGeneric("inspect", function(object) standardGeneric("inspect"))
448 :     setMethod("inspect",
449 :     c("TextDocCol"),
450 :     function(object) {
451 :     summary(object)
452 :     cat("\n")
453 :     show(as(object, "list"))
454 :     })

R-Forge@R-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business University of Wisconsin - Madison Powered By FusionForge