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 1108, Fri Oct 22 18:32:47 2010 UTC revision 1311, Thu Mar 27 14:15:08 2014 UTC
# Line 1  Line 1 
1  # Author: Ingo Feinerer  # Author: Ingo Feinerer
2    
3  .PCorpus <- function(x, cmeta, dmeta, dbcontrol) {  .PCorpus <-
4      attr(x, "CMetaData") <- cmeta  function(x, meta, dmeta, dbcontrol)
5      attr(x, "DMetaData") <- dmeta      structure(list(content = as.list(x), meta = meta, dmeta = dmeta,
6      attr(x, "DBControl") <- dbcontrol                     dbcontrol = dbcontrol),
7      class(x) <- c("PCorpus", "Corpus", "list")                class = c("PCorpus", "Corpus"))
8      x  
9  }  PCorpus <-
10  DBControl <- function(x) attr(x, "DBControl")  function(x,
11             readerControl = list(reader = x$defaultreader, language = "en"),
12             dbControl = list(dbName = "", dbType = "DB1"))
13    {
14        stopifnot(inherits(x, "Source"))
15    
16        readerControl <- prepareReader(readerControl, x$defaultreader)
17    
18        if (is.function(readerControl$init))
19            readerControl$init()
20    
21  PCorpus <- function(x,      if (is.function(readerControl$exit))
22                      readerControl = list(reader = x$DefaultReader, language = "en"),          on.exit(readerControl$exit())
                     dbControl = list(dbName = "", dbType = "DB1"),  
                     ...) {  
     readerControl <- prepareReader(readerControl, x$DefaultReader, ...)  
23    
24      if (!filehash::dbCreate(dbControl$dbName, dbControl$dbType))      if (!filehash::dbCreate(dbControl$dbName, dbControl$dbType))
25          stop("error in creating database")          stop("error in creating database")
26      db <- filehash::dbInit(dbControl$dbName, dbControl$dbType)      db <- filehash::dbInit(dbControl$dbName, dbControl$dbType)
27    
28      # Allocate memory in advance if length is known      # Allocate memory in advance if length is known
29      tdl <- if (x$Length > 0)      tdl <- if (x$length > 0)
30          vector("list", as.integer(x$Length))          vector("list", as.integer(x$length))
31      else      else
32          list()          list()
33    
# Line 29  Line 35 
35      while (!eoi(x)) {      while (!eoi(x)) {
36          x <- stepNext(x)          x <- stepNext(x)
37          elem <- getElem(x)          elem <- getElem(x)
38          doc <- readerControl$reader(elem, readerControl$language, if (is.null(x$Names)) as.character(counter) else x$Names[counter])          id <- if (is.null(x$names) || is.na(x$names))
39          filehash::dbInsert(db, ID(doc), doc)              as.character(counter)
40          if (x$Length > 0) tdl[[counter]] <- ID(doc)          else
41          else tdl <- c(tdl, ID(doc))              x$names[counter]
42            doc <- readerControl$reader(elem, readerControl$language, id)
43            filehash::dbInsert(db, meta(doc, "id"), doc)
44            if (x$length > 0) tdl[[counter]] <- meta(doc, "id")
45            else tdl <- c(tdl, meta(doc, "id"))
46          counter <- counter + 1          counter <- counter + 1
47      }      }
48      names(tdl) <- x$Names      if (!is.null(x$names) && !is.na(x$names))
49            names(tdl) <- x$names
50    
51      df <- data.frame(MetaID = rep(0, length(tdl)), stringsAsFactors = FALSE)      df <- data.frame(MetaID = rep(0, length(tdl)), stringsAsFactors = FALSE)
52      filehash::dbInsert(db, "DMetaData", df)      filehash::dbInsert(db, "CorpusDMeta", df)
53      dmeta.df <- data.frame(key = "DMetaData", subset = I(list(NA)))      dmeta.df <- data.frame(key = "CorpusDMeta", subset = I(list(NA)))
54    
55      .PCorpus(tdl, .MetaDataNode(), dmeta.df, dbControl)      .PCorpus(tdl, CorpusMeta(), dmeta.df, dbControl)
56  }  }
57    
58  .VCorpus <- function(x, cmeta, dmeta) {  .VCorpus <-
59      attr(x, "CMetaData") <- cmeta  function(x, meta, dmeta)
60      attr(x, "DMetaData") <- dmeta      structure(list(content = as.list(x), meta = meta, dmeta = dmeta),
61      class(x) <- c("VCorpus", "Corpus", "list")                class = c("VCorpus", "Corpus"))
     x  
 }  
