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 1348, Tue Apr 22 07:09:41 2014 UTC revision 1377, Wed May 21 17:15:56 2014 UTC
# 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 (length(x) > 0) vector("list", as.integer(length(x))) 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(names(x)) || is.na(names(x)))          doc <- readerControl$reader(elem,
28              as.character(counter)                                      readerControl$language,
29          else                                      as.character(counter))
             names(x)[counter]  
         doc <- readerControl$reader(elem, readerControl$language, id)  
30          filehash::dbInsert(db, meta(doc, "id"), doc)          filehash::dbInsert(db, meta(doc, "id"), doc)
31          tdl[[counter]] <- meta(doc, "id")          tdl[[counter]] <- meta(doc, "id")
32          counter <- counter + 1          counter <- counter + 1
33      }      }
     if (!is.null(names(x)) && !is.na(names(x)))  
         names(tdl) <- names(x)  
34    
35      structure(list(content = tdl,      structure(list(content = tdl,
36                     meta = CorpusMeta(),                     meta = CorpusMeta(),
# Line 45  Line 39 
39                class = c("PCorpus", "Corpus"))                class = c("PCorpus", "Corpus"))
40  }  }
41    
42    Corpus <-
43  VCorpus <-  VCorpus <-
44  function(x, readerControl = list(reader = reader(x), language = "en"))  function(x, readerControl = list(reader = reader(x), language = "en"))
45  {  {
# Line 58  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))
     tdl <- if (length(x) > 0) vector("list", as.integer(length(x))) else list()  
   
57      # Check for parallel element access      # Check for parallel element access
58      if (is.function(getS3method("pGetElem", class(x), TRUE)))      if (is.function(getS3method("pGetElem", class(x), TRUE)))
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(names(x)) || is.na(names(x)))                        id = as.character(seq_along(x)),
                           as.character(seq_len(length(x)))  
                       else names(x),  
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(names(x)) || is.na(names(x)))              doc <- readerControl$reader(elem,
70                  as.character(counter)                                          readerControl$language,
71              else                                          as.character(counter))
                 names(x)[counter]  
             doc <- readerControl$reader(elem, readerControl$language, id)  
72              tdl[[counter]] <- doc              tdl[[counter]] <- doc
73              counter <- counter + 1              counter <- counter + 1
74          }          }
75      }      }
     if (!is.null(names(x)) && !is.na(names(x)))  
         names(tdl) <- names(x)  
76    
77      structure(list(content = tdl,      structure(list(content = tdl,
78                     meta = CorpusMeta(),                     meta = CorpusMeta(),
# Line 93  Line 80 
80                class = c("VCorpus", "Corpus"))                class = c("VCorpus", "Corpus"))
81  }  }
82    
 as.VCorpus <-  
 function(x)  
     UseMethod("as.VCorpus")  
 as.VCorpus.VCorpus <- identity  
   
83  `[.PCorpus` <-  `[.PCorpus` <-
84  function(x, i)  function(x, i)
85  {  {
# Line 123  Line 105 
105  .map_name_index <-  .map_name_index <-
106  function(x, i)  function(x, i)
107  {  {
108      if (is.character(i)) {      if (is.character(i))
109          n <- names(x$content)          match(i, meta(x, "id", "local"))
110          match(i, if (is.null(n)) meta(x, "id", "local") else n)      else
     } else  
111          i          i
112  }  }
113    
# Line 165  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 191  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 217  Line 202 
202      filehash::dbMultiFetch(db, unlist(x$content))      filehash::dbMultiFetch(db, unlist(x$content))
203  }  }
204    
205    inspect <-
206    function(x)
207        UseMethod("inspect", x)
208    inspect.PCorpus <- inspect.VCorpus <-
209    function(x)
210    {
211        print(x)
212        cat("\n")
213        print(noquote(content(x)))
214        invisible(x)
215    }
216    
217  length.PCorpus <- length.VCorpus <-  length.PCorpus <- length.VCorpus <-
218  function(x)  function(x)
219      length(x$content)      length(x$content)
220    
221    names.PCorpus <- names.VCorpus <-
222    function(x)
223        as.character(meta(x, "id", "local"))
224    
225  print.PCorpus <- print.VCorpus <-  print.PCorpus <- print.VCorpus <-
226  function(x, ...)  function(x, ...)
227  {  {
# Line 232  Line 233 
233      invisible(x)      invisible(x)
234  }  }
235    
 inspect <-  
 function(x)  
     UseMethod("inspect", x)  
 inspect.PCorpus <- inspect.VCorpus <-  
 function(x)  
 {  
     print(x)  
     cat("\n")  
     print(noquote(content(x)))  
     invisible(x)  
 }  
   
236  writeCorpus <-  writeCorpus <-
237  function(x, path = ".", filenames = NULL)  function(x, path = ".", filenames = NULL)
238  {  {

Legend:
Removed from v.1348  
changed lines
  Added in v.1377

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