Compare `836bd9d ... +8 ... 5e8a5a8`

1	+	# lazyvec - R package for creating, testing and deploying custom ALTREP vectors
2	+	#
3	+	# Copyright (C) 2019-present, Mark AJ Klik
4	+	#
5	+	# This file is part of the lazyvec R package.
6	+	#
7	+	# The lazyvec R package is free software: you can redistribute it and/or modify it
8	+	# under the terms of the GNU Affero General Public License version 3 as
9	+	# published by the Free Software Foundation.
10	+	#
11	+	# The lazyvec R package is distributed in the hope that it will be useful, but
12	+	# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13	+	# FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License
14	+	# for more details.
15	+	#
16	+	# You should have received a copy of the GNU Affero General Public License along
17	+	# with the lazyvec R package. If not, see <http://www.gnu.org/licenses/>.
18	+	#
19	+	# You can contact the author at:
20	+	# - lazyvec R package source repository : https://github.com/fstpackage/lazyvec
21	+
22	+
23	+	#' Diagnostic methods to check boundaries and validity of return values of the
24	+	#' user lazyvecdefined API,
25	+	#'
26	+	#' @return list of diagnostic functions
27	+	diagnostics <- function() {
28	+	list(
29	+	diagnostic_length,
30	+	NULL, # diagnostic_dataptr_or_null
31	+	diagnostic_get_region,
32	+	diagnostic_element,
33	+	diagnostic_full_vec,
34	+	diagnostic_is_sorted,
35	+	diagnostic_no_na,
36	+	diagnostic_sum,
37	+	diagnostic_min,
38	+	diagnostic_max,
39	+	diagnostic_inspect,
40	+	diagnostic_unserialize_ex,
41	+	diagnostic_serialized_state,
42	+	diagnostic_duplicate_ex,
43	+	diagnostic_coerce,
44	+	diagnostic_extract_subset
45	+	)
46	+	}
47	+
48	+
49	+	user_method_length <- 1
50	+	user_method_dataptr_or_null <- 2
51	+	user_method_get_region <- 3
52	+	user_method_element <- 4
53	+	user_method_full_vec <- 5
54	+	user_method_is_sorted <- 6
55	+	user_method_no_na <- 7
56	+	user_method_sum <- 8
57	+	user_method_min <- 9
58	+	user_method_max <- 10
59	+	user_method_inspect <- 11
60	+	user_method_unserialize_ex <- 12
61	+	user_method_serialized_state <- 13
62	+	user_method_duplicate_ex <- 14
63	+	user_method_coerce <- 15
64	+	user_method_extract_subset <- 16
65	+
66	+
67	+	run_user_method <- function(x, method_id) {
68	+
69	+	# run user method
70	+	result <- tryCatch(
71	+	x$user_methods[[method_id]](x$user_data),
72	+	error = function(e) { e }, # nolint
73	+	warning = function(w) { w } # nolint
74	+	)
75	+
76	+	if (is(result, "error")) stop("Error detected in user method: ", result$message)
77	+
78	+	if (is(result, "warning")) stop("Warning detected in user method: ", result$message)
79	+
80	+	result
81	+	}
82	+
83	+
84	+	run_user_method2 <- function(method_id, x, arg2) {
85	+
86	+	# run user method
87	+	result <- tryCatch(
88	+	x$user_methods[[method_id]](x$user_data, arg2),
89	+	error = function(e) { e }, # nolint
90	+	warning = function(w) { w } # nolint
91	+	)
92	+
93	+	if (is(result, "error")) stop("Error detected in user method: ", result$message)
94	+
95	+	if (is(result, "warning")) stop("Warning detected in user method: ", result$message)
96	+
97	+	result
98	+	}
99	+
100	+
101	+	run_user_method3 <- function(method_id, x, arg2, arg3) {
102	+
103	+	# run user method
104	+	result <- tryCatch(
105	+	x$user_methods[[method_id]](x$user_data, arg2, arg3),
106	+	error = function(e) { e }, # nolint
107	+	warning = function(w) { w } # nolint
108	+	)
109	+
110	+	if (is(result, "error")) stop("Error detected in user method: ", result$message)
111	+
112	+	if (is(result, "warning")) stop("Warning detected in user method: ", result$message)
113	+
114	+	result
115	+	}
116	+
117	+
118	+	check_type <- function(x, result, method_name) {
119	+	if (typeof(result) != x$vec_type) stop("Method ", method_name, " generated a vector of type '",
120	+	typeof(result), "', but the lazyvec is of type '", x$vec_type, "'")
121	+	}
122	+
123	+
124	+	check_length <- function(x, result, method_name) {
125	+	vec_length <- run_user_method(x, user_method_length)
126	+
127	+	if (vec_length != length(result)) stop("Method ", method_name, " generated a result of length ",
128	+	length(result), " while method length() says the length should be ", vec_length)
129	+	}
130	+
131	+
132	+	diagnostic_length <- function(x) {
133	+
134	+	result <- run_user_method(x, user_method_length)
135	+
136	+	if (length(result) != 1) stop("Length method should return a length 1 integer vector")
137	+
138	+	if (typeof(result) != "integer") stop("Length method should return an integer vector, not a ", typeof(result))
139	+
140	+	# report result
141	+	cat(crayon::italic(
142	+	crayon::cyan(x$vec_id, ": length : result = ")),
143	+	display_parameter(result), "\n", sep = "")
144	+
145	+	result
146	+	}
147	+
148	+
149	+	diagnostic_full_vec <- function(x) {
150	+
151	+	result <- run_user_method(x, user_method_full_vec)
152	+
153	+	check_type(x, result, "full_vec")
154	+
155	+	check_length(x, result, "full_vec")
156	+
157	+	cat(crayon::italic(
158	+	crayon::cyan(x$vec_id, "lazyvec full_vec result = ")),
159	+	display_parameter(result), "\n", sep = "")
160	+
161	+	result
162	+	}
163	+
164	+
165	+	diagnostic_inspect <- function(x) {
166	+
167	+	cat(crayon::italic(
168	+	crayon::cyan(x$vec_id, " inspect: result = ")),
169	+	display_parameter(x[[1]]),
170	+	crayon::italic(crayon::cyan(", pre =")),
171	+	display_parameter(x[[2]]),
172	+	crayon::italic(crayon::cyan(", deep =")),
173	+	display_parameter(x[[3]]),
174	+	crayon::italic(crayon::cyan(", pVec =")),
175	+	display_parameter(x[[4]]), "\n", sep = "")
176	+	}
177	+
178	+
179	+	diagnostic_element <- function(x, i) {
180	+
181	+	result <- run_user_method2(user_method_element, x, i)
182	+
183	+	check_type(x, result, "element")
184	+
185	+	vec_length <- run_user_method(x, user_method_length)
186	+
187	+	if (i > vec_length) warning("Method element called with index larger than length()")
188	+
189	+	cat(crayon::italic(
190	+	crayon::cyan(x$vec_id, ": element : result = ")),
191	+	display_parameter(result), "\n", sep = "")
192	+
193	+	result
194	+	}
195	+
196	+
197	+	diagnostic_get_region <- function(x, i, n) {
198	+
199	+	result <- run_user_method3(user_method_get_region, x, i, n)
200	+
201	+	check_type(x, result, "get_region")
202	+
203	+	vec_length <- run_user_method(x, user_method_length)
204	+
205	+	if (i > vec_length) warning("Method element called with index larger than length()")
206	+
207	+	if (i + n > vec_length) warning("Method element called with range outside the vector")
208	+
209	+	cat(crayon::italic(
210	+	crayon::cyan(x$vec_id, ": get_region : result = ")),
211	+	display_parameter(result), "\n", sep = "")
212	+
213	+	result
214	+	}
215	+
216	+
217	+	diagnostic_is_sorted <- function(x) {
218	+	cat(crayon::italic(crayon::cyan(" is_sorted: result = ")),
219	+	display_parameter(x == 1), "\n", sep = "")
220	+	}
221	+
222	+
223	+	diagnostic_no_na <- function(x) {
224	+	cat(crayon::italic(crayon::cyan(" no_na: result = ")),
225	+	display_parameter(x == 1), "\n", sep = "")
226	+	}
227	+
228	+
229	+	diagnostic_sum <- function(x) {
230	+	cat(crayon::italic(crayon::cyan(" sum: na.rm = ")),
231	+	display_parameter(x[[2]] == 1),
232	+	crayon::italic(crayon::cyan(", result: ")),
233	+	display_parameter(x[[1]]), "\n", sep = "")
234	+	}
235	+
236	+
237	+	diagnostic_min <- function(x) {
238	+	cat(crayon::italic(
239	+	crayon::cyan(x[[1]], ": min: result = ")),
240	+	display_parameter(x[[2]]), "\n", sep = "")
241	+	}
242	+
243	+
244	+	diagnostic_max <- function(x) {
245	+	cat(crayon::italic(crayon::cyan(" max: result = ")),
246	+	display_parameter(x), "\n", sep = "")
247	+	}
248	+
249	+
250	+	diagnostic_serialized_state <- function(x) {
251	+	cat(crayon::italic(crayon::cyan(" serialized_state: result = ")),
252	+	display_parameter(x), "\n", sep = "")
253	+	}
254	+
255	+
256	+	diagnostic_unserialize_ex <- function(x) {
257	+	cat(crayon::italic(crayon::cyan(" unserialize_ex: altwrap_class = ")),
258	+	display_parameter(x[[1]]),
259	+	crayon::italic(crayon::cyan(", state =")),
260	+	display_parameter(x[[2]]),
261	+	crayon::italic(crayon::cyan(", attr =")),
262	+	display_parameter(x[[3]]),
263	+	crayon::italic(crayon::cyan(", objf =")),
264	+	display_parameter(x[[4]]),
265	+	crayon::italic(crayon::cyan(", levs =")),
266	+	display_parameter(x[[5]]))
267	+	}
268	+
269	+
270	+	diagnostic_unserialize <- function(x) {
271	+	cat(crayon::italic(crayon::cyan(" unserialize_ex: altwrap_class = ")),
272	+	display_parameter(x[[1]]),
273	+	crayon::italic(crayon::cyan(", state =")),
274	+	display_parameter(x[[2]]))
275	+	}
276	+
277	+
278	+	diagnostic_duplicate_ex <- function(x) {
279	+	cat(crayon::italic(crayon::cyan(" duplicate_ex: result = ?")),
280	+	# crayon::italic(crayon::cyan(", altwrap_class = ")),
281	+	# display_parameter(x[[1]]),
282	+	# crayon::italic(crayon::cyan(", state = ")),
283	+	# display_parameter(x[[2]]),
284	+	# crayon::italic(crayon::cyan(", attr = ")),
285	+	# display_parameter(x[[3]]),
286	+	# crayon::italic(crayon::cyan(", objf = ")),
287	+	# display_parameter(x[[4]]),
288	+	crayon::italic(crayon::cyan(", levs =")),
289	+	display_parameter(x[[5]]))
290	+	}
291	+
292	+
293	+	diagnostic_coerce <- function(x) {
294	+	cat(crayon::italic(crayon::cyan("coerce: result = ")),
295	+	display_parameter(x), "\n", sep = "")
296	+	}
297	+
298	+
299	+	diagnostic_extract_subset <- function(x) {
300	+	subset_result <- x[[1]]
301	+	if (is.null(subset_result)) subset_result <- "NULL"
302	+	cat(crayon::italic(crayon::cyan("extract_subset: result = ")),
303	+	display_parameter(subset_result),
304	+	crayon::italic(crayon::cyan(", indx =")),
305	+	display_parameter(x[[2]]),
306	+	crayon::italic(crayon::cyan(", call =")),
307	+	display_parameter(str(x[[3]])),
308	+	"\n", sep = "")
309	+	}

