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 1350, Tue Apr 22 07:41:14 2014 UTC revision 1419, Sat May 2 17:23:47 2015 UTC
# Line 9  Line 9 
9    
10      readerControl <- prepareReader(readerControl, reader(x))      readerControl <- prepareReader(readerControl, reader(x))
11    
     if (is.function(readerControl$init))  
         readerControl$init()  
   
     if (is.function(readerControl$exit))  
         on.exit(readerControl$exit())  
   
12      if (!filehash::dbCreate(dbControl$dbName, dbControl$dbType))      if (!filehash::dbCreate(dbControl$dbName, dbControl$dbType))
13          stop("error in creating database")          stop("error in creating database")
14      db <- filehash::dbInit(dbControl$dbName, dbControl$dbType)      db <- filehash::dbInit(dbControl$dbName, dbControl$dbType)
15    
16      # Allocate memory in advance if length is known      x <- open(x)
17      tdl <- if (length(x) > 0) vector("list", as.integer(length(x))) else list()      tdl <- vector("list", length(x))
   
18      counter <- 1      counter <- 1
19      while (!eoi(x)) {      while (!eoi(x)) {
20          x <- stepNext(x)          x <- stepNext(x)
21          elem <- getElem(x)          elem <- getElem(x)
22          id <- if (is.null(names(x)) || is.na(names(x)))          doc <- readerControl$reader(elem,
23              as.character(counter)                                      readerControl$language,
24          else                                      as.character(counter))
             names(x)[counter]  
         doc <- readerControl$reader(elem, readerControl$language, id)  
25          filehash::dbInsert(db, meta(doc, "id"), doc)          filehash::dbInsert(db, meta(doc, "id"), doc)
26          tdl[[counter]] <- meta(doc, "id")          tdl[[counter]] <- meta(doc, "id")
27          counter <- counter + 1          counter <- counter + 1
28      }      }
29      if (!is.null(names(x)) && !is.na(names(x)))      x <- close(x)
         names(tdl) <- names(x)  
