CODEWITHSUNDEEP
rdplyr
moodymudskipper
moodymudskipper

Reputation: 47300

Move a column conveniently

There are great questions and answers on how to move a column to the first or last place.

Using dplyr The best answers are respectively analog to :

iris2 <- iris %>% head(2)
iris2 %>% select( Sepal.Width, everything()) # move Sepal.Width to first
#   Sepal.Width Sepal.Length Petal.Length Petal.Width Species
# 1         3.5          5.1          1.4         0.2  setosa
# 2         3.0          4.9          1.4         0.2  setosa

iris2 %>% select(-Sepal.Width, Sepal.Width) # move Sepal.Width to last
#   Sepal.Length Petal.Length Petal.Width Species Sepal.Width
# 1          5.1          1.4         0.2  setosa         3.5
# 2          4.9          1.4         0.2  setosa         3.0

However I didn't find any easy way to move a column after or before a given one.

Expected output :

iris2 %>% move_at(Species, Sepal.Width, side = "before") 
#   Sepal.Length Species Sepal.Width Petal.Length Petal.Width
# 1          5.1  setosa         3.5          1.4         0.2
# 2          4.9  setosa         3.0          1.4         0.2

iris2 %>% move_at(Species, Sepal.Width, side = "after")
#   Sepal.Length Sepal.Width Species Petal.Length Petal.Width
# 1          5.1         3.5  setosa          1.4         0.2
# 2          4.9         3.0  setosa          1.4         0.2

Upvotes: 11

Views: 1054

Answers (6)

hello_friend
hello_friend

Reputation: 5788

Another Base R solution (not sure how it benchmarks against the others).

# Function to move column names before or after another column name: 
# .move_vec_name_to => function 
.move_vec_name_to <- function(vec_names, move_vec_name, near_vec_name, side = c("before", "after")){
  # Resolve the side to move the col vector to: 
  # .side => character scalar
  .side <- match.arg(side)
  # Resolve the number of column vectors: n => integer scalar
  n <- length(vec_names)
  # Resolve the index of the col vector to be moved: 
  # move_vec_idx => integer scalar
  move_vec_idx <- which(vec_names == move_vec_name)
  # Resolve the index of where the col vector is to be 
  # moved to: near_vec_idx => integer scalar
  near_vec_idx <- which(vec_names == near_vec_name)
  # If we want to move something before or after and there is no need:
  if((move_vec_idx <= near_vec_idx & .side == "before") || (near_vec_idx <= move_vec_idx && .side == "after")){
    # Keep the names the same: new_col_name_vec => character vector 
    new_col_name_vec <- vec_names
    # Otherwise: 
  }else{
    # Drop the name of the vector to be moved from the col 
    # name vector: vec_wo_move_vec => character vector
    vec_wo_move_vec <- vec_names[-move_vec_idx]
    # Resolve the new column name vector: 
    # if we want to move the column before a given col vector: 
    if(.side == "before"){
      # new_col_name_vec => character vector
      new_col_name_vec <- c(
        vec_wo_move_vec[seq_len(near_vec_idx - 1)], 
        move_vec_name,
        near_vec_name, 
        vec_wo_move_vec[seq(pmin(near_vec_idx + 1, n), length(vec_names))]
      )[seq_len(n)]
      # Otherwise if we want to move it after: 
    }else{
      # new_col_name_vec => character vector
      new_col_name_vec <- c(
        vec_wo_move_vec[seq_len(pmax(near_vec_idx-2, 0))], 
        near_vec_name, 
        move_vec_name,
        vec_wo_move_vec[seq(pmax(near_vec_idx, 1), n, 1)]
      )[seq_len(n)]
    }
  }
  # Explicitly define the returned object: 
  # character vector => env
  return(new_col_name_vec)
}