@@ -43,7 +43,7 @@

  SEXP user_data = PROTECT(LAZYVEC_USER_DATA(x));

  // length listener method
  SEXP length_listener = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(x), LAZYVEC_METHOD_LENGTH));
  SEXP length_listener = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(x), LAZYVEC_METHOD_LENGTH));

  SEXP custom_length = PROTECT(call_r_interface(length_listener, user_data, LAZYVEC_PACKAGE_ENV(x)));
  

@@ -56,86 +56,6 @@

}


//
// On Win there is no Unserialize method exported, check with R-dev!
//
static SEXP lazyvec_string_Unserialize_method(SEXP lazyvec_class, SEXP state)
{
  Rcpp::Environment pkgs = Rcpp::Environment::namespace_env("lazyvec");

  SEXP altrep_data1 = PROTECT(Rf_allocVector(VECSXP, 4));
  SET_VECTOR_ELT(altrep_data1, 0, VECTOR_ELT(state, 0));
  SET_VECTOR_ELT(altrep_data1, 1, VECTOR_ELT(state, 1));
  SET_VECTOR_ELT(altrep_data1, 2, VECTOR_ELT(state, 2));
  SET_VECTOR_ELT(altrep_data1, 3, pkgs);

  // unserialize listener method
  // SEXP unserialize_listener = PROTECT(VECTOR_ELT(VECTOR_ELT(state, 1), LAZYVEC_METHOD_UNSERIALIZE));
  
  // call_r_interface(unserialize_listener, state, LAZYVEC_PACKAGE_ENV(altrep_data1));

  // UNPROTECT(2);
  UNPROTECT(1);
  return lazyvec_string_wrapper(altrep_data1);
}


//
// ALTREP_UNSERIALIZE_EX is not linking on linux due to uncommented hidden_attribute
// in declaration
//
SEXP lazyvec_string_UnserializeEX_method(SEXP info, SEXP state, SEXP attr, int objf, int levs)
{
  // return ALTREP_UNSERIALIZE_EX_PROXY(info, state, attr, objf, levs);

  Rcpp::Environment pkgs = Rcpp::Environment::namespace_env("lazyvec");

  SEXP altrep_data1 = PROTECT(Rf_allocVector(VECSXP, 4));
  SET_VECTOR_ELT(altrep_data1, 0, VECTOR_ELT(state, 0));
  SET_VECTOR_ELT(altrep_data1, 1, VECTOR_ELT(state, 1));
  SET_VECTOR_ELT(altrep_data1, 2, VECTOR_ELT(state, 2));
  SET_VECTOR_ELT(altrep_data1, 3, pkgs);

  // SEXP unserialize_ex_listener = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(altrep_data1),
  //   LAZYVEC_METHOD_UNSERIALIZE_EX));

  // Rf_PrintValue(state);
  // call_r_interface(unserialize_ex_listener, state, LAZYVEC_PACKAGE_ENV(altrep_data1));
  
  // UNPROTECT(2);
  UNPROTECT(1);
  return lazyvec_string_wrapper(altrep_data1);
}


