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

revision 66, Tue Oct 31 22:03:33 2006 UTC revision 70, Tue Nov 7 18:18:51 2006 UTC
# Line 4  Line 4 
4  setGeneric("TextDocCol", function(object, parser = plaintext_parser, ...) standardGeneric("TextDocCol"))  setGeneric("TextDocCol", function(object, parser = plaintext_parser, ...) standardGeneric("TextDocCol"))
5  setMethod("TextDocCol",  setMethod("TextDocCol",
6            signature(object = "Source"),            signature(object = "Source"),
7            function(object, parser = plaintext_parser) {            function(object, parser = plaintext_parser, ...) {
8                if (inherits(parser, "function_generator"))                if (inherits(parser, "function_generator"))
9                    parser <- parser(...)                    parser <- parser(...)
10    
# Line 34  Line 34 
34                    Position = 0, Load = load)                    Position = 0, Load = load)
35            })            })
36    
37  setGeneric("CSVSource", function(object, isConCall = FALSE) standardGeneric("CSVSource"))  setGeneric("CSVSource", function(object) standardGeneric("CSVSource"))
38  setMethod("CSVSource",  setMethod("CSVSource",
39            signature(object = "character"),            signature(object = "character"),
40            function(object, isConCall = FALSE) {            function(object) {
41                if (!isConCall)                object <- substitute(file(object))
42                    object <- paste('file("', object, '")', sep = "")                con <- eval(object)
43                con <- eval(parse(text = object))                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")                content <- scan(con, what = "character")
54                close(con)                close(con)
55                new("CSVSource", LoDSupport = FALSE, URI = object,                new("CSVSource", LoDSupport = FALSE, URI = object,
56                    Content = content, Position = 0)                    Content = content, Position = 0)
57            })            })
58    
59  setGeneric("ReutersSource", function(object, isConCall = FALSE) standardGeneric("ReutersSource"))  setGeneric("ReutersSource", function(object) standardGeneric("ReutersSource"))
60  setMethod("ReutersSource",  setMethod("ReutersSource",
61            signature(object = "character"),            signature(object = "character"),
62            function(object, isConCall = FALSE) {            function(object) {
63                if (!isConCall)                object <- substitute(file(object))
64                   object <- paste('file("', object, '")', sep = "")                con <- eval(object)
65                con <- eval(parse(text = object))                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 = "")                corpus <- paste(readLines(con), "\n", collapse = "")
79                close(con)                close(con)
80                tree <- xmlTreeParse(corpus, asText = TRUE)                tree <- xmlTreeParse(corpus, asText = TRUE)
# Line 87  Line 108 
108  setMethod("get_elem",  setMethod("get_elem",
109            signature(object = "DirSource"),            signature(object = "DirSource"),
110            function(object) {            function(object) {
111                  filename <- object@FileList[object@Position]
112                list(content = readLines(object@FileList[object@Position]),                list(content = readLines(object@FileList[object@Position]),
113                     uri = paste('file("', object@FileList[object@Position], '")', sep = ""))                     uri = substitute(file(filename)))
114            })            })
115  setMethod("get_elem",  setMethod("get_elem",
116            signature(object = "CSVSource"),            signature(object = "CSVSource"),
# Line 300  Line 322 
322            signature(object = "PlainTextDocument"),            signature(object = "PlainTextDocument"),
323            function(object, ...) {            function(object, ...) {
324                if (!Cached(object)) {                if (!Cached(object)) {
325                    con <- eval(parse(text = URI(object)))                    con <- eval(URI(object))
326                    corpus <- readLines(con)                    corpus <- readLines(con)
327                    close(con)                    close(con)
328                    Corpus(object) <- corpus                    Corpus(object) <- corpus
# Line 314  Line 336 
336            signature(object =  "XMLTextDocument"),            signature(object =  "XMLTextDocument"),
337            function(object, ...) {            function(object, ...) {
338                if (!Cached(object)) {                if (!Cached(object)) {
339                    con <- eval(parse(text = URI(object)))                    con <- eval(URI(object))
340                    corpus <- paste(readLines(con), "\n", collapse = "")                    corpus <- paste(readLines(con), "\n", collapse = "")
341                    close(con)                    close(con)
342                    doc <- xmlTreeParse(corpus, asText = TRUE)                    doc <- xmlTreeParse(corpus, asText = TRUE)
# Line 330  Line 352 
352            signature(object = "NewsgroupDocument"),            signature(object = "NewsgroupDocument"),
353            function(object, ...) {            function(object, ...) {
354                if (!Cached(object)) {                if (!Cached(object)) {
355                    con <- eval(parse(text = URI(object)))                    con <- eval(URI(object))
356                    mail <- readLines(con)                    mail <- readLines(con)
357                    close(con)                    close(con)
358                    Cached(object) <- TRUE                    Cached(object) <- TRUE
# Line 375  Line 397 
397                return(FUN(xmlRoot(corpus), ...))                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"))  setGeneric("stem_doc", function(object, ...) standardGeneric("stem_doc"))
423  setMethod("stem_doc",  setMethod("stem_doc",
424            signature(object = "PlainTextDocument"),            signature(object = "PlainTextDocument"),
# Line 384  Line 428 
428    
429                require(Rstem)                require(Rstem)
430                splittedCorpus <- unlist(strsplit(object, " ", fixed = TRUE))                splittedCorpus <- unlist(strsplit(object, " ", fixed = TRUE))
431                stemmedCorpus <- wordStem(splittedCorpus, ...)                stemmedCorpus <- wordStem(splittedCorpus)
432                Corpus(object) <- paste(stemmedCorpus, collapse = " ")                Corpus(object) <- paste(stemmedCorpus, collapse = " ")
433                return(object)                return(object)
434            })            })
# Line 407  Line 451 
451  setMethod("tm_filter",  setMethod("tm_filter",
452            signature(object = "TextDocCol"),            signature(object = "TextDocCol"),
453            function(object, ..., FUN = s_filter) {            function(object, ..., FUN = s_filter) {
454                object[tm_index(object, ..., FUN)]                indices <- sapply(object, FUN, ..., GlobalMetaData = GlobalMetaData(object))
455                  object[indices]
456            })            })
457    
458  setGeneric("tm_index", function(object, ..., FUN = s_filter) standardGeneric("tm_index"))  setGeneric("tm_index", function(object, ..., FUN = s_filter) standardGeneric("tm_index"))
# Line 459  Line 504 
504                return(object)                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"))  setGeneric("set_subscriptable", function(object, name) standardGeneric("set_subscriptable"))
524  setMethod("set_subscriptable",  setMethod("set_subscriptable",
525            signature(object = "TextDocCol"),            signature(object = "TextDocCol"),
# Line 534  Line 595 
595  setMethod("show",  setMethod("show",
596            signature(object = "TextDocCol"),            signature(object = "TextDocCol"),
597            function(object){            function(object){
598                cat("A text document collection with", length(object), "text document")                cat(sprintf(ngettext(length(object),
599                if (length(object) == 1)                                     "A text document collection with %d text document\n",
600                    cat("\n")                                     "A text document collection with %d text documents\n"),
601                else                            length(object)))
                   cat("s\n")  
602      })      })
603    
604  setMethod("summary",  setMethod("summary",
# Line 546  Line 606 
606            function(object){            function(object){
607                show(object)                show(object)
608                if (length(GlobalMetaData(object)) > 0) {                if (length(GlobalMetaData(object)) > 0) {
609                    cat("\nThe global metadata consists of", length(GlobalMetaData(object)), "tag-value pair")                    cat(sprintf(ngettext(length(GlobalMetaData(object)),
610                    if (length(GlobalMetaData(object)) == 1)                                                "\nThe global metadata consists of %d tag-value pair\n",
611                        cat(".\n")                                                "\nThe global metadata consists of %d tag-value pairs\n"),
612                    else                                         length(GlobalMetaData(object))))
                       cat("s.\n")  
613                    cat("Available tags are:\n")                    cat("Available tags are:\n")
614                    cat(names(GlobalMetaData(object)), "\n")                    cat(names(GlobalMetaData(object)), "\n")
615                }                }

Legend:
Removed from v.66  
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