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 1460 - (view) (download)

1 : feinerer 17 # Author: Ingo Feinerer
2 :    
3 : feinerer 1440 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, "DirSource") || inherits(x, "VectorSource")) &&
11 :     identical(readerControl$reader, readPlain))
12 :     SimpleCorpus(x, readerControl)
13 :     else
14 :     VCorpus(x, readerControl)
15 :     }
16 :    
17 : khornik 1203 PCorpus <-
18 :     function(x,
19 : feinerer 1336 readerControl = list(reader = reader(x), language = "en"),
20 : feinerer 1259 dbControl = list(dbName = "", dbType = "DB1"))
21 : khornik 1203 {
22 : feinerer 1297 stopifnot(inherits(x, "Source"))
23 : feinerer 1273
24 : feinerer 1336 readerControl <- prepareReader(readerControl, reader(x))
25 : feinerer 63
26 : feinerer 946 if (!filehash::dbCreate(dbControl$dbName, dbControl$dbType))
27 :     stop("error in creating database")
28 :     db <- filehash::dbInit(dbControl$dbName, dbControl$dbType)
29 : feinerer 712
30 : feinerer 1397 x <- open(x)
31 : feinerer 1357 tdl <- vector("list", length(x))
32 : feinerer 946 counter <- 1
33 : feinerer 985 while (!eoi(x)) {
34 :     x <- stepNext(x)
35 :     elem <- getElem(x)
36 : feinerer 1376 doc <- readerControl$reader(elem,
37 :     readerControl$language,
38 :     as.character(counter))
39 : feinerer 1306 filehash::dbInsert(db, meta(doc, "id"), doc)
40 : feinerer 1336 tdl[[counter]] <- meta(doc, "id")
41 : feinerer 946 counter <- counter + 1
42 :     }
43 : feinerer 1397 x <- close(x)
44 : feinerer 63
45 : feinerer 1404 p <- list(content = tdl,
46 :     meta = CorpusMeta(),
47 :     dmeta = data.frame(row.names = seq_along(tdl)),
48 :     dbcontrol = dbControl)
49 :     class(p) <- c("PCorpus", "Corpus")
50 :     p
51 : feinerer 985 }
52 : feinerer 71
53 : feinerer 1437 SimpleCorpus <-
54 :     function(x, control = list(language = "en"))
55 :     {
56 :     stopifnot(inherits(x, "Source"))
57 :    
58 : feinerer 1440 if (!is.null(control$reader) && !identical(control$reader, readPlain))
59 : feinerer 1437 warning("custom reader is ignored")
60 :    
61 : feinerer 1460 content <- if (inherits(x, "VectorSource")) {
62 :     if (is.character(x$content)) x$content else as.character(x$content)
63 :     } else if (inherits(x, "DirSource")) {
64 : feinerer 1437 setNames(as.character(
65 :     lapply(x$filelist,
66 :     function(f) paste(readContent(f, x$encoding, "text"),
67 :     collapse = "\n"))
68 :     ),
69 :     basename(x$filelist))
70 :     } else
71 :     stop("unsupported source type")
72 :     s <- list(content = content,
73 :     meta = CorpusMeta(language = control$language),
74 :     dmeta = data.frame(row.names = seq_along(x)))
75 :     class(s) <- c("SimpleCorpus", "Corpus")
76 :     s
77 :     }
78 :    
79 : feinerer 1333 VCorpus <-
80 : feinerer 1336 function(x, readerControl = list(reader = reader(x), language = "en"))
81 : khornik 1203 {
82 : feinerer 1297 stopifnot(inherits(x, "Source"))
83 : feinerer 1273
84 : feinerer 1336 readerControl <- prepareReader(readerControl, reader(x))
85 : feinerer 49
86 : feinerer 1397 x <- open(x)
87 : feinerer 1357 tdl <- vector("list", length(x))
88 : feinerer 1336 # Check for parallel element access
89 :     if (is.function(getS3method("pGetElem", class(x), TRUE)))
90 : feinerer 1307 tdl <- mapply(function(elem, id)
91 : feinerer 1445 readerControl$reader(elem, readerControl$language, id),
92 : feinerer 987 pGetElem(x),
93 : feinerer 1376 id = as.character(seq_along(x)),
94 : feinerer 987 SIMPLIFY = FALSE)
95 : feinerer 946 else {
96 :     counter <- 1
97 : feinerer 985 while (!eoi(x)) {
98 :     x <- stepNext(x)
99 :     elem <- getElem(x)
100 : feinerer 1376 doc <- readerControl$reader(elem,
101 :     readerControl$language,
102 :     as.character(counter))
103 : feinerer 1336 tdl[[counter]] <- doc
104 : feinerer 946 counter <- counter + 1
105 :     }
106 :     }
107 : feinerer 1397 x <- close(x)
108 : feinerer 72
109 : feinerer 1409 as.VCorpus(tdl)
110 : feinerer 946 }
111 : feinerer 72
112 : feinerer 1315 `[.PCorpus` <-
113 : feinerer 1437 `[.SimpleCorpus` <-
114 : khornik 1203 function(x, i)
115 :     {
116 : feinerer 1307 if (!missing(i)) {
117 :     x$content <- x$content[i]
118 :     x$dmeta <- x$dmeta[i, , drop = FALSE]
119 :     }
120 :     x
121 : feinerer 985 }
122 : feinerer 1315 `[.VCorpus` <-
123 :     function(x, i)
124 :     {
125 :     if (!missing(i)) {
126 :     x$content <- x$content[i]
127 :     x$dmeta <- x$dmeta[i, , drop = FALSE]
128 :     if (!is.null(x$lazy))
129 :     x$lazy$index <- x$lazy$index[i]
130 :     }
131 :     x
132 :     }
133 :    
134 : khornik 1203 .map_name_index <-
135 :     function(x, i)
136 :     {
137 : feinerer 1376 if (is.character(i))
138 :     match(i, meta(x, "id", "local"))
139 :     else
140 : feinerer 1307 i
141 : feinerer 1108 }
142 :    
143 : khornik 1203 `[[.PCorpus` <-
144 :     function(x, i)
145 :     {
146 : feinerer 1108 i <- .map_name_index(x, i)
147 : feinerer 1307 db <- filehash::dbInit(x$dbcontrol[["dbName"]], x$dbcontrol[["dbType"]])
148 :     filehash::dbFetch(db, x$content[[i]])
149 : feinerer 985 }
150 : feinerer 1437 `[[.SimpleCorpus` <-
151 :     function(x, i)
152 :     {
153 :     i <- .map_name_index(x, i)
154 :     n <- names(x$content)
155 :     PlainTextDocument(x$content[[i]],
156 :     id = if (is.null(n)) i else n[i],
157 :     language = meta(x, "language"))
158 :     }
159 : khornik 1203 `[[.VCorpus` <-
160 :     function(x, i)
161 :     {
162 : feinerer 1108 i <- .map_name_index(x, i)
163 : feinerer 1315 if (!is.null(x$lazy))
164 :     .Call(copyCorpus, x, materialize(x, i))
165 : feinerer 1307 x$content[[i]]
166 : feinerer 985 }
167 : feinerer 886
168 : khornik 1203 `[[<-.PCorpus` <-
169 :     function(x, i, value)
170 :     {
171 : feinerer 1108 i <- .map_name_index(x, i)
172 : feinerer 1307 db <- filehash::dbInit(x$dbcontrol[["dbName"]], x$dbcontrol[["dbType"]])
173 :     db[[x$content[[i]]]] <- value
174 : feinerer 985 x
175 : feinerer 946 }
176 : khornik 1203 `[[<-.VCorpus` <-
177 :     function(x, i, value)
178 :     {
179 : feinerer 1108 i <- .map_name_index(x, i)
180 : feinerer 1315 # Mark new objects as inactive for lazy mapping
181 :     if (!is.null(x$lazy))
182 :     x$lazy$index[i] <- FALSE
183 : feinerer 1307 x$content[[i]] <- value
184 :     x
185 : feinerer 985 }
186 : feinerer 946
187 : feinerer 1350 as.list.PCorpus <- as.list.VCorpus <-
188 :     function(x, ...)
189 : feinerer 1411 setNames(content(x), as.character(lapply(content(x), meta, "id")))
190 : feinerer 1350
191 : feinerer 1437 as.list.SimpleCorpus <-
192 :     function(x, ...)
193 :     as.list(content(x))
194 :    
195 : feinerer 1350 as.VCorpus <-
196 :     function(x)
197 :     UseMethod("as.VCorpus")
198 :     as.VCorpus.VCorpus <- identity
199 : feinerer 1409 as.VCorpus.list <-
200 :     function(x)
201 :     {
202 :     v <- list(content = x,
203 :     meta = CorpusMeta(),
204 :     dmeta = data.frame(row.names = seq_along(x)))
205 :     class(v) <- c("VCorpus", "Corpus")
206 :     v
207 :     }
208 : feinerer 1350
209 : feinerer 1327 outer_union <-
210 :     function(x, y, ...)
211 :     {
212 :     if (nrow(x) > 0L)
213 :     x[, setdiff(names(y), names(x))] <- NA
214 :     if (nrow(y) > 0L)
215 :     y[, setdiff(names(x), names(y))] <- NA
216 :     res <- rbind(x, y)
217 :     if (ncol(res) == 0L)
218 :     res <- data.frame(row.names = seq_len(nrow(x) + nrow(y)))
219 :     res
220 :     }
221 : feinerer 71
222 : feinerer 1313 c.VCorpus <-
223 : khornik 1203 function(..., recursive = FALSE)
224 : feinerer 985 {
225 :     args <- list(...)
226 : khornik 1203 x <- args[[1L]]
227 : feinerer 71
228 : feinerer 1313 if (length(args) == 1L)
229 : feinerer 985 return(x)
230 : feinerer 71
231 : feinerer 985 if (!all(unlist(lapply(args, inherits, class(x)))))
232 :     stop("not all arguments are of the same corpus type")
233 : feinerer 71
234 : feinerer 1404 v <- list(content = do.call("c", lapply(args, content)),
235 :     meta = CorpusMeta(meta = do.call("c",
236 :     lapply(args, function(a) meta(a, type = "corpus")))),
237 :     dmeta = Reduce(outer_union, lapply(args, meta)))
238 :     class(v) <- c("VCorpus", "Corpus")
239 :     v
240 : feinerer 985 }
241 : feinerer 54
242 : feinerer 1313 content.VCorpus <-
243 : feinerer 1307 function(x)
244 : feinerer 1313 {
245 : feinerer 1315 if (!is.null(x$lazy))
246 :     .Call(copyCorpus, x, materialize(x))
247 : feinerer 1307 x$content
248 : feinerer 1313 }
249 : feinerer 1307
250 : feinerer 1437 content.SimpleCorpus <-
251 :     function(x)
252 :     x$content
253 :    
254 : feinerer 1313 content.PCorpus <-
255 :     function(x)
256 : feinerer 1307 {
257 : feinerer 1313 db <- filehash::dbInit(x$dbcontrol[["dbName"]], x$dbcontrol[["dbType"]])
258 :     filehash::dbMultiFetch(db, unlist(x$content))
259 : feinerer 1307 }
260 :    
261 : khornik 1203 inspect <-
262 :     function(x)
263 :     UseMethod("inspect", x)
264 : feinerer 1437 inspect.PCorpus <-
265 :     inspect.SimpleCorpus <-
266 :     inspect.VCorpus <-
267 : khornik 1203 function(x)
268 :     {
269 : feinerer 1307 print(x)
270 : feinerer 938 cat("\n")
271 : feinerer 1307 print(noquote(content(x)))
272 :     invisible(x)
273 : feinerer 946 }
274 : feinerer 65
275 : feinerer 1437 length.PCorpus <-
276 :     length.SimpleCorpus <-
277 :     length.VCorpus <-
278 : feinerer 1377 function(x)
279 :     length(x$content)
280 :    
281 : feinerer 1437 names.PCorpus <-
282 :     names.SimpleCorpus <-
283 :     names.VCorpus <-
284 : feinerer 1377 function(x)
285 :     as.character(meta(x, "id", "local"))
286 :    
287 : feinerer 1379 `names<-.PCorpus` <- `names<-.VCorpus` <-
288 :     function(x, value)
289 :     {
290 :     meta(x, "id", "local") <- as.character(value)
291 :     x
292 :     }
293 :    
294 : feinerer 1437 format.PCorpus <-
295 :     format.SimpleCorpus <-
296 :     format.VCorpus <-
297 : feinerer 1376 function(x, ...)
298 :     {
299 : feinerer 1419 c(sprintf("<<%s>>", class(x)[1L]),
300 :     sprintf("Metadata: corpus specific: %d, document level (indexed): %d",
301 :     length(meta(x, type = "corpus")),
302 :     ncol(meta(x, type = "indexed"))),
303 :     sprintf("Content: documents: %d", length(x)))
304 : feinerer 1376 }
305 :    
306 : khornik 1203 writeCorpus <-
307 :     function(x, path = ".", filenames = NULL)
308 :     {
309 : feinerer 985 filenames <- file.path(path,
310 : feinerer 1306 if (is.null(filenames))
311 :     sprintf("%s.txt", as.character(meta(x, "id", "local")))
312 :     else filenames)
313 :    
314 :     stopifnot(length(x) == length(filenames))
315 :    
316 :     mapply(function(doc, f) writeLines(as.character(doc), f), x, filenames)
317 :    
318 :     invisible(x)
319 : feinerer 985 }

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