SCM

SCM Repository

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

Diff of /pkg/R/corpus.R

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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

Legend:
Removed from v.18  
changed lines
  Added in v.70

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge