Skip to content

Instantly share code, notes, and snippets.

@mikmart
Last active September 27, 2019 13:41
Show Gist options
  • Save mikmart/b0ad390c85cf472166cf57d04b3e89cc to your computer and use it in GitHub Desktop.
Save mikmart/b0ad390c85cf472166cf57d04b3e89cc to your computer and use it in GitHub Desktop.
A dplyr-like verb to move columns in a data frame
vars_select_pos <- function(.vars, ...) {
match(tidyselect::vars_select(.vars, ...), .vars)
}
before <- function(..., .vars = tidyselect::peek_vars()) {
min(vars_select_pos(.vars, ...)) - 1
}
after <- function(..., .vars = tidyselect::peek_vars()) {
max(vars_select_pos(.vars, ...))
}
move <- function(.data, .position, ...) {
pos <- tidyselect::with_vars(names(.data), .position)
if ((n <- length(pos)) != 1) {
stop("`.position` must have length 1, not ", n, ".", call. = FALSE)
}
sels <- setdiff(vars_select_pos(names(.data), ...), pos)
head <- setdiff(seq_len(pos), sels)
select(.data, !!!head, !!!sels, everything())
}
library(dplyr)
head(iris) %>%
move(before(1), Species)
#> Species Sepal.Length Sepal.Width Petal.Length Petal.Width
#> 1 setosa 5.1 3.5 1.4 0.2
#> 2 setosa 4.9 3.0 1.4 0.2
#> 3 setosa 4.7 3.2 1.3 0.2
#> 4 setosa 4.6 3.1 1.5 0.2
#> 5 setosa 5.0 3.6 1.4 0.2
#> 6 setosa 5.4 3.9 1.7 0.4
head(iris) %>%
move(after(last_col()), 1)
#> Sepal.Width Petal.Length Petal.Width Species Sepal.Length
#> 1 3.5 1.4 0.2 setosa 5.1
#> 2 3.0 1.4 0.2 setosa 4.9
#> 3 3.2 1.3 0.2 setosa 4.7
#> 4 3.1 1.5 0.2 setosa 4.6
#> 5 3.6 1.4 0.2 setosa 5.0
#> 6 3.9 1.7 0.4 setosa 5.4
head(iris) %>%
move(after(ends_with("Length")), ends_with("Width"))
#> Sepal.Length Petal.Length Sepal.Width Petal.Width Species
#> 1 5.1 1.4 3.5 0.2 setosa
#> 2 4.9 1.4 3.0 0.2 setosa
#> 3 4.7 1.3 3.2 0.2 setosa
#> 4 4.6 1.5 3.1 0.2 setosa
#> 5 5.0 1.4 3.6 0.2 setosa
#> 6 5.4 1.7 3.9 0.4 setosa
head(iris) %>%
move(ends_with("Length"), ends_with("Width"))
#> Error: `.position` must have length 1, not 2.
# alternative API, matching tibble::add_column()
position_from_before_after <- function(.before, .after, .vars) {
before_is_null <- rlang::quo_is_null(enquo(.before))
after_is_null <- rlang::quo_is_null(enquo(.after))
if (!xor(before_is_null, after_is_null)) {
stop("Must supply either `.before` or `.after`.", call. = FALSE)
}
if (before_is_null) {
after({{ .after }}, .vars = .vars)
} else {
before({{ .before }}, .vars = .vars)
}
}
move <- function(.data, ..., .before = NULL, .after = NULL) {
pos <- position_from_before_after({{ .before }}, {{ .after }}, names(.data))
sels <- setdiff(vars_select_pos(names(.data), ...), pos)
head <- setdiff(seq_len(pos), sels)
select(.data, !!!head, !!!sels, everything())
}
head(iris) %>%
move(Species, .before = 1)
#> Species Sepal.Length Sepal.Width Petal.Length Petal.Width
#> 1 setosa 5.1 3.5 1.4 0.2
#> 2 setosa 4.9 3.0 1.4 0.2
#> 3 setosa 4.7 3.2 1.3 0.2
#> 4 setosa 4.6 3.1 1.5 0.2
#> 5 setosa 5.0 3.6 1.4 0.2
#> 6 setosa 5.4 3.9 1.7 0.4
head(iris) %>%
move(1, .after = last_col())
#> Sepal.Width Petal.Length Petal.Width Species Sepal.Length
#> 1 3.5 1.4 0.2 setosa 5.1
#> 2 3.0 1.4 0.2 setosa 4.9
#> 3 3.2 1.3 0.2 setosa 4.7
#> 4 3.1 1.5 0.2 setosa 4.6
#> 5 3.6 1.4 0.2 setosa 5.0
#> 6 3.9 1.7 0.4 setosa 5.4
head(iris) %>%
move(ends_with("Width"), .after = ends_with("Length"))
#> Sepal.Length Petal.Length Sepal.Width Petal.Width Species
#> 1 5.1 1.4 3.5 0.2 setosa
#> 2 4.9 1.4 3.0 0.2 setosa
#> 3 4.7 1.3 3.2 0.2 setosa
#> 4 4.6 1.5 3.1 0.2 setosa
#> 5 5.0 1.4 3.6 0.2 setosa
#> 6 5.4 1.7 3.9 0.4 setosa
head(iris) %>%
move(.after = Species, ends_with("Length"), ends_with("Width"))
#> Species Sepal.Length Petal.Length Sepal.Width Petal.Width
#> 1 setosa 5.1 1.4 3.5 0.2
#> 2 setosa 4.9 1.4 3.0 0.2
#> 3 setosa 4.7 1.3 3.2 0.2
#> 4 setosa 4.6 1.5 3.1 0.2
#> 5 setosa 5.0 1.4 3.6 0.2
#> 6 setosa 5.4 1.7 3.9 0.4
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment