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 32, Thu Dec 15 13:13:54 2005 UTC revision 39, Sat Jan 21 09:37:39 2006 UTC
# Line 1  Line 1 
1  # Author: Ingo Feinerer  # Author: Ingo Feinerer
2    
 # S4 class definition  
 # Text document collection  
 setClass("textdoccol",  
          contains = c("list"))  
   
 # 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"),            c("character", "character", "logical", "logical"),
6            function(object, inputType = "RCV1", stripWhiteSpace = FALSE, toLower = FALSE) {            function(object, inputType = "CSV", stripWhiteSpace = FALSE, toLower = FALSE) {
   
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","REUT21578"))                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                       # For the moment the first argument is still a single file                       # For details on the file format see the R documentation file
12                       # This will be changed to a directory as soon as we have the full RCV1 data set                       # The first argument is a directory with .csv files
                      "RCV1" = {  
                          tree <- xmlTreeParse(object)  
                          tdcl <- new("textdoccol", .Data = xmlApply(xmlRoot(tree), parseNewsItem, stripWhiteSpace, toLower))  
                      },  
                      # Text in a special CSV format (as e.g. exported from an Excel sheet)  
                      # For details on the file format see data/Umfrage.csv  
                      # The first argument has to be a single file  
13                       "CSV" = {                       "CSV" = {
14                           m <- as.matrix(read.csv(object))                           filelist <- dir(object, pattern = ".csv",full.names = TRUE)
15                             tdl <- sapply(filelist,
16                                           function(file) {
17                                               m <- as.matrix(read.csv(file, header = FALSE))
18                           l <- vector("list", dim(m)[1])                           l <- vector("list", dim(m)[1])
19                           for (i in 1:dim(m)[1]) {                           for (i in 1:dim(m)[1]) {
20                               author <- "Not yet implemented"                                                 author <- ""
21                               timestamp <- date()                               timestamp <- date()
22                               description <- "Not yet implemented"                                                 description <- ""
23                               id <- i                                                 id <- as.integer(m[i,1])
24                               corpus <- as.character(m[i,2:dim(m)[2]])                               corpus <- as.character(m[i,2:dim(m)[2]])
25                               if (stripWhiteSpace)                               if (stripWhiteSpace)
26                                   corpus <- gsub("[[:space:]]+", " ", corpus)                                   corpus <- gsub("[[:space:]]+", " ", corpus)
27                               if (toLower)                               if (toLower)
28                                   corpus <- tolower(corpus)                                   corpus <- tolower(corpus)
29                               origin <- "Not yet implemented"                                                 origin <- "CSV"
30                               heading <- "Not yet implemented"                                                 heading <- ""
31    
32                               l[[i]] <- new("textdocument", .Data = corpus, author = author, timestamp = timestamp,                               l[[i]] <- new("textdocument", .Data = corpus, author = author, timestamp = timestamp,
33                                   description = description, id = id, origin = origin, heading = heading)                                   description = description, id = id, origin = origin, heading = heading)
34                           }                           }
35                           tdcl <- new("textdoccol", .Data = l)                                             l
36                                           })
37                             if (length(filelist) > 1)
38                                 tdcl <- new("textdoccol", .Data = unlist(tdl, recursive = FALSE))
39                             else
40                                 tdcl <- new("textdoccol", .Data = tdl)
41                         },
42                         # Read in text documents in XML Reuters Corpus Volume 1 (RCV1) format
43                         # The first argument is a directory with the RCV1 XML files
44                         "RCV1" = {
45                             filelist <- dir(object, pattern = ".xml",full.names = TRUE)
46                             tdl <- sapply(filelist,
47                                           function(file) {
48                                               tree <- xmlTreeParse(file)
49                                               xmlApply(xmlRoot(tree), parseNewsItem, stripWhiteSpace, toLower)
50                                           })
51                             if (length(filelist) > 1)
52                                 tdcl <- new("textdoccol", .Data = unlist(tdl, recursive = FALSE))
53                             else
54                                 tdcl <- new("textdoccol", .Data = tdl)
55                       },                       },
56                       # Read in text documents in Reuters-21578 XML (not SGML) format                       # Read in text documents in Reuters-21578 XML (not SGML) format
57                       # Typically the first argument will be a directory where we can                       # Typically the first argument will be a directory where we can
58                       # find the files reut2-000.xml ... reut2-021.xml                       # find the files reut2-000.xml ... reut2-021.xml
59                       "REUT21578" = {                       "REUT21578" = {
60                           tdl <- sapply(dir(object,                           filelist <- dir(object, pattern = ".xml",full.names = TRUE)
61                                             pattern = ".xml",                           tdl <- sapply(filelist,
                                            full.names = TRUE),  
62                                         function(file) {                                         function(file) {
63                                             tree <- xmlTreeParse(file)                                             tree <- xmlTreeParse(file)
64                                             xmlApply(xmlRoot(tree), parseReuters, stripWhiteSpace, toLower)                                             xmlApply(xmlRoot(tree), parseReuters, stripWhiteSpace, toLower)
65                                         })                                         })
66                             if (length(filelist) > 1)
67                                 tdcl <- new("textdoccol", .Data = unlist(tdl, recursive = FALSE))
68                             else
69                           tdcl <- new("textdoccol", .Data = tdl)                           tdcl <- new("textdoccol", .Data = tdl)
70                       })                       })
71                tdcl                tdcl
72            })            })
73    
74    # TODO: Implement lacking fields as soon I have access to the original RCV1
75  # Parse a <newsitem></newsitem> element from a well-formed RCV1 XML file  # Parse a <newsitem></newsitem> element from a well-formed RCV1 XML file
76  parseNewsItem <- function(node, stripWhiteSpace = FALSE, toLower = FALSE) {  parseNewsItem <- function(node, stripWhiteSpace = FALSE, toLower = FALSE) {
77      author <- "Not yet implemented"      author <- "Not yet implemented"
78      timestamp <- xmlAttrs(node)[["date"]]      timestamp <- xmlAttrs(node)[["date"]]
79      description <- "Not yet implemented"      description <- "Not yet implemented"
80      id <- as.integer(xmlAttrs(node)[["itemid"]])      id <- as.integer(xmlAttrs(node)[["itemid"]])
81      origin <- "Not yet implemented"      origin <- "Reuters Corpus Volume 1 XML"
82      corpus <- unlist(xmlApply(node[["text"]], xmlValue), use.names = FALSE)      corpus <- unlist(xmlApply(node[["text"]], xmlValue), use.names = FALSE)
83    
84      if (stripWhiteSpace)      if (stripWhiteSpace)
# Line 85  Line 94 
94    
95  # Parse a <REUTERS></REUTERS> element from a well-formed Reuters-21578 XML file  # Parse a <REUTERS></REUTERS> element from a well-formed Reuters-21578 XML file
96  parseReuters <- function(node, stripWhiteSpace = FALSE, toLower = FALSE) {  parseReuters <- function(node, stripWhiteSpace = FALSE, toLower = FALSE) {
97      author <- "Not yet implemented"      # The <AUTHOR></AUTHOR> tag is unfortunately NOT obligatory!
98        if (!is.null(node[["TEXT"]][["AUTHOR"]]))
99            author <- xmlValue(node[["TEXT"]][["AUTHOR"]])
100        else
101            author <- ""
102    
103      timestamp <- xmlValue(node[["DATE"]])      timestamp <- xmlValue(node[["DATE"]])
104      description <- "Not yet implemented"      description <- ""
105      id <- as.integer(xmlAttrs(node)[["NEWID"]])      id <- as.integer(xmlAttrs(node)[["NEWID"]])
106    
107      origin <- "Not yet implemented"      origin <- "Reuters-21578 XML"
108    
109      # The <BODY></BODY> tag is unfortunately NOT obligatory!      # The <BODY></BODY> tag is unfortunately NOT obligatory!
110      if (!is.null(node[["TEXT"]][["BODY"]]))      if (!is.null(node[["TEXT"]][["BODY"]]))

Legend:
Removed from v.32  
changed lines
  Added in v.39

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