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"
)