# Function to move multiple vector names to a certain side of another vector name: 
# .move_vec_names_to => function 
.move_vec_names_to <- function(vec_names, move_vec_names, near_vec_name, side = c("before", "after")){
  # Resolve the side: .side => character vector
  .side <- match.arg(side)
  # Reverse the input vectors to be moved: .move_vec_names => character vector
  .move_vec_names <- if(.side == "after"){
    rev(move_vec_names)
  }else{
    move_vec_names
  }
  # Set the termination case: 
  if(length(.move_vec_names) <= 1){
    # Return vector names with columns moved: character vector => env
    return(
      .move_vec_name_to(
        vec_names, 
        .move_vec_names, 
        near_vec_name, 
        .side
      )
    )
    # Otherwise: 
  }else{
    # Apply the column movement function recursively: 
    # character vector => env
    return(
      .move_vec_name_to(
        .move_vec_name_to(
          vec_names, 
          .move_vec_names[1], 
          near_vec_name, 
          .side
        ), 
        .move_vec_names[-1], 
        near_vec_name, 
        .side
      )
    )
  }
}

# Function to move column vector before or after another column vector: 
# move_to => function
move_to <- function(df, move_vec_name, near_vec_name, side = c("before", "after")){
  # Resolve the side to move the col vector to: 
  # .side => character scalar
  .side <- match.arg(side)
  # Apply vector name move function: df => data.frame
  df <- if(length(move_vec_name) > 1){
    df[,.move_vec_names_to(colnames(df), move_vec_name, near_vec_name, .side), drop = FALSE]
  }else{
    df[,.move_vec_name_to(colnames(df), move_vec_name, near_vec_name, .side), drop = FALSE]
  }
  # Explicitly define the returned object: 
  # data.frame => env
  return(df)
}


# Function to test the move_to user defined function: 
# test_single_col_move_to => function 
test_single_col_move_to <- function(df){
  # Import required pacakage:
  library(dplyr)
  # Generate a data.frame of test cases: 
  # test_val_df => data.frame
  test_val_df <- setNames(
    expand.grid(
      names(df), 
      names(df),
      c("before", "after")
    ),
    c(
      "move_vec",
      "near_vec", 
      "side"
    )
  )
  # Convert vals to chars: test_val_df => data.frame
  test_val_df[] <- lapply(
    test_val_df, 
    as.character
  )
  # Test all vector names in iris are in the resulting df 
  # and that all names are where they are supposed to be: 
  # test_vec_names => list of boolean vectors
  test_vec_names <- lapply(
    seq_len(
      nrow(test_val_df)
    ), 
    function(i){
      # Resolve the test values: 
      move_vec <- test_val_df[i, 1, drop = TRUE] 
      near_vec <- test_val_df[i, 2, drop = TRUE] 
      side <- test_val_df[i, 3, drop = TRUE]
      # Test 1 base R functionality:
      test1 <- names(
        move_to(
          df, 
          move_vec,
          near_vec,
          side
        )
      )
      # Test 2 base R functionality: 
      test2 <- df |> move_to(move_vec, near_vec, side) |> names()
      # Test 3 dplyr functionality:
      test3 <- df %>% move_to(move_vec, near_vec, side) %>% names
      # Test 4 dply functionality: 
      test4 <- df %>% move_to(., move_vec, near_vec, side) %>% names
      # Store all tests in a list: test_list => list of character vectors
      test_list <- list(test1, test2, test3, test4)
      # list of tests: list of lists of boolean vectors => env
      list(
        # Test all names in new col vectors are in df: 
        unlist(Map(function(x){all(x %in% names(df))}, test_list)),
        # Test befores & afters: 
        unlist(Map(function(y){
          ifelse(
            side == "before", 
            which(y == move_vec) <= which(y == near_vec), 
            which(y == move_vec) >= which(y == near_vec)
          )
        },
        test_list
        )
        )
      )
    }
  )
  # Resolve if all tests have been passed:
  # tests_passed => boolean scalar
  tests_passed <- all(unlist(test_vec_names))
  # Explicitly define returned argument: 
  # boolean scalar => env
  return(tests_passed)
}

# Test any move of any column vector to anywhere on iris: 
# boolean scalar => stdout(console)
test_single_col_move_to(iris)

