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 1409, Fri Feb 27 16:10:18 2015 UTC revision 1481, Sat May 20 10:28:00 2017 UTC
# Line 1  Line 1 
1  # Author: Ingo Feinerer  # Author: Ingo Feinerer
2    
3    Corpus <-
4    function(x, readerControl = list(reader = reader(x), language = "en"))
5    {
6        stopifnot(inherits(x, "Source"))
7    
8        readerControl <- prepareReader(readerControl, reader(x))
9    
10        if ( (inherits(x, "DataframeSource") || inherits(x, "DirSource") ||
11              inherits(x, "VectorSource") ) &&
12            identical(readerControl$reader, reader(x)))
13            SimpleCorpus(x, readerControl)
14        else
15            VCorpus(x, readerControl)
16    }
17    
18  PCorpus <-  PCorpus <-
19  function(x,  function(x,
20           readerControl = list(reader = reader(x), language = "en"),           readerControl = list(reader = reader(x), language = "en"),
# Line 28  Line 43 
43      }      }
44      x <- close(x)      x <- close(x)
45    
46      p <- list(content = tdl,      cmeta <- CorpusMeta()
47                meta = CorpusMeta(),      dmeta <- data.frame(row.names = seq_along(tdl))
48                dmeta = data.frame(row.names = seq_along(tdl)),      # Check if metadata retrieval is supported
49                dbcontrol = dbControl)      if (is.function(getS3method("getMeta", class(x), TRUE))) {
50            m <- getMeta(x)
51            if (!is.null(m$cmeta)) cmeta <- m$cmeta
52            if (!is.null(m$dmeta)) dmeta <- m$dmeta
53        }
54    
55        p <- list(content = tdl, meta = cmeta, dmeta = dmeta, dbcontrol = dbControl)
56      class(p) <- c("PCorpus", "Corpus")      class(p) <- c("PCorpus", "Corpus")
57      p      p
58  }  }
59    
60  Corpus <-  SimpleCorpus <-
61    function(x, control = list(language = "en"))
62    {
63        stopifnot(inherits(x, "Source"))
64    
65        if (!is.null(control$reader) && !identical(control$reader, reader(x)))
66            warning("custom reader is ignored")
67    
68        content <- if (inherits(x, "VectorSource")) {
69            if (is.character(x$content)) x$content else as.character(x$content)
70        } else if (inherits(x, "DirSource")) {
71            setNames(as.character(
72                       lapply(x$filelist,
73                              function(f) paste(readContent(f, x$encoding, "text"),
74                                                collapse = "\n"))
75                       ),
76                     basename(x$filelist))
77        } else if (inherits(x, "DataframeSource")) {
78            setNames(as.character(x$content[, "text"]), x$content[, "doc_id"])
79        } else
80            stop("unsupported source type")
81    
82        dmeta <- if (inherits(x, "DataframeSource"))
83            x$content[, !names(x$content) %in% c("doc_id", "text")]
84        else
85            data.frame(row.names = seq_along(x))
86    
87        s <- list(content = content,
88                  meta = CorpusMeta(language = control$language),
89                  dmeta = dmeta)
90        class(s) <- c("SimpleCorpus", "Corpus")
91        s
92    }
93    
94  VCorpus <-  VCorpus <-
95  function(x, readerControl = list(reader = reader(x), language = "en"))  function(x, readerControl = list(reader = reader(x), language = "en"))
96  {  {
# Line 67  Line 121 
121      }      }
122      x <- close(x)      x <- close(x)
123    
124      as.VCorpus(tdl)      cmeta <- CorpusMeta()
125        dmeta <- data.frame(row.names = seq_along(tdl))
126        # Check if metadata retrieval is supported
127        if (is.function(getS3method("getMeta", class(x), TRUE))) {
128            m <- getMeta(x)
129            if (!is.null(m$cmeta)) cmeta <- m$cmeta
130            if (!is.null(m$dmeta)) dmeta <- m$dmeta
131        }
132    
133        v <- as.VCorpus(tdl)
134        v$meta <- cmeta
135        v$dmeta <- dmeta
136    
137        v
138  }  }
139    
140  `[.PCorpus` <-  `[.PCorpus` <-
141    `[.SimpleCorpus` <-
142  function(x, i)  function(x, i)
143  {  {
144      if (!missing(i)) {      if (!missing(i)) {
# Line 79  Line 147 
147      }      }
148      x      x
149  }  }
   