SEXP lazyvec_string_Serialized_state_method(SEXP x)
{
  // SEXP serialized_state_result = PROTECT(ALTREP_SERIALIZED_STATE_PROXY(LAZYVEC_PAYLOAD(x)));

  // length listener method
  // SEXP serialized_state_listener = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(x), LAZYVEC_METHOD_SERIALIZED_STATE));

  // create serialization state
  SEXP serialized_state = PROTECT(Rf_allocVector(VECSXP, 3));
  SET_VECTOR_ELT(serialized_state, 0, LAZYVEC_PAYLOAD(x));
  SET_VECTOR_ELT(serialized_state, 1, LAZYVEC_LISTENERS(x));
  SET_VECTOR_ELT(serialized_state, 2, LAZYVEC_METADATA(x));
  
  // if (serialized_state_result == NULL)
  // {
  //   call_r_interface(serialized_state_listener, R_NilValue, LAZYVEC_PACKAGE_ENV(x));
  // }
  // else
  // {
  //   call_r_interface(serialized_state_listener, serialized_state_result, LAZYVEC_PACKAGE_ENV(x));
  // }

  UNPROTECT(3);

  return serialized_state;
}


Rboolean lazyvec_string_Inspect_method(SEXP x, int pre, int deep, int pvec,
  inspect_subtree_method subtree_method)
{

@@ -152,7 +72,7 @@

  SEXP calling_env = PROTECT(LAZYVEC_PACKAGE_ENV(x));

  // length listener method
  SEXP full_vector_listener = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(x), LAZYVEC_METHOD_DATAPTR));
  SEXP full_vector_listener = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(x), LAZYVEC_METHOD_FULL_VECTOR));

  SEXP stored_full_vec = LAZYVEC_FULL_VEC(x);


@@ -178,11 +98,8 @@

{
  SEXP stored_full_vec = LAZYVEC_FULL_VEC(x);
  
  Rprintf("dataptr_or_null called");
  
  // return dataptr of stored vector
  if (!Rf_isNull(stored_full_vec)) {
    UNPROTECT(3);
    return DATAPTR(stored_full_vec);
  }
  

@@ -199,12 +116,11 @@

  SEXP calling_env = PROTECT(LAZYVEC_PACKAGE_ENV(x));
  
  // length listener method
  SEXP elt_listener = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(x), LAZYVEC_METHOD_ELT));
  SEXP elt_listener = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(x), LAZYVEC_METHOD_ELT));

  // i argument
  SEXP i_arg = PROTECT(Rf_ScalarInteger((int)(i + 1)));
  
  // ALTREP override

  // should return a length 1 vector containing the element
  SEXP custom_element = PROTECT(call_dual_r_interface(elt_listener, user_data, i_arg, calling_env));


@@ -226,7 +142,7 @@

  SEXP calling_env = PROTECT(LAZYVEC_PACKAGE_ENV(x));
  
  // length listener method
  SEXP is_sorted_listener = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(x), LAZYVEC_METHOD_IS_SORTED));
  SEXP is_sorted_listener = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(x), LAZYVEC_METHOD_IS_SORTED));
  
  // returns int
  SEXP custom_is_sorted = PROTECT(call_r_interface(is_sorted_listener, user_data, calling_env));

@@ -249,7 +165,7 @@

  SEXP calling_env = PROTECT(LAZYVEC_PACKAGE_ENV(x));

  // length listener method
  SEXP no_na_listener = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(x), LAZYVEC_METHOD_NO_NA));
  SEXP no_na_listener = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(x), LAZYVEC_METHOD_NO_NA));

  // returns int
  SEXP custom_no_na = PROTECT(call_r_interface(no_na_listener, user_data, calling_env));

@@ -268,7 +184,7 @@

  SEXP result_duplicate_ex = PROTECT(ALTREP_DUPLICATE_EX_PROXY(LAZYVEC_PAYLOAD(sx), deep));

  // retrieve duplicateEX listener method
  SEXP duplicate_ex_listener = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(sx), LAZYVEC_METHOD_DUPLICATE_EX));
  SEXP duplicate_ex_listener = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(sx), LAZYVEC_METHOD_DUPLICATE_EX));

  if (result_duplicate_ex == NULL)
  { 

@@ -290,7 +206,7 @@

SEXP lazyvec_string_Coerce_method(SEXP x, int type)
{
  // length listener method
  SEXP listener_coerce = VECTOR_ELT(LAZYVEC_LISTENERS(x), LAZYVEC_METHOD_COERCE);
  SEXP listener_coerce = VECTOR_ELT(LAZYVEC_DIAGNOSTICS(x), LAZYVEC_METHOD_COERCE);

  // use default coercion
  if (Rf_isNull(listener_coerce)) {

@@ -310,7 +226,7 @@

  SEXP calling_env = PROTECT(LAZYVEC_PACKAGE_ENV(x));
  
  // length listener method
  SEXP listener_extract_subset = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(x), LAZYVEC_METHOD_EXTRACT_SUBSET));
  SEXP listener_extract_subset = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(x), LAZYVEC_METHOD_EXTRACT_SUBSET));

  // checks are for safety, remove later
  if (indx == NULL)

@@ -333,6 +249,85 @@

