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 22, Sat Nov 19 16:58:34 2005 UTC revision 37, Wed Jan 11 17:49:17 2006 UTC
# Line 1  Line 1 
1  # Author: Ingo Feinerer  # Author: Ingo Feinerer
2    
 # S4 class definition  
 # Text document collection  
 setClass("textdoccol",  
          representation(tdm = "termdocmatrix"),  
          contains = c("list"))  
   
 # Accessor functions as described in "S4 Classes in 15 pages, more or less"  
   
 if (!isGeneric("tdm")) {  
     if (is.function("tdm"))  
         fun <- tdm  
     else  
         fun <- function(object) standardGeneric("tdm")  
     setGeneric("tdm", fun)  
 }  
 setMethod("tdm", "textdoccol", function(object) object@tdm)  
   
 # Constructors  
   
3  setGeneric("textdoccol", function(object, ...) standardGeneric("textdoccol"))  setGeneric("textdoccol", function(object, ...) standardGeneric("textdoccol"))
4  setMethod("textdoccol",  setMethod("textdoccol",
5            c("character", "character", "logical", "logical",  "character",            c("character", "character", "logical", "logical"),
6              "logical", "character", "integer", "integer", "logical"),            function(object, inputType = "CSV", stripWhiteSpace = FALSE, toLower = FALSE) {
           function(object, inputType = "RCV1", stripWhiteSpace = FALSE, toLower = FALSE, weighting = "tf",  
                    stemming = FALSE, language = "english", minWordLength = 3, minDocFreq = 1, stopwords = NULL) {  
   
7                # Add a new type for each unique input source format                # Add a new type for each unique input source format
8                type <- match.arg(inputType,c("RCV1","CSV"))                type <- match.arg(inputType,c("CSV","RCV1","REUT21578"))
9                switch(type,                switch(type,
10                       # Read in text documents in XML Reuters Corpus Volume 1 (RCV1) format                       # Text in a special CSV format
11                       "RCV1" = {                       # For details on the file format see the R documentation file
12                           require(XML)                       # The first argument is a directory with .csv files
   
                          tree <- xmlTreeParse(object)  
                          tdcl <- new("textdoccol", .Data = xmlApply(xmlRoot(tree), parseNewsItem, stripWhiteSpace, toLower))  
                      },  
                      # Text in CSV format (as e.g. exported from an Excel sheet)  
13                       "CSV" = {                       "CSV" = {
14                           m <- as.matrix(read.csv(object))                           tdl <- sapply(dir(object,
15                                               pattern = ".csv",
16                                               full.names = TRUE),
17                                           function(file) {
18                                               m <- as.matrix(read.csv(file, header = FALSE))
19                           l <- vector("list", dim(m)[1])                           l <- vector("list", dim(m)[1])
20                           for (i in 1:dim(m)[1]) {                           for (i in 1:dim(m)[1]) {
21                               author <- "Not yet implemented"                                                 author <- ""
22                               timestamp <- date()                               timestamp <- date()
23                               description <- "Not yet implemented"                                                 description <- ""
24                               id <- i                                                 id <- as.integer(m[i,1])
25                               corpus <- as.character(m[i,2:dim(m)[2]])                               corpus <- as.character(m[i,2:dim(m)[2]])
26                               if (stripWhiteSpace)                               if (stripWhiteSpace)
27                                   corpus <- gsub("[[:space:]]+", " ", corpus)                                   corpus <- gsub("[[:space:]]+", " ", corpus)
28                               if (toLower)                               if (toLower)
29                                   corpus <- tolower(corpus)                                   corpus <- tolower(corpus)
30                               origin <- "Not yet implemented"                                                 origin <- "CSV"
31                               heading <- "Not yet implemented"                                                 heading <- ""
32    
33                               l[[i]] <- new("textdocument", .Data = corpus, author = author, timestamp = timestamp,                               l[[i]] <- new("textdocument", .Data = corpus, author = author, timestamp = timestamp,
34                                   description = description, id = id, origin = origin, heading = heading)                                   description = description, id = id, origin = origin, heading = heading)
35                           }                           }
36                           tdcl <- new("textdoccol", .Data = l)                                             l
37                       }                                         })
38                       )                           tdcl <- new("textdoccol", .Data = tdl)
39                         },
40                tdcl@tdm <- termdocmatrix(tdcl, weighting, stemming, language, minWordLength, minDocFreq, stopwords)                       # 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                tdcl
66            })            })
67    
68  # Parse a <newsitem></newsitem> element from a valid RCV1 XML file  # TODO: Implement lacking fields as soon I have access to the original RCV1
69    # Parse a <newsitem></newsitem> element from a well-formed RCV1 XML file
70  parseNewsItem <- function(node, stripWhiteSpace = FALSE, toLower = FALSE) {  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)      if (stripWhiteSpace)
# Line 83  Line 84 
84    
85      new("textdocument", .Data = corpus, author = author, timestamp = timestamp,      new("textdocument", .Data = corpus, author = author, timestamp = timestamp,
86          description = description, id = id, origin = origin, heading = heading)          description = description, id = id, origin = origin, heading = heading)
87    }
88    
89    # 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.22  
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