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 1333, Fri Apr 18 10:38:46 2014 UTC revision 1376, Wed May 21 14:36:35 2014 UTC
# Line 2  Line 2 
2    
3  PCorpus <-  PCorpus <-
4  function(x,  function(x,
5           readerControl = list(reader = x$defaultreader, language = "en"),           readerControl = list(reader = reader(x), language = "en"),
6           dbControl = list(dbName = "", dbType = "DB1"))           dbControl = list(dbName = "", dbType = "DB1"))
7  {  {
8      stopifnot(inherits(x, "Source"))      stopifnot(inherits(x, "Source"))
9    
10      readerControl <- prepareReader(readerControl, x$defaultreader)      readerControl <- prepareReader(readerControl, reader(x))
11    
12      if (is.function(readerControl$init))      if (is.function(readerControl$init))
13          readerControl$init()          readerControl$init()
# Line 19  Line 19 
19          stop("error in creating database")          stop("error in creating database")
20      db <- filehash::dbInit(dbControl$dbName, dbControl$dbType)      db <- filehash::dbInit(dbControl$dbName, dbControl$dbType)
21    
22      # Allocate memory in advance if length is known      tdl <- vector("list", length(x))
     tdl <- if (x$length > 0) vector("list", as.integer(x$length)) else list()  
   
23      counter <- 1      counter <- 1
24      while (!eoi(x)) {      while (!eoi(x)) {
25          x <- stepNext(x)          x <- stepNext(x)
26          elem <- getElem(x)          elem <- getElem(x)
27          id <- if (is.null(x$names) || is.na(x$names))          doc <- readerControl$reader(elem,
28              as.character(counter)                                      readerControl$language,
29          else                                      as.character(counter))
             x$names[counter]  
         doc <- readerControl$reader(elem, readerControl$language, id)  
30          filehash::dbInsert(db, meta(doc, "id"), doc)          filehash::dbInsert(db, meta(doc, "id"), doc)
31          if (x$length > 0) tdl[[counter]] <- meta(doc, "id")          tdl[[counter]] <- meta(doc, "id")
         else tdl <- c(tdl, meta(doc, "id"))  
32          counter <- counter + 1          counter <- counter + 1
33      }      }
     if (!is.null(x$names) && !is.na(x$names))  
         names(tdl) <- x$names  
34    
35      structure(list(content = tdl,      structure(list(content = tdl,
36                     meta = CorpusMeta(),                     meta = CorpusMeta(),
# Line 46  Line 39 
39                class = c("PCorpus", "Corpus"))                class = c("PCorpus", "Corpus"))
40  }  }
41    
42    Corpus <-
43  VCorpus <-  VCorpus <-
44  function(x, readerControl = list(reader = x$defaultreader, language = "en"))  function(x, readerControl = list(reader = reader(x), language = "en"))
45  {  {
46      stopifnot(inherits(x, "Source"))      stopifnot(inherits(x, "Source"))
47    
48      readerControl <- prepareReader(readerControl, x$defaultreader)      readerControl <- prepareReader(readerControl, reader(x))
49    
50      if (is.function(readerControl$init))      if (is.function(readerControl$init))
51          readerControl$init()          readerControl$init()
# Line 59  Line 53 
53      if (is.function(readerControl$exit))      if (is.function(readerControl$exit))
54          on.exit(readerControl$exit())          on.exit(readerControl$exit())
55    
56      # Allocate memory in advance if length is known      tdl <- vector("list", length(x))
57      tdl <- if (x$length > 0) vector("list", as.integer(x$length)) else list()      # Check for parallel element access
58        if (is.function(getS3method("pGetElem", class(x), TRUE)))
     if (x$vectorized)  
59          tdl <- mapply(function(elem, id)          tdl <- mapply(function(elem, id)
60                            readerControl$reader(elem, readerControl$language, id),                            readerControl$reader(elem, readerControl$language, id),
61                        pGetElem(x),                        pGetElem(x),
62                        id = if (is.null(x$names) || is.na(x$names))                        id = as.character(seq_along(x)),
                           as.character(seq_len(x$length))  
                       else x$names,  
63                        SIMPLIFY = FALSE)                        SIMPLIFY = FALSE)
64      else {      else {
65          counter <- 1          counter <- 1
66          while (!eoi(x)) {          while (!eoi(x)) {
67              x <- stepNext(x)              x <- stepNext(x)
68              elem <- getElem(x)              elem <- getElem(x)
69              id <- if (is.null(x$names) || is.na(x$names))              doc <- readerControl$reader(elem,
70                  as.character(counter)                                          readerControl$language,
71              else                                          as.character(counter))
                 x$names[counter]  
             doc <- readerControl$reader(elem, readerControl$language, id)  
             if (x$length > 0)  
72                  tdl[[counter]] <- doc                  tdl[[counter]] <- doc
             else  
                 tdl <- c(tdl, list(doc))  
73              counter <- counter + 1              counter <- counter + 1
74          }          }
75      }      }
     if (!is.null(x$names) && !is.na(x$names))  
         names(tdl) <- x$names  
76    
77      structure(list(content = tdl,      structure(list(content = tdl,
78                     meta = CorpusMeta(),                     meta = CorpusMeta(),
# Line 122  Line 106 
106  function(x, i)  function(x, i)
107  {  {
108      if (is.character(i))      if (is.character(i))
109          match(i, if (is.null(names(x))) meta(x, "id", "local") else names(x))          match(i, meta(x, "id", "local"))
110      else      else
111          i          i
112  }  }
# Line 162  Line 146 
146      x      x
147  }  }
148    
149    as.list.PCorpus <- as.list.VCorpus <-
150    function(x, ...)
151        content(x)
152    
153    as.VCorpus <-
154    function(x)
155        UseMethod("as.VCorpus")
156    as.VCorpus.VCorpus <- identity
157    
158  outer_union <-  outer_union <-
159  function(x, y, ...)  function(x, y, ...)
160  {  {
# Line 188  Line 181 
181          stop("not all arguments are of the same corpus type")          stop("not all arguments are of the same corpus type")
182    
183      structure(list(content = do.call("c", lapply(args, content)),      structure(list(content = do.call("c", lapply(args, content)),
184                     meta = structure(do.call("c",                     meta = CorpusMeta(meta = do.call("c",
185                       lapply(args, function(a) meta(a, type = "corpus"))),                       lapply(args, function(a) meta(a, type = "corpus")))),
                                     class = "CorpusMeta"),  
186                     dmeta = Reduce(outer_union, lapply(args, meta))),                     dmeta = Reduce(outer_union, lapply(args, meta))),
187                class = c("VCorpus", "Corpus"))                class = c("VCorpus", "Corpus"))
188  }  }
189    
 as.list.PCorpus <- as.list.VCorpus <-  
 function(x, ...)  
     content(x)  
   
190  content.VCorpus <-  content.VCorpus <-
191  function(x)  function(x)
192  {  {
# Line 218  Line 206 
206  function(x)  function(x)
207      length(x$content)      length(x$content)
208    
 print.PCorpus <- print.VCorpus <-  
 function(x, ...)  
 {  
     writeLines(sprintf("<<%s (documents: %d, metadata (corpus/indexed): %d/%d)>>",  
                        class(x)[1],  
                        length(x),  
                        length(meta(x, type = "corpus")),  
                        ncol(meta(x, type = "indexed"))))  
     invisible(x)  
 }  
   
209  inspect <-  inspect <-
210  function(x)  function(x)
211      UseMethod("inspect", x)      UseMethod("inspect", x)
# Line 241  Line 218 
218      invisible(x)      invisible(x)
219  }  }
220    
221    print.PCorpus <- print.VCorpus <-
222    function(x, ...)
223    {
224        writeLines(sprintf("<<%s (documents: %d, metadata (corpus/indexed): %d/%d)>>",
225                           class(x)[1],
226                           length(x),
227                           length(meta(x, type = "corpus")),
228                           ncol(meta(x, type = "indexed"))))
229        invisible(x)
230    }
231    
232  writeCorpus <-  writeCorpus <-
233  function(x, path = ".", filenames = NULL)  function(x, path = ".", filenames = NULL)
234  {  {

Legend:
Removed from v.1333  
changed lines
  Added in v.1376

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