333	249		}
334	250
335	251
	252	+	//
	253	+	// On Win there is no Unserialize method exported, check with R-dev!
	254	+	//
	255	+	static SEXP lazyvec_string_Unserialize_method(SEXP lazyvec_class, SEXP state)
	256	+	{
	257	+	Rcpp::Environment pkgs = Rcpp::Environment::namespace_env("lazyvec");
	258	+
	259	+	SEXP altrep_data1 = PROTECT(Rf_allocVector(VECSXP, 4));
	260	+	SET_VECTOR_ELT(altrep_data1, 0, VECTOR_ELT(state, 0));
	261	+	SET_VECTOR_ELT(altrep_data1, 1, VECTOR_ELT(state, 1));
	262	+	SET_VECTOR_ELT(altrep_data1, 2, VECTOR_ELT(state, 2));
	263	+	SET_VECTOR_ELT(altrep_data1, 3, pkgs);
	264	+
	265	+	// unserialize listener method
	266	+	// SEXP unserialize_listener = PROTECT(VECTOR_ELT(VECTOR_ELT(state, 1), LAZYVEC_METHOD_UNSERIALIZE));
	267	+
	268	+	// call_r_interface(unserialize_listener, state, LAZYVEC_PACKAGE_ENV(altrep_data1));
	269	+
	270	+	// UNPROTECT(2);
	271	+	UNPROTECT(1);
	272	+	return lazyvec_string_wrapper(altrep_data1);
	273	+	}
	274	+
	275	+
	276	+	//
	277	+	// ALTREP_UNSERIALIZE_EX is not linking on linux due to uncommented hidden_attribute
	278	+	// in declaration
	279	+	//
	280	+	SEXP lazyvec_string_UnserializeEX_method(SEXP info, SEXP state, SEXP attr, int objf, int levs)
	281	+	{
	282	+	// return ALTREP_UNSERIALIZE_EX_PROXY(info, state, attr, objf, levs);
	283	+
	284	+	Rcpp::Environment pkgs = Rcpp::Environment::namespace_env("lazyvec");
	285	+
	286	+	SEXP altrep_data1 = PROTECT(Rf_allocVector(VECSXP, 4));
	287	+	SET_VECTOR_ELT(altrep_data1, 0, VECTOR_ELT(state, 0));
	288	+	SET_VECTOR_ELT(altrep_data1, 1, VECTOR_ELT(state, 1));
	289	+	SET_VECTOR_ELT(altrep_data1, 2, VECTOR_ELT(state, 2));
	290	+	SET_VECTOR_ELT(altrep_data1, 3, pkgs);
	291	+
	292	+	// SEXP unserialize_ex_listener = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(altrep_data1),
	293	+	// LAZYVEC_METHOD_UNSERIALIZE_EX));
	294	+
	295	+	// Rf_PrintValue(state);
	296	+	// call_r_interface(unserialize_ex_listener, state, LAZYVEC_PACKAGE_ENV(altrep_data1));
	297	+
	298	+	// UNPROTECT(2);
	299	+	UNPROTECT(1);
	300	+	return lazyvec_string_wrapper(altrep_data1);
	301	+	}
	302	+
	303	+
	304	+	SEXP lazyvec_string_Serialized_state_method(SEXP x)
	305	+	{
	306	+	// SEXP serialized_state_result = PROTECT(ALTREP_SERIALIZED_STATE_PROXY(LAZYVEC_PAYLOAD(x)));
	307	+
	308	+	// length listener method
	309	+	// SEXP serialized_state_listener = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(x), LAZYVEC_METHOD_SERIALIZED_STATE));
	310	+
	311	+	// create serialization state
	312	+	SEXP serialized_state = PROTECT(Rf_allocVector(VECSXP, 2));
	313	+	SET_VECTOR_ELT(serialized_state, 0, LAZYVEC_PAYLOAD(x));
	314	+	SET_VECTOR_ELT(serialized_state, 1, LAZYVEC_DIAGNOSTICS(x));
	315	+
	316	+	// if (serialized_state_result == NULL)
	317	+	// {
	318	+	// call_r_interface(serialized_state_listener, R_NilValue, LAZYVEC_PACKAGE_ENV(x));
	319	+	// }
	320	+	// else
	321	+	// {
	322	+	// call_r_interface(serialized_state_listener, serialized_state_result, LAZYVEC_PACKAGE_ENV(x));
	323	+	// }
	324	+
	325	+	UNPROTECT(3);
	326	+
	327	+	return serialized_state;
	328	+	}
	329	+
	330	+
336	331		// [[Rcpp::init]]
337	332		void register_lazyvec_string_class(DllInfo *dll)
338	333		{

@@ -35,10 +35,12 @@

#' the results of user defined methods to R. This greatly enhances the stability of lazyvec
#' implementation and should be set to TRUE during the development phase of new custom vectors
#' to avoid crashes and unexpected side-effects.
#' @param id identifier for your lazyvec, used for diagnostic output
#'
#' @return a user-defined ALTREP vector
#' @export
lazyvec <- function(metadata, vec_type, altrep_methods, package_environment = "lazyvec", diagnostics = TRUE) {
lazyvec <- function(metadata, vec_type, altrep_methods, package_environment = "lazyvec", diagnostics = TRUE,
  id = "lazyvec") {

  if (class(altrep_methods) != "lazyvec_api") {
    stop("Please use lazyvec_methods() to define the ALTREP methods for this vector")

@@ -49,39 +51,35 @@

  if (!is_attached) stop("Failed to attach package ", package_environment,
    ", please make sure it's installed correctly")

  altrep_methods_vec <- altrep_methods
  altrep_methods_list <- altrep_methods

  # if diagnostics are active, user methods are stored in user data
  if (diagnostics) {
    diagnostic_methods <- diagnostics()
  } else {
    diagnostic_methods <- altrep_methods
    altrep_methods_vec <- NULL
    altrep_methods_list <- diagnostics()
    metadata <- list(
      user_data = metadata,
      user_methods = altrep_methods,
      vec_id = id,
      vec_type = vec_type
    )
  }

  payload <- list(

    # ALTREP payload for testing (remove later)
    1:10,

    # user defined API
    altrep_methods_vec,

    # identifier, used in diagnostic output
    NULL,
    # user defined or diagnostic API
    altrep_methods_list,

    # (user) package environment in which to evaluate user defined mehods
    as.environment(paste0("package:", package_environment)),

    # user-defined metadata
    # user-defined metadata or diagnostic list including metadata
    metadata,

    # container for expanded vector
    NULL,

    # lazyvec package environment
    as.environment("package:lazyvec"),

    diagnostic_methods
    as.environment("package:lazyvec")
  )

  if (vec_type == "integer") {

@@ -43,7 +43,7 @@

  SEXP user_data = PROTECT(LAZYVEC_USER_DATA(x));

  // length listener method
  SEXP length_listener = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(x), LAZYVEC_METHOD_LENGTH));
  SEXP length_listener = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(x), LAZYVEC_METHOD_LENGTH));

  SEXP custom_length = PROTECT(call_r_interface(length_listener, user_data, LAZYVEC_PACKAGE_ENV(x)));
  

@@ -56,86 +56,6 @@

}


//
// On Win there is no Unserialize method exported, check with R-dev!
//
static SEXP lazyvec_logical_Unserialize_method(SEXP lazyvec_class, SEXP state)
{
  Rcpp::Environment pkgs = Rcpp::Environment::namespace_env("lazyvec");

  SEXP altrep_data1 = PROTECT(Rf_allocVector(VECSXP, 4));
  SET_VECTOR_ELT(altrep_data1, 0, VECTOR_ELT(state, 0));
  SET_VECTOR_ELT(altrep_data1, 1, VECTOR_ELT(state, 1));
  SET_VECTOR_ELT(altrep_data1, 2, VECTOR_ELT(state, 2));
  SET_VECTOR_ELT(altrep_data1, 3, pkgs);

  // unserialize listener method
  // SEXP unserialize_listener = PROTECT(VECTOR_ELT(VECTOR_ELT(state, 1), LAZYVEC_METHOD_UNSERIALIZE));
  
  // call_r_interface(unserialize_listener, state, LAZYVEC_PACKAGE_ENV(altrep_data1));

  // UNPROTECT(2);
  UNPROTECT(1);
  return lazyvec_logical_wrapper(altrep_data1);
}


