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 717, Fri Mar 16 11:13:04 2007 UTC revision 719, Sun Mar 18 09:24:47 2007 UTC
# Line 106  Line 106 
106                }                }
107            })            })
108    
109  # TODO: Check regarding new TextDocCol signature  setGeneric("tmUpdate", function(object,
110  setGeneric("tmUpdate", function(object, origin, parser = readPlain, ...) standardGeneric("tmUpdate"))                                  origin,
111                                    parserControl = list(parser = readPlain, language = "en_US", load = FALSE),
112                                    ...) standardGeneric("tmUpdate"))
113  # Update is only supported for directories  # Update is only supported for directories
114  # At the moment no other LoD devices are available anyway  # At the moment no other LoD devices are available anyway
115  setMethod("tmUpdate",  setMethod("tmUpdate",
116            signature(object = "TextDocCol", origin = "DirSource"),            signature(object = "TextDocCol", origin = "DirSource"),
117            function(object, origin, parser = readPlain, load = FALSE, ...) {            function(object, origin,
118                if (inherits(parser, "FunctionGenerator"))                     parserControl = list(parser = readPlain, language = "en_US", load = FALSE),
119                    parser <- parser(...)                     ...) {
120                  if (inherits(parserControl$parser, "FunctionGenerator"))
121                      parserControl$parser <- parserControl$parser(...)
122    
123                object.filelist <- unlist(lapply(object, function(x) {as.character(URI(x))[2]}))                object.filelist <- unlist(lapply(object, function(x) {as.character(URI(x))[2]}))
124                new.files <- setdiff(origin@FileList, object.filelist)                new.files <- setdiff(origin@FileList, object.filelist)
# Line 122  Line 126 
126                for (filename in new.files) {                for (filename in new.files) {
127                    elem <- list(content = readLines(filename),                    elem <- list(content = readLines(filename),
128                                 uri = substitute(file(filename)))                                 uri = substitute(file(filename)))
129                    object <- appendElem(object, parser(elem, load, filename))                    object <- appendElem(object, parserControl$parser(elem, parserControl$load, parserControl$language, filename))
130                }                }
131    
132                return(object)                return(object)
# Line 134  Line 138 
138            function(object, FUN, ...) {            function(object, FUN, ...) {
139                result <- object                result <- object
140                # Note that text corpora are automatically loaded into memory via \code{[[}                # Note that text corpora are automatically loaded into memory via \code{[[}
141                  if (DBControl(object)[["useDb"]]) {
142                      db <- dbInit(DBControl(object)[["dbName"]], DBControl(object)[["dbType"]])
143                      new <- lapply(object, FUN, ..., DMetaData = DMetaData(object))
144                      ids <- lapply(object, ID)
145                      # Avoidance of explicit loop is probably more efficient
146                      for (i in length(new)) {
147                          db[[ids[i]]] <- new[[i]]
148                      }
149                      dbDisconnect(db)
150                  }
151                  else
152                result@.Data <- lapply(object, FUN, ..., DMetaData = DMetaData(object))                result@.Data <- lapply(object, FUN, ..., DMetaData = DMetaData(object))
153                return(result)                return(result)
154            })            })
# Line 215  Line 230 
230                    return(FUN(object, ...)) # TODO: Check that FUN knows about the database                    return(FUN(object, ...)) # TODO: Check that FUN knows about the database
231            })            })
232    
 # TODO  
233  sFilter <- function(object, s, ...) {  sFilter <- function(object, s, ...) {
234      query.df <- DMetaData(object)      query.df <- DMetaData(object)
235      con <- textConnection(s)      con <- textConnection(s)
# Line 305  Line 319 
319            function(object, cmeta = NULL, dmeta = NULL) {            function(object, cmeta = NULL, dmeta = NULL) {
320                object@CMetaData@MetaData <- c(CMetaData(object)@MetaData, cmeta)                object@CMetaData@MetaData <- c(CMetaData(object)@MetaData, cmeta)
321                if (!is.null(dmeta)) {                if (!is.null(dmeta)) {
322                    DMetaData(object) <- cbind(DMetaData(object), dmeta)                    DMetaData(object) <- cbind(DMetaData(object), eval(dmeta))
323                }                }
324                return(object)                return(object)
325            })            })
# Line 323  Line 337 
337                return(object)                return(object)
338            })            })
339    
 # TODO  
