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

1 : feinerer 17 # Author: Ingo Feinerer
2 :    
3 : feinerer 65 # The "..." are additional arguments for the function_generator parser
4 : feinerer 63 setGeneric("TextDocCol", function(object, parser = plaintext_parser, ...) standardGeneric("TextDocCol"))
5 : feinerer 49 setMethod("TextDocCol",
6 : feinerer 63 signature(object = "Source"),
7 :     function(object, parser = plaintext_parser) {
8 :     if (inherits(parser, "function_generator"))
9 :     parser <- parser(...)
10 :    
11 :     tdl <- list()
12 :     counter <- 1
13 :     while (!eoi(object)) {
14 : feinerer 66 object <- step_next(object)
15 :     elem <- get_elem(object)
16 : feinerer 63 # If there is no Load on Demand support
17 :     # we need to load the corpus into memory at startup
18 :     if (object@LoDSupport)
19 :     load <- object@Load
20 :     else
21 :     load <- TRUE
22 :     tdl <- c(tdl, list(parser(elem, object@LoDSupport, load, as.character(counter))))
23 :     counter <- counter + 1
24 :     }
25 :    
26 : feinerer 60 return(new("TextDocCol", .Data = tdl))
27 : feinerer 21 })
28 :    
29 : feinerer 63 setGeneric("DirSource", function(directory, load = FALSE) standardGeneric("DirSource"))
30 :     setMethod("DirSource",
31 :     signature(directory = "character"),
32 :     function(directory, load = FALSE) {
33 :     new("DirSource", LoDSupport = TRUE, FileList = dir(directory, full.names = TRUE),
34 :     Position = 0, Load = load)
35 :     })
36 : feinerer 60
37 : feinerer 65 setGeneric("CSVSource", function(object, isConCall = FALSE) standardGeneric("CSVSource"))
38 : feinerer 63 setMethod("CSVSource",
39 : feinerer 65 signature(object = "character"),
40 :     function(object, isConCall = FALSE) {
41 :     if (!isConCall)
42 :     object <- paste('file("', object, '")', sep = "")
43 :     con <- eval(parse(text = object))
44 :     content <- scan(con, what = "character")
45 :     close(con)
46 :     new("CSVSource", LoDSupport = FALSE, URI = object,
47 :     Content = content, Position = 0)
48 : feinerer 63 })
49 : feinerer 60
50 : feinerer 65 setGeneric("ReutersSource", function(object, isConCall = FALSE) standardGeneric("ReutersSource"))
51 :     setMethod("ReutersSource",
52 :     signature(object = "character"),
53 :     function(object, isConCall = FALSE) {
54 :     if (!isConCall)
55 :     object <- paste('file("', object, '")', sep = "")
56 :     con <- eval(parse(text = object))
57 :     corpus <- paste(readLines(con), "\n", collapse = "")
58 :     close(con)
59 :     tree <- xmlTreeParse(corpus, asText = TRUE)
60 : feinerer 63 content <- xmlRoot(tree)$children
61 : feinerer 65
62 :     new("ReutersSource", LoDSupport = FALSE, URI = object,
63 : feinerer 63 Content = content, Position = 0)
64 :     })
65 :    
66 : feinerer 66 setGeneric("step_next", function(object) standardGeneric("step_next"))
67 :     setMethod("step_next",
68 : feinerer 63 signature(object = "DirSource"),
69 :     function(object) {
70 :     object@Position <- object@Position + 1
71 :     object
72 :     })
73 : feinerer 66 setMethod("step_next",
74 : feinerer 63 signature(object = "CSVSource"),
75 :     function(object) {
76 :     object@Position <- object@Position + 1
77 :     object
78 :     })
79 : feinerer 66 setMethod("step_next",
80 : feinerer 65 signature(object = "ReutersSource"),
81 : feinerer 63 function(object) {
82 :     object@Position <- object@Position + 1
83 :     object
84 :     })
85 :    
86 : feinerer 66 setGeneric("get_elem", function(object) standardGeneric("get_elem"))
87 :     setMethod("get_elem",
88 : feinerer 63 signature(object = "DirSource"),
89 :     function(object) {
90 :     list(content = readLines(object@FileList[object@Position]),
91 : feinerer 65 uri = paste('file("', object@FileList[object@Position], '")', sep = ""))
92 : feinerer 63 })
93 : feinerer 66 setMethod("get_elem",
94 : feinerer 63 signature(object = "CSVSource"),
95 :     function(object) {
96 :     list(content = object@Content[object@Position],
97 : feinerer 65 uri = object@URI)
98 : feinerer 63 })
99 : feinerer 66 setMethod("get_elem",
100 : feinerer 65 signature(object = "ReutersSource"),
101 : feinerer 63 function(object) {
102 : feinerer 65 # Construct a character representation from the XMLNode
103 :     con <- textConnection("virtual.file", "w")
104 :     saveXML(object@Content[[object@Position]], con)
105 :     close(con)
106 :    
107 :     list(content = virtual.file, uri = object@URI)
108 : feinerer 63 })
109 :    
110 :     setGeneric("eoi", function(object) standardGeneric("eoi"))
111 :     setMethod("eoi",
112 :     signature(object = "DirSource"),
113 :     function(object) {
114 :     if (length(object@FileList) <= object@Position)
115 :     return(TRUE)
116 :     else
117 :     return(FALSE)
118 :     })
119 :     setMethod("eoi",
120 :     signature(object = "CSVSource"),
121 :     function(object) {
122 :     if (length(object@Content) <= object@Position)
123 :     return(TRUE)
124 :     else
125 :     return(FALSE)
126 :     })
127 :     setMethod("eoi",
128 : feinerer 65 signature(object = "ReutersSource"),
129 : feinerer 63 function(object) {
130 :     if (length(object@Content) <= object@Position)
131 :     return(TRUE)
132 :     else
133 :     return(FALSE)
134 :     })
135 :    
136 :     plaintext_parser <- function(...) {
137 :     function(elem, lodsupport, load, id) {
138 :     if (!lodsupport || (lodsupport && load)) {
139 : feinerer 65 doc <- new("PlainTextDocument", .Data = elem$content, URI = elem$uri, Cached = TRUE,
140 : feinerer 63 Author = "", DateTimeStamp = date(), Description = "", ID = id, Origin = "", Heading = "")
141 :     }
142 :     else {
143 : feinerer 65 doc <- new("PlainTextDocument", URI = elem$uri, Cached = FALSE,
144 : feinerer 63 Author = "", DateTimeStamp = date(), Description = "", ID = id, Origin = "", Heading = "")
145 :     }
146 :    
147 :     return(doc)
148 : feinerer 60 }
149 :     }
150 : feinerer 63 class(plaintext_parser) <- "function_generator"
151 : feinerer 60
152 : feinerer 66 reut21578xml_parser <- function(...) {
153 : feinerer 63 function(elem, lodsupport, load, id) {
154 : feinerer 65 corpus <- paste(elem$content, "\n", collapse = "")
155 :     tree <- xmlTreeParse(corpus, asText = TRUE)
156 : feinerer 63 node <- xmlRoot(tree)
157 : feinerer 60
158 : feinerer 65 # Mask as list to bypass S4 checks
159 :     class(tree) <- "list"
160 :    
161 : feinerer 63 # The <AUTHOR></AUTHOR> tag is unfortunately NOT obligatory!
162 :     if (!is.null(node[["TEXT"]][["AUTHOR"]]))
163 :     author <- xmlValue(node[["TEXT"]][["AUTHOR"]])
164 :     else
165 :     author <- ""
166 : feinerer 60
167 : feinerer 63 datetimestamp <- xmlValue(node[["DATE"]])
168 :     description <- ""
169 :     id <- xmlAttrs(node)[["NEWID"]]
170 : feinerer 40
171 : feinerer 63 # The <TITLE></TITLE> tag is unfortunately NOT obligatory!
172 :     if (!is.null(node[["TEXT"]][["TITLE"]]))
173 :     heading <- xmlValue(node[["TEXT"]][["TITLE"]])
174 :     else
175 :     heading <- ""
176 : feinerer 41
177 : feinerer 63 topics <- unlist(xmlApply(node[["TOPICS"]], function(x) xmlValue(x)), use.names = FALSE)
178 : feinerer 41
179 : feinerer 63 if (!lodsupport || (lodsupport && load)) {
180 : feinerer 65 doc <- new("XMLTextDocument", .Data = tree, URI = elem$uri, Cached = TRUE, Author = author,
181 : feinerer 63 DateTimeStamp = datetimestamp, Description = "", ID = id, Origin = "Reuters-21578 XML",
182 :     Heading = heading, LocalMetaData = list(Topics = topics))
183 :     } else {
184 : feinerer 65 doc <- new("XMLTextDocument", URI = elem$uri, Cached = FALSE, Author = author,
185 : feinerer 63 DateTimeStamp = datetimestamp, Description = "", ID = id, Origin = "Reuters-21578 XML",
186 :     Heading = heading, LocalMetaData = list(Topics = topics))
187 :     }
188 : feinerer 40
189 : feinerer 63 return(doc)
190 : feinerer 60 }
191 :     }
192 : feinerer 66 class(reut21578xml_parser) <- "function_generator"
193 : feinerer 41
194 : feinerer 63 rcv1_parser <- function(...) {
195 :     function(elem, lodsupport, load, id) {
196 : feinerer 65 corpus <- paste(elem$content, "\n", collapse = "")
197 :     tree <- xmlTreeParse(corpus, asText = TRUE)
198 : feinerer 63 node <- xmlRoot(tree)
199 : feinerer 41
200 : feinerer 65 # Mask as list to bypass S4 checks
201 :     class(tree) <- "list"
202 :    
203 : feinerer 63 datetimestamp <- xmlAttrs(node)[["date"]]
204 :     id <- xmlAttrs(node)[["itemid"]]
205 :     heading <- xmlValue(node[["title"]])
206 : feinerer 40
207 : feinerer 63 if (!lodsupport || (lodsupport && load)) {
208 : feinerer 65 doc <- new("XMLTextDocument", .Data = tree, URI = elem$uri, Cached = TRUE, Author = "",
209 : feinerer 63 DateTimeStamp = datetimestamp, Description = "", ID = id, Origin = "Reuters Corpus Volume 1 XML",
210 :     Heading = heading)
211 :     } else {
212 : feinerer 65 doc <- new("XMLTextDocument", URI = elem$uri, Cached = FALSE, Author = "",
213 : feinerer 63 DateTimeStamp = datetimestamp, Description = "", ID = id, Origin = "Reuters Corpus Volume 1 XML",
214 :     Heading = heading)
215 :     }
216 : feinerer 40
217 : feinerer 63 return(doc)
218 : feinerer 60 }
219 : feinerer 40 }
220 : feinerer 63 class(rcv1_parser) <- "function_generator"
221 : feinerer 40
222 : feinerer 66 newsgroup_parser <- function(...) {
223 : feinerer 63 function(elem, lodsupport, load, id) {
224 : feinerer 65 mail <- elem$content
225 : feinerer 63 author <- gsub("From: ", "", grep("^From:", mail, value = TRUE))
226 :     datetimestamp <- gsub("Date: ", "", grep("^Date:", mail, value = TRUE))
227 :     origin <- gsub("Path: ", "", grep("^Path:", mail, value = TRUE))
228 :     heading <- gsub("Subject: ", "", grep("^Subject:", mail, value = TRUE))
229 :     newsgroup <- gsub("Newsgroups: ", "", grep("^Newsgroups:", mail, value = TRUE))
230 : feinerer 60
231 : feinerer 63 if (!lodsupport || (lodsupport && load)) {
232 : feinerer 65 # The header is separated from the body by a blank line.
233 :     # Reference: \url{http://en.wikipedia.org/wiki/E-mail#Internet_e-mail_format}
234 :     for (index in seq(along = mail)) {
235 :     if (mail[index] == "")
236 :     break
237 :     }
238 : feinerer 63 content <- mail[(index + 1):length(mail)]
239 : feinerer 60
240 : feinerer 65 doc <- new("NewsgroupDocument", .Data = content, URI = elem$uri, Cached = TRUE,
241 : feinerer 63 Author = author, DateTimeStamp = datetimestamp,
242 : feinerer 65 Description = "", ID = id, Origin = origin,
243 : feinerer 63 Heading = heading, Newsgroup = newsgroup)
244 :     } else {
245 : feinerer 65 doc <- new("NewsgroupDocument", URI = elem$uri, Cached = FALSE, Author = author, DateTimeStamp = datetimestamp,
246 :     Description = "", ID = id, Origin = origin, Heading = heading, Newsgroup = newsgroup)
247 : feinerer 63 }
248 :    
249 :     return(doc)
250 : feinerer 60 }
251 :     }
252 : feinerer 66 class(newsgroup_parser) <- "function_generator"
253 : feinerer 60
254 : feinerer 23 # Parse a <newsitem></newsitem> element from a well-formed RCV1 XML file
255 : feinerer 65 rcv1_to_plain <- function(node, ...) {
256 : feinerer 42 datetimestamp <- xmlAttrs(node)[["date"]]
257 : feinerer 60 id <- xmlAttrs(node)[["itemid"]]
258 : feinerer 36 origin <- "Reuters Corpus Volume 1 XML"
259 : feinerer 18 corpus <- unlist(xmlApply(node[["text"]], xmlValue), use.names = FALSE)
260 :     heading <- xmlValue(node[["title"]])
261 : feinerer 17
262 : feinerer 65 new("PlainTextDocument", .Data = corpus, Cached = TRUE, URI = "", Author = "", DateTimeStamp = datetimestamp,
263 : feinerer 60 Description = "", ID = id, Origin = "Reuters Corpus Volume 1 XML", Heading = heading)
264 : feinerer 19 }
265 : feinerer 23
266 :     # Parse a <REUTERS></REUTERS> element from a well-formed Reuters-21578 XML file
267 : feinerer 66 reut21578xml_to_plain <- function(node, ...) {
268 : feinerer 36 # The <AUTHOR></AUTHOR> tag is unfortunately NOT obligatory!
269 :     if (!is.null(node[["TEXT"]][["AUTHOR"]]))
270 :     author <- xmlValue(node[["TEXT"]][["AUTHOR"]])
271 :     else
272 :     author <- ""
273 :    
274 : feinerer 42 datetimestamp <- xmlValue(node[["DATE"]])
275 : feinerer 36 description <- ""
276 : feinerer 60 id <- xmlAttrs(node)[["NEWID"]]
277 : feinerer 23
278 : feinerer 36 origin <- "Reuters-21578 XML"
279 : feinerer 23
280 :     # The <BODY></BODY> tag is unfortunately NOT obligatory!
281 :     if (!is.null(node[["TEXT"]][["BODY"]]))
282 :     corpus <- xmlValue(node[["TEXT"]][["BODY"]])
283 :     else
284 :     corpus <- ""
285 :    
286 :     # The <TITLE></TITLE> tag is unfortunately NOT obligatory!
287 :     if (!is.null(node[["TEXT"]][["TITLE"]]))
288 :     heading <- xmlValue(node[["TEXT"]][["TITLE"]])
289 :     else
290 :     heading <- ""
291 :    
292 : feinerer 49 topics <- unlist(xmlApply(node[["TOPICS"]], function(x) xmlValue(x)), use.names = FALSE)
293 :    
294 : feinerer 65 new("PlainTextDocument", .Data = corpus, Cached = TRUE, URI = "", Author = author, DateTimeStamp = datetimestamp,
295 : feinerer 49 Description = description, ID = id, Origin = origin, Heading = heading, LocalMetaData = list(Topics = topics))
296 : feinerer 23 }
297 : feinerer 49
298 : feinerer 66 setGeneric("load_doc", function(object, ...) standardGeneric("load_doc"))
299 :     setMethod("load_doc",
300 : feinerer 62 signature(object = "PlainTextDocument"),
301 : feinerer 65 function(object, ...) {
302 : feinerer 61 if (!Cached(object)) {
303 : feinerer 65 con <- eval(parse(text = URI(object)))
304 :     corpus <- readLines(con)
305 :     close(con)
306 : feinerer 56 Corpus(object) <- corpus
307 : feinerer 60 Cached(object) <- TRUE
308 : feinerer 56 return(object)
309 :     } else {
310 :     return(object)
311 :     }
312 :     })
313 : feinerer 66 setMethod("load_doc",
314 : feinerer 62 signature(object = "XMLTextDocument"),
315 : feinerer 65 function(object, ...) {
316 : feinerer 61 if (!Cached(object)) {
317 : feinerer 65 con <- eval(parse(text = URI(object)))
318 :     corpus <- paste(readLines(con), "\n", collapse = "")
319 :     close(con)
320 :     doc <- xmlTreeParse(corpus, asText = TRUE)
321 : feinerer 49 class(doc) <- "list"
322 : feinerer 56 Corpus(object) <- doc
323 : feinerer 60 Cached(object) <- TRUE
324 : feinerer 49 return(object)
325 :     } else {
326 :     return(object)
327 :     }
328 :     })
329 : feinerer 66 setMethod("load_doc",
330 : feinerer 62 signature(object = "NewsgroupDocument"),
331 : feinerer 65 function(object, ...) {
332 : feinerer 61 if (!Cached(object)) {
333 : feinerer 65 con <- eval(parse(text = URI(object)))
334 :     mail <- readLines(con)
335 :     close(con)
336 : feinerer 60 Cached(object) <- TRUE
337 : feinerer 65 for (index in seq(along = mail)) {
338 :     if (mail[index] == "")
339 :     break
340 :     }
341 : feinerer 56 Corpus(object) <- mail[(index + 1):length(mail)]
342 :     return(object)
343 :     } else {
344 :     return(object)
345 :     }
346 :     })
347 : feinerer 49
348 : feinerer 54 setGeneric("tm_transform", function(object, FUN, ...) standardGeneric("tm_transform"))
349 :     setMethod("tm_transform",
350 : feinerer 62 signature(object = "TextDocCol", FUN = "function"),
351 : feinerer 49 function(object, FUN, ...) {
352 : feinerer 56 result <- as(lapply(object, FUN, ..., GlobalMetaData = GlobalMetaData(object)), "TextDocCol")
353 :     result@GlobalMetaData <- GlobalMetaData(object)
354 :     return(result)
355 : feinerer 49 })
356 :    
357 : feinerer 66 setGeneric("as.plaintext_doc", function(object, FUN, ...) standardGeneric("as.plaintext_doc"))
358 :     setMethod("as.plaintext_doc",
359 : feinerer 62 signature(object = "PlainTextDocument"),
360 : feinerer 49 function(object, FUN, ...) {
361 :     return(object)
362 :     })
363 : feinerer 66 setMethod("as.plaintext_doc",
364 : feinerer 62 signature(object = "XMLTextDocument", FUN = "function"),
365 : feinerer 49 function(object, FUN, ...) {
366 : feinerer 61 if (!Cached(object))
367 : feinerer 66 object <- load_doc(object)
368 : feinerer 49
369 : feinerer 56 corpus <- Corpus(object)
370 : feinerer 49
371 :     # As XMLDocument is no native S4 class, restore valid information
372 :     class(corpus) <- "XMLDocument"
373 :     names(corpus) <- c("doc","dtd")
374 :    
375 : feinerer 61 return(FUN(xmlRoot(corpus), ...))
376 : feinerer 49 })
377 :    
378 : feinerer 66 setGeneric("stem_doc", function(object, ...) standardGeneric("stem_doc"))
379 :     setMethod("stem_doc",
380 : feinerer 62 signature(object = "PlainTextDocument"),
381 : feinerer 61 function(object, ...) {
382 :     if (!Cached(object))
383 : feinerer 66 object <- load_doc(object)
384 : feinerer 56
385 : feinerer 49 require(Rstem)
386 :     splittedCorpus <- unlist(strsplit(object, " ", fixed = TRUE))
387 : feinerer 60 stemmedCorpus <- wordStem(splittedCorpus, ...)
388 : feinerer 56 Corpus(object) <- paste(stemmedCorpus, collapse = " ")
389 :     return(object)
390 : feinerer 49 })
391 :    
392 : feinerer 66 setGeneric("remove_words", function(object, stopwords, ...) standardGeneric("remove_words"))
393 :     setMethod("remove_words",
394 : feinerer 60 signature(object = "PlainTextDocument", stopwords = "character"),
395 : feinerer 61 function(object, stopwords, ...) {
396 :     if (!Cached(object))
397 : feinerer 66 object <- load_doc(object)
398 : feinerer 56
399 : feinerer 49 require(Rstem)
400 :     splittedCorpus <- unlist(strsplit(object, " ", fixed = TRUE))
401 :     noStopwordsCorpus <- splittedCorpus[!splittedCorpus %in% stopwords]
402 : feinerer 56 Corpus(object) <- paste(noStopwordsCorpus, collapse = " ")
403 :     return(object)
404 : feinerer 49 })
405 :    
406 : feinerer 64 setGeneric("tm_filter", function(object, ..., FUN = s_filter) standardGeneric("tm_filter"))
407 : feinerer 54 setMethod("tm_filter",
408 : feinerer 61 signature(object = "TextDocCol"),
409 : feinerer 64 function(object, ..., FUN = s_filter) {
410 : feinerer 61 object[tm_index(object, ..., FUN)]
411 :     })
412 :    
413 : feinerer 63 setGeneric("tm_index", function(object, ..., FUN = s_filter) standardGeneric("tm_index"))
414 : feinerer 61 setMethod("tm_index",
415 :     signature(object = "TextDocCol"),
416 : feinerer 64 function(object, ..., FUN = s_filter) {
417 : feinerer 57 sapply(object, FUN, ..., GlobalMetaData = GlobalMetaData(object))
418 : feinerer 49 })
419 :    
420 : feinerer 63 s_filter <- function(object, s, ..., GlobalMetaData) {
421 : feinerer 61 b <- TRUE
422 :     for (tag in names(s)) {
423 :     if (tag %in% names(LocalMetaData(object))) {
424 :     b <- b && any(grep(s[[tag]], LocalMetaData(object)[[tag]]))
425 :     } else if (tag %in% names(GlobalMetaData)){
426 :     b <- b && any(grep(s[[tag]], GlobalMetaData[[tag]]))
427 :     } else {
428 :     b <- b && any(grep(s[[tag]], eval(call(tag, object))))
429 :     }
430 :     }
431 :     return(b)
432 :     }
433 :    
434 : feinerer 63 setGeneric("fulltext_search_filter", function(object, pattern, ...) standardGeneric("fulltext_search_filter"))
435 :     setMethod("fulltext_search_filter",
436 : feinerer 61 signature(object = "PlainTextDocument", pattern = "character"),
437 :     function(object, pattern, ...) {
438 :     if (!Cached(object))
439 : feinerer 66 object <- load_doc(object)
440 : feinerer 61
441 :     return(any(grep(pattern, Corpus(object))))
442 :     })
443 :    
444 : feinerer 66 setGeneric("attach_data", function(object, data) standardGeneric("attach_data"))
445 :     setMethod("attach_data",
446 : feinerer 62 signature(object = "TextDocCol", data = "TextDocument"),
447 : feinerer 52 function(object, data) {
448 :     data <- as(list(data), "TextDocCol")
449 :     object@.Data <- as(c(object@.Data, data), "TextDocCol")
450 :     return(object)
451 :     })
452 :    
453 : feinerer 66 setGeneric("attach_metadata", function(object, name, metadata) standardGeneric("attach_metadata"))
454 :     setMethod("attach_metadata",
455 : feinerer 62 signature(object = "TextDocCol"),
456 : feinerer 52 function(object, name, metadata) {
457 : feinerer 56 object@GlobalMetaData <- c(GlobalMetaData(object), new = list(metadata))
458 :     names(object@GlobalMetaData)[length(names(GlobalMetaData(object)))] <- name
459 : feinerer 52 return(object)
460 :     })
461 : feinerer 53
462 : feinerer 66 setGeneric("set_subscriptable", function(object, name) standardGeneric("set_subscriptable"))
463 :     setMethod("set_subscriptable",
464 : feinerer 62 signature(object = "TextDocCol"),
465 : feinerer 53 function(object, name) {
466 : feinerer 56 if (!is.character(GlobalMetaData(object)$subscriptable))
467 : feinerer 66 object <- attach_metadata(object, "subscriptable", name)
468 : feinerer 53 else
469 : feinerer 56 object@GlobalMetaData$subscriptable <- c(GlobalMetaData(object)$subscriptable, name)
470 : feinerer 53 return(object)
471 :     })
472 :    
473 :     setMethod("[",
474 :     signature(x = "TextDocCol", i = "ANY", j = "ANY", drop = "ANY"),
475 :     function(x, i, j, ... , drop) {
476 :     if(missing(i))
477 :     return(x)
478 :    
479 :     object <- x
480 :     object@.Data <- x@.Data[i, ..., drop = FALSE]
481 : feinerer 56 for (m in names(GlobalMetaData(object))) {
482 :     if (m %in% GlobalMetaData(object)$subscriptable) {
483 :     object@GlobalMetaData[[m]] <- GlobalMetaData(object)[[m]][i, ..., drop = FALSE]
484 : feinerer 53 }
485 :     }
486 :     return(object)
487 :     })
488 :    
489 : feinerer 63 setMethod("[<-",
490 :     signature(x = "TextDocCol", i = "ANY", j = "ANY", value = "ANY"),
491 :     function(x, i, j, ... , value) {
492 :     object <- x
493 :     object@.Data[i, ...] <- value
494 :     return(object)
495 :     })
496 :    
497 :     setMethod("[[",
498 :     signature(x = "TextDocCol", i = "ANY", j = "ANY"),
499 :     function(x, i, j, ...) {
500 :     return(x@.Data[[i, ...]])
501 :     })
502 :    
503 :     setMethod("[[<-",
504 :     signature(x = "TextDocCol", i = "ANY", j = "ANY", value = "ANY"),
505 :     function(x, i, j, ..., value) {
506 :     object <- x
507 :     object@.Data[[i, ...]] <- value
508 :     return(object)
509 :     })
510 :    
511 : feinerer 53 setMethod("c",
512 :     signature(x = "TextDocCol"),
513 :     function(x, ..., recursive = TRUE){
514 :     args <- list(...)
515 :     if(length(args) == 0)
516 :     return(x)
517 :     return(as(c(as(x, "list"), ...), "TextDocCol"))
518 :     })
519 : feinerer 65 setMethod("c",
520 :     signature(x = "TextDocument"),
521 :     function(x, ..., recursive = TRUE){
522 :     args <- list(...)
523 :     if(length(args) == 0)
524 :     return(x)
525 :     return(new("TextDocCol", .Data = list(x, ...)))
526 :     })
527 : feinerer 54
528 :     setMethod("length",
529 :     signature(x = "TextDocCol"),
530 :     function(x){
531 :     return(length(as(x, "list")))
532 :     })
533 :    
534 :     setMethod("show",
535 :     signature(object = "TextDocCol"),
536 :     function(object){
537 :     cat("A text document collection with", length(object), "text document")
538 :     if (length(object) == 1)
539 :     cat("\n")
540 :     else
541 :     cat("s\n")
542 :     })
543 :    
544 :     setMethod("summary",
545 :     signature(object = "TextDocCol"),
546 :     function(object){
547 :     show(object)
548 :     if (length(GlobalMetaData(object)) > 0) {
549 :     cat("\nThe global metadata consists of", length(GlobalMetaData(object)), "tag-value pair")
550 :     if (length(GlobalMetaData(object)) == 1)
551 :     cat(".\n")
552 :     else
553 :     cat("s.\n")
554 :     cat("Available tags are:\n")
555 :     cat(names(GlobalMetaData(object)), "\n")
556 :     }
557 :     })
558 : feinerer 55
559 :     setGeneric("inspect", function(object) standardGeneric("inspect"))
560 :     setMethod("inspect",
561 : feinerer 65 signature("TextDocCol"),
562 : feinerer 55 function(object) {
563 :     summary(object)
564 :     cat("\n")
565 :     show(as(object, "list"))
566 :     })
567 : feinerer 65
568 :     # No metadata is checked
569 :     setGeneric("%IN%", function(x, y) standardGeneric("%IN%"))
570 :     setMethod("%IN%",
571 :     signature(x = "TextDocument", y = "TextDocCol"),
572 :     function(x, y) {
573 :     x %in% y
574 :     })

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