//
// ALTREP_UNSERIALIZE_EX is not linking on linux due to uncommented hidden_attribute
// in declaration
//
SEXP lazyvec_logical_UnserializeEX_method(SEXP info, SEXP state, SEXP attr, int objf, int levs)
{
  // return ALTREP_UNSERIALIZE_EX_PROXY(info, state, attr, objf, levs);

  Rcpp::Environment pkgs = Rcpp::Environment::namespace_env("lazyvec");

  SEXP altrep_data1 = PROTECT(Rf_allocVector(VECSXP, 4));
  SET_VECTOR_ELT(altrep_data1, 0, VECTOR_ELT(state, 0));
  SET_VECTOR_ELT(altrep_data1, 1, VECTOR_ELT(state, 1));
  SET_VECTOR_ELT(altrep_data1, 2, VECTOR_ELT(state, 2));
  SET_VECTOR_ELT(altrep_data1, 3, pkgs);

  // SEXP unserialize_ex_listener = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(altrep_data1),
  //   LAZYVEC_METHOD_UNSERIALIZE_EX));

  // Rf_PrintValue(state);
  // call_r_interface(unserialize_ex_listener, state, LAZYVEC_PACKAGE_ENV(altrep_data1));
  
  // UNPROTECT(2);
  UNPROTECT(1);
  return lazyvec_logical_wrapper(altrep_data1);
}


SEXP lazyvec_logical_Serialized_state_method(SEXP x)
{
  // SEXP serialized_state_result = PROTECT(ALTREP_SERIALIZED_STATE_PROXY(LAZYVEC_PAYLOAD(x)));

  // length listener method
  // SEXP serialized_state_listener = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(x), LAZYVEC_METHOD_SERIALIZED_STATE));

  // create serialization state
  SEXP serialized_state = PROTECT(Rf_allocVector(VECSXP, 3));
  SET_VECTOR_ELT(serialized_state, 0, LAZYVEC_PAYLOAD(x));
  SET_VECTOR_ELT(serialized_state, 1, LAZYVEC_LISTENERS(x));
  SET_VECTOR_ELT(serialized_state, 2, LAZYVEC_METADATA(x));
  
  // if (serialized_state_result == NULL)
  // {
  //   call_r_interface(serialized_state_listener, R_NilValue, LAZYVEC_PACKAGE_ENV(x));
  // }
  // else
  // {
  //   call_r_interface(serialized_state_listener, serialized_state_result, LAZYVEC_PACKAGE_ENV(x));
  // }

  UNPROTECT(3);

  return serialized_state;
}


Rboolean lazyvec_logical_Inspect_method(SEXP x, int pre, int deep, int pvec,
  inspect_subtree_method subtree_method)
{

@@ -152,7 +72,7 @@

  SEXP calling_env = PROTECT(LAZYVEC_PACKAGE_ENV(x));

  // length listener method
  SEXP full_vector_listener = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(x), LAZYVEC_METHOD_DATAPTR));
  SEXP full_vector_listener = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(x), LAZYVEC_METHOD_FULL_VECTOR));

  SEXP stored_full_vec = LAZYVEC_FULL_VEC(x);


@@ -178,11 +98,8 @@

{
  SEXP stored_full_vec = LAZYVEC_FULL_VEC(x);
  
  Rprintf("dataptr_or_null called");
  
  // return dataptr of stored vector
  if (!Rf_isNull(stored_full_vec)) {
    UNPROTECT(3);
    return DATAPTR(stored_full_vec);
  }
  

@@ -199,12 +116,11 @@

  SEXP calling_env = PROTECT(LAZYVEC_PACKAGE_ENV(x));
  
  // length listener method
  SEXP elt_listener = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(x), LAZYVEC_METHOD_ELT));
  SEXP elt_listener = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(x), LAZYVEC_METHOD_ELT));

  // i argument
  SEXP i_arg = PROTECT(Rf_ScalarInteger((int)(i + 1)));
  
  // ALTREP override

  // should return a length 1 vector containing the element
  SEXP custom_element = PROTECT(call_dual_r_interface(elt_listener, user_data, i_arg, calling_env));


@@ -217,25 +133,34 @@

}


R_xlen_t lazyvec_logical_Get_region_method(SEXP sx, R_xlen_t i, R_xlen_t n, int *buf)
R_xlen_t lazyvec_logical_Get_region_method(SEXP x, R_xlen_t i, R_xlen_t n, int *buf)
{
  R_xlen_t length = LOGICAL_GET_REGION(LAZYVEC_PAYLOAD(sx), i, n, buf);
  // test for expanded vector here

  // custom payload
  SEXP user_data = PROTECT(LAZYVEC_USER_DATA(x));

  SEXP arguments = PROTECT(Rf_allocVector(VECSXP, 4));
  SET_VECTOR_ELT(arguments, 0, LAZYVEC_METADATA(sx));
  SET_VECTOR_ELT(arguments, 1, Rf_ScalarInteger(i));
  SET_VECTOR_ELT(arguments, 2, Rf_ScalarInteger(n));
  SET_VECTOR_ELT(arguments, 3, Rf_ScalarInteger(length));
  // calling environment
  SEXP calling_env = PROTECT(LAZYVEC_PACKAGE_ENV(x));

  // length listener method
  SEXP get_region_listener = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(x), LAZYVEC_METHOD_GET_REGION));

  // dataptr_or_null listener method
  SEXP get_region_listener = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(sx), LAZYVEC_METHOD_GET_REGION));
  // i, n argument
  SEXP i_arg = PROTECT(Rf_ScalarInteger((int)(i + 1)));
  SEXP n_arg = PROTECT(Rf_ScalarInteger((int)(i)));

  // call listener with integer result
  call_r_interface(get_region_listener, arguments, LAZYVEC_PACKAGE_ENV(sx));
  // should return a length n vector containing the elements
  SEXP vec_elems = PROTECT(call_tripple_r_interface(get_region_listener, user_data, i_arg, n_arg, calling_env));

  UNPROTECT(2);
  // convert to C_TYPE
  int* elements = (int*)(LOGICAL(vec_elems));

  return length;
  memcpy(buf, elements, n * sizeof(int));

  UNPROTECT(6);

  return (R_xlen_t) LENGTH(vec_elems);
}



@@ -248,7 +173,7 @@

  SEXP calling_env = PROTECT(LAZYVEC_PACKAGE_ENV(x));
  
  // length listener method
  SEXP is_sorted_listener = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(x), LAZYVEC_METHOD_IS_SORTED));
  SEXP is_sorted_listener = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(x), LAZYVEC_METHOD_IS_SORTED));
  
  // returns int
  SEXP custom_is_sorted = PROTECT(call_r_interface(is_sorted_listener, user_data, calling_env));

@@ -271,7 +196,7 @@

  SEXP calling_env = PROTECT(LAZYVEC_PACKAGE_ENV(x));

  // length listener method
  SEXP no_na_listener = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(x), LAZYVEC_METHOD_NO_NA));
  SEXP no_na_listener = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(x), LAZYVEC_METHOD_NO_NA));

  // returns int
  SEXP custom_no_na = PROTECT(call_r_interface(no_na_listener, user_data, calling_env));

@@ -294,7 +219,7 @@

  SEXP calling_env = PROTECT(LAZYVEC_PACKAGE_ENV(x));
  
  // length listener method
  SEXP sum_listener = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(x), LAZYVEC_METHOD_SUM));
  SEXP sum_listener = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(x), LAZYVEC_METHOD_SUM));
  
  // na_rm argument
  SEXP na_rm_arg = PROTECT(Rf_ScalarInteger(na_rm));

