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 829, Mon Mar 10 22:55:39 2008 UTC revision 830, Tue Mar 11 15:23:28 2008 UTC
# Line 153  Line 153 
153                return(object)                return(object)
154            })            })
155    
156  setGeneric("tmMap", function(object, FUN, lazy = FALSE, ...) standardGeneric("tmMap"))  setGeneric("tmMap", function(object, FUN, ..., lazy = FALSE) standardGeneric("tmMap"))
 ############################################  
 # Lazy mapping restrictions (at the moment):  
 #   *) No database backend support  
 #   *) No function composition  
 ############################################  
157  setMethod("tmMap",  setMethod("tmMap",
158            signature(object = "Corpus", FUN = "function"),            signature(object = "Corpus", FUN = "function"),
159            function(object, FUN, lazy = FALSE, ...) {            function(object, FUN, ..., lazy = FALSE) {
160                result <- object                result <- object
161                # Note that text corpora are automatically loaded into memory via \code{[[}                # Note that text corpora are automatically loaded into memory via \code{[[}
162                if (DBControl(object)[["useDb"]]) {                if (DBControl(object)[["useDb"]]) {
163                      if (lazy)
164                          warning("lazy mapping is deactived when using database backend")
165                    db <- dbInit(DBControl(object)[["dbName"]], DBControl(object)[["dbType"]])                    db <- dbInit(DBControl(object)[["dbName"]], DBControl(object)[["dbType"]])
166                    i <- 1                    i <- 1
167                    for (id in unlist(object)) {                    for (id in unlist(object)) {
# Line 173  Line 170 
170                    }                    }
171                }                }
172                else {                else {
173                    if (lazy)                    # Lazy mapping
174                      if (lazy) {
175                          lazyTmMap <- meta(object, tag = "lazyTmMap", type = "corpus")
176                          if (is.null(lazyTmMap)) {
177                        meta(result, tag = "lazyTmMap", type = "corpus") <-                        meta(result, tag = "lazyTmMap", type = "corpus") <-
178                            list(index = rep(TRUE, length(result)),                            list(index = rep(TRUE, length(result)),
179                                 fun = FUN,                                     maps = list(function(x, DMetaData) FUN(x, ..., DMetaData = DMetaData)))
180                                 args = ...)                        }
181                          else {
182                              lazyTmMap$maps <- c(lazyTmMap$maps, list(function(x, DMetaData) FUN(x, ..., DMetaData = DMetaData)))
183                              meta(result, tag = "lazyTmMap", type = "corpus") <- lazyTmMap
184                          }
185                      }
186                    else                    else
187                        result@.Data <- lapply(object, FUN, ..., DMetaData = DMetaData(object))                        result@.Data <- lapply(object, FUN, ..., DMetaData = DMetaData(object))
188                }                }
# Line 185  Line 190 
190            })            })
191    
192  # Materialize lazy mappings  # Materialize lazy mappings
 # ToDo: Clean up lazyTmMap markers (for the case that everything is materialized)  
193  materialize <- function(corpus, range = seq_along(corpus)) {  materialize <- function(corpus, range = seq_along(corpus)) {
194      lazyTmMap <- meta(corpus, tag = "lazyTmMap", type = "corpus")      lazyTmMap <- meta(corpus, tag = "lazyTmMap", type = "corpus")
195      if (!is.null(lazyTmMap)) {      if (!is.null(lazyTmMap)) {
196          for (i in range)          for (i in range)
197              if (lazyTmMap$index[i]) {              if (lazyTmMap$index[i]) {
198                  corpus@.Data[[i]] <- lazyTmMap$fun(corpus@.Data[[i]], lazyTmMap$args, DMetaData = DMetaData(corpus))                  res <- loadDoc(corpus@.Data[[i]])
199                    for (m in lazyTmMap$maps)
200                        res <- m(res, DMetaData = DMetaData(corpus))
201                    corpus@.Data[[i]] <- res
202                  lazyTmMap$index[i] <- FALSE                  lazyTmMap$index[i] <- FALSE
203              }              }
204      }      }
205        # Clean up if everything is materialized
206        if (!any(lazyTmMap$index))
207            lazyTmMap <- NULL
208      meta(corpus, tag = "lazyTmMap", type = "corpus") <- lazyTmMap      meta(corpus, tag = "lazyTmMap", type = "corpus") <- lazyTmMap
209      return(corpus)      return(corpus)
210  }  }
# Line 410  Line 420 
420                return(object)                return(object)
421            })            })
422    
 # ToDo: Implement on-demand materialization of lazy mappings  
 ############################################  
 # Lazy mapping restrictions (at the moment):  
 #   *) No database backend support  
 ############################################  
