Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Add purrr_continue() #1100

Open
wants to merge 1 commit into
base: main
Choose a base branch
from
Open

Add purrr_continue() #1100

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
37 changes: 35 additions & 2 deletions R/map.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -169,13 +169,46 @@ map_ <- function(.type,
names <- vec_names(.x)

.f <- as_mapper(.f, ...)

i <- 0L
print(i)
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

For some reason I don't understand in the second run i is 5 at this point even though we just assigned 0 to it...


the$last_map_index <- NULL
the$last_map_results <- NULL
the$last_map <- list(
env = current_env(),
call = expr(call_with_cleanup(map_impl, environment(), .type, .progress, n, names, i, the))
)

with_indexed_errors(
i = i,
names = names,
error_call = .purrr_error_call,
call_with_cleanup(map_impl, environment(), .type, .progress, n, names, i)
call_with_cleanup(map_impl, environment(), .type, .progress, n, names, i, the)
)
}

purrr_continue <- function(.f = NULL) {
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It would be even nicer if updating the original .f would work, i.e.

map(x, f)
# something went wrong

# update `f`
f <- function(x) ...
# no need to pass the new `f` to `purrr_continue()`
purrr_continue()

# add 0 to force a copy
i <- the$last_map_index + 0L
last_map_index <- the$last_map_index
last_map_results <- the$last_map_results

env2 <- the$last_map$env
env2$.f <- .f %||% the$last_map$.f
env2$i <- i

new_map_results <- with_indexed_errors(
i = i,
names = env2$names,
error_call = env2$.purrr_error_call,
rlang::eval_bare(the$last_map$call, env = env2)
)

idx <- seq2(1, last_map_index)
vctrs::vec_assign(
new_map_results,
idx,
vctrs::vec_slice(last_map_results, idx)
)
}

Expand Down
2 changes: 1 addition & 1 deletion R/map2.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -79,7 +79,7 @@ map2_ <- function(.type,
i = i,
names = names,
error_call = .purrr_error_call,
call_with_cleanup(map2_impl, environment(), .type, .progress, n, names, i)
call_with_cleanup(map2_impl, environment(), .type, .progress, n, names, i, the)
)
}

Expand Down
3 changes: 3 additions & 0 deletions R/package-purrr.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,3 +7,6 @@
"_PACKAGE"

the <- new_environment()
the$last_map_results <- NULL
the$last_map_index <- NULL
the$last_map <- NULL
2 changes: 1 addition & 1 deletion R/pmap.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -128,7 +128,7 @@ pmap_ <- function(.type,
i = i,
names = names,
error_call = .purrr_error_call,
call_with_cleanup(pmap_impl, environment(), .type, .progress, n, names, i, call_names, call_n)
call_with_cleanup(pmap_impl, environment(), .type, .progress, n, names, i, call_names, call_n, the)
)
}

Expand Down
12 changes: 6 additions & 6 deletions src/init.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -13,9 +13,9 @@
extern SEXP coerce_impl(SEXP, SEXP);
extern SEXP pluck_impl(SEXP, SEXP, SEXP, SEXP);
extern SEXP flatten_impl(SEXP);
extern SEXP map_impl(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
extern SEXP map2_impl(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
extern SEXP pmap_impl(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
extern SEXP map_impl(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
extern SEXP map2_impl(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
extern SEXP pmap_impl(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
extern SEXP transpose_impl(SEXP, SEXP);
extern SEXP vflatten_impl(SEXP, SEXP);

Expand All @@ -24,9 +24,9 @@ static const R_CallMethodDef CallEntries[] = {
{"coerce_impl", (DL_FUNC) &coerce_impl, 2},
{"pluck_impl", (DL_FUNC) &pluck_impl, 4},
{"flatten_impl", (DL_FUNC) &flatten_impl, 1},
{"map_impl", (DL_FUNC) &map_impl, 6},
{"map2_impl", (DL_FUNC) &map2_impl, 6},
{"pmap_impl", (DL_FUNC) &pmap_impl, 8},
{"map_impl", (DL_FUNC) &map_impl, 7},
{"map2_impl", (DL_FUNC) &map2_impl, 7},
{"pmap_impl", (DL_FUNC) &pmap_impl, 9},
{"transpose_impl", (DL_FUNC) &transpose_impl, 2},
{"vflatten_impl", (DL_FUNC) &vflatten_impl, 2},
{"purrr_eval", (DL_FUNC) &Rf_eval, 2},
Expand Down
33 changes: 24 additions & 9 deletions src/map.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -25,15 +25,24 @@ SEXP call_loop(SEXP env,
int n,
SEXP names,
int* p_i,
int force) {
int force,
SEXP the_env) {
SEXP bar = cli_progress_bar(n, progress);
R_PreserveObject(bar);
r_call_on_exit((void (*)(void*)) cb_progress_done, (void*) bar);

SEXP results_symbol = Rf_install("last_map_results");
SEXP index_symbol = Rf_install("last_map_index");
int start = *p_i;
SEXP index = PROTECT(Rf_ScalarInteger(start));
Rf_defineVar(index_symbol, index, the_env);

SEXP out = PROTECT(Rf_allocVector(type, n));
Rf_defineVar(results_symbol, out, the_env);
Rf_setAttrib(out, R_NamesSymbol, names);

for (int i = 0; i < n; ++i) {
for (int i = start; i < n; ++i) {
SET_INTEGER_ELT(index, 0, i);
*p_i = i + 1;

if (CLI_SHOULD_TICK) {
Expand All @@ -55,7 +64,7 @@ SEXP call_loop(SEXP env,

*p_i = 0;

UNPROTECT(1);
UNPROTECT(2);
return out;
}

Expand All @@ -64,7 +73,8 @@ SEXP map_impl(SEXP env,
SEXP progress,
SEXP ffi_n,
SEXP names,
SEXP i) {
SEXP i,
SEXP the_env) {
static SEXP call = NULL;
if (call == NULL) {
SEXP x_sym = Rf_install(".x");
Expand Down Expand Up @@ -95,7 +105,8 @@ SEXP map_impl(SEXP env,
n,
names,
p_i,
force
force,
the_env
);
}

Expand All @@ -104,7 +115,8 @@ SEXP map2_impl(SEXP env,
SEXP progress,
SEXP ffi_n,
SEXP names,
SEXP i) {
SEXP i,
SEXP the_env) {
static SEXP call = NULL;
if (call == NULL) {
SEXP x_sym = Rf_install(".x");
Expand Down Expand Up @@ -135,7 +147,8 @@ SEXP map2_impl(SEXP env,
n,
names,
p_i,
force
force,
the_env
);
}

Expand All @@ -146,7 +159,8 @@ SEXP pmap_impl(SEXP env,
SEXP names,
SEXP i,
SEXP call_names,
SEXP ffi_call_n) {
SEXP ffi_call_n,
SEXP the_env) {
// Construct call like f(.l[[1]][[i]], .l[[2]][[i]], ...)
//
// Currently accessing S3 vectors in a list like .l[[c(1, i)]] will not
Expand Down Expand Up @@ -203,7 +217,8 @@ SEXP pmap_impl(SEXP env,
n,
names,
p_i,
force
force,
the_env
);

UNPROTECT(1);
Expand Down
Loading