closes #798
AshesITR
Showing 5 of 5 files from the diff.
@@ -15,8 +15,11 @@
Loading
| 15 | 15 | extern SEXP pluck_impl(SEXP, SEXP, SEXP, SEXP); |
|
| 16 | 16 | extern SEXP flatten_impl(SEXP); |
|
| 17 | 17 | extern SEXP map_impl(SEXP, SEXP, SEXP, SEXP); |
|
| 18 | + | extern SEXP map_matrix_impl(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); |
|
| 18 | 19 | extern SEXP map2_impl(SEXP, SEXP, SEXP, SEXP, SEXP); |
|
| 20 | + | extern SEXP map2_matrix_impl(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); |
|
| 19 | 21 | extern SEXP pmap_impl(SEXP, SEXP, SEXP, SEXP); |
|
| 22 | + | extern SEXP pmap_matrix_impl(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); |
|
| 20 | 23 | extern SEXP transpose_impl(SEXP, SEXP); |
|
| 21 | 24 | extern SEXP vflatten_impl(SEXP, SEXP); |
|
| 22 | 25 |
@@ -26,8 +29,11 @@
Loading
| 26 | 29 | {"pluck_impl", (DL_FUNC) &pluck_impl, 4}, |
|
| 27 | 30 | {"flatten_impl", (DL_FUNC) &flatten_impl, 1}, |
|
| 28 | 31 | {"map_impl", (DL_FUNC) &map_impl, 4}, |
|
| 32 | + | {"map_matrix_impl", (DL_FUNC) &map_matrix_impl, 6}, |
|
| 29 | 33 | {"map2_impl", (DL_FUNC) &map2_impl, 5}, |
|
| 34 | + | {"map2_matrix_impl", (DL_FUNC) &map2_matrix_impl, 7}, |
|
| 30 | 35 | {"pmap_impl", (DL_FUNC) &pmap_impl, 4}, |
|
| 36 | + | {"pmap_matrix_impl", (DL_FUNC) &pmap_matrix_impl, 6}, |
|
| 31 | 37 | {"transpose_impl", (DL_FUNC) &transpose_impl, 2}, |
|
| 32 | 38 | {"vflatten_impl", (DL_FUNC) &vflatten_impl, 2}, |
|
| 33 | 39 | {"purrr_eval", (DL_FUNC) &Rf_eval, 2}, |
@@ -218,6 +218,41 @@
Loading
| 218 | 218 | .Call(map_impl, environment(), ".x", ".f", "raw") |
|
| 219 | 219 | } |
|
| 220 | 220 | ||
| 221 | + | #' @rdname map |
|
| 222 | + | #' @export |
|
| 223 | + | map_lgl_matrix <- function(.x, .f, .n, ..., .by_row = FALSE) { |
|
| 224 | + | .f <- as_mapper(.f, ...) |
|
| 225 | + | .Call(map_matrix_impl, environment(), ".x", ".f", "logical", .n, .by_row) |
|
| 226 | + | } |
|
| 227 | + | ||
| 228 | + | #' @rdname map |
|
| 229 | + | #' @export |
|
| 230 | + | map_chr_matrix <- function(.x, .f, .n, ..., .by_row = FALSE) { |
|
| 231 | + | .f <- as_mapper(.f, ...) |
|
| 232 | + | .Call(map_matrix_impl, environment(), ".x", ".f", "character", .n, .by_row) |
|
| 233 | + | } |
|
| 234 | + | ||
| 235 | + | #' @rdname map |
|
| 236 | + | #' @export |
|
| 237 | + | map_int_matrix <- function(.x, .f, .n, ..., .by_row = FALSE) { |
|
| 238 | + | .f <- as_mapper(.f, ...) |
|
| 239 | + | .Call(map_matrix_impl, environment(), ".x", ".f", "integer", .n, .by_row) |
|
| 240 | + | } |
|
| 241 | + | ||
| 242 | + | #' @rdname map |
|
| 243 | + | #' @export |
|
| 244 | + | map_dbl_matrix <- function(.x, .f, .n, ..., .by_row = FALSE) { |
|
| 245 | + | .f <- as_mapper(.f, ...) |
|
| 246 | + | .Call(map_matrix_impl, environment(), ".x", ".f", "double", .n, .by_row) |
|
| 247 | + | } |
|
| 248 | + | ||
| 249 | + | #' @rdname map |
|
| 250 | + | #' @export |
|
| 251 | + | map_raw_matrix <- function(.x, .f, .n, ..., .by_row = FALSE) { |
|
| 252 | + | .f <- as_mapper(.f, ...) |
|
| 253 | + | .Call(map_matrix_impl, environment(), ".x", ".f", "raw", .n, .by_row) |
|
| 254 | + | } |
|
| 255 | + | ||
| 221 | 256 | #' @rdname map |
|
| 222 | 257 | #' @param .id Either a string or `NULL`. If a string, the output will contain |
|
| 223 | 258 | #' a variable with that name, storing either the name (if `.x` is named) or |
@@ -133,6 +133,38 @@
Loading
| 133 | 133 | .f <- as_mapper(.f, ...) |
|
| 134 | 134 | .Call(map2_impl, environment(), ".x", ".y", ".f", "raw") |
|
| 135 | 135 | } |
|
| 136 | + | ||
| 137 | + | #' @export |
|
| 138 | + | #' @rdname map2 |
|
| 139 | + | map2_lgl_matrix <- function(.x, .y, .f, .n, ..., .by_row = FALSE) { |
|
| 140 | + | .f <- as_mapper(.f, ...) |
|
| 141 | + | .Call(map2_matrix_impl, environment(), ".x", ".y", ".f", "logical", .n, .by_row) |
|
| 142 | + | } |
|
| 143 | + | #' @export |
|
| 144 | + | #' @rdname map2 |
|
| 145 | + | map2_int_matrix <- function(.x, .y, .f, .n, ..., .by_row = FALSE) { |
|
| 146 | + | .f <- as_mapper(.f, ...) |
|
| 147 | + | .Call(map2_matrix_impl, environment(), ".x", ".y", ".f", "integer", .n, .by_row) |
|
| 148 | + | } |
|
| 149 | + | #' @export |
|
| 150 | + | #' @rdname map2 |
|
| 151 | + | map2_dbl_matrix <- function(.x, .y, .f, .n, ..., .by_row = FALSE) { |
|
| 152 | + | .f <- as_mapper(.f, ...) |
|
| 153 | + | .Call(map2_matrix_impl, environment(), ".x", ".y", ".f", "double", .n, .by_row) |
|
| 154 | + | } |
|
| 155 | + | #' @export |
|
| 156 | + | #' @rdname map2 |
|
| 157 | + | map2_chr_matrix <- function(.x, .y, .f, .n, ..., .by_row = FALSE) { |
|
| 158 | + | .f <- as_mapper(.f, ...) |
|
| 159 | + | .Call(map2_matrix_impl, environment(), ".x", ".y", ".f", "character", .n, .by_row) |
|
| 160 | + | } |
|
| 161 | + | #' @export |
|
| 162 | + | #' @rdname map2 |
|
| 163 | + | map2_raw_matrix <- function(.x, .y, .f, .n, ..., .by_row = FALSE) { |
|
| 164 | + | .f <- as_mapper(.f, ...) |
|
| 165 | + | .Call(map2_matrix_impl, environment(), ".x", ".y", ".f", "raw", .n, .by_row) |
|
| 166 | + | } |
|
| 167 | + | ||
| 136 | 168 | #' @rdname map2 |
|
| 137 | 169 | #' @export |
|
| 138 | 170 | map2_dfr <- function(.x, .y, .f, ..., .id = NULL) { |
@@ -228,6 +260,61 @@
Loading
| 228 | 260 | .Call(pmap_impl, environment(), ".l", ".f", "raw") |
|
| 229 | 261 | } |
|
| 230 | 262 | ||
| 263 | + | #' @export |
|
| 264 | + | #' @rdname map2 |
|
| 265 | + | pmap_lgl_matrix <- function(.l, .f, .n, ..., .by_row = FALSE) { |
|
| 266 | + | .f <- as_mapper(.f, ...) |
|
| 267 | + | if (is.data.frame(.l)) { |
|
| 268 | + | .l <- as.list(.l) |
|
| 269 | + | } |
|
| 270 | + | ||
| 271 | + | .Call(pmap_matrix_impl, environment(), ".l", ".f", "logical", .n, .by_row) |
|
| 272 | + | } |
|
| 273 | + | ||
| 274 | + | #' @export |
|
| 275 | + | #' @rdname map2 |
|
| 276 | + | pmap_int_matrix <- function(.l, .f, .n, ..., .by_row = FALSE) { |
|
| 277 | + | .f <- as_mapper(.f, ...) |
|
| 278 | + | if (is.data.frame(.l)) { |
|
| 279 | + | .l <- as.list(.l) |
|
| 280 | + | } |
|
| 281 | + | ||
| 282 | + | .Call(pmap_matrix_impl, environment(), ".l", ".f", "integer", .n, .by_row) |
|
| 283 | + | } |
|
| 284 | + | ||
| 285 | + | #' @export |
|
| 286 | + | #' @rdname map2 |
|
| 287 | + | pmap_dbl_matrix <- function(.l, .f, .n, ..., .by_row = FALSE) { |
|
| 288 | + | .f <- as_mapper(.f, ...) |
|
| 289 | + | if (is.data.frame(.l)) { |
|
| 290 | + | .l <- as.list(.l) |
|
| 291 | + | } |
|
| 292 | + | ||
| 293 | + | .Call(pmap_matrix_impl, environment(), ".l", ".f", "double", .n, .by_row) |
|
| 294 | + | } |
|
| 295 | + | ||
| 296 | + | #' @export |
|
| 297 | + | #' @rdname map2 |
|
| 298 | + | pmap_chr_matrix <- function(.l, .f, .n, ..., .by_row = FALSE) { |
|
| 299 | + | .f <- as_mapper(.f, ...) |
|
| 300 | + | if (is.data.frame(.l)) { |
|
| 301 | + | .l <- as.list(.l) |
|
| 302 | + | } |
|
| 303 | + | ||
| 304 | + | .Call(pmap_matrix_impl, environment(), ".l", ".f", "character", .n, .by_row) |
|
| 305 | + | } |
|
| 306 | + | ||
| 307 | + | #' @export |
|
| 308 | + | #' @rdname map2 |
|
| 309 | + | pmap_raw_matrix <- function(.l, .f, .n, ..., .by_row = FALSE) { |
|
| 310 | + | .f <- as_mapper(.f, ...) |
|
| 311 | + | if (is.data.frame(.l)) { |
|
| 312 | + | .l <- as.list(.l) |
|
| 313 | + | } |
|
| 314 | + | ||
| 315 | + | .Call(pmap_matrix_impl, environment(), ".l", ".f", "raw", .n, .by_row) |
|
| 316 | + | } |
|
| 317 | + | ||
| 231 | 318 | #' @rdname map2 |
|
| 232 | 319 | #' @export |
|
| 233 | 320 | pmap_dfr <- function(.l, .f, ..., .id = NULL) { |
@@ -57,6 +57,49 @@
Loading
| 57 | 57 | return out; |
|
| 58 | 58 | } |
|
| 59 | 59 | ||
| 60 | + | // call must involve i |
|
| 61 | + | SEXP call_loop_matrix(SEXP env, SEXP call, int n, int m, SEXPTYPE type, int force_args, int by_row) { |
|
| 62 | + | // Create variable "i" and map to scalar integer |
|
| 63 | + | SEXP i_val = PROTECT(Rf_ScalarInteger(1)); |
|
| 64 | + | SEXP i = Rf_install("i"); |
|
| 65 | + | Rf_defineVar(i, i_val, env); |
|
| 66 | + | ||
| 67 | + | SEXP out; |
|
| 68 | + | if (by_row) { |
|
| 69 | + | out = PROTECT(Rf_allocMatrix(type, n, m)); |
|
| 70 | + | } else { |
|
| 71 | + | out = PROTECT(Rf_allocMatrix(type, m, n)); |
|
| 72 | + | } |
|
| 73 | + | for (int i = 0; i < n; ++i) { |
|
| 74 | + | if (i % 1024 == 0) |
|
| 75 | + | R_CheckUserInterrupt(); |
|
| 76 | + | ||
| 77 | + | INTEGER(i_val)[0] = i + 1; |
|
| 78 | + | ||
| 79 | + | #if defined(R_VERSION) && R_VERSION >= R_Version(3, 2, 3) |
|
| 80 | + | SEXP res = PROTECT(R_forceAndCall(call, force_args, env)); |
|
| 81 | + | #else |
|
| 82 | + | SEXP res = PROTECT(Rf_eval(call, env)); |
|
| 83 | + | #endif |
|
| 84 | + | if (type != VECSXP && Rf_length(res) != m) { |
|
| 85 | + | SEXP ptype = PROTECT(Rf_allocVector(type, 0)); |
|
| 86 | + | stop_bad_element_vector(res, i + 1, ptype, m, "Result", NULL, false); |
|
| 87 | + | } |
|
| 88 | + | ||
| 89 | + | for (int j = 0; j < m; j++) { |
|
| 90 | + | if (by_row) { |
|
| 91 | + | set_vector_value(out, n * j + i, res, j); |
|
| 92 | + | } else { |
|
| 93 | + | set_vector_value(out, m * i + j, res, j); |
|
| 94 | + | } |
|
| 95 | + | } |
|
| 96 | + | UNPROTECT(1); |
|
| 97 | + | } |
|
| 98 | + | ||
| 99 | + | UNPROTECT(2); |
|
| 100 | + | return out; |
|
| 101 | + | } |
|
| 102 | + | ||
| 60 | 103 | SEXP map_impl(SEXP env, SEXP x_name_, SEXP f_name_, SEXP type_) { |
|
| 61 | 104 | const char* x_name = CHAR(Rf_asChar(x_name_)); |
|
| 62 | 105 | const char* f_name = CHAR(Rf_asChar(f_name_)); |
@@ -91,6 +134,42 @@
Loading
| 91 | 134 | return out; |
|
| 92 | 135 | } |
|
| 93 | 136 | ||
| 137 | + | SEXP map_matrix_impl(SEXP env, SEXP x_name_, SEXP f_name_, SEXP type_, SEXP n_elem_, SEXP by_row_) { |
|
| 138 | + | const char* x_name = CHAR(Rf_asChar(x_name_)); |
|
| 139 | + | const char* f_name = CHAR(Rf_asChar(f_name_)); |
|
| 140 | + | const int n_elem = Rf_asInteger(n_elem_); |
|
| 141 | + | const int by_row = Rf_asLogical(by_row_); |
|
| 142 | + | ||
| 143 | + | SEXP x = Rf_install(x_name); |
|
| 144 | + | SEXP f = Rf_install(f_name); |
|
| 145 | + | SEXP i = Rf_install("i"); |
|
| 146 | + | SEXPTYPE type = Rf_str2type(CHAR(Rf_asChar(type_))); |
|
| 147 | + | ||
| 148 | + | SEXP x_val = PROTECT(Rf_eval(x, env)); |
|
| 149 | + | check_vector(x_val, ".x"); |
|
| 150 | + | ||
| 151 | + | int n = Rf_length(x_val); |
|
| 152 | + | if (n == 0) { |
|
| 153 | + | SEXP out = PROTECT(Rf_allocVector(type, 0)); |
|
| 154 | + | copy_names(x_val, out); |
|
| 155 | + | UNPROTECT(2); |
|
| 156 | + | return out; |
|
| 157 | + | } |
|
| 158 | + | ||
| 159 | + | // Constructs a call like f(x[[i]], ...) - don't want to substitute |
|
| 160 | + | // actual values for f or x, because they may be long, which creates |
|
| 161 | + | // bad tracebacks() |
|
| 162 | + | SEXP Xi = PROTECT(Rf_lang3(R_Bracket2Symbol, x, i)); |
|
| 163 | + | SEXP f_call = PROTECT(Rf_lang3(f, Xi, R_DotsSymbol)); |
|
| 164 | + | ||
| 165 | + | SEXP out = PROTECT(call_loop_matrix(env, f_call, n, n_elem, type, 1, by_row)); |
|
| 166 | + | copy_names(x_val, out); |
|
| 167 | + | ||
| 168 | + | UNPROTECT(4); |
|
| 169 | + | ||
| 170 | + | return out; |
|
| 171 | + | } |
|
| 172 | + | ||
| 94 | 173 | SEXP map2_impl(SEXP env, SEXP x_name_, SEXP y_name_, SEXP f_name_, SEXP type_) { |
|
| 95 | 174 | const char* x_name = CHAR(Rf_asChar(x_name_)); |
|
| 96 | 175 | const char* y_name = CHAR(Rf_asChar(y_name_)); |
@@ -137,6 +216,54 @@
Loading
| 137 | 216 | return out; |
|
| 138 | 217 | } |
|
| 139 | 218 | ||
| 219 | + | SEXP map2_matrix_impl(SEXP env, SEXP x_name_, SEXP y_name_, SEXP f_name_, SEXP type_, SEXP n_elem_, SEXP by_row_) { |
|
| 220 | + | const char* x_name = CHAR(Rf_asChar(x_name_)); |
|
| 221 | + | const char* y_name = CHAR(Rf_asChar(y_name_)); |
|
| 222 | + | const char* f_name = CHAR(Rf_asChar(f_name_)); |
|
| 223 | + | const int n_elem = Rf_asInteger(n_elem_); |
|
| 224 | + | const int by_row = Rf_asLogical(by_row_); |
|
| 225 | + | ||
| 226 | + | SEXP x = Rf_install(x_name); |
|
| 227 | + | SEXP y = Rf_install(y_name); |
|
| 228 | + | SEXP f = Rf_install(f_name); |
|
| 229 | + | SEXP i = Rf_install("i"); |
|
| 230 | + | SEXPTYPE type = Rf_str2type(CHAR(Rf_asChar(type_))); |
|
| 231 | + | ||
| 232 | + | SEXP x_val = PROTECT(Rf_eval(x, env)); |
|
| 233 | + | check_vector(x_val, ".x"); |
|
| 234 | + | SEXP y_val = PROTECT(Rf_eval(y, env)); |
|
| 235 | + | check_vector(y_val, ".y"); |
|
| 236 | + | ||
| 237 | + | int nx = Rf_length(x_val), ny = Rf_length(y_val); |
|
| 238 | + | if (nx == 0 || ny == 0) { |
|
| 239 | + | SEXP out = PROTECT(Rf_allocVector(type, 0)); |
|
| 240 | + | copy_names(x_val, out); |
|
| 241 | + | UNPROTECT(3); |
|
| 242 | + | return out; |
|
| 243 | + | } |
|
| 244 | + | if (nx != ny && !(nx == 1 || ny == 1)) { |
|
| 245 | + | Rf_errorcall(R_NilValue, |
|
| 246 | + | "Mapped vectors must have consistent lengths:\n" |
|
| 247 | + | "* `.x` has length %d\n" |
|
| 248 | + | "* `.y` has length %d", |
|
| 249 | + | nx, |
|
| 250 | + | ny); |
|
| 251 | + | } |
|
| 252 | + | int n = (nx > ny) ? nx : ny; |
|
| 253 | + | ||
| 254 | + | // Constructs a call like f(x[[i]], y[[i]], ...) |
|
| 255 | + | SEXP one = PROTECT(Rf_ScalarInteger(1)); |
|
| 256 | + | SEXP Xi = PROTECT(Rf_lang3(R_Bracket2Symbol, x, nx == 1 ? one : i)); |
|
| 257 | + | SEXP Yi = PROTECT(Rf_lang3(R_Bracket2Symbol, y, ny == 1 ? one : i)); |
|
| 258 | + | SEXP f_call = PROTECT(Rf_lang4(f, Xi, Yi, R_DotsSymbol)); |
|
| 259 | + | ||
| 260 | + | SEXP out = PROTECT(call_loop_matrix(env, f_call, n, n_elem, type, 2, by_row)); |
|
| 261 | + | copy_names(x_val, out); |
|
| 262 | + | ||
| 263 | + | UNPROTECT(7); |
|
| 264 | + | return out; |
|
| 265 | + | } |
|
| 266 | + | ||
| 140 | 267 | SEXP pmap_impl(SEXP env, SEXP l_name_, SEXP f_name_, SEXP type_) { |
|
| 141 | 268 | const char* l_name = CHAR(Rf_asChar(l_name_)); |
|
| 142 | 269 | SEXP l = Rf_install(l_name); |
@@ -229,3 +356,98 @@
Loading
| 229 | 356 | UNPROTECT(5); |
|
| 230 | 357 | return out; |
|
| 231 | 358 | } |
|
| 359 | + | ||
| 360 | + | SEXP pmap_matrix_impl(SEXP env, SEXP l_name_, SEXP f_name_, SEXP type_, SEXP n_elem_, SEXP by_row_) { |
|
| 361 | + | const char* l_name = CHAR(Rf_asChar(l_name_)); |
|
| 362 | + | SEXP l = Rf_install(l_name); |
|
| 363 | + | SEXP l_val = PROTECT(Rf_eval(l, env)); |
|
| 364 | + | SEXPTYPE type = Rf_str2type(CHAR(Rf_asChar(type_))); |
|
| 365 | + | const int n_elem = Rf_asInteger(n_elem_); |
|
| 366 | + | const int by_row = Rf_asLogical(by_row_); |
|
| 367 | + | ||
| 368 | + | if (!Rf_isVectorList(l_val)) { |
|
| 369 | + | stop_bad_type(l_val, "a list", NULL, l_name); |
|
| 370 | + | } |
|
| 371 | + | ||
| 372 | + | // Check all elements are lists and find maximum length |
|
| 373 | + | int m = Rf_length(l_val); |
|
| 374 | + | int n = 0; |
|
| 375 | + | for (int j = 0; j < m; ++j) { |
|
| 376 | + | SEXP j_val = VECTOR_ELT(l_val, j); |
|
| 377 | + | ||
| 378 | + | if (!Rf_isVector(j_val) && !Rf_isNull(j_val)) { |
|
| 379 | + | stop_bad_element_type(j_val, j + 1, "a vector", NULL, l_name); |
|
| 380 | + | } |
|
| 381 | + | ||
| 382 | + | int nj = Rf_length(j_val); |
|
| 383 | + | ||
| 384 | + | if (nj == 0) { |
|
| 385 | + | SEXP out = PROTECT(Rf_allocVector(type, 0)); |
|
| 386 | + | copy_names(j_val, out); |
|
| 387 | + | UNPROTECT(2); |
|
| 388 | + | return out; |
|
| 389 | + | } |
|
| 390 | + | ||
| 391 | + | if (nj > n) { |
|
| 392 | + | n = nj; |
|
| 393 | + | } |
|
| 394 | + | ||
| 395 | + | } |
|
| 396 | + | ||
| 397 | + | // Check length of all elements |
|
| 398 | + | for (int j = 0; j < m; ++j) { |
|
| 399 | + | SEXP j_val = VECTOR_ELT(l_val, j); |
|
| 400 | + | int nj = Rf_length(j_val); |
|
| 401 | + | ||
| 402 | + | if (nj != 1 && nj != n) { |
|
| 403 | + | stop_bad_element_length(j_val, j + 1, n, NULL, ".l", true); |
|
| 404 | + | } |
|
| 405 | + | } |
|
| 406 | + | ||
| 407 | + | SEXP l_names = PROTECT(Rf_getAttrib(l_val, R_NamesSymbol)); |
|
| 408 | + | int has_names = !Rf_isNull(l_names); |
|
| 409 | + | ||
| 410 | + | const char* f_name = CHAR(Rf_asChar(f_name_)); |
|
| 411 | + | SEXP f = Rf_install(f_name); |
|
| 412 | + | SEXP i = Rf_install("i"); |
|
| 413 | + | SEXP one = PROTECT(Rf_ScalarInteger(1)); |
|
| 414 | + | ||
| 415 | + | // Construct call like f(.l[[1]][[i]], .l[[2]][[i]], ...) |
|
| 416 | + | // |
|
| 417 | + | // Currently accessing S3 vectors in a list like .l[[c(1, i)]] will not |
|
| 418 | + | // preserve the class (cf. #358). |
|
| 419 | + | // |
|
| 420 | + | // We construct the call backwards because can only add to the front of a |
|
| 421 | + | // linked list. That makes PROTECTion tricky because we need to update it |
|
| 422 | + | // each time to point to the start of the linked list. |
|
| 423 | + | ||
| 424 | + | SEXP f_call = Rf_lang1(R_DotsSymbol); |
|
| 425 | + | PROTECT_INDEX fi; |
|
| 426 | + | PROTECT_WITH_INDEX(f_call, &fi); |
|
| 427 | + | ||
| 428 | + | for (int j = m - 1; j >= 0; --j) { |
|
| 429 | + | int nj = Rf_length(VECTOR_ELT(l_val, j)); |
|
| 430 | + | ||
| 431 | + | // Construct call like .l[[j]][[i]] |
|
| 432 | + | SEXP j_ = PROTECT(Rf_ScalarInteger(j + 1)); |
|
| 433 | + | SEXP l_j = PROTECT(Rf_lang3(R_Bracket2Symbol, l, j_)); |
|
| 434 | + | SEXP l_ji = PROTECT(Rf_lang3(R_Bracket2Symbol, l_j, nj == 1 ? one : i)); |
|
| 435 | + | ||
| 436 | + | REPROTECT(f_call = Rf_lcons(l_ji, f_call), fi); |
|
| 437 | + | if (has_names && CHAR(STRING_ELT(l_names, j))[0] != '\0') |
|
| 438 | + | SET_TAG(f_call, Rf_install(CHAR(STRING_ELT(l_names, j)))); |
|
| 439 | + | ||
| 440 | + | UNPROTECT(3); |
|
| 441 | + | } |
|
| 442 | + | ||
| 443 | + | REPROTECT(f_call = Rf_lcons(f, f_call), fi); |
|
| 444 | + | ||
| 445 | + | SEXP out = PROTECT(call_loop_matrix(env, f_call, n, n_elem, type, m, by_row)); |
|
| 446 | + | ||
| 447 | + | if (Rf_length(l_val)) { |
|
| 448 | + | copy_names(VECTOR_ELT(l_val, 0), out); |
|
| 449 | + | } |
|
| 450 | + | ||
| 451 | + | UNPROTECT(5); |
|
| 452 | + | return out; |
|
| 453 | + | } |
Sunburst
The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file.
The size and color of each slice is representing the number of statements and the coverage, respectively.
Icicle
The top section represents the entire project. Proceeding with folders and finally individual files.
The size and color of each slice is representing the number of statements and the coverage, respectively.
