SCM

SCM Repository

[tm] Annotation of /pkg/R/corpus.R
ViewVC logotype

Annotation of /pkg/R/corpus.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1308 - (view) (download)

1 : feinerer 17 # Author: Ingo Feinerer
2 :    
3 : khornik 1203 .PCorpus <-
4 : feinerer 1307 function(x, meta, dmeta, dbcontrol)
5 :     structure(list(content = as.list(x), meta = meta, dmeta = dmeta,
6 :     dbcontrol = dbcontrol),
7 :     class = c("PCorpus", "Corpus"))
8 : feinerer 985
9 : khornik 1203 PCorpus <-
10 :     function(x,
11 : feinerer 1306 readerControl = list(reader = x$defaultreader, language = "en"),
12 : feinerer 1259 dbControl = list(dbName = "", dbType = "DB1"))
13 : khornik 1203 {
14 : feinerer 1297 stopifnot(inherits(x, "Source"))
15 : feinerer 1273
16 : feinerer 1306 readerControl <- prepareReader(readerControl, x$defaultreader)
17 : feinerer 63
18 : feinerer 1114 if (is.function(readerControl$init))
19 :     readerControl$init()
20 :    
21 :     if (is.function(readerControl$exit))
22 :     on.exit(readerControl$exit())
23 :    
24 : feinerer 946 if (!filehash::dbCreate(dbControl$dbName, dbControl$dbType))
25 :     stop("error in creating database")
26 :     db <- filehash::dbInit(dbControl$dbName, dbControl$dbType)
27 : feinerer 712
28 : feinerer 946 # Allocate memory in advance if length is known
29 : feinerer 1306 tdl <- if (x$length > 0)
30 :     vector("list", as.integer(x$length))
31 : feinerer 946 else
32 :     list()
33 : feinerer 869
34 : feinerer 946 counter <- 1
35 : feinerer 985 while (!eoi(x)) {
36 :     x <- stepNext(x)
37 :     elem <- getElem(x)
38 : feinerer 1306 id <- if (is.null(x$names) || is.na(x$names))
39 : feinerer 1307 as.character(counter)
40 :     else
41 :     x$names[counter]
42 : feinerer 1259 doc <- readerControl$reader(elem, readerControl$language, id)
43 : feinerer 1306 filehash::dbInsert(db, meta(doc, "id"), doc)
44 :     if (x$length > 0) tdl[[counter]] <- meta(doc, "id")
45 :     else tdl <- c(tdl, meta(doc, "id"))
46 : feinerer 946 counter <- counter + 1
47 :     }
48 : feinerer 1306 if (!is.null(x$names) && !is.na(x$names))
49 :     names(tdl) <- x$names
50 : feinerer 63
51 : feinerer 946 df <- data.frame(MetaID = rep(0, length(tdl)), stringsAsFactors = FALSE)
52 : feinerer 1307 filehash::dbInsert(db, "CorpusDMeta", df)
53 :     dmeta.df <- data.frame(key = "CorpusDMeta", subset = I(list(NA)))
54 : feinerer 712
55 : feinerer 1307 .PCorpus(tdl, CorpusMeta(), dmeta.df, dbControl)
56 : feinerer 985 }
57 : feinerer 71
58 : khornik 1203 .VCorpus <-
59 : feinerer 1307 function(x, meta, dmeta)
60 :     structure(list(content = as.list(x), meta = meta, dmeta = dmeta),
61 :     class = c("VCorpus", "Corpus"))
62 : feinerer 21
63 : khornik 1203 VCorpus <-
64 :     Corpus <-
65 : feinerer 1306 function(x, readerControl = list(reader = x$defaultreader, language = "en"))
66 : khornik 1203 {
67 : feinerer 1297 stopifnot(inherits(x, "Source"))
68 : feinerer 1273
69 : feinerer 1306 readerControl <- prepareReader(readerControl, x$defaultreader)
70 : feinerer 49
71 : feinerer 1114 if (is.function(readerControl$init))
72 :     readerControl$init()
73 :    
74 :     if (is.function(readerControl$exit))
75 :     on.exit(readerControl$exit())
76 :    
77 : feinerer 946 # Allocate memory in advance if length is known
78 : feinerer 1306 tdl <- if (x$length > 0)
79 :     vector("list", as.integer(x$length))
80 : feinerer 946 else
81 :     list()
82 : feinerer 72
83 : feinerer 1306 if (x$vectorized)
84 : feinerer 1307 tdl <- mapply(function(elem, id)
85 :     readerControl$reader(elem, readerControl$language, id),
86 : feinerer 987 pGetElem(x),
87 : feinerer 1307 id = if (is.null(x$names) || is.na(x$names))
88 :     as.character(seq_len(x$length))
89 :     else x$names,
90 : feinerer 987 SIMPLIFY = FALSE)
91 : feinerer 946 else {
92 :     counter <- 1
93 : feinerer 985 while (!eoi(x)) {
94 :     x <- stepNext(x)
95 :     elem <- getElem(x)
96 : feinerer 1306 id <- if (is.null(x$names) || is.na(x$names))
97 : feinerer 1258 as.character(counter)
98 :     else
99 : feinerer 1306 x$names[counter]
100 : feinerer 1258 doc <- readerControl$reader(elem, readerControl$language, id)
101 : feinerer 1306 if (x$length > 0)
102 : feinerer 946 tdl[[counter]] <- doc
103 :     else
104 :     tdl <- c(tdl, list(doc))
105 :     counter <- counter + 1
106 :     }
107 :     }
108 : feinerer 1306 if (!is.null(x$names) && !is.na(x$names))
109 :     names(tdl) <- x$names
110 : feinerer 946 df <- data.frame(MetaID = rep(0, length(tdl)), stringsAsFactors = FALSE)
111 : feinerer 1307 .VCorpus(tdl, CorpusMeta(), df)
112 : feinerer 985 }
113 : feinerer 72
114 : khornik 1203 `[.PCorpus` <-
115 :     function(x, i)
116 :     {
117 : feinerer 1307 if (!missing(i)) {
118 :     x$content <- x$content[i]
119 :     index <- x$dmeta[[1 , "subset"]]
120 :     x$dmeta[[1 , "subset"]] <- if (is.numeric(index)) index[i] else i
121 :     }
122 :     x
123 : feinerer 946 }
124 : feinerer 72
125 : khornik 1203 `[.VCorpus` <-
126 :     function(x, i)
127 :     {
128 : feinerer 1307 if (!missing(i)) {
129 :     x$content <- x$content[i]
130 :     x$dmeta <- x$dmeta[i, , drop = FALSE]
131 :     }
132 :     x
133 : feinerer 985 }
134 : feinerer 49
135 : khornik 1203 `[<-.PCorpus` <-
136 :     function(x, i, value)
137 :     {
138 : feinerer 1307 db <- filehash::dbInit(x$dbcontrol[["dbName"]], x$dbcontrol[["dbType"]])
139 : feinerer 985 counter <- 1
140 : feinerer 1307 for (id in x$content[i]) {
141 :     db[[id]] <- if (identical(length(value), 1L))
142 :     value
143 :     else
144 :     value[[counter]]
145 : feinerer 985 counter <- counter + 1
146 : feinerer 829 }
147 : feinerer 985 x
148 : feinerer 828 }
149 :    
150 : khornik 1203 .map_name_index <-
151 :     function(x, i)
152 :     {
153 : feinerer 1307 if (is.character(i))
154 :     match(i, if (is.null(names(x))) meta(x, "id", "local") else names(x))
155 :     else
156 :     i
157 : feinerer 1108 }
158 :    
159 : khornik 1203 `[[.PCorpus` <-
160 :     function(x, i)
161 :     {
162 : feinerer 1108 i <- .map_name_index(x, i)
163 : feinerer 1307 db <- filehash::dbInit(x$dbcontrol[["dbName"]], x$dbcontrol[["dbType"]])
164 :     filehash::dbFetch(db, x$content[[i]])
165 : feinerer 985 }
166 : khornik 1203 `[[.VCorpus` <-
167 :     function(x, i)
168 :     {
169 : feinerer 1108 i <- .map_name_index(x, i)
170 : feinerer 985 lazyTmMap <- meta(x, tag = "lazyTmMap", type = "corpus")
171 :     if (!is.null(lazyTmMap))
172 :     .Call("copyCorpus", x, materialize(x, i))
173 : feinerer 1307 x$content[[i]]
174 : feinerer 985 }
175 : feinerer 886
176 : khornik 1203 `[[<-.PCorpus` <-
177 :     function(x, i, value)
178 :     {
179 : feinerer 1108 i <- .map_name_index(x, i)
180 : feinerer 1307 db <- filehash::dbInit(x$dbcontrol[["dbName"]], x$dbcontrol[["dbType"]])
181 :     db[[x$content[[i]]]] <- value
182 : feinerer 985 x
183 : feinerer 946 }
184 : khornik 1203 `[[<-.VCorpus` <-
185 :     function(x, i, value)
186 :     {
187 : feinerer 1108 i <- .map_name_index(x, i)
188 : feinerer 985 # Mark new objects as not active for lazy mapping
189 :     lazyTmMap <- meta(x, tag = "lazyTmMap", type = "corpus")
190 :     if (!is.null(lazyTmMap)) {
191 :     lazyTmMap$index[i] <- FALSE
192 :     meta(x, tag = "lazyTmMap", type = "corpus") <- lazyTmMap
193 :     }
194 : feinerer 1307 x$content[[i]] <- value
195 :     x
196 : feinerer 985 }
197 : feinerer 946
198 : feinerer 1004 # Update NodeIDs of a CMetaData tree
199 : khornik 1203 .update_id <-
200 :     function(x, id = 0, mapping = NULL, left.mapping = NULL, level = 0)
201 :     {
202 : feinerer 1004 # Traversal of (binary) CMetaData tree with setup of NodeIDs
203 : feinerer 985 set_id <- function(x) {
204 : feinerer 988 x$NodeID <- id
205 : feinerer 697 id <<- id + 1
206 :     level <<- level + 1
207 : feinerer 1285 if (length(x$Children)) {
208 : feinerer 988 mapping <<- cbind(mapping, c(x$Children[[1]]$NodeID, id))
209 :     left <- set_id(x$Children[[1]])
210 : feinerer 697 if (level == 1) {
211 :     left.mapping <<- mapping
212 :     mapping <<- NULL
213 :     }
214 : feinerer 988 mapping <<- cbind(mapping, c(x$Children[[2]]$NodeID, id))
215 :     right <- set_id(x$Children[[2]])
216 : feinerer 71
217 : feinerer 988 x$Children <- list(left, right)
218 : feinerer 71 }
219 : feinerer 697 level <<- level - 1
220 : feinerer 985 x
221 : feinerer 71 }
222 : feinerer 985 list(root = set_id(x), left.mapping = left.mapping, right.mapping = mapping)
223 : feinerer 71 }
224 :    
225 : feinerer 1004 # Find indices to be updated for a CMetaData tree
226 : khornik 1203 .find_indices <-
227 :     function(x)
228 :     {
229 : feinerer 1004 indices.mapping <- NULL
230 : feinerer 1307 for (m in levels(as.factor(CorpusDMeta(x)$MetaID))) {
231 :     indices <- (CorpusDMeta(x)$MetaID == m)
232 : feinerer 1004 indices.mapping <- c(indices.mapping, list(m = indices))
233 :     names(indices.mapping)[length(indices.mapping)] <- m
234 :     }
235 :     indices.mapping
236 :     }
237 :    
238 : feinerer 1307 #c2 <-
239 :     #function(x, y, ...)
240 :     #{
241 :     # # Update the CMetaData tree
242 :     # cmeta <- .MetaDataNode(0, list(merge_date = as.POSIXlt(Sys.time(), tz = "GMT"), merger = Sys.getenv("LOGNAME")), list(CMetaData(x), CMetaData(y)))
243 :     # update.struct <- .update_id(cmeta)
244 :     #
245 :     # new <- .VCorpus(c(unclass(x), unclass(y)), update.struct$root, NULL)
246 :     #
247 :     # # Find indices to be updated for the left tree
248 :     # indices.mapping <- .find_indices(x)
249 :     #
250 :     # # Update the CorpusDMeta data frames for the left tree
251 :     # for (i in 1:ncol(update.struct$left.mapping)) {
252 :     # map <- update.struct$left.mapping[,i]
253 :     # DMetaData(x)$MetaID <- replace(DMetaData(x)$MetaID, indices.mapping[[as.character(map[1])]], map[2])
254 :     # }
255 :     #
256 :     # # Find indices to be updated for the right tree
257 :     # indices.mapping <- .find_indices(y)
258 :     #
259 :     # # Update the CorpusDMeta data frames for the right tree
260 :     # for (i in 1:ncol(update.struct$right.mapping)) {
261 :     # map <- update.struct$right.mapping[,i]
262 :     # DMetaData(y)$MetaID <- replace(DMetaData(y)$MetaID, indices.mapping[[as.character(map[1])]], map[2])
263 :     # }
264 :     #
265 :     # # Merge the CorpusDMeta data frames
266 :     # labels <- setdiff(names(DMetaData(y)), names(DMetaData(x)))
267 :     # na.matrix <- matrix(NA,
268 :     # nrow = nrow(DMetaData(x)),
269 :     # ncol = length(labels),
270 :     # dimnames = list(row.names(DMetaData(x)), labels))
271 :     # x.dmeta.aug <- cbind(DMetaData(x), na.matrix)
272 :     # labels <- setdiff(names(DMetaData(x)), names(DMetaData(y)))
273 :     # na.matrix <- matrix(NA,
274 :     # nrow = nrow(DMetaData(y)),
275 :     # ncol = length(labels),
276 :     # dimnames = list(row.names(DMetaData(y)), labels))
277 :     # y.dmeta.aug <- cbind(DMetaData(y), na.matrix)
278 :     # DMetaData(new) <- rbind(x.dmeta.aug, y.dmeta.aug)
279 :     #
280 :     # new
281 :     #}
282 : feinerer 71
283 : feinerer 985 c.Corpus <-
284 : khornik 1203 function(..., recursive = FALSE)
285 : feinerer 985 {
286 :     args <- list(...)
287 : khornik 1203 x <- args[[1L]]
288 : feinerer 71
289 : khornik 1203 if(length(args) == 1L)
290 : feinerer 985 return(x)
291 : feinerer 71
292 : feinerer 985 if (!all(unlist(lapply(args, inherits, class(x)))))
293 :     stop("not all arguments are of the same corpus type")
294 : feinerer 71
295 : feinerer 985 if (inherits(x, "PCorpus"))
296 :     stop("concatenation of corpora with underlying databases is not supported")
297 : feinerer 689
298 : feinerer 1095 if (recursive)
299 : khornik 1203 Reduce(c2, args)
300 : feinerer 1095 else {
301 : feinerer 1308 args <- do.call("c", lapply(args, content))
302 : khornik 1203 .VCorpus(args,
303 : feinerer 1307 CorpusMeta(),
304 :     data.frame(MetaID = rep(0, length(args)),
305 :     stringsAsFactors = FALSE))
306 : feinerer 1095 }
307 : feinerer 985 }
308 : feinerer 54
309 : khornik 1203 c.TextDocument <-
310 :     function(..., recursive = FALSE)
311 :     {
312 : feinerer 985 args <- list(...)
313 : khornik 1203 x <- args[[1L]]
314 : feinerer 72
315 : khornik 1203 if(length(args) == 1L)
316 : feinerer 985 return(x)
317 : feinerer 72
318 : feinerer 985 if (!all(unlist(lapply(args, inherits, class(x)))))
319 :     stop("not all arguments are text documents")
320 : feinerer 54
321 : feinerer 1308 .VCorpus(args,
322 :     CorpusMeta(),
323 :     data.frame(MetaID = rep(0, length(args)),
324 :     stringsAsFactors = FALSE))
325 : feinerer 985 }
326 : feinerer 55
327 : feinerer 1307 content.Corpus <-
328 :     function(x)
329 :     x$content
330 :    
331 :     `content<-.Corpus` <-
332 :     function(x, value)
333 :     {
334 :     x$content <- value
335 :     x
336 :     }
337 :    
338 :     length.Corpus <-
339 :     function(x)
340 :     length(content(x))
341 :    
342 : khornik 1203 print.Corpus <-
343 :     function(x, ...)
344 :     {
345 : feinerer 985 cat(sprintf(ngettext(length(x),
346 : feinerer 1307 "A corpus with %d text document\n\n",
347 :     "A corpus with %d text documents\n\n"),
348 : feinerer 985 length(x)))
349 : feinerer 1307
350 :     meta <- meta(x, type = "corpus")$value
351 :     dmeta <- meta(x, type = "indexed")
352 :    
353 :     cat("Metadata:\n")
354 :     cat(sprintf(" Tag-value pairs. Tags: %s\n",
355 :     paste(names(meta), collapse = " ")))
356 :     cat(" Data frame. Variables:", colnames(dmeta), "\n")
357 :    
358 : feinerer 985 invisible(x)
359 :     }
360 :    
361 : khornik 1203 inspect <-
362 :     function(x)
363 :     UseMethod("inspect", x)
364 :     inspect.PCorpus <-
365 :     function(x)
366 :     {
367 : feinerer 1307 print(x)
368 : feinerer 938 cat("\n")
369 : feinerer 1307 db <- filehash::dbInit(x$dbcontrol[["dbName"]], x$dbcontrol[["dbType"]])
370 : feinerer 946 show(filehash::dbMultiFetch(db, unlist(x)))
371 : feinerer 1307 invisible(x)
372 : feinerer 938 }
373 : khornik 1203 inspect.VCorpus <-
374 :     function(x)
375 :     {
376 : feinerer 1307 print(x)
377 : feinerer 946 cat("\n")
378 : feinerer 1307 print(noquote(content(x)))
379 :     invisible(x)
380 : feinerer 946 }
381 : feinerer 65
382 : khornik 1203 lapply.PCorpus <-
383 :     function(X, FUN, ...)
384 :     {
385 : feinerer 1307 db <- filehash::dbInit(X$dbcontrol[["dbName"]], X$dbcontrol[["dbType"]])
386 :     lapply(filehash::dbMultiFetch(db, unlist(content(X))), FUN, ...)
387 : feinerer 985 }
388 : khornik 1203 lapply.VCorpus <-
389 :     function(X, FUN, ...)
390 :     {
391 : feinerer 985 lazyTmMap <- meta(X, tag = "lazyTmMap", type = "corpus")
392 :     if (!is.null(lazyTmMap))
393 :     .Call("copyCorpus", X, materialize(X))
394 : feinerer 1307 lapply(content(X), FUN, ...)
395 : feinerer 985 }
396 : feinerer 719
397 : khornik 1203 writeCorpus <-
398 :     function(x, path = ".", filenames = NULL)
399 :     {
400 : feinerer 985 filenames <- file.path(path,
401 : feinerer 1306 if (is.null(filenames))
402 :     sprintf("%s.txt", as.character(meta(x, "id", "local")))
403 :     else filenames)
404 :    
405 :     stopifnot(length(x) == length(filenames))
406 :    
407 :     mapply(function(doc, f) writeLines(as.character(doc), f), x, filenames)
408 :    
409 :     invisible(x)
410 : feinerer 985 }

R-Forge@R-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business University of Wisconsin - Madison Powered By FusionForge