@@ -314,7 +239,7 @@

  SEXP result_duplicate_ex = PROTECT(ALTREP_DUPLICATE_EX_PROXY(LAZYVEC_PAYLOAD(sx), deep));

  // retrieve duplicateEX listener method
  SEXP duplicate_ex_listener = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(sx), LAZYVEC_METHOD_DUPLICATE_EX));
  SEXP duplicate_ex_listener = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(sx), LAZYVEC_METHOD_DUPLICATE_EX));

  if (result_duplicate_ex == NULL)
  { 

@@ -336,7 +261,7 @@

SEXP lazyvec_logical_Coerce_method(SEXP x, int type)
{
  // length listener method
  SEXP listener_coerce = VECTOR_ELT(LAZYVEC_LISTENERS(x), LAZYVEC_METHOD_COERCE);
  SEXP listener_coerce = VECTOR_ELT(LAZYVEC_DIAGNOSTICS(x), LAZYVEC_METHOD_COERCE);

  // use default coercion
  if (Rf_isNull(listener_coerce)) {

@@ -356,7 +281,7 @@

  SEXP calling_env = PROTECT(LAZYVEC_PACKAGE_ENV(x));
  
  // length listener method
  SEXP listener_extract_subset = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(x), LAZYVEC_METHOD_EXTRACT_SUBSET));
  SEXP listener_extract_subset = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(x), LAZYVEC_METHOD_EXTRACT_SUBSET));

  // checks are for safety, remove later
  if (indx == NULL)

@@ -379,6 +304,85 @@

379	304		}
380	305
381	306
	307	+	//
	308	+	// On Win there is no Unserialize method exported, check with R-dev!
	309	+	//
	310	+	static SEXP lazyvec_logical_Unserialize_method(SEXP lazyvec_class, SEXP state)
	311	+	{
	312	+	Rcpp::Environment pkgs = Rcpp::Environment::namespace_env("lazyvec");
	313	+
	314	+	SEXP altrep_data1 = PROTECT(Rf_allocVector(VECSXP, 4));
	315	+	SET_VECTOR_ELT(altrep_data1, 0, VECTOR_ELT(state, 0));
	316	+	SET_VECTOR_ELT(altrep_data1, 1, VECTOR_ELT(state, 1));
	317	+	SET_VECTOR_ELT(altrep_data1, 2, VECTOR_ELT(state, 2));
	318	+	SET_VECTOR_ELT(altrep_data1, 3, pkgs);
	319	+
	320	+	// unserialize listener method
	321	+	// SEXP unserialize_listener = PROTECT(VECTOR_ELT(VECTOR_ELT(state, 1), LAZYVEC_METHOD_UNSERIALIZE));
	322	+
	323	+	// call_r_interface(unserialize_listener, state, LAZYVEC_PACKAGE_ENV(altrep_data1));
	324	+
	325	+	// UNPROTECT(2);
	326	+	UNPROTECT(1);
	327	+	return lazyvec_logical_wrapper(altrep_data1);
	328	+	}
	329	+
	330	+
	331	+	//
	332	+	// ALTREP_UNSERIALIZE_EX is not linking on linux due to uncommented hidden_attribute
	333	+	// in declaration
	334	+	//
	335	+	SEXP lazyvec_logical_UnserializeEX_method(SEXP info, SEXP state, SEXP attr, int objf, int levs)
	336	+	{
	337	+	// return ALTREP_UNSERIALIZE_EX_PROXY(info, state, attr, objf, levs);
	338	+
	339	+	Rcpp::Environment pkgs = Rcpp::Environment::namespace_env("lazyvec");
	340	+
	341	+	SEXP altrep_data1 = PROTECT(Rf_allocVector(VECSXP, 4));
	342	+	SET_VECTOR_ELT(altrep_data1, 0, VECTOR_ELT(state, 0));
	343	+	SET_VECTOR_ELT(altrep_data1, 1, VECTOR_ELT(state, 1));
	344	+	SET_VECTOR_ELT(altrep_data1, 2, VECTOR_ELT(state, 2));
	345	+	SET_VECTOR_ELT(altrep_data1, 3, pkgs);
	346	+
	347	+	// SEXP unserialize_ex_listener = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(altrep_data1),
	348	+	// LAZYVEC_METHOD_UNSERIALIZE_EX));
	349	+
	350	+	// Rf_PrintValue(state);
	351	+	// call_r_interface(unserialize_ex_listener, state, LAZYVEC_PACKAGE_ENV(altrep_data1));
	352	+
	353	+	// UNPROTECT(2);
	354	+	UNPROTECT(1);
	355	+	return lazyvec_logical_wrapper(altrep_data1);
	356	+	}
	357	+
	358	+
	359	+	SEXP lazyvec_logical_Serialized_state_method(SEXP x)
	360	+	{
	361	+	// SEXP serialized_state_result = PROTECT(ALTREP_SERIALIZED_STATE_PROXY(LAZYVEC_PAYLOAD(x)));
	362	+
	363	+	// length listener method
	364	+	// SEXP serialized_state_listener = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(x), LAZYVEC_METHOD_SERIALIZED_STATE));
	365	+
	366	+	// create serialization state
	367	+	SEXP serialized_state = PROTECT(Rf_allocVector(VECSXP, 2));
	368	+	SET_VECTOR_ELT(serialized_state, 0, LAZYVEC_PAYLOAD(x));
	369	+	SET_VECTOR_ELT(serialized_state, 1, LAZYVEC_DIAGNOSTICS(x));
	370	+
	371	+	// if (serialized_state_result == NULL)
	372	+	// {
	373	+	// call_r_interface(serialized_state_listener, R_NilValue, LAZYVEC_PACKAGE_ENV(x));
	374	+	// }
	375	+	// else
	376	+	// {
	377	+	// call_r_interface(serialized_state_listener, serialized_state_result, LAZYVEC_PACKAGE_ENV(x));
	378	+	// }
	379	+
	380	+	UNPROTECT(3);
	381	+
	382	+	return serialized_state;
	383	+	}
	384	+
	385	+