150  `[.VCorpus` <-  `[.VCorpus` <-
151  function(x, i)  function(x, i)
152  {  {
# Line 108  Line 175 
175      db <- filehash::dbInit(x$dbcontrol[["dbName"]], x$dbcontrol[["dbType"]])      db <- filehash::dbInit(x$dbcontrol[["dbName"]], x$dbcontrol[["dbType"]])
176      filehash::dbFetch(db, x$content[[i]])      filehash::dbFetch(db, x$content[[i]])
177  }  }
178    `[[.SimpleCorpus` <-
179    function(x, i)
180    {
181        i <- .map_name_index(x, i)
182        n <- names(x$content)
183        PlainTextDocument(x$content[[i]],
184                          id = if (is.null(n)) i else n[i],
185                          language = meta(x, "language"))
186    }
187  `[[.VCorpus` <-  `[[.VCorpus` <-
188  function(x, i)  function(x, i)
189  {  {
190      i <- .map_name_index(x, i)      i <- .map_name_index(x, i)
191      if (!is.null(x$lazy))      if (!is.null(x$lazy))
192          .Call(copyCorpus, x, materialize(x, i))          .Call(tm_copyCorpus, x, materialize(x, i))
193      x$content[[i]]      x$content[[i]]
194  }  }
195    
# Line 138  Line 214 
214    
215  as.list.PCorpus <- as.list.VCorpus <-  as.list.PCorpus <- as.list.VCorpus <-
216  function(x, ...)  function(x, ...)
217      content(x)      setNames(content(x), as.character(lapply(content(x), meta, "id")))
218    
219    as.list.SimpleCorpus <-
220    function(x, ...)
221        as.list(content(x))
222    
223  as.VCorpus <-  as.VCorpus <-
224  function(x)  function(x)
# Line 191  Line 271 
271  function(x)  function(x)
272  {  {
273      if (!is.null(x$lazy))      if (!is.null(x$lazy))
274          .Call(copyCorpus, x, materialize(x))          .Call(tm_copyCorpus, x, materialize(x))
275      x$content      x$content
276  }  }
277    
278    content.SimpleCorpus <-
279    function(x)
280        x$content
281    
282  content.PCorpus <-  content.PCorpus <-
283  function(x)  function(x)
284  {  {
# Line 205  Line 289 
289  inspect <-  inspect <-
290  function(x)  function(x)
291      UseMethod("inspect", x)      UseMethod("inspect", x)
292  inspect.PCorpus <- inspect.VCorpus <-  inspect.PCorpus <-
293    inspect.SimpleCorpus <-
294    inspect.VCorpus <-
295  function(x)  function(x)
296  {  {
297      print(x)      print(x)
# Line 214  Line 300 
300      invisible(x)      invisible(x)
301  }  }
302    
303  length.PCorpus <- length.VCorpus <-  length.PCorpus <-
304    length.SimpleCorpus <-
305    length.VCorpus <-
306  function(x)  function(x)
307      length(x$content)      length(x$content)
308    
309  names.PCorpus <- names.VCorpus <-  names.PCorpus <-
310    names.SimpleCorpus <-
311    names.VCorpus <-
312  function(x)  function(x)
313      as.character(meta(x, "id", "local"))      as.character(meta(x, "id", "local"))
314    
# Line 229  Line 319 
319      x      x
320  }  }
321    
322  print.PCorpus <- print.VCorpus <-  format.PCorpus <-
323    format.SimpleCorpus <-
324    format.VCorpus <-
325  function(x, ...)  function(x, ...)
326  {  {
327      writeLines(sprintf("<<%s (documents: %d, metadata (corpus/indexed): %d/%d)>>",      c(sprintf("<<%s>>", class(x)[1L]),
328                         class(x)[1],        sprintf("Metadata:  corpus specific: %d, document level (indexed): %d",
                        length(x),  
329                         length(meta(x, type = "corpus")),                         length(meta(x, type = "corpus")),
330                         ncol(meta(x, type = "indexed"))))                ncol(meta(x, type = "indexed"))),
331      invisible(x)        sprintf("Content:  documents: %d", length(x)))
332  }  }
333    
334  writeCorpus <-  writeCorpus <-

Legend:
Removed from v.1409  
changed lines
  Added in v.1481

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