# Apply the function to move multiple vectors before or after another
# vector: data.frame => stdout(console)
names(iris)
move_to(
  iris, 
  c("Sepal.Width", "Petal.Length"), 
  "Species", 
  "after"
)
move_to(
  iris, 
  c("Species", "Petal.Width"), 
  "Petal.Length", 
  "before"
)

Upvotes: 0

bretauv
bretauv

Reputation: 8506

To complete the answers, there is a function called relocate() since dplyr 1.0.0:

library(dplyr)

iris %>% 
  head(n = 2) %>%
  relocate(Species, .before = Sepal.Width)
#>   Sepal.Length Species Sepal.Width Petal.Length Petal.Width
#> 1          5.1  setosa         3.5          1.4         0.2
#> 2          4.9  setosa         3.0          1.4         0.2

Created on 2022-10-18 with reprex v2.0.2

Upvotes: 3

moodymudskipper
moodymudskipper

Reputation: 47300

UPDATE : using rlang::enquo I could make it much better, then using @Zsombor's answer I could make it much shorter and more elegant. old solution (in base R) at the end of answer

#' Move column or selection of columns
#'
#' Column(s) described by \code{cols} are moved before (default) or after the reference 
#'   column described by \code{ref}
#'
#' @param data A \code{data.frame}
#' @param cols unquoted column name or numeric or selection of columns using a select helper
#' @param ref unquoted column name
#' @param side \code{"before"} or \code{"after"}
#'
#' @return A data.frame with reordered columns
#' @export
#'
#' @examples
#' iris2 <- head(iris,2)
#' move(iris2, Species, Sepal.Width)
#' move(iris2, Species, Sepal.Width, "after")
#' move(iris2, 5, 2)
#' move(iris2, 4:5, 2)
#' move(iris2, one_of("Sepal.Width","Species"), Sepal.Width)
#' move(iris2, starts_with("Petal"), Sepal.Width)
move <- function(data, cols, ref, side = c("before","after")){
  if(! requireNamespace("dplyr")) 
    stop("Make sure package 'dplyr' is installed to use function 'move'")
  side <- match.arg(side)
  cols <- rlang::enquo(cols)
  ref  <- rlang::enquo(ref)
  if(side == "before") 
    dplyr::select(data,1:!!ref,-!!ref,-!!cols,!!cols,dplyr::everything()) 
  else
    dplyr::select(data,1:!!ref,-!!cols,!!cols,dplyr::everything())
}

examples:

iris2 %>% move(Species, Sepal.Width)
#   Sepal.Length Species Sepal.Width Petal.Length Petal.Width
# 1          5.1  setosa         3.5          1.4         0.2
# 2          4.9  setosa         3.0          1.4         0.2

iris2 %>% move(Species, Sepal.Width, "after")
#   Sepal.Length Sepal.Width Species Petal.Length Petal.Width
# 1          5.1         3.5  setosa          1.4         0.2
# 2          4.9         3.0  setosa          1.4         0.2

iris2 %>% move(5, 2)
#   Sepal.Length Species Sepal.Width Petal.Length Petal.Width
# 1          5.1  setosa         3.5          1.4         0.2
# 2          4.9  setosa         3.0          1.4         0.2

iris2 %>% move(4:5, 2)
#   Sepal.Length Petal.Width Species Sepal.Width Petal.Length
# 1          5.1         0.2  setosa         3.5          1.4
# 2          4.9         0.2  setosa         3.0          1.4

iris2 %>% move(one_of("Sepal.Width","Species"), Sepal.Width)
#   Sepal.Length Sepal.Width Species Petal.Length Petal.Width
# 1          5.1         3.5  setosa          1.4         0.2
# 2          4.9         3.0  setosa          1.4         0.2

iris2 %>% move(starts_with("Petal"), Sepal.Width)
#   Sepal.Length Petal.Length Petal.Width Sepal.Width Species
# 1          5.1          1.4         0.2         3.5  setosa
# 2          4.9          1.4         0.2         3.0  setosa

