仅当列的所有值都满足条件时才重命名列

Question

我想根据这些列中的所有值是否满足某个条件来重命名数据中的列。例如，在数值列中，如果所有值都大于 5，则将该列重命名为 large_values，否则保持列名不变。另一个例子，如果字符列中的所有值都没有& 字符，则将该列重命名为no_ampersand。

数据

library(tibble)

df <- 
  tribble(~age_1, ~age_2, ~string_1,
        2, 7, "abc",
        3, 8, "efg",
        1, 11, "hi&",
        10, 6, "klmn",
        50, 100, "opq")

定义两个函数进行演示

1. 向量元素是否大于某个值

is_larger_than_val <- function(x, y) {
  all(x > y)
}

1. 向量元素是否包含&？

does_contain_ampersand <- function(x) {
  all(grepl("&", x))
}

问题

那么使用这些函数，我怎样才能重命名df 的标题，这样当

is_larger_than_val(df$age_2, 5)

[1] TRUE

将age_2重命名为large_values，但以防万一

is_larger_than_val(df$age_1, 5)

[1] FALSE

将保持age_1 原样吗？

同样，因为

does_contain_ampersand(df$string_1)

[1] FALSE

将保持string_1 原样（但如果它是TRUE，那么string_1 将被重命名为no_ampersand）？

所需输出

给定当前数据，根据我在is_larger_than_val() 和does_contain_ampersand() 中指定的条件重命名应该返回：

# A tibble: 5 x 3
  age_1 large_values string_1
  <dbl>        <dbl> <chr>   
1     2            7 abc     
2     3            8 efg     
3     1           11 hi&     
4    10            6 klmn    
5    50          100 opq  

我确信这可以通过嵌套一些 if else 语句来实现，但我想知道是否有更简单的方法（也许使用 tidyverse 技巧？）。

谢谢！

---

编辑

---

把问题放在上下文中

在下面@Ian 的评论之后，这是我的问题的上下文。

1. 我有一个源自JSON 文件的R 数据对象。一旦我将JSON 文件读入R，它就会以以下格式结束：

vec <- c(1, 2, 3)
names(vec) <- c("A", "B", "C")
my_data_object_as_list <- as.list(vec)

my_data_object_as_list
## $A
## [1] 1

## $B
## [1] 2

## $C
## [1] 3

1. 我想构建一个函数，它接受my_data_object_as_list 并将其重新组织成一个表格。

require(tidyr)
require(dplyr)
require(tidyselect)

organize_in_table <- function(as_list_object) {
    as_list_object %>%
    bind_rows() %>%
    pivot_longer(cols = tidyselect::everything())
}

organize_in_table(my_data_object_as_list)

## # A tibble: 3 x 2
##   name  value
##   <chr> <dbl>
## 1 A         1
## 2 B         2
## 3 C         3

1. 因为organize_in_table() 非常通用，所以它会返回一个表，其中的列名（name 和value）并不表示每列的内容。为了解决这个问题，我想在organize_in_table() 中添加一个purpose 参数，下面是一个例子：

organize_in_table <-
  function(as_list_object,
           purpose = NULL) {
    table <- as_list_object %>%
      bind_rows() %>%
      pivot_longer(cols = tidyselect::everything())
    
    if (is.null(purpose)) {
      return(table)
    } else if (purpose == "match_letters_and_numbers") {
      table <- rename(table, letters = name, numbers = value)
    }
    return(table)
  }

现在，organize_in_table() 可以返回具有有意义名称的对象：

df_letters_and_numbers <- 
  organize_in_table(my_data_object_as_list, "match_letters_and_numbers")

> df_letters_and_numbers
## # A tibble: 3 x 2
##   letters numbers
##   <chr>     <dbl>
## 1 A             1
## 2 B             2
## 3 C             3

4. 这里我遇到了一个问题： 我怎么知道df_letters_and_numbers[1] 被正确命名为letters 而df_letters_and_numbers[2] 是numbers？我在什么基础上验证了——当我在organize_in_table() 中重命名table 时——第一列（name）全是字母，第二列（value）全是数字？我没有验证。

如果my_data_object_as_list 看起来像这样会怎样：

vec_2 <- c("A", "B", "C")
names(vec_2) <- c(1, 2, 3)
my_data_object_as_list_2 <- as.list(vec_2)

> my_data_object_as_list_2 
## $`1`
## [1] "A"

## $`2`
## [1] "B"

## $`3`
## [1] "C"

如果我运行organize_in_table(my_data_object_as_list_2, "match_letters_and_numbers")，我会得到列名不匹配的数据框：

## # A tibble: 3 x 2
##   letters numbers
##   <chr>   <chr>  
## 1 1       A      
## 2 2       B      
## 3 3       C     

底线

所以我的结论是，我必须根据要重命名的每一列的 content 在organize_in_table() 中调整重命名步骤。为此，我认为第一步应该是为我要执行的每个测试定义一个单独的函数（例如，列号中的所有值吗？所有值都是字母吗？）。而且因为我想让organize_in_table() 尽可能具有可扩展性，我希望它接受我可以为其构建测试功能的任何测试。

Answer 1

在数据上使用sapply 以便在列上创建逻辑索引，但要注意与号大小写中的字符列：

i <- sapply(df, is_larger_than_val, y = 5)
names(df)[i] <- "large_values"

i <- sapply(df, does_contain_ampersand)
i <- i | !sapply(df, is.character)
names(df)[!i] <- "no_ampersand"

names(df)
#[1] "age_1"        "large_values" "no_ampersand"

Answer 2

sapply 解决方案非常简单，非常棒。这是data.table 的替代解决方案，需要更多的努力。我认为它的原理相同，但我添加了一个步骤来识别数字和字符串列，以确保只测试某些列

# data.table solution
library(data.table)
dt <- as.data.table(df)

# I think you need !(any()) rather than all
# This will identify if there is no_ampersand.
# Design tests so that if they are TRUE then change the column name for consistency
# Also & needs to be escaped with \\ to find it
no_ampersand <- function(x) {
  !any(grepl("\\&", x))
}

# function for taking data.table (dt), the test result and the new column names
# and updating the column name
alterColumnIfMatch <- function(dt, test_data, new_column="large_values"){
  # find ones to change
  alter_data <- names(test_data)[which(test_data == TRUE)]
  # if there are any, then use setnames to update to the new column value
  if(length(alter_data) > 0) setnames(dt, alter_data, new_column)
  return(dt)
}

# identify which columns to run through the tests
col_class <- sapply(dt, class)
numeric_cols <- names(col_class)[col_class == "numeric" | col_class == "integer"]
character_cols <- names(col_class)[col_class == "character" ]

# test for larger than 5 and update
test_larger <- dt[, lapply(.SD, function(col) is_larger_than_val(col, 5)),
                  .SDcols = numeric_cols]
dt <- alterColumnIfMatch(dt, test_larger, "large_values")

# test for no ampersand and update
test_ampersand <- dt[, lapply(.SD, function(col) does_contain_ampersand(col)),
                     .SDcols = character_cols]
dt <- alterColumnIfMatch(dt, test_ampersand, "no_ampersand")

# convert back to tibble for you
out <- as_tibble(dt)
out