423  setMethod("[[",  setMethod("[[",
424            signature(x = "Corpus", i = "ANY", j = "ANY"),            signature(x = "Corpus", i = "ANY", j = "ANY"),
425            function(x, i, j, ...) {            function(x, i, j, ...) {
# Line 424  Line 429 
429                    return(loadDoc(result))                    return(loadDoc(result))
430                }                }
431                else {                else {
432                    # ToDo: Ensure that loadDoc is called and cached                    lazyTmMap <- meta(x, tag = "lazyTmMap", type = "corpus")
433                      if (!is.null(lazyTmMap))
434                    .Call("copyCorpus", x, materialize(x, i))                    .Call("copyCorpus", x, materialize(x, i))
435                    return(loadDoc(x@.Data[[i]]))                    return(loadDoc(x@.Data[[i]]))
436                }                }
437            })            })
438    
 # ToDo: Mark set objects as not active for lazy mapping  
439  setMethod("[[<-",  setMethod("[[<-",
440            signature(x = "Corpus", i = "ANY", j = "ANY", value = "ANY"),            signature(x = "Corpus", i = "ANY", j = "ANY", value = "ANY"),
441            function(x, i, j, ..., value) {            function(x, i, j, ..., value) {
# Line 440  Line 445 
445                    index <- object@.Data[[i]]                    index <- object@.Data[[i]]
446                    db[[index]] <- value                    db[[index]] <- value
447                }                }
448                else                else {
449                      # Mark new objects as not active for lazy mapping
450                      lazyTmMap <- meta(object, tag = "lazyTmMap", type = "corpus")
451                      if (!is.null(lazyTmMap))
452                          lazyTmMap$index[i] <- FALSE
453                      # Set the value
454                    object@.Data[[i, ...]] <- value                    object@.Data[[i, ...]] <- value
455                  }
456                return(object)                return(object)
457            })            })
458    
# Line 610  Line 621 
621                    show(dbMultiFetch(db, unlist(object)))                    show(dbMultiFetch(db, unlist(object)))
622                }                }
623                else                else
624                    show(object@.Data)                    show(lapply(object, "[[", 1))
625            })            })
626    
627  # No metadata is checked  # No metadata is checked
# Line 630  Line 641 
641  setMethod("lapply",  setMethod("lapply",
642            signature(X = "Corpus"),            signature(X = "Corpus"),
643            function(X, FUN, ...) {            function(X, FUN, ...) {
644                  print("lapply")
645                if (DBControl(X)[["useDb"]]) {                if (DBControl(X)[["useDb"]]) {
646                    db <- dbInit(DBControl(X)[["dbName"]], DBControl(X)[["dbType"]])                    db <- dbInit(DBControl(X)[["dbName"]], DBControl(X)[["dbType"]])
647                    result <- lapply(dbMultiFetch(db, unlist(X)), FUN, ...)                    result <- lapply(dbMultiFetch(db, unlist(X)), FUN, ...)
648                }                }
649                else                else {
650                      lazyTmMap <- meta(X, tag = "lazyTmMap", type = "corpus")
651                      if (!is.null(lazyTmMap))
652                          .Call("copyCorpus", X, materialize(X))
653                    result <- base::lapply(X, FUN, ...)                    result <- base::lapply(X, FUN, ...)
654                  }
655                return(result)                return(result)
656            })            })
657    
# Line 646  Line 662 
662                    db <- dbInit(DBControl(X)[["dbName"]], DBControl(X)[["dbType"]])                    db <- dbInit(DBControl(X)[["dbName"]], DBControl(X)[["dbType"]])
663                    result <- sapply(dbMultiFetch(db, unlist(X)), FUN, ...)                    result <- sapply(dbMultiFetch(db, unlist(X)), FUN, ...)
664                }                }
665                else                else {
666                      lazyTmMap <- meta(X, tag = "lazyTmMap", type = "corpus")
667                      if (!is.null(lazyTmMap))
668                          .Call("copyCorpus", X, materialize(X))
669                    result <- base::sapply(X, FUN, ...)                    result <- base::sapply(X, FUN, ...)
670                  }
671                return(result)                return(result)
672            })            })
673    

Legend:
Removed from v.829  
changed lines
  Added in v.830

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