382	386		// [[Rcpp::init]]
383	387		void register_lazyvec_logical_class(DllInfo *dll)
384	388		{

@@ -26,10 +26,9 @@

#' ALTREP vector will be diverted to these user functions.
#' 
#' @param method_length override for the ALTREP length method
#' @param method_dataptr_or_null  override for the ALTREP dataptr_or_null method
#' @param method_full_vector generates the full expanded vector
#' @param method_get_region override for the ALTREP get_region method
#' @param method_element override for the ALTREP element method
#' @param method_dataptr override for the ALTREP dataptr method
#' @param method_is_sorted override for the ALTREP is_sorted method
#' @param method_no_na override for the ALTREP no_na method
#' @param method_sum override for the ALTREP sum method

@@ -47,11 +46,10 @@

#' @export
lazyvec_methods <- function(
  method_length,
  method_init = NULL,
  method_dataptr_or_null = NULL,
  method_get_region = NULL,
  method_full_vector = NULL,
  method_element = NULL,
  method_dataptr = NULL,
  method_get_region = NULL,
  method_init = NULL,
  method_is_sorted = NULL,
  method_no_na = NULL,
  method_sum = NULL,

@@ -68,10 +66,10 @@


  methods <- list(
    method_length,
    method_dataptr_or_null,
    NULL, # method_dataptr_or_null
    method_get_region,
    method_element,
    method_dataptr,
    method_full_vector,
    method_is_sorted,
    method_no_na,
    method_sum,

Click to load this diff.

Loading diff...

Click to load this diff.

Loading diff...

Click to load this diff.

Loading diff...

Click to load this diff.

Loading diff...

Click to load this diff.

Loading diff...

Learn more Showing 4 files with coverage changes found.

New file R/lazyvec_diagnostics.R

New

Loading file...

New file src/lazyvec_access.cpp

New

Loading file...

Changes in src/lazyvec_integer.cpp

-18

→

+18

Loading file...

Changes in src/api_helpers.cpp

-10

→

+10

Loading file...

Hiding 9 contexual commits

24.76% ø ø

Update package docs

MarcusKlik

836bd9d

CI Passed

Files		•	•	•	Coverage
R	+43	+43	ø	ø	^+6.90% 52.98%
src	-12	+52	ø	-64	^+2.72% 24.39%
Project Totals (23 files)	2,345	668	0	1,677	28.49%

Navigation	Overlay
`t` Navigate files	`h` Toggle hits
`y` Change url to tip of branch	`m` Toggle misses
`b / v` Jump to prev/next hit line	`p` Toggle partial
`z / x` Jump to prev/next missed or partial line	`1..9` Toggle flags
`shift + o` Open current page in GitHub	`a` Toggle all on
`/ or ?` Show keyboard shortcuts dialog	`c` Toggle context lines or commits

Compare `836bd9d ... +8 ... 5e8a5a8`

No flags found

Show failed CI and contexual commits `c`

10 Commits

43	43		SEXP user_data = PROTECT(LAZYVEC_USER_DATA(x));
44	44
45	45		// length listener method
46		-	SEXP length_listener = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(x), LAZYVEC_METHOD_LENGTH));
	46	+	SEXP length_listener = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(x), LAZYVEC_METHOD_LENGTH));
47	47
48	48		SEXP custom_length = PROTECT(call_r_interface(length_listener, user_data, LAZYVEC_PACKAGE_ENV(x)));
49	49

152	72		SEXP calling_env = PROTECT(LAZYVEC_PACKAGE_ENV(x));
153	73
154	74		// length listener method
155		-	SEXP full_vector_listener = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(x), LAZYVEC_METHOD_DATAPTR));
	75	+	SEXP full_vector_listener = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(x), LAZYVEC_METHOD_FULL_VECTOR));
156	76
157	77		SEXP stored_full_vec = LAZYVEC_FULL_VEC(x);
158	78

178	98		{
179	99		SEXP stored_full_vec = LAZYVEC_FULL_VEC(x);
180	100
181		-	Rprintf("dataptr_or_null called");
182		-
183	101		// return dataptr of stored vector
184	102		if (!Rf_isNull(stored_full_vec)) {
185		-	UNPROTECT(3);
186	103		return DATAPTR(stored_full_vec);
187	104		}
188	105

199	116		SEXP calling_env = PROTECT(LAZYVEC_PACKAGE_ENV(x));
200	117
201	118		// length listener method
202		-	SEXP elt_listener = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(x), LAZYVEC_METHOD_ELT));
	119	+	SEXP elt_listener = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(x), LAZYVEC_METHOD_ELT));
203	120
204	121		// i argument
205	122		SEXP i_arg = PROTECT(Rf_ScalarInteger((int)(i + 1)));
206		-
207		-	// ALTREP override
	123	+
208	124		// should return a length 1 vector containing the element
209	125		SEXP custom_element = PROTECT(call_dual_r_interface(elt_listener, user_data, i_arg, calling_env));
210	126

226	142		SEXP calling_env = PROTECT(LAZYVEC_PACKAGE_ENV(x));
227	143
228	144		// length listener method
229		-	SEXP is_sorted_listener = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(x), LAZYVEC_METHOD_IS_SORTED));
	145	+	SEXP is_sorted_listener = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(x), LAZYVEC_METHOD_IS_SORTED));
230	146
231	147		// returns int
232	148		SEXP custom_is_sorted = PROTECT(call_r_interface(is_sorted_listener, user_data, calling_env));

249	165		SEXP calling_env = PROTECT(LAZYVEC_PACKAGE_ENV(x));
250	166
251	167		// length listener method
252		-	SEXP no_na_listener = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(x), LAZYVEC_METHOD_NO_NA));
	168	+	SEXP no_na_listener = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(x), LAZYVEC_METHOD_NO_NA));
253	169
254	170		// returns int
255	171		SEXP custom_no_na = PROTECT(call_r_interface(no_na_listener, user_data, calling_env));

268	184		SEXP result_duplicate_ex = PROTECT(ALTREP_DUPLICATE_EX_PROXY(LAZYVEC_PAYLOAD(sx), deep));
269	185
270	186		// retrieve duplicateEX listener method
271		-	SEXP duplicate_ex_listener = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(sx), LAZYVEC_METHOD_DUPLICATE_EX));
	187	+	SEXP duplicate_ex_listener = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(sx), LAZYVEC_METHOD_DUPLICATE_EX));
272	188
273	189		if (result_duplicate_ex == NULL)
274	190		{

290	206		SEXP lazyvec_string_Coerce_method(SEXP x, int type)
291	207		{
292	208		// length listener method
293		-	SEXP listener_coerce = VECTOR_ELT(LAZYVEC_LISTENERS(x), LAZYVEC_METHOD_COERCE);
	209	+	SEXP listener_coerce = VECTOR_ELT(LAZYVEC_DIAGNOSTICS(x), LAZYVEC_METHOD_COERCE);
294	210
295	211		// use default coercion
296	212		if (Rf_isNull(listener_coerce)) {

310	226		SEXP calling_env = PROTECT(LAZYVEC_PACKAGE_ENV(x));
311	227
312	228		// length listener method
313		-	SEXP listener_extract_subset = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(x), LAZYVEC_METHOD_EXTRACT_SUBSET));
	229	+	SEXP listener_extract_subset = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(x), LAZYVEC_METHOD_EXTRACT_SUBSET));
314	230
315	231		// checks are for safety, remove later
316	232		if (indx == NULL)

35	35		#' the results of user defined methods to R. This greatly enhances the stability of lazyvec
36	36		#' implementation and should be set to TRUE during the development phase of new custom vectors
37	37		#' to avoid crashes and unexpected side-effects.
	38	+	#' @param id identifier for your lazyvec, used for diagnostic output
