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

1 : feinerer 911 ## Author: Ingo Feinerer
2 :     ## Sources
3 : feinerer 689
4 : feinerer 1298 getSources <-
5 :     function()
6 : feinerer 1336 c("DataframeSource", "DirSource", "URISource", "VectorSource", "XMLSource")
7 : feinerer 848
8 : feinerer 1297 SimpleSource <-
9 : feinerer 1346 function(encoding = "",
10 : feinerer 1257 length = NA_integer_,
11 :     names = NA_character_,
12 :     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 :     if (!is.integer(length))
20 :     stop("invalid length entry denoting the number of elements")
21 :     if (!is.character(names) && !is.null(names))
22 :     stop("invalid element names")
23 :     if (!is.null(names) && !is.na(names) && (length != length(names)))
24 :     stop("incorrect number of element names")
25 :     if (!is.numeric(position))
26 :     stop("invalid position")
27 : feinerer 1336 if (!is.function(reader))
28 : feinerer 1297 stop("invalid default reader")
29 :    
30 : feinerer 1346 structure(list(encoding = encoding, length = length, names = names,
31 :     position = position, reader = reader, ...),
32 : feinerer 1297 class = unique(c(class, "SimpleSource", "Source")))
33 : feinerer 985 }
34 : feinerer 689
35 : feinerer 985 # A data frame where each row is interpreted as document
36 : feinerer 1297 DataframeSource <-
37 : feinerer 1334 function(x)
38 :     SimpleSource(length = nrow(x), names = row.names(x),
39 : feinerer 1306 content = if (is.factor(x)) as.character(x) else x,
40 : feinerer 1297 class = "DataframeSource")
41 : feinerer 876
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 :     names = basename(d[isfile]), mode = mode,
65 :     filelist = d[isfile], class = "DirSource")
66 : feinerer 946 }
67 : feinerer 689
68 : feinerer 1261 # Documents identified by a Uniform Resource Identifier
69 : feinerer 1297 URISource <-
70 : feinerer 1326 function(x, encoding = "", mode = "text")
71 : feinerer 1298 {
72 :     if (!identical(mode, "text") &&
73 :     !identical(mode, "binary") &&
74 :     !identical(mode, ""))
75 :     stop(sprintf("invalid mode '%s'", mode))
76 :    
77 : feinerer 1346 SimpleSource(encoding = encoding, length = length(x), mode = mode, uri = x,
78 : feinerer 1297 class = "URISource")
79 : feinerer 1298 }
80 : feinerer 874
81 : feinerer 1336 # A vector where each component is interpreted as document
82 :     VectorSource <-
83 :     function(x)
84 :     SimpleSource(length = length(x), names = names(x),
85 :     content = if (is.factor(x)) as.character(x) else x,
86 :     class = "VectorSource")
87 : feinerer 689
88 : feinerer 1336 XMLSource <-
89 :     function(x, parser, reader)
90 :     {
91 :     tree <- XML::xmlParse(x)
92 : feinerer 911 content <- parser(tree)
93 : feinerer 1179 XML::free(tree)
94 : feinerer 689
95 : feinerer 1346 SimpleSource(length = length(content), reader = reader, content = content,
96 : feinerer 1336 uri = x, class = "XMLSource")
97 : feinerer 911 }
98 : feinerer 689
99 : feinerer 1303 # tau:::read_all_bytes
100 :     read_all_bytes <-
101 :     function(con, chunksize = 2 ^ 16)
102 :     {
103 :     if(is.character(con)) {
104 :     return(readBin(con, raw(), file.info(con)$size))
105 :     }
106 :    
107 :     if(!isOpen(con)) {
108 :     open(con, "rb")
109 :     on.exit(close(con))
110 :     }
111 :    
112 :     bytes <- list()
113 :     repeat {
114 :     chunk <- readBin(con, raw(), chunksize)
115 :     bytes <- c(bytes, list(chunk))
116 :     if(length(chunk) < chunksize) break
117 :     }
118 :    
119 :     unlist(bytes)
120 :     }
121 :    
122 : feinerer 1297 readContent <-
123 :     function(x, encoding, mode)
124 :     {
125 :     if (identical(mode, "text"))
126 : feinerer 1336 iconv(readLines(x, warn = FALSE), encoding, "UTF-8", "byte")
127 : feinerer 1303 else if (identical(mode, "binary"))
128 :     read_all_bytes(x)
129 : feinerer 1297 else if (identical(mode, ""))
130 :     NULL
131 : feinerer 1298 else
132 :     stop("invalid mode")
133 : feinerer 1297 }
134 :    
135 : feinerer 1336 eoi <-
136 :     function(x)
137 :     UseMethod("eoi", x)
138 :     eoi.SimpleSource <-
139 :     function(x)
140 :     x$length <= x$position
141 :    
142 : feinerer 985 getElem <- function(x) UseMethod("getElem", x)
143 : feinerer 1297 getElem.DataframeSource <-
144 :     function(x)
145 : feinerer 1306 list(content = x$content[x$position, ],
146 : feinerer 1297 uri = NULL)
147 :     getElem.DirSource <-
148 :     function(x)
149 :     {
150 : feinerer 1306 filename <- x$filelist[x$position]
151 :     list(content = readContent(filename, x$encoding, x$mode),
152 : feinerer 1297 uri = sprintf("file://%s", filename))
153 : feinerer 985 }
154 : feinerer 1261 getElem.URISource <-
155 : feinerer 1297 function(x)
156 : feinerer 1306 list(content = readContent(x$uri[x$position], x$encoding, x$mode),
157 :     uri = x$uri[x$position])
158 : feinerer 1297 getElem.VectorSource <-
159 :     function(x)
160 : feinerer 1306 list(content = x$content[x$position],
161 : feinerer 1297 uri = NULL)
162 :     getElem.XMLSource <-
163 :     function(x)
164 : feinerer 1306 list(content = XML::saveXML(x$content[[x$position]]),
165 :     uri = x$uri)
166 : feinerer 689
167 : feinerer 1336 length.SimpleSource <-
168 :     function(x)
169 :     x$length
170 :    
171 :     names.SimpleSource <-
172 :     function(x)
173 :     x$names
174 :    
175 : feinerer 985 pGetElem <- function(x) UseMethod("pGetElem", x)
176 : feinerer 1297 pGetElem.DataframeSource <-
177 :     function(x)
178 : feinerer 1306 lapply(seq_len(x$length),
179 :     function(y) list(content = x$content[y,],
180 : feinerer 1297 uri = NULL))
181 :     pGetElem.DirSource <-
182 :     function(x)
183 : feinerer 1306 lapply(x$filelist,
184 :     function(f) list(content = readContent(f, x$encoding, x$mode),
185 : feinerer 1297 uri = sprintf("file://%s", f)))
186 :     pGetElem.URISource <-
187 :     function(x)
188 : feinerer 1306 lapply(x$uri,
189 :     function(uri) list(content = readContent(uri, x$encoding, x$mode),
190 : feinerer 1297 uri = uri))
191 :     pGetElem.VectorSource <-
192 :     function(x)
193 : feinerer 1306 lapply(x$content,
194 : feinerer 1297 function(y) list(content = y,
195 :     uri = NULL))
196 : feinerer 909
197 : feinerer 1336 reader <-
198 : feinerer 1307 function(x)
199 : feinerer 1336 UseMethod("reader", x)
200 :     reader.SimpleSource <-
201 : feinerer 1307 function(x)
202 : feinerer 1336 x$reader
203 :    
204 :     stepNext <-
205 :     function(x)
206 :     UseMethod("stepNext", x)
207 :     stepNext.SimpleSource <-
208 :     function(x)
209 :     {
210 :     x$position <- x$position + 1
211 :     x
212 :     }

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