340  setGeneric("prescindMeta", function(object, meta) standardGeneric("prescindMeta"))  setGeneric("prescindMeta", function(object, meta) standardGeneric("prescindMeta"))
341  setMethod("prescindMeta",  setMethod("prescindMeta",
342            signature(object = "TextDocCol", meta = "character"),            signature(object = "TextDocCol", meta = "character"),
343            function(object, meta) {            function(object, meta) {
344                for (m in meta) {                for (m in meta) {
345                    if (m %in% c("Author", "DateTimeStamp", "Description", "ID", "Origin", "Heading")) {                    if (m %in% c("Author", "DateTimeStamp", "Description", "ID", "Origin", "Heading", "Language")) {
346                        local.m <- lapply(object, m)                        local.m <- lapply(object, m)
347                        local.m <- lapply(local.m, function(x) if (is.null(x)) return(NA) else return(x))                        local.m <- lapply(local.m, function(x) if (is.null(x)) return(NA) else return(x))
348                        local.m <- unlist(local.m)                        local.m <- unlist(local.m)
349                        object@DMetaData <- cbind(DMetaData(object), data.frame(m = local.m), stringsAsFactors = FALSE)                        DMetaData(object) <- cbind(DMetaData(object), data.frame(m = local.m), stringsAsFactors = FALSE)
350                        names(object@DMetaData)[length(object@DMetaData)] <- m                        names(DMetaData(object))[length(DMetaData(object))] <- m
351                    }                    }
352                    else {                    else {
353                        local.meta <- lapply(object, LocalMetaData)                        local.meta <- lapply(object, LocalMetaData)
# Line 344  Line 357 
357                            local.m <- unlist(local.m)                            local.m <- unlist(local.m)
358                        else                        else
359                            local.m <- I(local.m)                            local.m <- I(local.m)
360                        object@DMetaData <- cbind(DMetaData(object), data.frame(m = local.m), stringsAsFactors = FALSE)                        DMetaData(object) <- cbind(DMetaData(object), data.frame(m = local.m), stringsAsFactors = FALSE)
361                        names(object@DMetaData)[length(object@DMetaData)] <- m                        names(DMetaData(object))[length(DMetaData(object))] <- m
362                    }                    }
363                }                }
364                return(object)                return(object)
# Line 403  Line 416 
416                return(object)                return(object)
417            })            })
418    
 # TODO  
419  # Update \code{NodeID}s of a CMetaData tree  # Update \code{NodeID}s of a CMetaData tree
420  update_id <- function(object, id = 0, mapping = NULL, left.mapping = NULL, level = 0) {  update_id <- function(object, id = 0, mapping = NULL, left.mapping = NULL, level = 0) {
421      # Traversal of (binary) CMetaData tree with setup of \code{NodeID}s      # Traversal of (binary) CMetaData tree with setup of \code{NodeID}s
# Line 551  Line 563 
563                }                }
564      })      })
565    
 # TODO  
566  setGeneric("inspect", function(object) standardGeneric("inspect"))  setGeneric("inspect", function(object) standardGeneric("inspect"))
567  setMethod("inspect",  setMethod("inspect",
568            signature("TextDocCol"),            signature("TextDocCol"),
569            function(object) {            function(object) {
570                summary(object)                summary(object)
571                cat("\n")                cat("\n")
572                  if (DBControl(object)[["useDb"]]) {
573                      db <- dbInit(DBControl(object)[["dbName"]], DBControl(object)[["dbType"]])
574                      show(dbMultiFetch(db, unlist(object)))
575                      dbDisconnect(db)
576                  }
577                  else
578                show(object@.Data)                show(object@.Data)
579            })            })
580    
 # TODO  
581  # No metadata is checked  # No metadata is checked
582  setGeneric("%IN%", function(x, y) standardGeneric("%IN%"))  setGeneric("%IN%", function(x, y) standardGeneric("%IN%"))
583  setMethod("%IN%",  setMethod("%IN%",
# Line 569  Line 585 
585            function(x, y) {            function(x, y) {
586                x %in% y                x %in% y
587            })            })
588    
589    setMethod("lapply",
590              signature(X = "TextDocCol"),
591              function(X, FUN, ...) {
592                  if (DBControl(X)[["useDb"]]) {
593                      db <- dbInit(DBControl(X)[["dbName"]], DBControl(X)[["dbType"]])
594                      result <- lapply(dbMultiFetch(db, unlist(X)), FUN, ...)
595                      dbDisconnect(db)
596                  }
597                  else
598                      result <- base::lapply(X, FUN, ...)
599                  return(result)
600              })
601    
602    setMethod("sapply",
603              signature(X = "TextDocCol"),
604              function(X, FUN, ..., simplify = TRUE, USE.NAMES = TRUE) {
605                  if (DBControl(X)[["useDb"]]) {
606                      db <- dbInit(DBControl(X)[["dbName"]], DBControl(X)[["dbType"]])
607                      result <- sapply(dbMultiFetch(db, unlist(X)), FUN, ...)
608                      dbDisconnect(db)
609                  }
610                  else
611                      result <- base::sapply(X, FUN, ...)
612                  return(result)
613              })

Legend:
Removed from v.717  
changed lines
  Added in v.719

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business University of Wisconsin - Madison Powered By FusionForge