Skip to content

Commit

Permalink
evaluate the [ in the frame
Browse files Browse the repository at this point in the history
  • Loading branch information
romainfrancois committed Oct 18, 2018
1 parent 323b199 commit e0cf600
Show file tree
Hide file tree
Showing 13 changed files with 133 additions and 116 deletions.
36 changes: 18 additions & 18 deletions R/RcppExports.R
Original file line number Diff line number Diff line change
Expand Up @@ -38,8 +38,8 @@ maybe_shared_columns <- function(df) {
.Call(`_dplyr_maybe_shared_columns`, df)
}

arrange_impl <- function(df, quosures) {
.Call(`_dplyr_arrange_impl`, df, quosures)
arrange_impl <- function(df, quosures, frame) {
.Call(`_dplyr_arrange_impl`, df, quosures, frame)
}

#' Do values in a numeric vector fall in specified range?
Expand Down Expand Up @@ -76,8 +76,8 @@ combine_all <- function(data) {
.Call(`_dplyr_combine_all`, data)
}

distinct_impl <- function(df, vars, keep) {
.Call(`_dplyr_distinct_impl`, df, vars, keep)
distinct_impl <- function(df, vars, keep, frame) {
.Call(`_dplyr_distinct_impl`, df, vars, keep, frame)
}

n_distinct_multi <- function(variables, na_rm = FALSE) {
Expand Down Expand Up @@ -120,32 +120,32 @@ hybrids <- function() {
.Call(`_dplyr_hybrids`)
}

semi_join_impl <- function(x, y, by_x, by_y, na_match) {
.Call(`_dplyr_semi_join_impl`, x, y, by_x, by_y, na_match)
semi_join_impl <- function(x, y, by_x, by_y, na_match, frame) {
.Call(`_dplyr_semi_join_impl`, x, y, by_x, by_y, na_match, frame)
}

anti_join_impl <- function(x, y, by_x, by_y, na_match) {
.Call(`_dplyr_anti_join_impl`, x, y, by_x, by_y, na_match)
anti_join_impl <- function(x, y, by_x, by_y, na_match, frame) {
.Call(`_dplyr_anti_join_impl`, x, y, by_x, by_y, na_match, frame)
}

inner_join_impl <- function(x, y, by_x, by_y, aux_x, aux_y, na_match) {
.Call(`_dplyr_inner_join_impl`, x, y, by_x, by_y, aux_x, aux_y, na_match)
inner_join_impl <- function(x, y, by_x, by_y, aux_x, aux_y, na_match, frame) {
.Call(`_dplyr_inner_join_impl`, x, y, by_x, by_y, aux_x, aux_y, na_match, frame)
}

nest_join_impl <- function(x, y, by_x, by_y, aux_y, yname) {
.Call(`_dplyr_nest_join_impl`, x, y, by_x, by_y, aux_y, yname)
nest_join_impl <- function(x, y, by_x, by_y, aux_y, yname, frame) {
.Call(`_dplyr_nest_join_impl`, x, y, by_x, by_y, aux_y, yname, frame)
}

left_join_impl <- function(x, y, by_x, by_y, aux_x, aux_y, na_match) {
.Call(`_dplyr_left_join_impl`, x, y, by_x, by_y, aux_x, aux_y, na_match)
left_join_impl <- function(x, y, by_x, by_y, aux_x, aux_y, na_match, frame) {
.Call(`_dplyr_left_join_impl`, x, y, by_x, by_y, aux_x, aux_y, na_match, frame)
}

right_join_impl <- function(x, y, by_x, by_y, aux_x, aux_y, na_match) {
.Call(`_dplyr_right_join_impl`, x, y, by_x, by_y, aux_x, aux_y, na_match)
right_join_impl <- function(x, y, by_x, by_y, aux_x, aux_y, na_match, frame) {
.Call(`_dplyr_right_join_impl`, x, y, by_x, by_y, aux_x, aux_y, na_match, frame)
}

full_join_impl <- function(x, y, by_x, by_y, aux_x, aux_y, na_match) {
.Call(`_dplyr_full_join_impl`, x, y, by_x, by_y, aux_x, aux_y, na_match)
full_join_impl <- function(x, y, by_x, by_y, aux_x, aux_y, na_match, frame) {
.Call(`_dplyr_full_join_impl`, x, y, by_x, by_y, aux_x, aux_y, na_match, frame)
}

mutate_impl <- function(df, dots) {
Expand Down
2 changes: 1 addition & 1 deletion R/dataframe.R
Original file line number Diff line number Diff line change
Expand Up @@ -213,7 +213,7 @@ distinct.data.frame <- function(.data, ..., .keep_all = FALSE) {
dist <- distinct_vars(.data, quos(...), .keep_all = .keep_all)
vars <- match_vars(dist$vars, dist$data)
keep <- match_vars(dist$keep, dist$data)
distinct_impl(dist$data, vars, keep)
distinct_impl(dist$data, vars, keep, environment())
}
#' @export
distinct_.data.frame <- function(.data, ..., .dots = list(), .keep_all = FALSE) {
Expand Down
2 changes: 1 addition & 1 deletion R/grouped-df.r
Original file line number Diff line number Diff line change
Expand Up @@ -355,7 +355,7 @@ distinct.grouped_df <- function(.data, ..., .keep_all = FALSE) {
)
vars <- match_vars(dist$vars, dist$data)
keep <- match_vars(dist$keep, dist$data)
out <- distinct_impl(dist$data, vars, keep)
out <- distinct_impl(dist$data, vars, keep, environment())
grouped_df(out, groups(.data))
}
#' @export
Expand Down
2 changes: 1 addition & 1 deletion R/manip.r
Original file line number Diff line number Diff line change
Expand Up @@ -510,7 +510,7 @@ arrange.grouped_df <- function(.data, ..., .by_group = FALSE) {
dots <- quos(...)
}

arrange_impl(.data, dots)
arrange_impl(.data, dots, environment())
}

#' Select/rename variables by name
Expand Down
18 changes: 9 additions & 9 deletions R/tbl-df.r
Original file line number Diff line number Diff line change
Expand Up @@ -43,12 +43,12 @@ as.data.frame.tbl_df <- function(x, row.names = NULL, optional = FALSE, ...) {
#' @export
arrange.tbl_df <- function(.data, ..., .by_group = FALSE) {
dots <- quos(...)
arrange_impl(.data, dots)
arrange_impl(.data, dots, environment())
}
#' @export
arrange_.tbl_df <- function(.data, ..., .dots = list(), .by_group = FALSE) {
dots <- compat_lazy_dots(.dots, caller_env(), ...)
arrange_impl(.data, dots)
arrange_impl(.data, dots, environment())
}

#' @export
Expand Down Expand Up @@ -175,7 +175,7 @@ inner_join.tbl_df <- function(x, y, by = NULL, copy = FALSE,
aux_x <- vars$idx$x$aux
aux_y <- vars$idx$y$aux

out <- inner_join_impl(x, y, by_x, by_y, aux_x, aux_y, na_matches)
out <- inner_join_impl(x, y, by_x, by_y, aux_x, aux_y, na_matches, environment())
names(out) <- vars$alias

reconstruct_join(out, x, vars)
Expand All @@ -199,7 +199,7 @@ nest_join.tbl_df <- function(x, y, by = NULL, copy = FALSE, keep = FALSE, name =
aux_y <- c(by_y, aux_y)
}

out <- nest_join_impl(x, y, by_x, by_y, aux_y, name_var)
out <- nest_join_impl(x, y, by_x, by_y, aux_y, name_var, environment())
out
}

Expand All @@ -223,7 +223,7 @@ left_join.tbl_df <- function(x, y, by = NULL, copy = FALSE,
aux_x <- vars$idx$x$aux
aux_y <- vars$idx$y$aux

out <- left_join_impl(x, y, by_x, by_y, aux_x, aux_y, na_matches)
out <- left_join_impl(x, y, by_x, by_y, aux_x, aux_y, na_matches, environment())
names(out) <- vars$alias

reconstruct_join(out, x, vars)
Expand All @@ -248,7 +248,7 @@ right_join.tbl_df <- function(x, y, by = NULL, copy = FALSE,
aux_x <- vars$idx$x$aux
aux_y <- vars$idx$y$aux

out <- right_join_impl(x, y, by_x, by_y, aux_x, aux_y, na_matches)
out <- right_join_impl(x, y, by_x, by_y, aux_x, aux_y, na_matches, environment())
names(out) <- vars$alias

reconstruct_join(out, x, vars)
Expand All @@ -273,7 +273,7 @@ full_join.tbl_df <- function(x, y, by = NULL, copy = FALSE,
aux_x <- vars$idx$x$aux
aux_y <- vars$idx$y$aux

out <- full_join_impl(x, y, by_x, by_y, aux_x, aux_y, na_matches)
out <- full_join_impl(x, y, by_x, by_y, aux_x, aux_y, na_matches, environment())
names(out) <- vars$alias

reconstruct_join(out, x, vars)
Expand All @@ -288,7 +288,7 @@ semi_join.tbl_df <- function(x, y, by = NULL, copy = FALSE, ...,

by <- common_by(by, x, y)
y <- auto_copy(x, y, copy = copy)
out <- semi_join_impl(x, y, by$x, by$y, check_na_matches(na_matches))
out <- semi_join_impl(x, y, by$x, by$y, check_na_matches(na_matches), environment())
if (is_grouped_df(x)) {
out <- grouped_df_impl(out, group_vars(x))
}
Expand All @@ -304,7 +304,7 @@ anti_join.tbl_df <- function(x, y, by = NULL, copy = FALSE, ...,

by <- common_by(by, x, y)
y <- auto_copy(x, y, copy = copy)
out <- anti_join_impl(x, y, by$x, by$y, check_na_matches(na_matches))
out <- anti_join_impl(x, y, by$x, by$y, check_na_matches(na_matches), environment())
if (is_grouped_df(x)) {
out <- grouped_df_impl(out, group_vars(x))
}
Expand Down
5 changes: 3 additions & 2 deletions inst/include/dplyr/data/DataMask.h
Original file line number Diff line number Diff line change
Expand Up @@ -136,11 +136,12 @@ struct ColumnBinding {
const typename SlicedTibble::slicing_index& indices,
SEXP mask_resolved)
{
SEXP frame = ENCLOS(ENCLOS(mask_resolved));

// materialize
Shield<SEXP> value(summary ?
column_subset(data, RowwiseSlicingIndex(indices.group())) :
column_subset(data, indices)
column_subset(data, RowwiseSlicingIndex(indices.group()), frame) :
column_subset(data, indices, frame)
);
MARK_NOT_MUTABLE(value);

Expand Down
7 changes: 4 additions & 3 deletions inst/include/dplyr/visitors/subset/DataFrameSubsetVisitors.h
Original file line number Diff line number Diff line change
Expand Up @@ -10,22 +10,23 @@ namespace dplyr {
class DataFrameSubsetVisitors {
private:
DataFrame data;
SEXP frame;

public:
DataFrameSubsetVisitors(const DataFrame& data_): data(data_) {}
DataFrameSubsetVisitors(const DataFrame& data_, SEXP frame_): data(data_), frame(frame_) {}

inline int size() const {
return data.size();
}

template <typename Index>
DataFrame subset_all(const Index& index) const {
return dataframe_subset<Index>(data, index, get_class(data));
return dataframe_subset<Index>(data, index, get_class(data), frame);
}

template <typename Index>
SEXP subset_one(int i, const Index& index) const {
return column_subset(data[i], index);
return column_subset(data[i], index, frame);
}

};
Expand Down
28 changes: 12 additions & 16 deletions inst/include/dplyr/visitors/subset/column_subset.h
Original file line number Diff line number Diff line change
Expand Up @@ -105,41 +105,37 @@ SEXP column_subset_impl(SEXP x, const Index& index) {
}

template <typename Index>
DataFrame dataframe_subset(const List& data, const Index& index, CharacterVector classes);

inline SEXP r_subset_env(SEXP x) {
return IS_S4_OBJECT(x) ? ns_methods() : R_BaseEnv;
}
DataFrame dataframe_subset(const List& data, const Index& index, CharacterVector classes, SEXP frame);

template <typename Index>
SEXP r_column_subset(SEXP x, const Index& index) {
SEXP r_column_subset(SEXP x, const Index& index, SEXP frame) {
Shield<SEXP> one_based_index(index);
if (Rf_isMatrix(x)) {
return Language("[", x, one_based_index, R_MissingArg, _["drop"] = false).eval(r_subset_env(x));
return Language("[", x, one_based_index, R_MissingArg, _["drop"] = false).eval(frame);
} else {
return Language("[", x, one_based_index).eval(r_subset_env(x));
return Language("[", x, one_based_index).eval(frame);
}
}

template <>
inline SEXP r_column_subset<RowwiseSlicingIndex>(SEXP x, const RowwiseSlicingIndex& index) {
inline SEXP r_column_subset<RowwiseSlicingIndex>(SEXP x, const RowwiseSlicingIndex& index, SEXP frame) {
if (Rf_isMatrix(x)) {
// TODO: not sure about this
return Language("[", x, index, R_MissingArg).eval(r_subset_env(x));
return Language("[", x, index, R_MissingArg).eval(frame);
} else {
return Language("[[", x, index).eval(r_subset_env(x));
return Language("[[", x, index).eval(frame);
}
}

template <typename Index>
SEXP column_subset(SEXP x, const Index& index) {
SEXP column_subset(SEXP x, const Index& index, SEXP frame) {
if (Rf_inherits(x, "data.frame")) {
return dataframe_subset(x, index, Rf_getAttrib(x, R_ClassSymbol));
return dataframe_subset(x, index, Rf_getAttrib(x, R_ClassSymbol), frame);
}

// this has a class, so just use R `[` or `[[`
if (OBJECT(x) || !Rf_isNull(Rf_getAttrib(x, R_ClassSymbol))) {
return r_column_subset(x, index);
return r_column_subset(x, index, frame);
}

switch (TYPEOF(x)) {
Expand All @@ -166,12 +162,12 @@ SEXP column_subset(SEXP x, const Index& index) {
}

template <typename Index>
DataFrame dataframe_subset(const List& data, const Index& index, CharacterVector classes) {
DataFrame dataframe_subset(const List& data, const Index& index, CharacterVector classes, SEXP frame) {
int nc = data.size();
List res(nc);

for (int i = 0; i < nc; i++) {
res[i] = column_subset(data[i], index);
res[i] = column_subset(data[i], index, frame);
}

copy_most_attributes(res, data);
Expand Down
Loading

0 comments on commit e0cf600

Please sign in to comment.