62    
63  # Register S3 corpus classes to be recognized by S4 methods. This is  VCorpus <-
64  # mainly a fix to be compatible with packages which were originally  Corpus <-
65  # developed to cooperate with corresponding S4 tm classes. Necessary  function(x, readerControl = list(reader = x$defaultreader, language = "en"))
66  # since tm's class architecture was changed to S3 since tm version 0.5.  {
67  setOldClass(c("VCorpus", "Corpus", "list"))      stopifnot(inherits(x, "Source"))
68    
69  # The "..." are additional arguments for the FunctionGenerator reader      readerControl <- prepareReader(readerControl, x$defaultreader)
70  VCorpus <- Corpus <- function(x,  
71                                readerControl = list(reader = x$DefaultReader, language = "en"),      if (is.function(readerControl$init))
72                                ...) {          readerControl$init()
73      readerControl <- prepareReader(readerControl, x$DefaultReader, ...)  
74        if (is.function(readerControl$exit))
75            on.exit(readerControl$exit())
76    
77      # Allocate memory in advance if length is known      # Allocate memory in advance if length is known
78      tdl <- if (x$Length > 0)      tdl <- if (x$length > 0)
79          vector("list", as.integer(x$Length))          vector("list", as.integer(x$length))
80      else      else
81          list()          list()
82    
83      if (x$Vectorized)      if (x$vectorized)
84          tdl <- mapply(function(x, id) readerControl$reader(x, readerControl$language, id),          tdl <- mapply(function(elem, id)
85                              readerControl$reader(elem, readerControl$language, id),
86                        pGetElem(x),                        pGetElem(x),
87                        id = if (is.null(x$Names)) as.character(seq_len(x$Length)) else x$Names,                        id = if (is.null(x$names) || is.na(x$names))
88                              as.character(seq_len(x$length))
89                          else x$names,
90                        SIMPLIFY = FALSE)                        SIMPLIFY = FALSE)
91      else {      else {
92          counter <- 1          counter <- 1
93          while (!eoi(x)) {          while (!eoi(x)) {
94              x <- stepNext(x)              x <- stepNext(x)
95              elem <- getElem(x)              elem <- getElem(x)
96              doc <- readerControl$reader(elem, readerControl$language, if (is.null(x$Names)) as.character(counter) else x$Names[counter])              id <- if (is.null(x$names) || is.na(x$names))
97              if (x$Length > 0)                  as.character(counter)
98                else
99                    x$names[counter]
100                doc <- readerControl$reader(elem, readerControl$language, id)
101                if (x$length > 0)
102                  tdl[[counter]] <- doc                  tdl[[counter]] <- doc
103              else              else
104                  tdl <- c(tdl, list(doc))                  tdl <- c(tdl, list(doc))
105              counter <- counter + 1              counter <- counter + 1
106          }          }
107      }      }
108      names(tdl) <- x$Names      if (!is.null(x$names) && !is.na(x$names))
109            names(tdl) <- x$names
110      df <- data.frame(MetaID = rep(0, length(tdl)), stringsAsFactors = FALSE)      df <- data.frame(MetaID = rep(0, length(tdl)), stringsAsFactors = FALSE)
111      .VCorpus(tdl, .MetaDataNode(), df)      .VCorpus(tdl, CorpusMeta(), df)
112  }  }
113    
114  `[.PCorpus` <- function(x, i) {  `[.PCorpus` <-
115      if (missing(i)) return(x)  function(x, i)
116      index <- attr(x, "DMetaData")[[1 , "subset"]]  {
117      attr(x, "DMetaData")[[1 , "subset"]] <- if (is.numeric(index)) index[i] else i      if (!missing(i)) {
118      dmeta <- attr(x, "DMetaData")          x$content <- x$content[i]
119      .PCorpus(NextMethod("["), CMetaData(x), dmeta, DBControl(x))          index <- x$dmeta[[1 , "subset"]]
120            x$dmeta[[1 , "subset"]] <- if (is.numeric(index)) index[i] else i
121        }
122        x
123  }  }
124    
125  `[.VCorpus` <- function(x, i) {  `[.VCorpus` <-
126      if (missing(i)) return(x)  function(x, i)
127      .VCorpus(NextMethod("["), CMetaData(x), DMetaData(x)[i, , drop = FALSE])  {
128        if (!missing(i)) {
129            x$content <- x$content[i]
130            x$dmeta <- x$dmeta[i, , drop = FALSE]
131        }
132        x
133  }  }
134    
135  `[<-.PCorpus` <- function(x, i, value) {  `[<-.PCorpus` <-
136      db <- filehash::dbInit(DBControl(x)[["dbName"]], DBControl(x)[["dbType"]])  function(x, i, value)
137    {
138        db <- filehash::dbInit(x$dbcontrol[["dbName"]], x$dbcontrol[["dbType"]])
139      counter <- 1      counter <- 1
140      for (id in unclass(x)[i]) {      for (id in x$content[i]) {
141          if (identical(length(value), 1L)) db[[id]] <- value          db[[id]] <- if (identical(length(value), 1L))
142          else db[[id]] <- value[[counter]]              value
143            else
144                value[[counter]]
145          counter <- counter + 1          counter <- counter + 1
146      }      }
147      x      x
148  }  }
149    
150  .map_name_index <- function(x, i) {  .map_name_index <-
151      if (is.character(i)) {  function(x, i)
152          if (is.null(names(x)))  {
153              match(i, meta(x, "ID", type = "local"))      if (is.character(i))
154            match(i, if (is.null(names(x))) meta(x, "id", "local") else names(x))
155          else          else
             match(i, names(x))  
     }  
156      i      i
157  }  }
158    
159  `[[.PCorpus` <-  function(x, i) {  `[[.PCorpus` <-
160    function(x, i)
161    {
162      i <- .map_name_index(x, i)      i <- .map_name_index(x, i)
163      db <- filehash::dbInit(DBControl(x)[["dbName"]], DBControl(x)[["dbType"]])      db <- filehash::dbInit(x$dbcontrol[["dbName"]], x$dbcontrol[["dbType"]])
164      filehash::dbFetch(db, NextMethod("[["))      filehash::dbFetch(db, x$content[[i]])
165  }  }
166  `[[.VCorpus` <-  function(x, i) {  `[[.VCorpus` <-
167    function(x, i)
168    {
169      i <- .map_name_index(x, i)      i <- .map_name_index(x, i)
170      lazyTmMap <- meta(x, tag = "lazyTmMap", type = "corpus")      lazyTmMap <- meta(x, tag = "lazyTmMap", type = "corpus")
171      if (!is.null(lazyTmMap))      if (!is.null(lazyTmMap))
172          .Call("copyCorpus", x, materialize(x, i))          .Call("copyCorpus", x, materialize(x, i))
173      NextMethod("[[")      x$content[[i]]
174  }  }
175    
176  `[[<-.PCorpus` <-  function(x, i, value) {  `[[<-.PCorpus` <-
177    function(x, i, value)
178    {
179      i <- .map_name_index(x, i)      i <- .map_name_index(x, i)
180      db <- filehash::dbInit(DBControl(x)[["dbName"]], DBControl(x)[["dbType"]])      db <- filehash::dbInit(x$dbcontrol[["dbName"]], x$dbcontrol[["dbType"]])
181      index <- unclass(x)[[i]]      db[[x$content[[i]]]] <- value
     db[[index]] <- value  
182      x      x
183  }  }
184  `[[<-.VCorpus` <-  function(x, i, value) {  `[[<-.VCorpus` <-
185    function(x, i, value)
186    {
187      i <- .map_name_index(x, i)      i <- .map_name_index(x, i)
188      # Mark new objects as not active for lazy mapping      # Mark new objects as not active for lazy mapping
189      lazyTmMap <- meta(x, tag = "lazyTmMap", type = "corpus")      lazyTmMap <- meta(x, tag = "lazyTmMap", type = "corpus")
# Line 154  Line 191 
191          lazyTmMap$index[i] <- FALSE          lazyTmMap$index[i] <- FALSE
192          meta(x, tag = "lazyTmMap", type = "corpus") <- lazyTmMap          meta(x, tag = "lazyTmMap", type = "corpus") <- lazyTmMap
193      }      }
194      # Set the value      x$content[[i]] <- value
195      cl <- class(x)      x
     y <- NextMethod("[[<-")  
     class(y) <- cl  
     y  
