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 18, Sat Nov 5 19:00:05 2005 UTC revision 37, Wed Jan 11 17:49:17 2006 UTC
# Line 1  Line 1 
1  # Author: Ingo Feinerer  # Author: Ingo Feinerer
2    
3  # S4 class definition  setGeneric("textdoccol", function(object, ...) standardGeneric("textdoccol"))
4  # Text document collection  setMethod("textdoccol",
5  # TODO: Define proper S4 term-document matrix            c("character", "character", "logical", "logical"),
6  setClass("textdoccol", representation(docs = "list",            function(object, inputType = "CSV", stripWhiteSpace = FALSE, toLower = FALSE) {
7                                        tdm = "matrix"))                # Add a new type for each unique input source format
8                  type <- match.arg(inputType,c("CSV","RCV1","REUT21578"))
9  # Accessor function                switch(type,
10  if (!isGeneric("docs")) {                       # Text in a special CSV format
11      if (is.function("docs"))                       # For details on the file format see the R documentation file
12          fun <- docs                       # The first argument is a directory with .csv files
13      else                       "CSV" = {
14          fun <- function(object) standardGeneric("docs")                           tdl <- sapply(dir(object,
15      setGeneric("docs", fun)                                             pattern = ".csv",
16  }                                             full.names = TRUE),
17  setMethod("docs", "textdoccol", function(object) object@docs)                                         function(file) {
18                                               m <- as.matrix(read.csv(file, header = FALSE))
19  setGeneric("textdoccol", function(docs) standardGeneric("textdoccol"))                                             l <- vector("list", dim(m)[1])
20  # Read in XML text documents                                             for (i in 1:dim(m)[1]) {
21  # Reuters Corpus Volume 1 (RCV1)                                                 author <- ""
22  setMethod("textdoccol", "character", function(docs) {                                                 timestamp <- date()
23      require(XML)                                                 description <- ""
24                                                   id <- as.integer(m[i,1])
25                                                   corpus <- as.character(m[i,2:dim(m)[2]])
26                                                   if (stripWhiteSpace)
27                                                       corpus <- gsub("[[:space:]]+", " ", corpus)
28                                                   if (toLower)
29                                                       corpus <- tolower(corpus)
30                                                   origin <- "CSV"
31                                                   heading <- ""
32    
33      tree <- xmlTreeParse(docs)                                                 l[[i]] <- new("textdocument", .Data = corpus, author = author, timestamp = timestamp,
34      root <- xmlRoot(tree)                                                               description = description, id = id, origin = origin, heading = heading)
35                                               }
36      # TODO: At each loop node points to the current newsitem                                             l
37      node <- root                                         })
38                             tdcl <- new("textdoccol", .Data = tdl)
39                         },
40                         # Read in text documents in XML Reuters Corpus Volume 1 (RCV1) format
41                         # The first argument is a directory with the RCV1 XML files
42                         "RCV1" = {
43                             tdl <- sapply(dir(object,
44                                               pattern = ".xml",
45                                               full.names = TRUE),
46                                           function(file) {
47                                               tree <- xmlTreeParse(file)
48                                               xmlApply(xmlRoot(tree), parseNewsItem, stripWhiteSpace, toLower)
49                                           })
50                             tdcl <- new("textdoccol", .Data = tdl)
51                         },
52                         # Read in text documents in Reuters-21578 XML (not SGML) format
53                         # Typically the first argument will be a directory where we can
54                         # find the files reut2-000.xml ... reut2-021.xml
55                         "REUT21578" = {
56                             tdl <- sapply(dir(object,
57                                               pattern = ".xml",
58                                               full.names = TRUE),
59                                           function(file) {
60                                               tree <- xmlTreeParse(file)
61                                               xmlApply(xmlRoot(tree), parseReuters, stripWhiteSpace, toLower)
62                                           })
63                             tdcl <- new("textdoccol", .Data = tdl)
64                         })
65                  tdcl
66              })
67    
68      # TODO: Implement lacking fields.  # TODO: Implement lacking fields as soon I have access to the original RCV1
69      # For this we need the full RCV1 XML set to know where to find those things  # Parse a <newsitem></newsitem> element from a well-formed RCV1 XML file
70    parseNewsItem <- function(node, stripWhiteSpace = FALSE, toLower = FALSE) {
71      author <- "Not yet implemented"      author <- "Not yet implemented"
72      timestamp <- xmlAttrs(node)[["date"]]      timestamp <- xmlAttrs(node)[["date"]]
73      description <- "Not yet implemented"      description <- "Not yet implemented"
74      id <- as.integer(xmlAttrs(node)[["itemid"]])      id <- as.integer(xmlAttrs(node)[["itemid"]])
75      origin <- "Not yet implemented"      origin <- "Reuters Corpus Volume 1 XML"
76      corpus <- unlist(xmlApply(node[["text"]], xmlValue), use.names = FALSE)      corpus <- unlist(xmlApply(node[["text"]], xmlValue), use.names = FALSE)
77    
78        if (stripWhiteSpace)
79            corpus <- gsub("[[:space:]]+", " ", corpus)
80        if (toLower)
81            corpus <- tolower(corpus)
82    
83      heading <- xmlValue(node[["title"]])      heading <- xmlValue(node[["title"]])
84    
85      doc <- new("textdocument", author = author, timestamp = timestamp, description = description,      new("textdocument", .Data = corpus, author = author, timestamp = timestamp,
86                 id = id, origin = origin, corpus = corpus, heading = heading)          description = description, id = id, origin = origin, heading = heading)
87    }
88    
89      new("textdoccol", docs = list(doc), tdm = matrix())  # Parse a <REUTERS></REUTERS> element from a well-formed Reuters-21578 XML file
90  })  parseReuters <- function(node, stripWhiteSpace = FALSE, toLower = FALSE) {
91        # The <AUTHOR></AUTHOR> tag is unfortunately NOT obligatory!
92        if (!is.null(node[["TEXT"]][["AUTHOR"]]))
93            author <- xmlValue(node[["TEXT"]][["AUTHOR"]])
94        else
95            author <- ""
96    
97        timestamp <- xmlValue(node[["DATE"]])
98        description <- ""
99        id <- as.integer(xmlAttrs(node)[["NEWID"]])
100    
101        origin <- "Reuters-21578 XML"
102    
103        # The <BODY></BODY> tag is unfortunately NOT obligatory!
104        if (!is.null(node[["TEXT"]][["BODY"]]))
105            corpus <- xmlValue(node[["TEXT"]][["BODY"]])
106        else
107            corpus <- ""
108    
109        if (stripWhiteSpace)
110            corpus <- gsub("[[:space:]]+", " ", corpus)
111        if (toLower)
112            corpus <- tolower(corpus)
113    
114        # The <TITLE></TITLE> tag is unfortunately NOT obligatory!
115        if (!is.null(node[["TEXT"]][["TITLE"]]))
116            heading <- xmlValue(node[["TEXT"]][["TITLE"]])
117        else
118            heading <- ""
119    
120        new("textdocument", .Data = corpus, author = author, timestamp = timestamp,
121            description = description, id = id, origin = origin, heading = heading)
122    }

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

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