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 1377, Wed May 21 17:15:56 2014 UTC revision 1411, Sat Feb 28 18:16:54 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        x <- open(x)
17      tdl <- vector("list", length(x))      tdl <- vector("list", length(x))
18      counter <- 1      counter <- 1
19      while (!eoi(x)) {      while (!eoi(x)) {
# Line 31  Line 26 
26          tdl[[counter]] <- meta(doc, "id")          tdl[[counter]] <- meta(doc, "id")
27          counter <- counter + 1          counter <- counter + 1
28      }      }
29        x <- close(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 <-  Corpus <-
# Line 47  Line 44 
44    
45      readerControl <- prepareReader(readerControl, reader(x))      readerControl <- prepareReader(readerControl, reader(x))
46    
47      if (is.function(readerControl$init))      x <- open(x)
         readerControl$init()  
   
     if (is.function(readerControl$exit))  
         on.exit(readerControl$exit())  
   
48      tdl <- vector("list", length(x))      tdl <- vector("list", length(x))
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)))
# Line 73  Line 65 
65              counter <- counter + 1              counter <- counter + 1
66          }          }
67      }      }
68        x <- close(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 148  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 180  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 = CorpusMeta(meta = 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                     dmeta = Reduce(outer_union, lapply(args, meta))),                dmeta = Reduce(outer_union, lapply(args, meta)))
186                class = c("VCorpus", "Corpus"))      class(v) <- c("VCorpus", "Corpus")
187        v
188  }  }
189    
190  content.VCorpus <-  content.VCorpus <-
# Line 222  Line 222 
222  function(x)  function(x)
223      as.character(meta(x, "id", "local"))      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  print.PCorpus <- print.VCorpus <-  print.PCorpus <- print.VCorpus <-
233  function(x, ...)  function(x, ...)
234  {  {

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

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