38	39		#'
39	40		#' @return a user-defined ALTREP vector
40	41		#' @export
41		-	lazyvec <- function(metadata, vec_type, altrep_methods, package_environment = "lazyvec", diagnostics = TRUE) {
	42	+	lazyvec <- function(metadata, vec_type, altrep_methods, package_environment = "lazyvec", diagnostics = TRUE,
	43	+	id = "lazyvec") {
42	44
43	45		if (class(altrep_methods) != "lazyvec_api") {
44	46		stop("Please use lazyvec_methods() to define the ALTREP methods for this vector")

49	51		if (!is_attached) stop("Failed to attach package ", package_environment,
50	52		", please make sure it's installed correctly")
51	53
52		-	altrep_methods_vec <- altrep_methods
	54	+	altrep_methods_list <- altrep_methods
53	55
	56	+	# if diagnostics are active, user methods are stored in user data
54	57		if (diagnostics) {
55		-	diagnostic_methods <- diagnostics()
56		-	} else {
57		-	diagnostic_methods <- altrep_methods
58		-	altrep_methods_vec <- NULL
	58	+	altrep_methods_list <- diagnostics()
	59	+	metadata <- list(
	60	+	user_data = metadata,
	61	+	user_methods = altrep_methods,
	62	+	vec_id = id,
	63	+	vec_type = vec_type
	64	+	)
59	65		}
60	66
61	67		payload <- list(
62	68
63		-	# ALTREP payload for testing (remove later)
64		-	1:10,
65		-
66		-	# user defined API
67		-	altrep_methods_vec,
68		-
69		-	# identifier, used in diagnostic output
70		-	NULL,
	69	+	# user defined or diagnostic API
	70	+	altrep_methods_list,
71	71
72	72		# (user) package environment in which to evaluate user defined mehods
73	73		as.environment(paste0("package:", package_environment)),
74	74
75		-	# user-defined metadata
	75	+	# user-defined metadata or diagnostic list including metadata
76	76		metadata,
77	77
78	78		# container for expanded vector
79	79		NULL,
80	80
81	81		# lazyvec package environment
82		-	as.environment("package:lazyvec"),
83		-
84		-	diagnostic_methods
	82	+	as.environment("package:lazyvec")
85	83		)
86	84
87	85		if (vec_type == "integer") {

217	133		}
218	134
219	135
220		-	R_xlen_t lazyvec_logical_Get_region_method(SEXP sx, R_xlen_t i, R_xlen_t n, int *buf)
	136	+	R_xlen_t lazyvec_logical_Get_region_method(SEXP x, R_xlen_t i, R_xlen_t n, int *buf)
221	137		{
222		-	R_xlen_t length = LOGICAL_GET_REGION(LAZYVEC_PAYLOAD(sx), i, n, buf);
	138	+	// test for expanded vector here
	139	+
	140	+	// custom payload
	141	+	SEXP user_data = PROTECT(LAZYVEC_USER_DATA(x));
223	142
224		-	SEXP arguments = PROTECT(Rf_allocVector(VECSXP, 4));
225		-	SET_VECTOR_ELT(arguments, 0, LAZYVEC_METADATA(sx));
226		-	SET_VECTOR_ELT(arguments, 1, Rf_ScalarInteger(i));
227		-	SET_VECTOR_ELT(arguments, 2, Rf_ScalarInteger(n));
228		-	SET_VECTOR_ELT(arguments, 3, Rf_ScalarInteger(length));
	143	+	// calling environment
	144	+	SEXP calling_env = PROTECT(LAZYVEC_PACKAGE_ENV(x));
	145	+
	146	+	// length listener method
	147	+	SEXP get_region_listener = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(x), LAZYVEC_METHOD_GET_REGION));
229	148
230		-	// dataptr_or_null listener method
231		-	SEXP get_region_listener = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(sx), LAZYVEC_METHOD_GET_REGION));
	149	+	// i, n argument
	150	+	SEXP i_arg = PROTECT(Rf_ScalarInteger((int)(i + 1)));
	151	+	SEXP n_arg = PROTECT(Rf_ScalarInteger((int)(i)));
232	152
233		-	// call listener with integer result
234		-	call_r_interface(get_region_listener, arguments, LAZYVEC_PACKAGE_ENV(sx));
	153	+	// should return a length n vector containing the elements
	154	+	SEXP vec_elems = PROTECT(call_tripple_r_interface(get_region_listener, user_data, i_arg, n_arg, calling_env));
235	155
236		-	UNPROTECT(2);
	156	+	// convert to C_TYPE
	157	+	int* elements = (int*)(LOGICAL(vec_elems));
237	158
238		-	return length;
	159	+	memcpy(buf, elements, n * sizeof(int));
	160	+
	161	+	UNPROTECT(6);
	162	+
	163	+	return (R_xlen_t) LENGTH(vec_elems);
239	164		}
240	165
241	166

294	219		SEXP calling_env = PROTECT(LAZYVEC_PACKAGE_ENV(x));
295	220
296	221		// length listener method
297		-	SEXP sum_listener = PROTECT(VECTOR_ELT(LAZYVEC_LISTENERS(x), LAZYVEC_METHOD_SUM));
	222	+	SEXP sum_listener = PROTECT(VECTOR_ELT(LAZYVEC_DIAGNOSTICS(x), LAZYVEC_METHOD_SUM));
298	223
299	224		// na_rm argument
300	225		SEXP na_rm_arg = PROTECT(Rf_ScalarInteger(na_rm));

336	261		SEXP lazyvec_logical_Coerce_method(SEXP x, int type)
337	262		{
338	263		// length listener method
339		-	SEXP listener_coerce = VECTOR_ELT(LAZYVEC_LISTENERS(x), LAZYVEC_METHOD_COERCE);
	264	+	SEXP listener_coerce = VECTOR_ELT(LAZYVEC_DIAGNOSTICS(x), LAZYVEC_METHOD_COERCE);
340	265
341	266		// use default coercion
342	267		if (Rf_isNull(listener_coerce)) {

26	26		#' ALTREP vector will be diverted to these user functions.
27	27		#'
28	28		#' @param method_length override for the ALTREP length method
29		-	#' @param method_dataptr_or_null override for the ALTREP dataptr_or_null method
	29	+	#' @param method_full_vector generates the full expanded vector
30	30		#' @param method_get_region override for the ALTREP get_region method
31	31		#' @param method_element override for the ALTREP element method
32		-	#' @param method_dataptr override for the ALTREP dataptr method
33	32		#' @param method_is_sorted override for the ALTREP is_sorted method
34	33		#' @param method_no_na override for the ALTREP no_na method
35	34		#' @param method_sum override for the ALTREP sum method

47	46		#' @export
48	47		lazyvec_methods <- function(
49	48		method_length,
50		-	method_init = NULL,
51		-	method_dataptr_or_null = NULL,
52		-	method_get_region = NULL,
	49	+	method_full_vector = NULL,
53	50		method_element = NULL,
54		-	method_dataptr = NULL,
	51	+	method_get_region = NULL,
	52	+	method_init = NULL,
55	53		method_is_sorted = NULL,
56	54		method_no_na = NULL,
57	55		method_sum = NULL,

68	66
69	67		methods <- list(
70	68		method_length,
71		-	method_dataptr_or_null,
	69	+	NULL, # method_dataptr_or_null
72	70		method_get_region,
73	71		method_element,
74		-	method_dataptr,
	72	+	method_full_vector,
75	73		method_is_sorted,
76	74		method_no_na,
77	75		method_sum,

Compare 836bd9d ... +8 ... 5e8a5a8

No flags found

Show failed CI and contexual commits c 10 Commits

Compare `836bd9d ... +8 ... 5e8a5a8`

Show failed CI and contexual commits `c`

10 Commits