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 62 - (view) (download)
Original Path: trunk/R/textmin/R/textdoccol.R

1 : feinerer 17 # Author: Ingo Feinerer
2 :    
3 : feinerer 60 setGeneric("TextDocCol", function(object, parser = plaintext.parser, lod = FALSE) standardGeneric("TextDocCol"))
4 : feinerer 49 setMethod("TextDocCol",
5 : feinerer 60 signature(object = "character"),
6 :     function(object, parser = plaintext.parser, lod = FALSE) {
7 :     filelist <- dir(object, full.names = TRUE)
8 :     tdl <- lapply(filelist, parser, lod)
9 :     return(new("TextDocCol", .Data = tdl))
10 : feinerer 21 })
11 :    
12 : feinerer 60 plaintext.parser <- function(file, lod) {
13 :     id <- file
14 :     origin <- dirname(file)
15 :    
16 :     doc <- new("PlainTextDocument", FileName = file, Cached = FALSE, Author = "Unknown",
17 :     DateTimeStamp = date(), Description = "", ID = id, Origin = origin, Heading = "")
18 :    
19 :     if (lod) {
20 :     doc <- loadFileIntoMem(doc)
21 :     }
22 :    
23 :     return(doc)
24 :     }
25 :    
26 : feinerer 61 reuters21578xml.parser <- function(file, lod) {
27 : feinerer 60 tree <- xmlTreeParse(file)
28 :     node <- xmlRoot(tree)
29 :    
30 :     # The <AUTHOR></AUTHOR> tag is unfortunately NOT obligatory!
31 :     if (!is.null(node[["TEXT"]][["AUTHOR"]]))
32 :     author <- xmlValue(node[["TEXT"]][["AUTHOR"]])
33 :     else
34 :     author <- ""
35 :    
36 :     datetimestamp <- xmlValue(node[["DATE"]])
37 : feinerer 40 description <- ""
38 : feinerer 60 id <- xmlAttrs(node)[["NEWID"]]
39 : feinerer 40
40 : feinerer 60 # The <TITLE></TITLE> tag is unfortunately NOT obligatory!
41 :     if (!is.null(node[["TEXT"]][["TITLE"]]))
42 :     heading <- xmlValue(node[["TEXT"]][["TITLE"]])
43 :     else
44 :     heading <- ""
45 : feinerer 41
46 : feinerer 60 topics <- unlist(xmlApply(node[["TOPICS"]], function(x) xmlValue(x)), use.names = FALSE)
47 : feinerer 41
48 : feinerer 60 doc <- new("XMLTextDocument", FileName = file, Cached = FALSE, Author = author,
49 :     DateTimeStamp = datetimestamp, Description = "", ID = id, Origin = "Reuters-21578 XML",
50 :     Heading = heading, LocalMetaData = list(Topics = topics))
51 : feinerer 40
52 : feinerer 60 if (lod) {
53 :     doc <- loadFileIntoMem(doc)
54 :     }
55 : feinerer 41
56 : feinerer 60 return(doc)
57 :     }
58 : feinerer 41
59 : feinerer 60 rcv1.parser <- function(file, lod) {
60 :     tree <- xmlTreeParse(file)
61 :     node <- xmlRoot(tree)
62 : feinerer 41
63 : feinerer 60 datetimestamp <- xmlAttrs(node)[["date"]]
64 :     id <- xmlAttrs(node)[["itemid"]]
65 :     heading <- xmlValue(node[["title"]])
66 : feinerer 40
67 : feinerer 60 doc <- new("XMLTextDocument", FileName = file, Cached = FALSE, Author = "",
68 :     DateTimeStamp = datetimestamp, Description = "", ID = id, Origin = "Reuters Corpus Volume 1 XML",
69 :     Heading = heading)
70 : feinerer 40
71 : feinerer 60 if (lod) {
72 :     doc <- loadFileIntoMem(doc)
73 :     }
74 : feinerer 40
75 : feinerer 60 return(doc)
76 : feinerer 40 }
77 :    
78 : feinerer 60 uci.kdd.newsgroup.parser <- function(file, lod) {
79 :     mail <- readLines(file)
80 :     author <- gsub("From: ", "", grep("^From:", mail, value = TRUE))
81 :     datetimestamp <- gsub("Date: ", "", grep("^Date:", mail, value = TRUE))
82 :     origin <- gsub("Path: ", "", grep("^Path:", mail, value = TRUE))
83 :     heading <- gsub("Subject: ", "", grep("^Subject:", mail, value = TRUE))
84 :     newsgroup <- gsub("Newsgroups: ", "", grep("^Newsgroups:", mail, value = TRUE))
85 :    
86 :     new("NewsgroupDocument", FileName = file, Cached = FALSE, Author = author, DateTimeStamp = datetimestamp,
87 :     Description = "", ID = file, Origin = origin, Heading = heading, Newsgroup = newsgroup)
88 :    
89 :     if (lod) {
90 :     doc <- loadFileIntoMem(doc)
91 :     }
92 :    
93 :     return(doc)
94 :     }
95 :    
96 : feinerer 23 # Parse a <newsitem></newsitem> element from a well-formed RCV1 XML file
97 : feinerer 60 rcv1.to.plain <- function(node) {
98 : feinerer 42 datetimestamp <- xmlAttrs(node)[["date"]]
99 : feinerer 60 id <- xmlAttrs(node)[["itemid"]]
100 : feinerer 36 origin <- "Reuters Corpus Volume 1 XML"
101 : feinerer 18 corpus <- unlist(xmlApply(node[["text"]], xmlValue), use.names = FALSE)
102 :     heading <- xmlValue(node[["title"]])
103 : feinerer 17
104 : feinerer 60 new("PlainTextDocument", .Data = corpus, Author = "", DateTimeStamp = datetimestamp,
105 :     Description = "", ID = id, Origin = "Reuters Corpus Volume 1 XML", Heading = heading)
106 : feinerer 19 }
107 : feinerer 23
108 :     # Parse a <REUTERS></REUTERS> element from a well-formed Reuters-21578 XML file
109 : feinerer 60 reuters21578xml.to.plain <- function(node) {
110 : feinerer 36 # The <AUTHOR></AUTHOR> tag is unfortunately NOT obligatory!
111 :     if (!is.null(node[["TEXT"]][["AUTHOR"]]))
112 :     author <- xmlValue(node[["TEXT"]][["AUTHOR"]])
113 :     else
114 :     author <- ""
115 :    
116 : feinerer 42 datetimestamp <- xmlValue(node[["DATE"]])
117 : feinerer 36 description <- ""
118 : feinerer 60 id <- xmlAttrs(node)[["NEWID"]]
119 : feinerer 23
120 : feinerer 36 origin <- "Reuters-21578 XML"
121 : feinerer 23
122 :     # The <BODY></BODY> tag is unfortunately NOT obligatory!
123 :     if (!is.null(node[["TEXT"]][["BODY"]]))
124 :     corpus <- xmlValue(node[["TEXT"]][["BODY"]])
125 :     else
126 :     corpus <- ""
127 :    
128 :     # The <TITLE></TITLE> tag is unfortunately NOT obligatory!
129 :     if (!is.null(node[["TEXT"]][["TITLE"]]))
130 :     heading <- xmlValue(node[["TEXT"]][["TITLE"]])
131 :     else
132 :     heading <- ""
133 :    
134 : feinerer 49 topics <- unlist(xmlApply(node[["TOPICS"]], function(x) xmlValue(x)), use.names = FALSE)
135 :    
136 : feinerer 60 new("PlainTextDocument", .Data = corpus, Cached = TRUE, Author = author, DateTimeStamp = datetimestamp,
137 : feinerer 49 Description = description, ID = id, Origin = origin, Heading = heading, LocalMetaData = list(Topics = topics))
138 : feinerer 23 }
139 : feinerer 49
140 : feinerer 61 setGeneric("loadFileIntoMem", function(object) standardGeneric("loadFileIntoMem"))
141 : feinerer 49 setMethod("loadFileIntoMem",
142 : feinerer 62 signature(object = "PlainTextDocument"),
143 : feinerer 61 function(object) {
144 :     if (!Cached(object)) {
145 : feinerer 56 corpus <- readLines(FileName(object))
146 :     Corpus(object) <- corpus
147 : feinerer 60 Cached(object) <- TRUE
148 : feinerer 56 return(object)
149 :     } else {
150 :     return(object)
151 :     }
152 :     })
153 :     setMethod("loadFileIntoMem",
154 : feinerer 62 signature(object = "XMLTextDocument"),
155 : feinerer 61 function(object) {
156 :     if (!Cached(object)) {
157 : feinerer 56 file <- FileName(object)
158 : feinerer 49 doc <- xmlTreeParse(file)
159 :     class(doc) <- "list"
160 : feinerer 56 Corpus(object) <- doc
161 : feinerer 60 Cached(object) <- TRUE
162 : feinerer 49 return(object)
163 :     } else {
164 :     return(object)
165 :     }
166 :     })
167 : feinerer 56 setMethod("loadFileIntoMem",
168 : feinerer 62 signature(object = "NewsgroupDocument"),
169 : feinerer 61 function(object) {
170 :     if (!Cached(object)) {
171 : feinerer 56 mail <- readLines(FileName(object))
172 : feinerer 60 Cached(object) <- TRUE
173 : feinerer 56 index <- grep("^Lines:", mail)
174 :     Corpus(object) <- mail[(index + 1):length(mail)]
175 :     return(object)
176 :     } else {
177 :     return(object)
178 :     }
179 :     })
180 : feinerer 49
181 : feinerer 54 setGeneric("tm_transform", function(object, FUN, ...) standardGeneric("tm_transform"))
182 :     setMethod("tm_transform",
183 : feinerer 62 signature(object = "TextDocCol", FUN = "function"),
184 : feinerer 49 function(object, FUN, ...) {
185 : feinerer 56 result <- as(lapply(object, FUN, ..., GlobalMetaData = GlobalMetaData(object)), "TextDocCol")
186 :     result@GlobalMetaData <- GlobalMetaData(object)
187 :     return(result)
188 : feinerer 49 })
189 :    
190 :     setGeneric("toPlainTextDocument", function(object, FUN, ...) standardGeneric("toPlainTextDocument"))
191 :     setMethod("toPlainTextDocument",
192 : feinerer 62 signature(object = "PlainTextDocument"),
193 : feinerer 49 function(object, FUN, ...) {
194 :     return(object)
195 :     })
196 :     setMethod("toPlainTextDocument",
197 : feinerer 62 signature(object = "XMLTextDocument", FUN = "function"),
198 : feinerer 49 function(object, FUN, ...) {
199 : feinerer 61 if (!Cached(object))
200 : feinerer 49 object <- loadFileIntoMem(object)
201 :    
202 : feinerer 56 corpus <- Corpus(object)
203 : feinerer 49
204 :     # As XMLDocument is no native S4 class, restore valid information
205 :     class(corpus) <- "XMLDocument"
206 :     names(corpus) <- c("doc","dtd")
207 :    
208 : feinerer 61 return(FUN(xmlRoot(corpus), ...))
209 : feinerer 49 })
210 :    
211 : feinerer 55 setGeneric("stemTextDocument", function(object, ...) standardGeneric("stemTextDocument"))
212 : feinerer 49 setMethod("stemTextDocument",
213 : feinerer 62 signature(object = "PlainTextDocument"),
214 : feinerer 61 function(object, ...) {
215 :     if (!Cached(object))
216 : feinerer 56 object <- loadFileIntoMem(object)
217 :    
218 : feinerer 49 require(Rstem)
219 :     splittedCorpus <- unlist(strsplit(object, " ", fixed = TRUE))
220 : feinerer 60 stemmedCorpus <- wordStem(splittedCorpus, ...)
221 : feinerer 56 Corpus(object) <- paste(stemmedCorpus, collapse = " ")
222 :     return(object)
223 : feinerer 49 })
224 :    
225 : feinerer 55 setGeneric("removeStopWords", function(object, stopwords, ...) standardGeneric("removeStopWords"))
226 : feinerer 53 setMethod("removeStopWords",
227 : feinerer 60 signature(object = "PlainTextDocument", stopwords = "character"),
228 : feinerer 61 function(object, stopwords, ...) {
229 :     if (!Cached(object))
230 : feinerer 56 object <- loadFileIntoMem(object)
231 :    
232 : feinerer 49 require(Rstem)
233 :     splittedCorpus <- unlist(strsplit(object, " ", fixed = TRUE))
234 :     noStopwordsCorpus <- splittedCorpus[!splittedCorpus %in% stopwords]
235 : feinerer 56 Corpus(object) <- paste(noStopwordsCorpus, collapse = " ")
236 :     return(object)
237 : feinerer 49 })
238 :    
239 : feinerer 61 setGeneric("tm_filter", function(object, ..., FUN = s.filter) standardGeneric("tm_filter"))
240 : feinerer 54 setMethod("tm_filter",
241 : feinerer 61 signature(object = "TextDocCol"),
242 :     function(object, ..., FUN = s.filter) {
243 :     object[tm_index(object, ..., FUN)]
244 :     })
245 :    
246 :     setGeneric("tm_index", function(object, ..., FUN = s.filter) standardGeneric("tm_index"))
247 :     setMethod("tm_index",
248 :     signature(object = "TextDocCol"),
249 :     function(object, ..., FUN = s.filter) {
250 : feinerer 57 sapply(object, FUN, ..., GlobalMetaData = GlobalMetaData(object))
251 : feinerer 49 })
252 :    
253 : feinerer 61 s.filter <- function(object, s, ..., GlobalMetaData) {
254 :     b <- TRUE
255 :     for (tag in names(s)) {
256 :     if (tag %in% names(LocalMetaData(object))) {
257 :     b <- b && any(grep(s[[tag]], LocalMetaData(object)[[tag]]))
258 :     } else if (tag %in% names(GlobalMetaData)){
259 :     b <- b && any(grep(s[[tag]], GlobalMetaData[[tag]]))
260 :     } else {
261 :     b <- b && any(grep(s[[tag]], eval(call(tag, object))))
262 :     }
263 :     }
264 :     return(b)
265 :     }
266 :    
267 :     setGeneric("fulltext.search.filter", function(object, pattern, ...) standardGeneric("fulltext.search.filter"))
268 :     setMethod("fulltext.search.filter",
269 :     signature(object = "PlainTextDocument", pattern = "character"),
270 :     function(object, pattern, ...) {
271 :     if (!Cached(object))
272 :     object <- loadFileIntoMem(object)
273 :    
274 :     return(any(grep(pattern, Corpus(object))))
275 :     })
276 :    
277 :     setGeneric("reuters21578.topic.filter", function(object, topics, ...) standardGeneric("reuters21578.topic.filter"))
278 :     setMethod("reuters21578.topic.filter",
279 : feinerer 62 signature(object = "PlainTextDocument", topics = "character"),
280 : feinerer 61 function(object, topics, ...) {
281 :     if (!Cached(object))
282 : feinerer 49 object <- loadFileIntoMem(object)
283 :    
284 : feinerer 56 if (any(LocalMetaData(object)$Topics %in% topics))
285 : feinerer 49 return(TRUE)
286 :     else
287 :     return(FALSE)
288 :     })
289 : feinerer 52
290 : feinerer 61 setGeneric("id.filter", function(object, IDs, ...) standardGeneric("id.filter"))
291 :     setMethod("id.filter",
292 : feinerer 62 signature(object = "TextDocument", IDs = "numeric"),
293 : feinerer 61 function(object, IDs, ...) {
294 : feinerer 56 if (ID(object) %in% IDs)
295 : feinerer 53 return(TRUE)
296 :     else
297 :     return(FALSE)
298 :     })
299 :    
300 : feinerer 52 setGeneric("attachData", function(object, data) standardGeneric("attachData"))
301 :     setMethod("attachData",
302 : feinerer 62 signature(object = "TextDocCol", data = "TextDocument"),
303 : feinerer 52 function(object, data) {
304 :     data <- as(list(data), "TextDocCol")
305 :     object@.Data <- as(c(object@.Data, data), "TextDocCol")
306 :     return(object)
307 :     })
308 :    
309 :     setGeneric("attachMetaData", function(object, name, metadata) standardGeneric("attachMetaData"))
310 :     setMethod("attachMetaData",
311 : feinerer 62 signature(object = "TextDocCol"),
312 : feinerer 52 function(object, name, metadata) {
313 : feinerer 56 object@GlobalMetaData <- c(GlobalMetaData(object), new = list(metadata))
314 :     names(object@GlobalMetaData)[length(names(GlobalMetaData(object)))] <- name
315 : feinerer 52 return(object)
316 :     })
317 : feinerer 53
318 :     setGeneric("setSubscriptable", function(object, name) standardGeneric("setSubscriptable"))
319 :     setMethod("setSubscriptable",
320 : feinerer 62 signature(object = "TextDocCol"),
321 : feinerer 53 function(object, name) {
322 : feinerer 56 if (!is.character(GlobalMetaData(object)$subscriptable))
323 : feinerer 53 object <- attachMetaData(object, "subscriptable", name)
324 :     else
325 : feinerer 56 object@GlobalMetaData$subscriptable <- c(GlobalMetaData(object)$subscriptable, name)
326 : feinerer 53 return(object)
327 :     })
328 :    
329 :     setMethod("[",
330 :     signature(x = "TextDocCol", i = "ANY", j = "ANY", drop = "ANY"),
331 :     function(x, i, j, ... , drop) {
332 :     if(missing(i))
333 :     return(x)
334 :    
335 :     object <- x
336 :     object@.Data <- x@.Data[i, ..., drop = FALSE]
337 : feinerer 56 for (m in names(GlobalMetaData(object))) {
338 :     if (m %in% GlobalMetaData(object)$subscriptable) {
339 :     object@GlobalMetaData[[m]] <- GlobalMetaData(object)[[m]][i, ..., drop = FALSE]
340 : feinerer 53 }
341 :     }
342 :     return(object)
343 :     })
344 :    
345 :     setMethod("c",
346 :     signature(x = "TextDocCol"),
347 :     function(x, ..., recursive = TRUE){
348 :     args <- list(...)
349 :     if(length(args) == 0)
350 :     return(x)
351 :     return(as(c(as(x, "list"), ...), "TextDocCol"))
352 :     })
353 : feinerer 54
354 :     setMethod("length",
355 :     signature(x = "TextDocCol"),
356 :     function(x){
357 :     return(length(as(x, "list")))
358 :     })
359 :    
360 :     setMethod("show",
361 :     signature(object = "TextDocCol"),
362 :     function(object){
363 :     cat("A text document collection with", length(object), "text document")
364 :     if (length(object) == 1)
365 :     cat("\n")
366 :     else
367 :     cat("s\n")
368 :     })
369 :    
370 :     setMethod("summary",
371 :     signature(object = "TextDocCol"),
372 :     function(object){
373 :     show(object)
374 :     if (length(GlobalMetaData(object)) > 0) {
375 :     cat("\nThe global metadata consists of", length(GlobalMetaData(object)), "tag-value pair")
376 :     if (length(GlobalMetaData(object)) == 1)
377 :     cat(".\n")
378 :     else
379 :     cat("s.\n")
380 :     cat("Available tags are:\n")
381 :     cat(names(GlobalMetaData(object)), "\n")
382 :     }
383 :     })
384 : feinerer 55
385 :     setGeneric("inspect", function(object) standardGeneric("inspect"))
386 :     setMethod("inspect",
387 :     c("TextDocCol"),
388 :     function(object) {
389 :     summary(object)
390 :     cat("\n")
391 :     show(as(object, "list"))
392 :     })

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