Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Fill down or _up_. Fixes #114.
  • Loading branch information
hadley committed Dec 30, 2015
1 parent 9b773fb commit 37108ce
Show file tree
Hide file tree
Showing 8 changed files with 150 additions and 20 deletions.
3 changes: 3 additions & 0 deletions NEWS.md
@@ -1,5 +1,8 @@
# tidyr 0.3.1.9000

* `fill()` gains a direction argument so that it can fill either upwards or
downwards (#114).

* `nest()` now produces a single list of data frames called "data" rather
than a list column for each variable. Nesting variables are not included
in nested data frames. It also works with grouped data frames made
Expand Down
8 changes: 6 additions & 2 deletions R/RcppExports.R
@@ -1,8 +1,12 @@
# This file was generated by Rcpp::compileAttributes
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

fillVector <- function(x, rev = FALSE) {
.Call('tidyr_fillVector', PACKAGE = 'tidyr', x, rev)
fillDown <- function(x) {
.Call('tidyr_fillDown', PACKAGE = 'tidyr', x)
}

fillUp <- function(x) {
.Call('tidyr_fillUp', PACKAGE = 'tidyr', x)
}

matrixToDataFrame <- function(x) {
Expand Down
16 changes: 10 additions & 6 deletions R/fill.R
Expand Up @@ -13,13 +13,14 @@ NULL
#' \code{-y}. For more options, see the \link[dplyr]{select} documentation.
#' @export
#' @inheritParams extract_
#' @inheritParams fill_
#' @export
#' @examples
#' df <- data.frame(Month = 1:12, Year = c(2000, rep(NA, 11)))
#' df %>% fill(Year)
fill <- function(data, ...) {
fill <- function(data, ..., .direction = c("down", "up")) {
fill_cols <- unname(dplyr::select_vars(names(data), ...))
fill_(data, fill_cols)
fill_(data, fill_cols, .direction = .direction)
}

#' Standard-evaluation version of \code{fill}.
Expand All @@ -28,18 +29,21 @@ fill <- function(data, ...) {
#'
#' @param data A data frame.
#' @param fill_cols Character vector of column names.
#' @param .direction Direction in which to fill missing values. Currently
#' either "down" (the default) or "up".
#' @keywords internal
#' @export
fill_ <- function(data, fill_cols) {
fill_ <- function(data, fill_cols, .direction = c("down", "up")) {
UseMethod("fill_")
}

#' @export
fill_.data.frame <- function(data, fill_cols) {
fill_.data.frame <- function(data, fill_cols, .direction = c("down", "up")) {
.direction <- match.arg(.direction)
fillVector <- switch(.direction, down = fillDown, up = fillUp)

for (col in fill_cols) {
old_attr <- attributes(data[[col]])
data[[col]] <- fillVector(data[[col]])
attributes(data[[col]]) <- old_attr
}

data
Expand Down
5 changes: 4 additions & 1 deletion man/fill.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

5 changes: 4 additions & 1 deletion man/fill_.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

20 changes: 15 additions & 5 deletions src/RcppExports.cpp
Expand Up @@ -5,15 +5,25 @@

using namespace Rcpp;

// fillVector
SEXP fillVector(SEXP x, bool rev);
RcppExport SEXP tidyr_fillVector(SEXP xSEXP, SEXP revSEXP) {
// fillDown
SEXP fillDown(SEXP x);
RcppExport SEXP tidyr_fillDown(SEXP xSEXP) {
BEGIN_RCPP
Rcpp::RObject __result;
Rcpp::RNGScope __rngScope;
Rcpp::traits::input_parameter< SEXP >::type x(xSEXP);
Rcpp::traits::input_parameter< bool >::type rev(revSEXP);
__result = Rcpp::wrap(fillVector(x, rev));
__result = Rcpp::wrap(fillDown(x));
return __result;
END_RCPP
}
// fillUp
SEXP fillUp(SEXP x);
RcppExport SEXP tidyr_fillUp(SEXP xSEXP) {
BEGIN_RCPP
Rcpp::RObject __result;
Rcpp::RNGScope __rngScope;
Rcpp::traits::input_parameter< SEXP >::type x(xSEXP);
__result = Rcpp::wrap(fillUp(x));
return __result;
END_RCPP
}
Expand Down
70 changes: 69 additions & 1 deletion src/fill.cpp
Expand Up @@ -2,7 +2,7 @@
using namespace Rcpp;

// [[Rcpp::export]]
SEXP fillVector(SEXP x, bool rev = false) {
SEXP fillDown(SEXP x) {
int n = Rf_length(x);
SEXP out = Rf_allocVector(TYPEOF(x), n);

Expand Down Expand Up @@ -63,5 +63,73 @@ SEXP fillVector(SEXP x, bool rev = false) {
stop("Don't know how to handle column of type", Rf_type2char(TYPEOF(x)));
}

Rf_copyMostAttrib(x, out);
return out;
}


// [[Rcpp::export]]
SEXP fillUp(SEXP x) {
int n = Rf_length(x);
SEXP out = Rf_allocVector(TYPEOF(x), n);

switch(TYPEOF(x)) {
case LGLSXP: {
int* xin = LOGICAL(x);
int* xout = LOGICAL(out);

int lastVal = xin[n - 1];

for (int i = n - 1; i >= 0; --i) {
if (xin[i] != NA_LOGICAL)
lastVal = xin[i];
xout[i] = lastVal;
}
break;
}
case INTSXP: {
int* xin = INTEGER(x);
int* xout = INTEGER(out);

int lastVal = xin[n - 1];

for (int i = n - 1; i >= 0; --i) {
if (xin[i] != NA_INTEGER)
lastVal = xin[i];
xout[i] = lastVal;
}
break;

}
case REALSXP: {
double* xin = REAL(x);
double* xout = REAL(out);

double lastVal = xin[n - 1];

for (int i = n - 1; i >= 0; --i) {
if (!ISNA(xin[i]))
lastVal = xin[i];
xout[i] = lastVal;
}
break;

}
case STRSXP: {
SEXP lastVal = NA_STRING;

for (int i = n - 1; i >= 0; --i) {
if (STRING_ELT(x, i) != NA_STRING)
lastVal = STRING_ELT(x, i);
SET_STRING_ELT(out, i, lastVal);
}
break;

}
default:
stop("Don't know how to handle column of type", Rf_type2char(TYPEOF(x)));
}

Rf_copyMostAttrib(x, out);
return out;
}
43 changes: 39 additions & 4 deletions tests/testthat/test-fill.R
Expand Up @@ -8,18 +8,28 @@ test_that("all missings left unchanged", {
chr = c(NA_character_, NA)
)

out <- fill(df, lgl, int, dbl, chr)
expect_identical(out, df)
down <- fill(df, lgl, int, dbl, chr)
up <- fill(df, lgl, int, dbl, chr, .direction = "up")

expect_identical(down, df)
expect_identical(up, df)
})

test_that("missings filled from last non-missing", {
test_that("missings filled down from last non-missing", {
df <- dplyr::data_frame(x = c(1, NA, NA))

out <- fill(df, x)
expect_equal(out$x, c(1, 1, 1))
})

test_that("missings filled for each atomic vector", {
test_that("missings filled up from last non-missing", {
df <- dplyr::data_frame(x = c(NA, NA, 1))

out <- fill(df, x, .direction = "up")
expect_equal(out$x, c(1, 1, 1))
})

test_that("missings filled down for each atomic vector", {
df <- dplyr::data_frame(
lgl = c(T, NA),
int = c(1L, NA),
Expand All @@ -33,3 +43,28 @@ test_that("missings filled for each atomic vector", {
expect_equal(out$dbl, c(1, 1))
expect_equal(out$chr, c("a", "a"))
})

test_that("missings filled up for each atomic vector", {
df <- dplyr::data_frame(
lgl = c(NA, T),
int = c(NA, 1L),
dbl = c(NA, 1),
chr = c(NA, "a")
)

out <- fill(df, lgl, int, dbl, chr, .direction = "up")
expect_equal(out$lgl, c(TRUE, TRUE))
expect_equal(out$int, c(1L, 1L))
expect_equal(out$dbl, c(1, 1))
expect_equal(out$chr, c("a", "a"))
})

test_that("fill preserves attributes", {
df <- dplyr::data_frame(x = factor(c(NA, "a", NA)))

out_d <- fill(df, x)
out_u <- fill(df, x, .direction = "up")

expect_equal(attributes(out_d$x), attributes(df$x))
expect_equal(attributes(out_u$x), attributes(df$x))
})

0 comments on commit 37108ce

Please sign in to comment.