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 60 - (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 :     reuter21578xml.parser <- function(file, lod) {
27 :     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 # TODO: Check if it works with example
98 :     rcv1.to.plain <- function(node) {
99 : feinerer 42 datetimestamp <- xmlAttrs(node)[["date"]]
100 : feinerer 60 id <- xmlAttrs(node)[["itemid"]]
101 : feinerer 36 origin <- "Reuters Corpus Volume 1 XML"
102 : feinerer 18 corpus <- unlist(xmlApply(node[["text"]], xmlValue), use.names = FALSE)
103 :     heading <- xmlValue(node[["title"]])
104 : feinerer 17
105 : feinerer 60 new("PlainTextDocument", .Data = corpus, Author = "", DateTimeStamp = datetimestamp,
106 :     Description = "", ID = id, Origin = "Reuters Corpus Volume 1 XML", Heading = heading)
107 : feinerer 19 }
108 : feinerer 23
109 :     # Parse a <REUTERS></REUTERS> element from a well-formed Reuters-21578 XML file
110 : feinerer 60 # TODO: Ensure it works
111 :     reuters21578xml.to.plain <- function(node) {
112 : feinerer 36 # The <AUTHOR></AUTHOR> tag is unfortunately NOT obligatory!
113 :     if (!is.null(node[["TEXT"]][["AUTHOR"]]))
114 :     author <- xmlValue(node[["TEXT"]][["AUTHOR"]])
115 :     else
116 :     author <- ""
117 :    
118 : feinerer 42 datetimestamp <- xmlValue(node[["DATE"]])
119 : feinerer 36 description <- ""
120 : feinerer 60 id <- xmlAttrs(node)[["NEWID"]]
121 : feinerer 23
122 : feinerer 36 origin <- "Reuters-21578 XML"
123 : feinerer 23
124 :     # The <BODY></BODY> tag is unfortunately NOT obligatory!
125 :     if (!is.null(node[["TEXT"]][["BODY"]]))
126 :     corpus <- xmlValue(node[["TEXT"]][["BODY"]])
127 :     else
128 :     corpus <- ""
129 :    
130 :     # The <TITLE></TITLE> tag is unfortunately NOT obligatory!
131 :     if (!is.null(node[["TEXT"]][["TITLE"]]))
132 :     heading <- xmlValue(node[["TEXT"]][["TITLE"]])
133 :     else
134 :     heading <- ""
135 :    
136 : feinerer 49 topics <- unlist(xmlApply(node[["TOPICS"]], function(x) xmlValue(x)), use.names = FALSE)
137 :    
138 : feinerer 60 new("PlainTextDocument", .Data = corpus, Cached = TRUE, Author = author, DateTimeStamp = datetimestamp,
139 : feinerer 49 Description = description, ID = id, Origin = origin, Heading = heading, LocalMetaData = list(Topics = topics))
140 : feinerer 23 }
141 : feinerer 49
142 : feinerer 56 setGeneric("loadFileIntoMem", function(object, ...) standardGeneric("loadFileIntoMem"))
143 : feinerer 49 setMethod("loadFileIntoMem",
144 : feinerer 56 c("PlainTextDocument"),
145 :     function(object, ...) {
146 : feinerer 60 if (Cached(object) == FALSE) {
147 : feinerer 56 corpus <- readLines(FileName(object))
148 :     Corpus(object) <- corpus
149 : feinerer 60 Cached(object) <- TRUE
150 : feinerer 56 return(object)
151 :     } else {
152 :     return(object)
153 :     }
154 :     })
155 :     setMethod("loadFileIntoMem",
156 : feinerer 49 c("XMLTextDocument"),
157 : feinerer 56 function(object, ...) {
158 : feinerer 60 if (Cached(object) == FALSE) {
159 : feinerer 56 file <- FileName(object)
160 : feinerer 49 doc <- xmlTreeParse(file)
161 :     class(doc) <- "list"
162 : feinerer 56 Corpus(object) <- doc
163 : feinerer 60 Cached(object) <- TRUE
164 : feinerer 49 return(object)
165 :     } else {
166 :     return(object)
167 :     }
168 :     })
169 : feinerer 56 setMethod("loadFileIntoMem",
170 :     c("NewsgroupDocument"),
171 :     function(object, ...) {
172 : feinerer 60 if (Cached(object) == FALSE) {
173 : feinerer 56 mail <- readLines(FileName(object))
174 : feinerer 60 Cached(object) <- TRUE
175 : feinerer 56 index <- grep("^Lines:", mail)
176 :     Corpus(object) <- mail[(index + 1):length(mail)]
177 :     return(object)
178 :     } else {
179 :     return(object)
180 :     }
181 :     })
182 : feinerer 49
183 : feinerer 54 setGeneric("tm_transform", function(object, FUN, ...) standardGeneric("tm_transform"))
184 :     setMethod("tm_transform",
185 : feinerer 49 c("TextDocCol"),
186 :     function(object, FUN, ...) {
187 : feinerer 56 result <- as(lapply(object, FUN, ..., GlobalMetaData = GlobalMetaData(object)), "TextDocCol")
188 :     result@GlobalMetaData <- GlobalMetaData(object)
189 :     return(result)
190 : feinerer 49 })
191 :    
192 :     setGeneric("toPlainTextDocument", function(object, FUN, ...) standardGeneric("toPlainTextDocument"))
193 :     setMethod("toPlainTextDocument",
194 :     c("PlainTextDocument"),
195 :     function(object, FUN, ...) {
196 :     return(object)
197 :     })
198 :     setMethod("toPlainTextDocument",
199 :     c("XMLTextDocument"),
200 :     function(object, FUN, ...) {
201 : feinerer 60 if (Cached(object) == FALSE)
202 : feinerer 49 object <- loadFileIntoMem(object)
203 :    
204 : feinerer 56 corpus <- Corpus(object)
205 : feinerer 49
206 :     # As XMLDocument is no native S4 class, restore valid information
207 :     class(corpus) <- "XMLDocument"
208 :     names(corpus) <- c("doc","dtd")
209 :    
210 : feinerer 60 return(FUN(xmlRoot(corpus), ...)))
211 : feinerer 49 })
212 :    
213 : feinerer 55 setGeneric("stemTextDocument", function(object, ...) standardGeneric("stemTextDocument"))
214 : feinerer 49 setMethod("stemTextDocument",
215 :     c("PlainTextDocument"),
216 :     function(object) {
217 : feinerer 60 if (Cached(object) == FALSE)
218 : feinerer 56 object <- loadFileIntoMem(object)
219 :    
220 : feinerer 49 require(Rstem)
221 :     splittedCorpus <- unlist(strsplit(object, " ", fixed = TRUE))
222 : feinerer 60 stemmedCorpus <- wordStem(splittedCorpus, ...)
223 : feinerer 56 Corpus(object) <- paste(stemmedCorpus, collapse = " ")
224 :     return(object)
225 : feinerer 49 })
226 :    
227 : feinerer 55 setGeneric("removeStopWords", function(object, stopwords, ...) standardGeneric("removeStopWords"))
228 : feinerer 53 setMethod("removeStopWords",
229 : feinerer 60 signature(object = "PlainTextDocument", stopwords = "character"),
230 : feinerer 49 function(object, stopwords) {
231 : feinerer 60 if (Cached(object) == FALSE)
232 : feinerer 56 object <- loadFileIntoMem(object)
233 :    
234 : feinerer 49 require(Rstem)
235 :     splittedCorpus <- unlist(strsplit(object, " ", fixed = TRUE))
236 :     noStopwordsCorpus <- splittedCorpus[!splittedCorpus %in% stopwords]
237 : feinerer 56 Corpus(object) <- paste(noStopwordsCorpus, collapse = " ")
238 :     return(object)
239 : feinerer 49 })
240 :    
241 : feinerer 54 setGeneric("tm_filter", function(object, FUN, ...) standardGeneric("tm_filter"))
242 :     setMethod("tm_filter",
243 : feinerer 49 c("TextDocCol"),
244 :     function(object, FUN, ...) {
245 : feinerer 57 sapply(object, FUN, ..., GlobalMetaData = GlobalMetaData(object))
246 : feinerer 49 })
247 :    
248 :     setGeneric("filterREUT21578Topics", function(object, topics, ...) standardGeneric("filterREUT21578Topics"))
249 :     setMethod("filterREUT21578Topics",
250 :     c("PlainTextDocument", "character"),
251 : feinerer 55 function(object, topics) {
252 : feinerer 60 if (Cached(object) == FALSE)
253 : feinerer 49 object <- loadFileIntoMem(object)
254 :    
255 : feinerer 56 if (any(LocalMetaData(object)$Topics %in% topics))
256 : feinerer 49 return(TRUE)
257 :     else
258 :     return(FALSE)
259 :     })
260 : feinerer 52
261 : feinerer 55 setGeneric("filterIDs", function(object, IDs, ...) standardGeneric("filterIDs"))
262 : feinerer 53 setMethod("filterIDs",
263 :     c("TextDocument", "numeric"),
264 :     function(object, IDs) {
265 : feinerer 56 if (ID(object) %in% IDs)
266 : feinerer 53 return(TRUE)
267 :     else
268 :     return(FALSE)
269 :     })
270 :    
271 : feinerer 52 setGeneric("attachData", function(object, data) standardGeneric("attachData"))
272 :     setMethod("attachData",
273 :     c("TextDocCol","TextDocument"),
274 :     function(object, data) {
275 :     data <- as(list(data), "TextDocCol")
276 :     object@.Data <- as(c(object@.Data, data), "TextDocCol")
277 :     return(object)
278 :     })
279 :    
280 :     setGeneric("attachMetaData", function(object, name, metadata) standardGeneric("attachMetaData"))
281 :     setMethod("attachMetaData",
282 :     c("TextDocCol"),
283 :     function(object, name, metadata) {
284 : feinerer 56 object@GlobalMetaData <- c(GlobalMetaData(object), new = list(metadata))
285 :     names(object@GlobalMetaData)[length(names(GlobalMetaData(object)))] <- name
286 : feinerer 52 return(object)
287 :     })
288 : feinerer 53
289 :     setGeneric("setSubscriptable", function(object, name) standardGeneric("setSubscriptable"))
290 :     setMethod("setSubscriptable",
291 :     c("TextDocCol"),
292 :     function(object, name) {
293 : feinerer 56 if (!is.character(GlobalMetaData(object)$subscriptable))
294 : feinerer 53 object <- attachMetaData(object, "subscriptable", name)
295 :     else
296 : feinerer 56 object@GlobalMetaData$subscriptable <- c(GlobalMetaData(object)$subscriptable, name)
297 : feinerer 53 return(object)
298 :     })
299 :    
300 :     setMethod("[",
301 :     signature(x = "TextDocCol", i = "ANY", j = "ANY", drop = "ANY"),
302 :     function(x, i, j, ... , drop) {
303 :     if(missing(i))
304 :     return(x)
305 :    
306 :     object <- x
307 :     object@.Data <- x@.Data[i, ..., drop = FALSE]
308 : feinerer 56 for (m in names(GlobalMetaData(object))) {
309 :     if (m %in% GlobalMetaData(object)$subscriptable) {
310 :     object@GlobalMetaData[[m]] <- GlobalMetaData(object)[[m]][i, ..., drop = FALSE]
311 : feinerer 53 }
312 :     }
313 :     return(object)
314 :     })
315 :    
316 :     setMethod("c",
317 :     signature(x = "TextDocCol"),
318 :     function(x, ..., recursive = TRUE){
319 :     args <- list(...)
320 :     if(length(args) == 0)
321 :     return(x)
322 :     return(as(c(as(x, "list"), ...), "TextDocCol"))
323 :     })
324 : feinerer 54
325 :     setMethod("length",
326 :     signature(x = "TextDocCol"),
327 :     function(x){
328 :     return(length(as(x, "list")))
329 :     })
330 :    
331 :     setMethod("show",
332 :     signature(object = "TextDocCol"),
333 :     function(object){
334 :     cat("A text document collection with", length(object), "text document")
335 :     if (length(object) == 1)
336 :     cat("\n")
337 :     else
338 :     cat("s\n")
339 :     })
340 :    
341 :     setMethod("summary",
342 :     signature(object = "TextDocCol"),
343 :     function(object){
344 :     show(object)
345 :     if (length(GlobalMetaData(object)) > 0) {
346 :     cat("\nThe global metadata consists of", length(GlobalMetaData(object)), "tag-value pair")
347 :     if (length(GlobalMetaData(object)) == 1)
348 :     cat(".\n")
349 :     else
350 :     cat("s.\n")
351 :     cat("Available tags are:\n")
352 :     cat(names(GlobalMetaData(object)), "\n")
353 :     }
354 :     })
355 : feinerer 55
356 :     setGeneric("inspect", function(object) standardGeneric("inspect"))
357 :     setMethod("inspect",
358 :     c("TextDocCol"),
359 :     function(object) {
360 :     summary(object)
361 :     cat("\n")
362 :     show(as(object, "list"))
363 :     })

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