196  }  }
197    
198  # Update NodeIDs of a CMetaData tree  # Update NodeIDs of a CMetaData tree
199  .update_id <- function(x, id = 0, mapping = NULL, left.mapping = NULL, level = 0) {  .update_id <-
200    function(x, id = 0, mapping = NULL, left.mapping = NULL, level = 0)
201    {
202      # Traversal of (binary) CMetaData tree with setup of NodeIDs      # Traversal of (binary) CMetaData tree with setup of NodeIDs
203      set_id <- function(x) {      set_id <- function(x) {
204          x$NodeID <- id          x$NodeID <- id
205          id <<- id + 1          id <<- id + 1
206          level <<- level + 1          level <<- level + 1
207          if (length(x$Children) > 0) {          if (length(x$Children)) {
208              mapping <<- cbind(mapping, c(x$Children[[1]]$NodeID, id))              mapping <<- cbind(mapping, c(x$Children[[1]]$NodeID, id))
209              left <- set_id(x$Children[[1]])              left <- set_id(x$Children[[1]])
210              if (level == 1) {              if (level == 1) {
# Line 187  Line 223 
223  }  }
224    
225  # Find indices to be updated for a CMetaData tree  # Find indices to be updated for a CMetaData tree
226  .find_indices <- function(x) {  .find_indices <-
227    function(x)
228    {
229      indices.mapping <- NULL      indices.mapping <- NULL
230      for (m in levels(as.factor(DMetaData(x)$MetaID))) {      for (m in levels(as.factor(CorpusDMeta(x)$MetaID))) {
231          indices <- (DMetaData(x)$MetaID == m)          indices <- (CorpusDMeta(x)$MetaID == m)
232          indices.mapping <- c(indices.mapping, list(m = indices))          indices.mapping <- c(indices.mapping, list(m = indices))
233          names(indices.mapping)[length(indices.mapping)] <- m          names(indices.mapping)[length(indices.mapping)] <- m
234      }      }
235      indices.mapping      indices.mapping
236  }  }
237    
238  c2 <- function(x, y, ...) {  #c2 <-
239      # Update the CMetaData tree  #function(x, y, ...)
240      cmeta <- .MetaDataNode(0, list(merge_date = as.POSIXlt(Sys.time(), tz = "GMT"), merger = Sys.getenv("LOGNAME")), list(CMetaData(x), CMetaData(y)))  #{
241      update.struct <- .update_id(cmeta)  #    # Update the CMetaData tree
242    #    cmeta <- .MetaDataNode(0, list(merge_date = as.POSIXlt(Sys.time(), tz = "GMT"), merger = Sys.getenv("LOGNAME")), list(CMetaData(x), CMetaData(y)))
243      new <- .VCorpus(c(unclass(x), unclass(y)), update.struct$root, NULL)  #    update.struct <- .update_id(cmeta)
244    #
245      # Find indices to be updated for the left tree  #    new <- .VCorpus(c(unclass(x), unclass(y)), update.struct$root, NULL)
246      indices.mapping <- .find_indices(x)  #
247    #    # Find indices to be updated for the left tree
248      # Update the DMetaData data frames for the left tree  #    indices.mapping <- .find_indices(x)
249      for (i in 1:ncol(update.struct$left.mapping)) {  #
250          map <- update.struct$left.mapping[,i]  #    # Update the CorpusDMeta data frames for the left tree
251          DMetaData(x)$MetaID <- replace(DMetaData(x)$MetaID, indices.mapping[[as.character(map[1])]], map[2])  #    for (i in 1:ncol(update.struct$left.mapping)) {
252      }  #        map <- update.struct$left.mapping[,i]
253    #        DMetaData(x)$MetaID <- replace(DMetaData(x)$MetaID, indices.mapping[[as.character(map[1])]], map[2])
254      # Find indices to be updated for the right tree  #    }
255      indices.mapping <- .find_indices(y)  #
256    #    # Find indices to be updated for the right tree
257      # Update the DMetaData data frames for the right tree  #    indices.mapping <- .find_indices(y)
258      for (i in 1:ncol(update.struct$right.mapping)) {  #
259          map <- update.struct$right.mapping[,i]  #    # Update the CorpusDMeta data frames for the right tree
260          DMetaData(y)$MetaID <- replace(DMetaData(y)$MetaID, indices.mapping[[as.character(map[1])]], map[2])  #    for (i in 1:ncol(update.struct$right.mapping)) {
261      }  #        map <- update.struct$right.mapping[,i]
262    #        DMetaData(y)$MetaID <- replace(DMetaData(y)$MetaID, indices.mapping[[as.character(map[1])]], map[2])
263      # Merge the DMetaData data frames  #    }
264      labels <- setdiff(names(DMetaData(y)), names(DMetaData(x)))  #
265      na.matrix <- matrix(NA, nrow = nrow(DMetaData(x)), ncol = length(labels), dimnames = list(row.names(DMetaData(x)), labels))  #    # Merge the CorpusDMeta data frames
266      x.dmeta.aug <- cbind(DMetaData(x), na.matrix)  #    labels <- setdiff(names(DMetaData(y)), names(DMetaData(x)))
267      labels <- setdiff(names(DMetaData(x)), names(DMetaData(y)))  #    na.matrix <- matrix(NA,
268      na.matrix <- matrix(NA, nrow = nrow(DMetaData(y)), ncol = length(labels), dimnames = list(row.names(DMetaData(y)), labels))  #                        nrow = nrow(DMetaData(x)),
269      y.dmeta.aug <- cbind(DMetaData(y), na.matrix)  #                        ncol = length(labels),
270      DMetaData(new) <- rbind(x.dmeta.aug, y.dmeta.aug)  #                        dimnames = list(row.names(DMetaData(x)), labels))
271    #    x.dmeta.aug <- cbind(DMetaData(x), na.matrix)
272      new  #    labels <- setdiff(names(DMetaData(x)), names(DMetaData(y)))
273  }  #    na.matrix <- matrix(NA,
274    #                        nrow = nrow(DMetaData(y)),
275    #                        ncol = length(labels),
276    #                        dimnames = list(row.names(DMetaData(y)), labels))
277    #    y.dmeta.aug <- cbind(DMetaData(y), na.matrix)
278    #    DMetaData(new) <- rbind(x.dmeta.aug, y.dmeta.aug)
279    #
280    #    new
281    #}
282    
283  c.Corpus <-  c.Corpus <-
284  function(x, ..., recursive = FALSE)  function(..., recursive = FALSE)
285  {  {
286      args <- list(...)      args <- list(...)
287        x <- args[[1L]]
288    
289      if (identical(length(args), 0L))      if(length(args) == 1L)
290          return(x)          return(x)
291    
292      if (!all(unlist(lapply(args, inherits, class(x)))))      if (!all(unlist(lapply(args, inherits, class(x)))))
# Line 248  Line 295 
295      if (inherits(x, "PCorpus"))      if (inherits(x, "PCorpus"))
296          stop("concatenation of corpora with underlying databases is not supported")          stop("concatenation of corpora with underlying databases is not supported")
297    
     l <- base::c(list(x), args)  
298      if (recursive)      if (recursive)
299          Reduce(c2, l)          Reduce(c2, args)
300      else {      else {
301          l <- do.call("c", lapply(l, unclass))          args <- do.call("c", lapply(args, content))
302          .VCorpus(l,          .VCorpus(args,
303                   cmeta = .MetaDataNode(),                   CorpusMeta(),
304                   dmeta = data.frame(MetaID = rep(0, length(l)), stringsAsFactors = FALSE))                   data.frame(MetaID = rep(0, length(args)),
305                                stringsAsFactors = FALSE))
306      }      }
307  }  }
308    
309  c.TextDocument <- function(x, ..., recursive = FALSE) {  c.TextDocument <-
310    function(..., recursive = FALSE)
311    {
312      args <- list(...)      args <- list(...)
313        x <- args[[1L]]
314    
315      if (identical(length(args), 0L))      if(length(args) == 1L)
316          return(x)          return(x)
317    
318      if (!all(unlist(lapply(args, inherits, class(x)))))      if (!all(unlist(lapply(args, inherits, class(x)))))
319          stop("not all arguments are text documents")          stop("not all arguments are text documents")
320    
321      dmeta <- data.frame(MetaID = rep(0, length(list(x, ...))), stringsAsFactors = FALSE)      .VCorpus(args,
322      .VCorpus(list(x, ...), .MetaDataNode(), dmeta)               CorpusMeta(),
323                 data.frame(MetaID = rep(0, length(args)),
324                            stringsAsFactors = FALSE))
325  }  }
326    
327  print.Corpus <- function(x, ...) {  content.Corpus <-
328    function(x)
329        x$content
330    
331    `content<-.Corpus` <-
332    function(x, value)
333    {
334        x$content <- value
335        x
336    }
337    
338    length.Corpus <-
339    function(x)
340        length(content(x))
341    
342    print.Corpus <-
343    function(x, ...)
344    {
345      cat(sprintf(ngettext(length(x),      cat(sprintf(ngettext(length(x),
346                           "A corpus with %d text document\n",                           "A corpus with %d text document\n\n",
347                           "A corpus with %d text documents\n"),                           "A corpus with %d text documents\n\n"),
348                  length(x)))                  length(x)))
     invisible(x)  
 }  
349    
350  summary.Corpus <- function(object, ...) {      meta <- meta(x, type = "corpus")$value
351      print(object)      dmeta <- meta(x, type = "indexed")
352      if (length(DMetaData(object)) > 0) {  
353          cat(sprintf(ngettext(length(attr(CMetaData(object), "MetaData")),      cat("Metadata:\n")
354                               "\nThe metadata consists of %d tag-value pair and a data frame\n",      cat(sprintf("  Tag-value pairs. Tags: %s\n",
355                               "\nThe metadata consists of %d tag-value pairs and a data frame\n"),                  paste(names(meta), collapse = " ")))
356                      length(CMetaData(object)$MetaData)))      cat("  Data frame. Variables:", colnames(dmeta), "\n")
357          cat("Available tags are:\n")  
358          cat(strwrap(paste(names(CMetaData(object)$MetaData), collapse = " "), indent = 2, exdent = 2), "\n")      invisible(x)
         cat("Available variables in the data frame are:\n")  
         cat(strwrap(paste(names(DMetaData(object)), collapse = " "), indent = 2, exdent = 2), "\n")  
     }  
359  }  }
360    
361  inspect <- function(x) UseMethod("inspect", x)  inspect <-
362  inspect.PCorpus <- function(x) {  function(x)
363      summary(x)      UseMethod("inspect", x)
364    inspect.PCorpus <-
365    function(x)
366    {
367        print(x)
368      cat("\n")      cat("\n")
369      db <- filehash::dbInit(DBControl(x)[["dbName"]], DBControl(x)[["dbType"]])      db <- filehash::dbInit(x$dbcontrol[["dbName"]], x$dbcontrol[["dbType"]])
370      show(filehash::dbMultiFetch(db, unlist(x)))      show(filehash::dbMultiFetch(db, unlist(content(x))))
371        invisible(x)
372  }  }
373  inspect.VCorpus <- function(x) {  inspect.VCorpus <-
374      summary(x)  function(x)
375    {
376        print(x)
377      cat("\n")      cat("\n")
378      print(noquote(lapply(x, identity)))      print(noquote(content(x)))
379        invisible(x)
380  }  }
381    
382  lapply.PCorpus <- function(X, FUN, ...) {  lapply.PCorpus <-
383      db <- filehash::dbInit(DBControl(X)[["dbName"]], DBControl(X)[["dbType"]])  function(X, FUN, ...)
384      lapply(filehash::dbMultiFetch(db, unlist(X)), FUN, ...)  {
385        db <- filehash::dbInit(X$dbcontrol[["dbName"]], X$dbcontrol[["dbType"]])
386        lapply(filehash::dbMultiFetch(db, unlist(content(X))), FUN, ...)
387  }  }
388  lapply.VCorpus <- function(X, FUN, ...) {  lapply.VCorpus <-
389    function(X, FUN, ...)
390    {
391      lazyTmMap <- meta(X, tag = "lazyTmMap", type = "corpus")      lazyTmMap <- meta(X, tag = "lazyTmMap", type = "corpus")
392      if (!is.null(lazyTmMap))      if (!is.null(lazyTmMap))
393          .Call("copyCorpus", X, materialize(X))          .Call("copyCorpus", X, materialize(X))
394      base::lapply(X, FUN, ...)      lapply(content(X), FUN, ...)
395  }  }
396    
397  writeCorpus <-  function(x, path = ".", filenames = NULL) {  writeCorpus <-
398    function(x, path = ".", filenames = NULL)
399    {
400      filenames <- file.path(path,      filenames <- file.path(path,
401                             if (is.null(filenames)) unlist(lapply(x, function(x) sprintf("%s.txt", ID(x))))        if (is.null(filenames))
402              sprintf("%s.txt", as.character(meta(x, "id", "local")))
403                             else filenames)                             else filenames)
404      i <- 1  
405      for (o in x) {      stopifnot(length(x) == length(filenames))
406          writeLines(as.PlainTextDocument(o), filenames[i])  
407          i <- i + 1      mapply(function(doc, f) writeLines(as.character(doc), f), x, filenames)
408      }  
409        invisible(x)
410  }  }

Legend:
Removed from v.1108  
changed lines
  Added in v.1311

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