30    
31      structure(list(content = tdl,      p <- list(content = tdl,
32                     meta = CorpusMeta(),                     meta = CorpusMeta(),
33                     dmeta = data.frame(row.names = seq_along(tdl)),                     dmeta = data.frame(row.names = seq_along(tdl)),
34                     dbcontrol = dbControl),                dbcontrol = dbControl)
35                class = c("PCorpus", "Corpus"))      class(p) <- c("PCorpus", "Corpus")
36        p
37  }  }
38    
39    Corpus <-
40  VCorpus <-  VCorpus <-
41  function(x, readerControl = list(reader = reader(x), language = "en"))  function(x, readerControl = list(reader = reader(x), language = "en"))
42  {  {
# Line 52  Line 44 
44    
45      readerControl <- prepareReader(readerControl, reader(x))      readerControl <- prepareReader(readerControl, reader(x))
46    
47      if (is.function(readerControl$init))      x <- open(x)
48          readerControl$init()      tdl <- vector("list", length(x))
   
     if (is.function(readerControl$exit))  
         on.exit(readerControl$exit())  
   
     # Allocate memory in advance if length is known  
     tdl <- if (length(x) > 0) vector("list", as.integer(length(x))) else list()  
   
49      # Check for parallel element access      # Check for parallel element access
50      if (is.function(getS3method("pGetElem", class(x), TRUE)))      if (is.function(getS3method("pGetElem", class(x), TRUE)))
51          tdl <- mapply(function(elem, id)          tdl <- mapply(function(elem, id)
52                            readerControl$reader(elem, readerControl$language, id),                            readerControl$reader(elem, readerControl$language, id),
53                        pGetElem(x),                        pGetElem(x),
54                        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),  
55                        SIMPLIFY = FALSE)                        SIMPLIFY = FALSE)
56      else {      else {
57          counter <- 1          counter <- 1
58          while (!eoi(x)) {          while (!eoi(x)) {
59              x <- stepNext(x)              x <- stepNext(x)
60              elem <- getElem(x)              elem <- getElem(x)
61              id <- if (is.null(names(x)) || is.na(names(x)))              doc <- readerControl$reader(elem,
62                  as.character(counter)                                          readerControl$language,
63              else                                          as.character(counter))
                 names(x)[counter]  
             doc <- readerControl$reader(elem, readerControl$language, id)  
64              tdl[[counter]] <- doc              tdl[[counter]] <- doc
65              counter <- counter + 1              counter <- counter + 1
66          }          }
67      }      }
68      if (!is.null(names(x)) && !is.na(names(x)))      x <- close(x)
         names(tdl) <- names(x)  
69    
70      structure(list(content = tdl,      as.VCorpus(tdl)
                    meta = CorpusMeta(),  
                    dmeta = data.frame(row.names = seq_along(tdl))),  
               class = c("VCorpus", "Corpus"))  
71  }  }
72    
73  `[.PCorpus` <-  `[.PCorpus` <-
# Line 118  Line 95 
95  .map_name_index <-  .map_name_index <-
96  function(x, i)  function(x, i)
97  {  {
98      if (is.character(i)) {      if (is.character(i))
99          n <- names(x$content)          match(i, meta(x, "id", "local"))
100          match(i, if (is.null(n)) meta(x, "id", "local") else n)      else
     } else  
101          i          i
102  }  }
103    
# Line 162  Line 138 
138    
139  as.list.PCorpus <- as.list.VCorpus <-  as.list.PCorpus <- as.list.VCorpus <-
140  function(x, ...)  function(x, ...)
141      content(x)      setNames(content(x), as.character(lapply(content(x), meta, "id")))
142    
143  as.VCorpus <-  as.VCorpus <-
144  function(x)  function(x)
145      UseMethod("as.VCorpus")      UseMethod("as.VCorpus")
146  as.VCorpus.VCorpus <- identity  as.VCorpus.VCorpus <- identity
147    as.VCorpus.list <-
148    function(x)
149    {
150        v <- list(content = x,
151                  meta = CorpusMeta(),
152                  dmeta = data.frame(row.names = seq_along(x)))
153        class(v) <- c("VCorpus", "Corpus")
154        v
155    }
156    
157  outer_union <-  outer_union <-
158  function(x, y, ...)  function(x, y, ...)
# Line 194  Line 179 
179      if (!all(unlist(lapply(args, inherits, class(x)))))      if (!all(unlist(lapply(args, inherits, class(x)))))
180          stop("not all arguments are of the same corpus type")          stop("not all arguments are of the same corpus type")
181    
182      structure(list(content = do.call("c", lapply(args, content)),      v <- list(content = do.call("c", lapply(args, content)),
183                     meta = structure(do.call("c",                meta = CorpusMeta(meta = do.call("c",
184                       lapply(args, function(a) meta(a, type = "corpus"))),                  lapply(args, function(a) meta(a, type = "corpus")))),
185                                      class = "CorpusMeta"),                dmeta = Reduce(outer_union, lapply(args, meta)))
186                     dmeta = Reduce(outer_union, lapply(args, meta))),      class(v) <- c("VCorpus", "Corpus")
187                class = c("VCorpus", "Corpus"))      v
188  }  }
189    
190  content.VCorpus <-  content.VCorpus <-
# Line 217  Line 202 
202      filehash::dbMultiFetch(db, unlist(x$content))      filehash::dbMultiFetch(db, unlist(x$content))
203  }  }
204    
 length.PCorpus <- length.VCorpus <-  
 function(x)  
     length(x$content)  
   
 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)  
 }  
   
205  inspect <-  inspect <-
206  function(x)  function(x)
207      UseMethod("inspect", x)      UseMethod("inspect", x)
# Line 244  Line 214 
214      invisible(x)      invisible(x)
215  }  }
216    
217    length.PCorpus <- length.VCorpus <-
218    function(x)
219        length(x$content)
220    
221    names.PCorpus <- names.VCorpus <-
222    function(x)
223        as.character(meta(x, "id", "local"))
224    
225    `names<-.PCorpus` <- `names<-.VCorpus` <-
226    function(x, value)
227    {
228        meta(x, "id", "local") <- as.character(value)
229        x
230    }
231    
232    format.PCorpus <- format.VCorpus <-
233    function(x, ...)
234    {
235        c(sprintf("<<%s>>", class(x)[1L]),
236          sprintf("Metadata:  corpus specific: %d, document level (indexed): %d",
237                  length(meta(x, type = "corpus")),
238                  ncol(meta(x, type = "indexed"))),
239          sprintf("Content:  documents: %d", length(x)))
240    }
241    
242  writeCorpus <-  writeCorpus <-
243  function(x, path = ".", filenames = NULL)  function(x, path = ".", filenames = NULL)
244  {  {

Legend:
Removed from v.1350  
changed lines
  Added in v.1419

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