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 37, Wed Jan 11 17:49:17 2006 UTC revision 42, Sat Jul 1 08:42:26 2006 UTC
# Line 1  Line 1 
1  # Author: Ingo Feinerer  # Author: Ingo Feinerer
2    
3  setGeneric("textdoccol", function(object, ...) standardGeneric("textdoccol"))  setGeneric("textdoccol", function(object, inputType = "CSV", stripWhiteSpace = FALSE, toLower = FALSE) standardGeneric("textdoccol"))
4  setMethod("textdoccol",  setMethod("textdoccol",
5            c("character", "character", "logical", "logical"),            c("character"),
6            function(object, inputType = "CSV", 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("CSV","RCV1","REUT21578"))                type <- match.arg(inputType,c("CSV", "RCV1", "REUT21578", "RIS"))
9                switch(type,                switch(type,
10                       # Text in a special CSV format                       # Text in a special CSV format
11                       # For details on the file format see the R documentation file                       # For details on the file format see the R documentation file
12                       # The first argument is a directory with .csv files                       # The first argument is a directory with .csv files
13                       "CSV" = {                       "CSV" = {
14                           tdl <- sapply(dir(object,                           filelist <- dir(object, pattern = ".csv", full.names = TRUE)
15                                             pattern = ".csv",                           tdl <- sapply(filelist,
                                            full.names = TRUE),  
16                                         function(file) {                                         function(file) {
17                                             m <- as.matrix(read.csv(file, header = FALSE))                                             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 <- ""                                                 author <- ""
21                                                 timestamp <- date()                                                 datetimestamp <- date()
22                                                 description <- ""                                                 description <- ""
23                                                 id <- as.integer(m[i,1])                                                 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]])
# Line 30  Line 29 
29                                                 origin <- "CSV"                                                 origin <- "CSV"
30                                                 heading <- ""                                                 heading <- ""
31    
32                                                 l[[i]] <- new("textdocument", .Data = corpus, author = author, timestamp = timestamp,                                                 l[[i]] <- new("textdocument", .Data = corpus, author = author, datetimestamp = datetimestamp,
33                                                               description = description, id = id, origin = origin, heading = heading)                                                               description = description, id = id, origin = origin, heading = heading)
34                                             }                                             }
35                                             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)                           tdcl <- new("textdoccol", .Data = tdl)
41                       },                       },
42                       # Read in text documents in XML Reuters Corpus Volume 1 (RCV1) format                       # Read in text documents in XML Reuters Corpus Volume 1 (RCV1) format
43                       # The first argument is a directory with the RCV1 XML files                       # The first argument is a directory with the RCV1 XML files
44                       "RCV1" = {                       "RCV1" = {
45                           tdl <- sapply(dir(object,                           filelist <- dir(object, pattern = ".xml", full.names = TRUE)
46                                             pattern = ".xml",                           tdl <- sapply(filelist,
                                            full.names = TRUE),  
47                                         function(file) {                                         function(file) {
48                                             tree <- xmlTreeParse(file)                                             tree <- xmlTreeParse(file)
49                                             xmlApply(xmlRoot(tree), parseNewsItem, stripWhiteSpace, toLower)                                             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)                           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)
70                         },
71                         # Read in HTML documents as used by http://ris.bka.gv.at/vwgh
72                         "RIS" = {
73                             filelist <- dir(object, pattern = ".html", full.names = TRUE)
74                             tdl <- sapply(filelist,
75                                           function(file) {
76                                               # Ignore warnings from misformed HTML documents
77                                               suppressWarnings(RISDoc <- parseHTML(file, stripWhiteSpace, toLower))
78                                               if (!is.null(RISDoc)) {
79                                                   l <- list()
80                                                   l[[length(l) + 1]] <- RISDoc
81                                                   l
82                                               }
83                                           })
84                           tdcl <- new("textdoccol", .Data = tdl)                           tdcl <- new("textdoccol", .Data = tdl)
85                       })                       })
86                tdcl                tdcl
87            })            })
88    
89    # Parse an Austrian RIS HTML document
90    parseHTML <- function(file, stripWhiteSpace = FALSE, toLower = FALSE) {
91        author <- ""
92        datetimestamp <- date()
93        description <- ""
94    
95        tree <- htmlTreeParse(file)
96        htmlElem <- unlist(tree$children$html$children)
97    
98        if (is.null(htmlElem))
99            stop(paste("Empty document", file, "cannot be processed."))
100    
101        textElem <- htmlElem[which(regexpr("text.value", names(htmlElem)) > 0)]
102        names(textElem) <- NULL
103    
104        corpus <- paste(textElem, collapse = " ")
105    
106        year <- substring(corpus, regexpr("..../../", corpus), regexpr("..../../", corpus) + 3)
107        senat <- substring(corpus, regexpr("..../../", corpus) + 5, regexpr("..../../", corpus) + 6)
108        number <- substring(corpus, regexpr("..../../", corpus) + 8, regexpr("..../../", corpus) + 11)
109    
110        id <- as.integer(paste(year, senat, number, sep = ""))
111    
112        if (is.na(id))
113            stop(paste("Cannot extract 'Geschaeftszahl' out of malformed document", file))
114        origin <- ""
115    
116        if (stripWhiteSpace)
117            corpus <- gsub("[[:space:]]+", " ", corpus)
118        if (toLower)
119            corpus <- tolower(corpus)
120    
121        heading <- ""
122    
123        new("textdocument", .Data = corpus, author = author, datetimestamp = datetimestamp,
124            description = description, id = id, origin = origin, heading = heading)
125    }
126    
127  # TODO: Implement lacking fields as soon I have access to the original RCV1  # TODO: Implement lacking fields as soon I have access to the original RCV1
128  # Parse a <newsitem></newsitem> element from a well-formed RCV1 XML file  # Parse a <newsitem></newsitem> element from a well-formed RCV1 XML file
129  parseNewsItem <- function(node, stripWhiteSpace = FALSE, toLower = FALSE) {  parseNewsItem <- function(node, stripWhiteSpace = FALSE, toLower = FALSE) {
130      author <- "Not yet implemented"      author <- "Not yet implemented"
131      timestamp <- xmlAttrs(node)[["date"]]      datetimestamp <- xmlAttrs(node)[["date"]]
132      description <- "Not yet implemented"      description <- "Not yet implemented"
133      id <- as.integer(xmlAttrs(node)[["itemid"]])      id <- as.integer(xmlAttrs(node)[["itemid"]])
134      origin <- "Reuters Corpus Volume 1 XML"      origin <- "Reuters Corpus Volume 1 XML"
# Line 82  Line 141 
141    
142      heading <- xmlValue(node[["title"]])      heading <- xmlValue(node[["title"]])
143    
144      new("textdocument", .Data = corpus, author = author, timestamp = timestamp,      new("textdocument", .Data = corpus, author = author, datetimestamp = datetimestamp,
145          description = description, id = id, origin = origin, heading = heading)          description = description, id = id, origin = origin, heading = heading)
146  }  }
147    
# Line 94  Line 153 
153      else      else
154          author <- ""          author <- ""
155    
156      timestamp <- xmlValue(node[["DATE"]])      datetimestamp <- xmlValue(node[["DATE"]])
157      description <- ""      description <- ""
158      id <- as.integer(xmlAttrs(node)[["NEWID"]])      id <- as.integer(xmlAttrs(node)[["NEWID"]])
159    
# Line 117  Line 176 
176      else      else
177          heading <- ""          heading <- ""
178    
179      new("textdocument", .Data = corpus, author = author, timestamp = timestamp,      new("textdocument", .Data = corpus, author = author, datetimestamp = datetimestamp,
180          description = description, id = id, origin = origin, heading = heading)          description = description, id = id, origin = origin, heading = heading)
181  }  }

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

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