Old solution

Here's a simple solution using only base R programming :

move_at <- function(data, col, ref, side = c("before","after")){
  side = match.arg(side)
  col_pos <- match(as.character(substitute(col)),names(data))
  ref_pos <- match(as.character(substitute(ref)),names(data))
  sorted_pos <- c(col_pos,ref_pos)
  if(side =="after") sorted_pos <- rev(sorted_pos)
  data[c(setdiff(seq_len(ref_pos-1),col_pos),
         sorted_pos,
         setdiff(seq_along(data),c(seq_len(ref_pos),col_pos)))]
}

iris2 %>% move_at(Species, Sepal.Width)
#   Sepal.Length Species Sepal.Width Petal.Length Petal.Width
# 1          5.1  setosa         3.5          1.4         0.2
# 2          4.9  setosa         3.0          1.4         0.2

iris2 %>% move_at(Species, Sepal.Width, "after")
#   Sepal.Length Sepal.Width Species Petal.Length Petal.Width
# 1          5.1         3.5  setosa          1.4         0.2
# 2          4.9         3.0  setosa          1.4         0.2

Upvotes: 15

Daniel
Daniel

Reputation: 7822

Just for the record, another solution would be

library(tidyverse)
data(iris)

iris %>% 
  select(-Species) %>% 
  add_column(Specis = iris$Species, .before = "Petal.Length") %>% 
  head()

#>   Sepal.Length Sepal.Width Specis Petal.Length Petal.Width
#> 1          5.1         3.5 setosa          1.4         0.2
#> 2          4.9         3.0 setosa          1.4         0.2
#> 3          4.7         3.2 setosa          1.3         0.2
#> 4          4.6         3.1 setosa          1.5         0.2
#> 5          5.0         3.6 setosa          1.4         0.2
#> 6          5.4         3.9 setosa          1.7         0.4

Created on 2018-08-31 by the reprex package (v0.2.0).

Upvotes: 3

4126cfbe1fd5
4126cfbe1fd5

Reputation: 136

This seems to work, regardless of original column order (thanks for the comment to @Moody_Mudskipper ):

iris %>% select(1:Sepal.Width, -Species, Species, everything()) %>% head(2)
#>   Sepal.Length Sepal.Width Species Petal.Length Petal.Width
#> 1          5.1         3.5  setosa          1.4         0.2
#> 2          4.9         3.0  setosa          1.4         0.2
iris %>% select(1:Sepal.Width, -Sepal.Width, -Species, Species, everything()) %>% head(2)
#>   Sepal.Length Species Sepal.Width Petal.Length Petal.Width
#> 1          5.1  setosa         3.5          1.4         0.2
#> 2          4.9  setosa         3.0          1.4         0.2

Upvotes: 7

mt1022
mt1022

Reputation: 17289

I found an interesting function (moveMe, written by @A5C1D2H2I1M1N2O1R2T1) that closely fits the problem:

source('https://raw.githubusercontent.com/mrdwab/SOfun/master/R/moveMe.R')

head(iris[ moveMe(names(iris), 'Species before Sepal.Width') ], 2)
#   Sepal.Length Species Sepal.Width Petal.Length Petal.Width
# 1          5.1  setosa         3.5          1.4         0.2
# 2          4.9  setosa         3.0          1.4         0.2


head(iris[ moveMe(names(iris), 'Species after Sepal.Width') ], 2)
#   Sepal.Length Sepal.Width Species Petal.Length Petal.Width
# 1          5.1         3.5  setosa          1.4         0.2
# 2          4.9         3.0  setosa          1.4         0.2

It also allows for more complex instructions:

head(iris[ moveMe(names(iris), 'Species after Sepal.Width; Petal.Width first; Sepal.Length last') ], 2)
#   Petal.Width Sepal.Width Species Petal.Length Sepal.Length
# 1         0.2         3.5  setosa          1.4          5.1
# 2         0.2         3.0  setosa          1.4          4.9

Upvotes: 2

Related Questions