SCM

SCM Repository

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

Annotation of /pkg/R/source.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1481 - (view) (download)

1 : feinerer 911 ## Author: Ingo Feinerer
2 :     ## Sources
3 : feinerer 689
4 : feinerer 1298 getSources <-
5 :     function()
6 : feinerer 1407 c("DataframeSource", "DirSource", "URISource", "VectorSource", "XMLSource",
7 :     "ZipSource")
8 : feinerer 848
9 : feinerer 1297 SimpleSource <-
10 : feinerer 1346 function(encoding = "",
11 : feinerer 1357 length = 0,
12 : feinerer 1257 position = 0,
13 : feinerer 1346 reader = readPlain,
14 : feinerer 1297 ...,
15 : feinerer 1257 class)
16 :     {
17 : feinerer 1346 if (!is.character(encoding))
18 :     stop("invalid encoding")
19 : feinerer 1357 if (!is.numeric(length) || (length < 0))
20 : feinerer 1346 stop("invalid length entry denoting the number of elements")
21 :     if (!is.numeric(position))
22 :     stop("invalid position")
23 : feinerer 1336 if (!is.function(reader))
24 : feinerer 1297 stop("invalid default reader")
25 :    
26 : feinerer 1404 s <- list(encoding = encoding, length = length,
27 :     position = position, reader = reader, ...)
28 :     class(s) <- unique(c(class, "SimpleSource", "Source"))
29 :     s
30 : feinerer 985 }
31 : feinerer 689
32 : feinerer 985 # A data frame where each row is interpreted as document
33 : feinerer 1297 DataframeSource <-
34 : feinerer 1334 function(x)
35 : feinerer 1481 {
36 :     stopifnot(all(c("doc_id", "text") %in% names(x)))
37 : feinerer 876
38 : feinerer 1481 SimpleSource(length = nrow(x), reader = readDataframe,
39 :     content = x, class = "DataframeSource")
40 :     }
41 :    
42 : feinerer 1336 # A directory with files interpreted as documents
43 : feinerer 1297 DirSource <-
44 : feinerer 1326 function(directory = ".", encoding = "", pattern = NULL,
45 : feinerer 1298 recursive = FALSE, ignore.case = FALSE, mode = "text")
46 :     {
47 :     if (!identical(mode, "text") &&
48 :     !identical(mode, "binary") &&
49 :     !identical(mode, ""))
50 :     stop(sprintf("invalid mode '%s'", mode))
51 :    
52 : feinerer 1297 d <- dir(directory, full.names = TRUE, pattern = pattern,
53 :     recursive = recursive, ignore.case = ignore.case)
54 : feinerer 1017
55 : feinerer 1285 if (!length(d))
56 : feinerer 1070 stop("empty directory")
57 : feinerer 1017
58 : feinerer 1252 isfile <- !file.info(d)[["isdir"]]
59 :     if (any(is.na(isfile)))
60 :     stop("non-existent or non-readable file(s): ",
61 :     paste(d[is.na(isfile)], collapse = " "))
62 : feinerer 985
63 : feinerer 1306 SimpleSource(encoding = encoding, length = sum(isfile),
64 : feinerer 1376 mode = mode, filelist = d[isfile], class = "DirSource")
65 : feinerer 946 }
66 : feinerer 689
67 : feinerer 1261 # Documents identified by a Uniform Resource Identifier
68 : feinerer 1297 URISource <-
69 : feinerer 1326 function(x, encoding = "", mode = "text")
70 : feinerer 1298 {
71 :     if (!identical(mode, "text") &&
72 :     !identical(mode, "binary") &&
73 :     !identical(mode, ""))
74 :     stop(sprintf("invalid mode '%s'", mode))
75 :    
76 : feinerer 1346 SimpleSource(encoding = encoding, length = length(x), mode = mode, uri = x,
77 : feinerer 1297 class = "URISource")
78 : feinerer 1298 }
79 : feinerer 874
80 : feinerer 1336 # A vector where each component is interpreted as document
81 :     VectorSource <-
82 :     function(x)
83 : feinerer 1390 SimpleSource(length = length(x), content = x, class = "VectorSource")
84 : feinerer 689
85 : feinerer 1336 XMLSource <-
86 :     function(x, parser, reader)
87 :     {
88 :     tree <- XML::xmlParse(x)
89 : feinerer 911 content <- parser(tree)
90 : feinerer 1179 XML::free(tree)
91 : feinerer 689
92 : feinerer 1346 SimpleSource(length = length(content), reader = reader, content = content,
93 : feinerer 1336 uri = x, class = "XMLSource")
94 : feinerer 911 }
95 : feinerer 689
96 : feinerer 1407 # A ZIP file with its compressed files interpreted as documents
97 :     ZipSource <-
98 :     function(zipfile, pattern = NULL, recursive = FALSE, ignore.case = FALSE,
99 :     mode = "text")
100 :     {
101 :     if (!identical(mode, "text") &&
102 :     !identical(mode, "binary") &&
103 :     !identical(mode, ""))
104 :     stop(sprintf("invalid mode '%s'", mode))
105 :    
106 :     SimpleSource(exdir = NULL,
107 :     files = NULL,
108 :     mode = mode,
109 :     pattern = pattern,
110 :     recursive = recursive,
111 :     ignore.case = ignore.case,
112 :     zipfile = zipfile,
113 :     class = "ZipSource")
114 :     }
115 :    
116 : feinerer 1303 # tau:::read_all_bytes
117 :     read_all_bytes <-
118 :     function(con, chunksize = 2 ^ 16)
119 :     {
120 : feinerer 1445 if (is.character(con)) {
121 : feinerer 1303 return(readBin(con, raw(), file.info(con)$size))
122 :     }
123 :    
124 : feinerer 1445 if (!isOpen(con)) {
125 : feinerer 1303 open(con, "rb")
126 :     on.exit(close(con))
127 :     }
128 :    
129 :     bytes <- list()
130 :     repeat {
131 :     chunk <- readBin(con, raw(), chunksize)
132 :     bytes <- c(bytes, list(chunk))
133 : feinerer 1445 if (length(chunk) < chunksize) break
134 : feinerer 1303 }
135 :    
136 :     unlist(bytes)
137 :     }
138 :    
139 : feinerer 1297 readContent <-
140 :     function(x, encoding, mode)
141 :     {
142 :     if (identical(mode, "text"))
143 : feinerer 1336 iconv(readLines(x, warn = FALSE), encoding, "UTF-8", "byte")
144 : feinerer 1303 else if (identical(mode, "binary"))
145 :     read_all_bytes(x)
146 : feinerer 1297 else if (identical(mode, ""))
147 :     NULL
148 : feinerer 1298 else
149 :     stop("invalid mode")
150 : feinerer 1297 }
151 :    
152 : feinerer 1397 open.SimpleSource <-
153 :     close.SimpleSource <-
154 : feinerer 1398 function(con, ...)
155 :     con
156 : feinerer 1407 open.ZipSource <-
157 : feinerer 1408 function(con, ...)
158 : feinerer 1407 {
159 : feinerer 1408 x <- con
160 : feinerer 1407 exdir <- tempfile("ZipSource")
161 :     dir.create(exdir, mode = "0700")
162 : feinerer 1397
163 : feinerer 1407 destfile <- x$zipfile
164 :    
165 :     if (!file.exists(destfile)) {
166 :     destfile <- tempfile()
167 :     download.file(x$zipfile, destfile)
168 :     on.exit(file.remove(destfile))
169 :     }
170 :    
171 :     files <- unzip(destfile, list = TRUE)
172 :     ## Directories have length 0
173 :     files <- files[files$Length > 0, "Name"]
174 :     ## Idea: Subdirectories contain file separators
175 :     if (!x$recursive)
176 :     files <- files[!grepl(.Platform$file.sep, files, fixed = TRUE)]
177 :     ## Idea: pattern and ignore.case refer to the file name (like basename)
178 :     ## Cf. also ?dir
179 :     if (!is.null(x$pattern))
180 :     files <- files[grepl(x$pattern, files, ignore.case = x$ignore.case)]
181 :    
182 :     unzip(destfile, files, exdir = exdir)
183 :    
184 :     x$exdir <- exdir
185 :     x$files <- files
186 :     x$length <- length(files)
187 :     x
188 :     }
189 :    
190 :     close.ZipSource <-
191 : feinerer 1408 function(con, ...)
192 : feinerer 1407 {
193 : feinerer 1408 x <- con
194 : feinerer 1407 if (!is.null(x$exdir)) {
195 :     unlink(x$exdir, recursive = TRUE)
196 :     x$exdir <- NULL
197 :     x$files <- NULL
198 :     x$length <- 0
199 :     }
200 :     x
201 :     }
202 :    
203 : feinerer 1336 eoi <-
204 :     function(x)
205 :     UseMethod("eoi", x)
206 :     eoi.SimpleSource <-
207 :     function(x)
208 :     x$length <= x$position
209 :    
210 : feinerer 1376 getElem <-
211 :     function(x)
212 :     UseMethod("getElem", x)
213 : feinerer 1297 getElem.DataframeSource <-
214 :     function(x)
215 : feinerer 1306 list(content = x$content[x$position, ],
216 : feinerer 1297 uri = NULL)
217 :     getElem.DirSource <-
218 :     function(x)
219 :     {
220 : feinerer 1306 filename <- x$filelist[x$position]
221 :     list(content = readContent(filename, x$encoding, x$mode),
222 : feinerer 1407 uri = paste0("file://", filename))
223 : feinerer 985 }
224 : feinerer 1261 getElem.URISource <-
225 : feinerer 1297 function(x)
226 : feinerer 1306 list(content = readContent(x$uri[x$position], x$encoding, x$mode),
227 :     uri = x$uri[x$position])
228 : feinerer 1297 getElem.VectorSource <-
229 :     function(x)
230 : feinerer 1306 list(content = x$content[x$position],
231 : feinerer 1297 uri = NULL)
232 :     getElem.XMLSource <-
233 :     function(x)
234 : feinerer 1306 list(content = XML::saveXML(x$content[[x$position]]),
235 :     uri = x$uri)
236 : feinerer 1407 getElem.ZipSource <-
237 :     function(x)
238 :     {
239 :     path <- file.path(x$exdir, x$files[x$position])
240 :     list(content = readContent(path, x$encoding, x$mode),
241 :     uri = paste0("file://", path))
242 :     }
243 : feinerer 689
244 : feinerer 1481 getMeta <-
245 :     function(x)
246 :     UseMethod("getMeta", x)
247 :     getMeta.DataframeSource <-
248 :     function(x)
249 :     list(cmeta = NULL,
250 :     dmeta = x$content[, !names(x$content) %in% c("doc_id", "text")])
251 : feinerer 1407
252 : feinerer 1481
253 : feinerer 1336 length.SimpleSource <-
254 :     function(x)
255 :     x$length
256 :    
257 : feinerer 1376 pGetElem <-
258 : feinerer 1336 function(x)
259 : feinerer 1376 UseMethod("pGetElem", x)
260 : feinerer 1461
261 : feinerer 1297 pGetElem.DataframeSource <-
262 :     function(x)
263 : feinerer 1306 lapply(seq_len(x$length),
264 : feinerer 1445 function(y) list(content = x$content[y, ],
265 : feinerer 1297 uri = NULL))
266 : feinerer 1461 `[.DataframeSource` <- function(x, i, j, ...) x$content[i, j, ...]
267 :     `[[.DataframeSource` <- function(x, ...) x$content[[...]]
268 :    
269 : feinerer 1297 pGetElem.DirSource <-
270 :     function(x)
271 : feinerer 1306 lapply(x$filelist,
272 :     function(f) list(content = readContent(f, x$encoding, x$mode),
273 : feinerer 1407 uri = paste0("file://", f)))
274 : feinerer 1461 `[.DirSource` <- function(x, i, ...) x$filelist[i, ...]
275 :     `[[.DirSource` <- function(x, i, ...) x$filelist[[i, ...]]
276 :    
277 : feinerer 1297 pGetElem.URISource <-
278 :     function(x)
279 : feinerer 1306 lapply(x$uri,
280 :     function(uri) list(content = readContent(uri, x$encoding, x$mode),
281 : feinerer 1297 uri = uri))
282 : feinerer 1461 `[.URISource` <- function(x, i, ...) x$uri[i, ...]
283 :     `[[.URISource` <- function(x, i, ...) x$uri[[i, ...]]
284 :    
285 : feinerer 1297 pGetElem.VectorSource <-
286 :     function(x)
287 : feinerer 1306 lapply(x$content,
288 : feinerer 1297 function(y) list(content = y,
289 :     uri = NULL))
290 : feinerer 1461 `[.VectorSource` <- function(x, i, ...) x$content[i, ...]
291 :     `[[.VectorSource` <- function(x, i, ...) x$content[[i, ...]]
292 :    
293 : feinerer 1407 pGetElem.ZipSource <-
294 :     function(x)
295 :     lapply(file.path(x$exdir, x$files),
296 :     function(f) list(content = readContent(f, x$encoding, x$mode),
297 : feinerer 1408 uri = paste0("file://", f)))
298 : feinerer 909
299 : feinerer 1336 reader <-
300 : feinerer 1307 function(x)
301 : feinerer 1336 UseMethod("reader", x)
302 :     reader.SimpleSource <-
303 : feinerer 1307 function(x)
304 : feinerer 1336 x$reader
305 :    
306 :     stepNext <-
307 :     function(x)
308 :     UseMethod("stepNext", x)
309 :     stepNext.SimpleSource <-
310 :     function(x)
311 :     {
312 :     x$position <- x$position + 1
313 :     x
314 :     }

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