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 987, Wed Sep 2 17:54:45 2009 UTC revision 988, Fri Sep 4 12:27:12 2009 UTC
# Line 1  Line 1 
1  # Author: Ingo Feinerer  # Author: Ingo Feinerer
2    
 prepareReader <- function(readerControl, defaultReader = NULL, ...) {  
     if (is.null(readerControl$reader))  
         readerControl$reader <- defaultReader  
     if (inherits(readerControl$reader, "FunctionGenerator"))  
         readerControl$reader <- readerControl$reader(...)  
     if (is.null(readerControl$language))  
         readerControl$language <- "eng"  
     readerControl  
 }  
   
 # Node ID, actual meta data, and possibly other nodes as children  
 .MetaDataNode <- function(nodeid = 0, meta = list(create_date = as.POSIXlt(Sys.time(), tz = "GMT"), creator = Sys.getenv("LOGNAME")), children = NULL) {  
     structure(list(NodeID = nodeid, MetaData = meta, Children = children),  
               class = "MetaDataNode")  
 }  
   
 print.MetaDataNode <- function(x, ...)  
     print(x$MetaData)  
   
3  .PCorpus <- function(x, cmeta, dmeta, dbcontrol) {  .PCorpus <- function(x, cmeta, dmeta, dbcontrol) {
4      attr(x, "CMetaData") <- cmeta      attr(x, "CMetaData") <- cmeta
5      attr(x, "DMetaData") <- dmeta      attr(x, "DMetaData") <- dmeta
# Line 26  Line 7 
7      class(x) <- c("PCorpus", "Corpus", "list")      class(x) <- c("PCorpus", "Corpus", "list")
8      x      x
9  }  }
10    DBControl <- function(x) attr(x, "DBControl")
11    
12  PCorpus <- function(x,  PCorpus <- function(x,
13                      readerControl = list(reader = x$DefaultReader, language = "eng"),                      readerControl = list(reader = x$DefaultReader, language = "eng"),
# Line 171  Line 153 
153  update_id <- function(x, id = 0, mapping = NULL, left.mapping = NULL, level = 0) {  update_id <- function(x, id = 0, mapping = NULL, left.mapping = NULL, level = 0) {
154      # Traversal of (binary) CMetaData tree with setup of \code{NodeID}s      # Traversal of (binary) CMetaData tree with setup of \code{NodeID}s
155      set_id <- function(x) {      set_id <- function(x) {
156          attrs <- attributes(x)          x$NodeID <- id
         x <- id  
         attributes(x) <- attrs  
157          id <<- id + 1          id <<- id + 1
158          level <<- level + 1          level <<- level + 1
159          if (length(attr(x, "Children")) > 0) {          if (length(x$Children) > 0) {
160              mapping <<- cbind(mapping, c(as.numeric(attr(x, "Children")[[1]]), id))              mapping <<- cbind(mapping, c(x$Children[[1]]$NodeID, id))
161              left <- set_id(attr(x, "Children")[[1]])              left <- set_id(x$Children[[1]])
162              if (level == 1) {              if (level == 1) {
163                  left.mapping <<- mapping                  left.mapping <<- mapping
164                  mapping <<- NULL                  mapping <<- NULL
165              }              }
166              mapping <<- cbind(mapping, c(as.numeric(attr(x, "Children")[[2]]), id))              mapping <<- cbind(mapping, c(x$Children[[2]]$NodeID, id))
167              right <- set_id(attr(x, "Children")[[2]])              right <- set_id(x$Children[[2]])
168    
169              attr(x, "Children") <- list(left, right)              x$Children <- list(left, right)
170          }          }
171          level <<- level - 1          level <<- level - 1
172          x          x
173      }      }
   
174      list(root = set_id(x), left.mapping = left.mapping, right.mapping = mapping)      list(root = set_id(x), left.mapping = left.mapping, right.mapping = mapping)
175  }  }
176    
# Line 280  Line 259 
259      invisible(x)      invisible(x)
260  }  }
261    
262  summary.Corpus <- function(x, ...) {  summary.Corpus <- function(object, ...) {
263      print(x)      print(object)
264      if (length(DMetaData(x)) > 0) {      if (length(DMetaData(object)) > 0) {
265          cat(sprintf(ngettext(length(attr(CMetaData(x), "MetaData")),          cat(sprintf(ngettext(length(attr(CMetaData(object), "MetaData")),
266                               "\nThe metadata consists of %d tag-value pair and a data frame\n",                               "\nThe metadata consists of %d tag-value pair and a data frame\n",
267                               "\nThe metadata consists of %d tag-value pairs and a data frame\n"),                               "\nThe metadata consists of %d tag-value pairs and a data frame\n"),
268                      length(attr(CMetaData(x), "MetaData"))))                      length(CMetaData(object)$MetaData)))
269          cat("Available tags are:\n")          cat("Available tags are:\n")
270          cat(strwrap(paste(names(attr(CMetaData(x), "MetaData")), collapse = " "), indent = 2, exdent = 2), "\n")          cat(strwrap(paste(names(CMetaData(object)$MetaData), collapse = " "), indent = 2, exdent = 2), "\n")
271          cat("Available variables in the data frame are:\n")          cat("Available variables in the data frame are:\n")
272          cat(strwrap(paste(names(DMetaData(x)), collapse = " "), indent = 2, exdent = 2), "\n")          cat(strwrap(paste(names(DMetaData(object)), collapse = " "), indent = 2, exdent = 2), "\n")
273      }      }
274  }  }
275    

Legend:
Removed from v.987  
changed lines
  Added in v.988

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