SCM

SCM Repository

[tm] Diff of /trunk/R/textmin/R/textdoccol.R
ViewVC logotype

Diff of /trunk/R/textmin/R/textdoccol.R

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 49, Sun Aug 6 10:12:13 2006 UTC revision 51, Mon Aug 7 12:14:09 2006 UTC
# Line 5  Line 5 
5            c("character"),            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_PLAIN", "REUT21578_PLAIN", "REUT21578_XML", "RIS"))                type <- match.arg(inputType,c("CSV", "RCV1", "REUT21578", "REUT21578_XML", "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
# Line 41  Line 41 
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_PLAIN" = {                       "RCV1" = {
45                           filelist <- dir(object, pattern = ".xml", full.names = TRUE)                           filelist <- dir(object, pattern = ".xml", full.names = TRUE)
46                           tdl <- sapply(filelist,                           tdl <- sapply(filelist,
47                                         function(file) {                                         function(file) {
# Line 56  Line 56 
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_PLAIN" = {                       "REUT21578" = {
60                           filelist <- dir(object, pattern = ".xml", full.names = TRUE)                           filelist <- dir(object, pattern = ".xml", full.names = TRUE)
61                           tdl <- sapply(filelist,                           tdl <- sapply(filelist,
62                                         function(file) {                                         function(file) {
# Line 74  Line 74 
74                                         function(file) {                                         function(file) {
75                                             parseReutersXML(file)                                             parseReutersXML(file)
76                                         })                                         })
                          if (length(filelist) > 1)  
                              tdcl <- new("TextDocCol", .Data = unlist(tdl, recursive = FALSE))  
                          else  
77                               tdcl <- new("TextDocCol", .Data = tdl)                               tdcl <- new("TextDocCol", .Data = tdl)
78                       },                       },
79                       # Read in HTML documents as used by http://ris.bka.gv.at/vwgh                       # Read in HTML documents as used by http://ris.bka.gv.at/vwgh
# Line 85  Line 82 
82                           tdl <- sapply(filelist,                           tdl <- sapply(filelist,
83                                         function(file) {                                         function(file) {
84                                             # Ignore warnings from misformed HTML documents                                             # Ignore warnings from misformed HTML documents
85                                             suppressWarnings(RISDoc <- parseHTMLPlain(file, stripWhiteSpace, toLower))                                             suppressWarnings(RISDoc <- parseRISPlain(file, stripWhiteSpace, toLower))
86                                             if (!is.null(RISDoc)) {                                             if (!is.null(RISDoc)) {
87                                                 l <- list()                                                 l <- list()
88                                                 l[[length(l) + 1]] <- RISDoc                                                 l[[length(l) + 1]] <- RISDoc
# Line 98  Line 95 
95            })            })
96    
97  # Parse an Austrian RIS HTML document  # Parse an Austrian RIS HTML document
98  parseHTMLPlain <- function(file, stripWhiteSpace = FALSE, toLower = FALSE) {  parseRISPlain <- function(file, stripWhiteSpace = FALSE, toLower = FALSE) {
99      author <- ""      author <- ""
100      datetimestamp <- date()      datetimestamp <- date()
101      description <- ""      description <- ""
# Line 186  Line 183 
183      else      else
184          heading <- ""          heading <- ""
185    
     # TODO: Check whether <TOPICS></TOPICS> tags are obligatory  
186      topics <- unlist(xmlApply(node[["TOPICS"]], function(x) xmlValue(x)), use.names = FALSE)      topics <- unlist(xmlApply(node[["TOPICS"]], function(x) xmlValue(x)), use.names = FALSE)
187    
188      new("PlainTextDocument", .Data = corpus, Cached = 1, Author = author, DateTimeStamp = datetimestamp,      new("PlainTextDocument", .Data = corpus, Cached = 1, Author = author, DateTimeStamp = datetimestamp,

Legend:
Removed from v.49  
changed lines
  Added in v.51

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