| 3255 |
mrmanese |
1 |
#include "sqlite_dataframe.h"
|
|
|
2 |
|
|
|
3 |
SEXP sdf_get_variable(SEXP sdf, SEXP name) {
|
|
|
4 |
if (!IS_CHARACTER(name)) {
|
|
|
5 |
Rprintf("ERROR: argument is not a string.\n");
|
|
|
6 |
return R_NilValue;
|
|
|
7 |
}
|
|
|
8 |
|
|
|
9 |
char *iname = SDF_INAME(sdf);
|
|
|
10 |
char *varname = CHAR_ELT(name, 0);
|
|
|
11 |
|
|
|
12 |
/* check if sdf & varname w/in that sdf exists */
|
|
|
13 |
sqlite3_stmt *stmt;
|
|
|
14 |
sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data", varname, iname);
|
|
|
15 |
|
|
|
16 |
int res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
|
|
|
17 |
|
|
|
18 |
if (_sqlite_error(res)) { sqlite3_finalize(stmt); return R_NilValue; }
|
|
|
19 |
|
|
|
20 |
int sxptype;
|
|
|
21 |
const char *coltype = sqlite3_column_decltype(stmt, 0);
|
|
|
22 |
sqlite3_finalize(stmt);
|
|
|
23 |
|
|
|
24 |
|
|
|
25 |
SEXP ret, value, class; int nprotected = 0;
|
|
|
26 |
PROTECT(ret = NEW_LIST(2)); nprotected++;
|
|
|
27 |
|
|
|
28 |
/* set list names */
|
|
|
29 |
PROTECT(value = NEW_CHARACTER(2)); nprotected++;
|
|
|
30 |
SET_STRING_ELT(value, 0, mkChar("iname"));
|
|
|
31 |
SET_STRING_ELT(value, 1, mkChar("varname"));
|
|
|
32 |
SET_NAMES(ret, value);
|
|
|
33 |
|
|
|
34 |
/* set list values */
|
|
|
35 |
SET_VECTOR_ELT(ret, 0, mkString(iname));
|
|
|
36 |
SET_VECTOR_ELT(ret, 1, mkString(varname));
|
|
|
37 |
|
|
|
38 |
/* set class */
|
|
|
39 |
int type = -1;
|
|
|
40 |
if (strcmp(coltype, "text") == 0) class = mkChar("character");
|
|
|
41 |
else if (strcmp(coltype, "double") == 0) class = mkChar("numeric");
|
|
|
42 |
else if (strcmp(coltype, "bit") == 0) class = mkChar("logical");
|
|
|
43 |
else if (strcmp(coltype, "integer") == 0 || strcmp(coltype, "int") == 0) {
|
|
|
44 |
/* determine if int, factor or ordered */
|
|
|
45 |
type = _get_factor_levels1(iname, varname, ret);
|
|
|
46 |
switch(type) {
|
|
|
47 |
case VAR_INTEGER: class = mkChar("numeric"); break;
|
|
|
48 |
case VAR_FACTOR: class = mkChar("factor"); break;
|
|
|
49 |
case VAR_ORDERED: class = mkChar("ordered");
|
|
|
50 |
}
|
|
|
51 |
|
|
|
52 |
}
|
|
|
53 |
|
|
|
54 |
if (type != VAR_ORDERED) {
|
|
|
55 |
PROTECT(value = NEW_CHARACTER(2)); nprotected++;
|
|
|
56 |
SET_STRING_ELT(value, 0, mkChar("sqlite.vector"));
|
|
|
57 |
SET_STRING_ELT(value, 1, class);
|
|
|
58 |
} else {
|
|
|
59 |
PROTECT(value = NEW_CHARACTER(3)); nprotected++;
|
|
|
60 |
SET_STRING_ELT(value, 0, mkChar("sqlite.vector"));
|
|
|
61 |
SET_STRING_ELT(value, 1, class);
|
|
|
62 |
SET_STRING_ELT(value, 2, mkChar("factor"));
|
|
|
63 |
}
|
|
|
64 |
SET_CLASS(ret, value);
|
|
|
65 |
|
|
|
66 |
UNPROTECT(nprotected);
|
|
|
67 |
return ret;
|
|
|
68 |
|
|
|
69 |
}
|
|
|
70 |
|
|
|
71 |
int _get_vector_index_typed_result(sqlite3_stmt *stmt, SEXP *ret, int idx_or_len) {
|
|
|
72 |
int added = 1;
|
|
|
73 |
if (*ret == NULL || *ret == R_NilValue) {
|
|
|
74 |
const char *coltype = sqlite3_column_decltype(stmt, 0);
|
|
|
75 |
if (sqlite3_column_type(stmt, 0) == SQLITE_NULL) {
|
|
|
76 |
added = 0;
|
|
|
77 |
}
|
|
|
78 |
|
|
|
79 |
if (strcmp(coltype, "text") == 0) {
|
|
|
80 |
PROTECT(*ret = NEW_CHARACTER(idx_or_len));
|
|
|
81 |
if (added)
|
|
|
82 |
SET_STRING_ELT(*ret, 0, mkChar(sqlite3_column_text(stmt, 0)));
|
|
|
83 |
} else if (strcmp(coltype, "double") == 0) {
|
|
|
84 |
PROTECT(*ret = NEW_NUMERIC(idx_or_len));
|
|
|
85 |
if (added) REAL(*ret)[0] = sqlite3_column_double(stmt, 0);
|
|
|
86 |
} else if (strcmp(coltype, "bit") == 0) {
|
|
|
87 |
PROTECT(*ret = NEW_LOGICAL(idx_or_len));
|
|
|
88 |
if (added) INTEGER(*ret)[0] = sqlite3_column_int(stmt, 0);
|
|
|
89 |
} else if (strcmp(coltype, "integer") == 0 ||
|
|
|
90 |
strcmp(coltype, "int") == 0) {
|
|
|
91 |
/* caller should just copy off the vars level attr for factors */
|
|
|
92 |
PROTECT(*ret = NEW_INTEGER(idx_or_len));
|
|
|
93 |
if (added) INTEGER(*ret)[0] = sqlite3_column_int(stmt, 0);
|
|
|
94 |
} else added = 0;
|
|
|
95 |
|
|
|
96 |
UNPROTECT(1);
|
|
|
97 |
} else {
|
|
|
98 |
const char *coltype = sqlite3_column_decltype(stmt, 0);
|
|
|
99 |
if (sqlite3_column_type(stmt, 0) == SQLITE_NULL) {
|
|
|
100 |
added = 0;
|
|
|
101 |
} else if (strcmp(coltype, "text") == 0) {
|
|
|
102 |
SET_STRING_ELT(*ret, idx_or_len,
|
|
|
103 |
mkChar(sqlite3_column_text(stmt, 0)));
|
|
|
104 |
} else if (strcmp(coltype, "double") == 0) {
|
|
|
105 |
REAL(*ret)[idx_or_len] = sqlite3_column_double(stmt, 0);
|
|
|
106 |
} else if (strcmp(coltype, "bit") == 0) {
|
|
|
107 |
INTEGER(*ret)[idx_or_len] = sqlite3_column_int(stmt, 0);
|
|
|
108 |
} else if (strcmp(coltype, "integer") == 0 ||
|
|
|
109 |
strcmp(coltype, "int") == 0) {
|
|
|
110 |
/* caller should just copy off the vars level attr for factors */
|
|
|
111 |
INTEGER(*ret)[idx_or_len] = sqlite3_column_int(stmt, 0);
|
|
|
112 |
} else added = 0;
|
|
|
113 |
}
|
|
|
114 |
|
|
|
115 |
return added;
|
|
|
116 |
}
|
|
|
117 |
|
|
|
118 |
SEXP sdf_get_variable_length(SEXP svec) {
|
|
|
119 |
char *iname = SDF_INAME(svec);
|
|
|
120 |
sprintf(g_sql_buf[0], "[%s].sdf_data", iname);
|
|
|
121 |
|
|
|
122 |
SEXP ret;
|
|
|
123 |
PROTECT(ret = NEW_INTEGER(1));
|
|
|
124 |
INTEGER(ret)[0] = _get_row_count2(g_sql_buf[0]);
|
|
|
125 |
UNPROTECT(1);
|
|
|
126 |
return ret;
|
|
|
127 |
}
|
|
|
128 |
|
|
|
129 |
|
|
|
130 |
SEXP sdf_get_variable_index(SEXP svec, SEXP idx) {
|
|
|
131 |
SEXP ret = R_NilValue, tmp;
|
|
|
132 |
char *iname = SDF_INAME(svec), *varname = SVEC_VARNAME(svec);
|
|
|
133 |
int index, idxlen, i, retlen, res, nprotected = 0;
|
|
|
134 |
|
|
|
135 |
/* check if sdf exists */
|
|
|
136 |
sqlite3_stmt *stmt;
|
|
|
137 |
sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data", varname, iname);
|
|
|
138 |
res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
|
|
|
139 |
sqlite3_finalize(stmt);
|
|
|
140 |
if (_sqlite_error(res)) { return ret; }
|
|
|
141 |
|
|
|
142 |
idxlen = LENGTH(idx);
|
|
|
143 |
if (idxlen < 1) return ret;
|
|
|
144 |
|
|
|
145 |
sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data limit ?,1",
|
|
|
146 |
varname, iname);
|
|
|
147 |
res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
|
|
|
148 |
|
|
|
149 |
/* get data based on index */
|
|
|
150 |
if (IS_NUMERIC(idx)) {
|
|
|
151 |
index = ((int) REAL(idx)[0]) - 1;
|
|
|
152 |
if (index < 0 && idxlen == 1) return ret;
|
|
|
153 |
|
|
|
154 |
if (index > 0) {
|
|
|
155 |
sqlite3_bind_int(stmt, 1, index);
|
|
|
156 |
res = sqlite3_step(stmt);
|
|
|
157 |
if (res == SQLITE_ROW) {
|
|
|
158 |
retlen = _get_vector_index_typed_result(stmt, &ret, idxlen);
|
|
|
159 |
}
|
|
|
160 |
}
|
|
|
161 |
|
|
|
162 |
if (index <= 0 || res != SQLITE_ROW) {
|
|
|
163 |
/* something wrong w/ 1st idx, and it is quietly ignored. we make
|
|
|
164 |
* a "dummy" call to setup the SEXP */
|
|
|
165 |
sqlite3_bind_int(stmt, 1, 0);
|
|
|
166 |
_get_vector_index_typed_result(stmt, &ret, idxlen - 1);
|
|
|
167 |
retlen = 0;
|
|
|
168 |
}
|
|
|
169 |
|
|
|
170 |
if (idxlen > 1) {
|
|
|
171 |
for (i = 1; i < idxlen; i++) {
|
|
|
172 |
index = ((int) REAL(idx)[i]) - 1;
|
|
|
173 |
if (index < 0) continue;
|
|
|
174 |
sqlite3_reset(stmt);
|
|
|
175 |
sqlite3_bind_int(stmt, 1, index);
|
|
|
176 |
res = sqlite3_step(stmt);
|
|
|
177 |
if (res == SQLITE_ROW)
|
|
|
178 |
retlen += _get_vector_index_typed_result(stmt, &ret, retlen);
|
|
|
179 |
}
|
|
|
180 |
}
|
|
|
181 |
} else if (IS_INTEGER(idx)) {
|
|
|
182 |
/* similar to REAL (IS_NUMERIC) above, except that we don't have
|
|
|
183 |
* to cast idx to int. can't refactor this out, sucks. */
|
|
|
184 |
index = INTEGER(idx)[0] - 1;
|
|
|
185 |
if (index < 0 && idxlen == 1) return ret;
|
|
|
186 |
|
|
|
187 |
if (index > 0) {
|
|
|
188 |
sqlite3_bind_int(stmt, 1, index);
|
|
|
189 |
sqlite3_step(stmt);
|
|
|
190 |
retlen = _get_vector_index_typed_result(stmt, &ret, idxlen);
|
|
|
191 |
} else {
|
|
|
192 |
sqlite3_bind_int(stmt, 1, 0);
|
|
|
193 |
_get_vector_index_typed_result(stmt, &ret, idxlen - 1);
|
|
|
194 |
retlen = 0;
|
|
|
195 |
}
|
|
|
196 |
|
|
|
197 |
if (idxlen > 1) {
|
|
|
198 |
for (i = 1; i < idxlen; i++) {
|
|
|
199 |
index = INTEGER(idx)[i] - 1;
|
|
|
200 |
if (index < 0) continue;
|
|
|
201 |
sqlite3_reset(stmt);
|
|
|
202 |
sqlite3_bind_int(stmt, 1, index);
|
|
|
203 |
sqlite3_step(stmt);
|
|
|
204 |
retlen += _get_vector_index_typed_result(stmt, &ret, retlen);
|
|
|
205 |
}
|
|
|
206 |
}
|
|
|
207 |
|
|
|
208 |
} else if (IS_LOGICAL(idx)) {
|
|
|
209 |
/* have to deal with recycling */
|
|
|
210 |
sprintf(g_sql_buf[0], "[%s].sdf_data", iname);
|
|
|
211 |
int veclen = _get_row_count2(g_sql_buf[0]);
|
|
|
212 |
|
|
|
213 |
/* find if there is any TRUE element in the vector */
|
|
|
214 |
for (i = 0; i < idxlen; i++) {
|
|
|
215 |
if (LOGICAL(idx)[i]) {
|
|
|
216 |
sqlite3_bind_int(stmt, 1, i);
|
|
|
217 |
sqlite3_step(stmt);
|
|
|
218 |
/* there are at least (idxlen-i) TRUE per cycle of the LOGICAL
|
|
|
219 |
* index. there are at least (veclen/idxlen) cycles (int div).
|
|
|
220 |
* at the last cycle, if (veclen%idxlen > 0), there will be
|
|
|
221 |
* at least (veclen%idxlen - i) if veclen%idxlen > i */
|
|
|
222 |
retlen = (idxlen-i) * (veclen/idxlen);
|
|
|
223 |
if (veclen%idxlen > i) retlen += (veclen%idxlen - i);
|
|
|
224 |
|
|
|
225 |
/* create the vector */
|
|
|
226 |
retlen = _get_vector_index_typed_result(stmt, &ret, retlen);
|
|
|
227 |
break;
|
|
|
228 |
}
|
|
|
229 |
}
|
|
|
230 |
|
|
|
231 |
if (i < idxlen) {
|
|
|
232 |
for (i++; i < veclen; i++) {
|
|
|
233 |
if (LOGICAL(idx)[i%idxlen]) {
|
|
|
234 |
sqlite3_reset(stmt);
|
|
|
235 |
sqlite3_bind_int(stmt, 1, i);
|
|
|
236 |
sqlite3_step(stmt);
|
|
|
237 |
retlen += _get_vector_index_typed_result(stmt, &ret, retlen);
|
|
|
238 |
}
|
|
|
239 |
}
|
|
|
240 |
}
|
|
|
241 |
}
|
|
|
242 |
|
|
|
243 |
sqlite3_finalize(stmt);
|
|
|
244 |
|
|
|
245 |
if (ret != R_NilValue) {
|
|
|
246 |
ret = _shrink_vector(ret, retlen);
|
|
|
247 |
tmp = GET_LEVELS(svec);
|
|
|
248 |
if (tmp != R_NilValue) {
|
|
|
249 |
SET_LEVELS(ret, duplicate(tmp));
|
|
|
250 |
if (LENGTH(GET_CLASS(svec)) == 2) {
|
|
|
251 |
SET_CLASS(ret, mkString("factor"));
|
|
|
252 |
} else {
|
|
|
253 |
PROTECT(tmp = NEW_CHARACTER(2));
|
|
|
254 |
SET_STRING_ELT(tmp, 0, mkChar("ordered"));
|
|
|
255 |
SET_STRING_ELT(tmp, 1, mkChar("factor"));
|
|
|
256 |
UNPROTECT(1);
|
|
|
257 |
}
|
|
|
258 |
}
|
|
|
259 |
}
|
|
|
260 |
|
|
|
261 |
return ret;
|
|
|
262 |
}
|
|
|
263 |
|
|
|
264 |
|
|
|
265 |
|
|
|
266 |
|
The R Project SVN
R-packages