将数据对象转换为数据框时如何编写自定义函数以半自动列命名

Question

我正在尝试编写一个函数，该函数将获取一个列表对象（以特定格式）并返回一个数据框。 这样做时，我有两个标准有些冲突：

1. 返回的数据框应具有指示每列内容的列名（即不是col_a、col_b等）。
2. 该函数应接受一个列表对象，该对象可以保存各种数据（例如，体重/身高/年龄/心情/国家等）

这些标准相互矛盾，因为如果没有先验信息，该函数无法知道如何命名数据列。我的解决方案是通过包含一个参数来半自动化该函数，该参数告诉函数被调用时它的目的是什么。

因此，因为函数在执行时知道其“目的”，所以它知道一列将包括（例如）年龄，另一列将包括国家等。

但是，我如何确定正确的列被命名为适当的名称，并且没有不匹配（例如，“年龄”标题分配给权重列）？

我正在尝试使用 tidyverse 函数解决这个问题。

1 -- 要转换的数据对象

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

2 -- 我的自定义转换函数

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

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

编辑
从@akrun 的评论中，我了解到我可以等效地使用：

library(tibble)

organize_in_table <-
  function(as_list_object,
           purpose = NULL) {
    table <- as_list_object %>%
      enframe() %>%
      tidyr::unnest(c(value))
    
    if (is.null(purpose)) {
      return(table)
    } else if (purpose == "match_letters_and_numbers") {
      table <- rename(table, letters = name, numbers = value)
    }
    return(table)
}

3 -- 函数使用示例

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 -- 潜在问题的演示

待转换数据

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 

---

要记住的关键点是，此函数应可能接受任何类型的数据（例如，年龄、体重、距离、主要人格特征、姓名、驾驶执照 ID 等） .执行函数的用户负责详细说明所包含变量的属性。

以下是两个示例，用于在重命名之前需要进行某些验证的数据类型。提供purpose 参数，organize_in_table() 在返回列名数据框之前应该知道哪些“验证函数”是相关的。

示例 #1 -- 匹配希腊语单词和英语中的等效单词
数据

vec_greek <- c("σκύλος", "Γάτα", "ζέβρα")
names(vec_greek) <- c("dog", "cat", "zebra")
data_object_greek_english <- as.list(vec_greek)

data_object_greek_english
## $dog
## [1] "sκύλος"

## $cat
## [1] "Gάta"

## $zebra
## [1] "ζέßρa"

验证函数

1. Is Greek?

grepl("[\u0370-\u03ff\u1f00-\u1fff]+", x)

1. Is English?

library(stringi)
stri_enc_isascii()

期望的输出

## regardless of whether data object is "data_object_greek_english_1": 
vec_greek <- c("σκύλος", "Γάτα", "ζέβρα")
names(vec_greek) <- c("dog", "cat", "zebra")
data_object_greek_english_1 <- as.list(vec_greek)
## or "data_object_greek_english_2":
vec_english <- c("dog", "cat", "zebra")
names(vec_english) <- c("σκύλος", "Γάτα", "ζέβρα")
data_object_greek_english_2 <- as.list(vec_english)

## the call:
organize_in_table(data_object_greek_english_1, purpose = "match_greek_and_english")
## should return the same output as:
organize_in_table(data_object_greek_english_2, purpose = "match_greek_and_english")

## # A tibble: 3 x 2
##   english greek   ## position of columns doesn't matter as long as headers are appropriate to values
##   <chr>   <chr> 
## 1 dog     sκύλος
## 2 cat     Gάta  
## 3 zebra   ζέßρa

---

示例 #2 -- 匹配电话号码和加州驾照 ID
数据
^{_{以下数据纯属捏造}}

vec_driver_license <- c("F2849563", "I2938461", "B2293890")
names(vec_driver_license) <- c("626-710-9060", "831-263-9154", "510-923-6869")
data_object_phone_dl <- as.list(vec_driver_license)

data_object_phone_dl
## $`626-710-9060`
## [1] "F2849563"

## $`831-263-9154`
## [1] "I2938461"

## $`510-923-6869`
## [1] "B2293890"

验证函数

1. Is phone number?

grepl("^\\s*(\\+\\s*1(-?|\\s+))*[0-9]{3}\\s*-?\\s*[0-9]{3}\\s*-?\\s*[0-9]{4}$", x)

1. Is driver license ID?

grepl("^[A-Z]{1}\\d{7}$", x)

期望的输出

## regardless of whether data object is "data_object_phone_dl_1": 
vec_driver_license <- c("F2849563", "I2938461", "B2293890")
names(vec_driver_license) <- c("626-710-9060", "831-263-9154", "510-923-6869")
data_object_phone_dl_1 <- as.list(vec_driver_license)
## or "data_object_phone_dl_2":
vec_phone_number <- c("626-710-9060", "831-263-9154", "510-923-6869")
names(vec_phone_number) <- c("F2849563", "I2938461", "B2293890")
data_object_phone_dl_2 <- as.list(vec_phone_number)

## the call:
organize_in_table(data_object_phone_dl_1, purpose = "match_phone_and_dl")
## should return the same output as:
organize_in_table(data_object_phone_dl_2, purpose = "match_phone_and_dl")

## # A tibble: 3 x 2
##   phone_number driver_license_id  ## position of columns doesn't matter as long as headers are appropriate to values
##   <chr>        <chr>            
## 1 626-710-9060 F2849563         
## 2 831-263-9154 I2938461         
## 3 510-923-6869 B2293890  

Answer 1

我将最终解决方案分成两个不同的功能；但是，如果您愿意，您可能想要嵌套它们。另外，我摆脱了purpose 论点。如果它绝对符合你的目的，你绝对可以把它放回去：

# Load packages
library(dplyr)

# Make data
vec_driver_license <- c("F2849563", "I2938461", "B2293890")
names(vec_driver_license) <- c("626-710-9060", "831-263-9154", "510-923-6869")
data_object_phone_dl_1 <- as.list(vec_driver_license)

vec_phone_number <- c("626-710-9060", "831-263-9154", "510-923-6869")
names(vec_phone_number) <- c("F2849563", "I2938461", "B2293890")
data_object_phone_dl_2 <- as.list(vec_phone_number)

# Create custom functions

check_content <- function(x){
  
  if(all(grepl("[\u0370-\u03ff\u1f00-\u1fff]+", x))){
    out <- "greek"
  } else if(all(grepl("^[A-Z]{1}\\d{7}$", x))){
    out <- "driver_license"
  } else if(all(grepl("^\\s*(\\+\\s*1(-?|\\s+))*[0-9]{3}\\s*-?\\s*[0-9]{3}\\s*-?\\s*[0-9]{4}$", x))){
    out <- "phone_number"
  } else if(all(grepl("^[A-Z]{1}\\d{7}$", x))){
    out <- "driver_license_id"
  } else {
    out <- "undefined"
  }
  
  out
  
}

organize_in_table <- function(data_list){
  
  df <- tibble::enframe(data_list) %>%
    tidyr::unnest(cols = value)
  
  colnames(df) <- purrr::map_chr(df, check_content)
  
  df
}

# Demo with data_object_phone_dl_1
organize_in_table(data_object_phone_dl_1)

# A tibble: 3 x 2
  phone_number driver_license
  <chr>        <chr>         
1 626-710-9060 F2849563      
2 831-263-9154 I2938461      
3 510-923-6869 B2293890 

# Demo with data_object_phone_dl_2
organize_in_table(data_object_phone_dl_2)

# A tibble: 3 x 2
  driver_license phone_number
  <chr>          <chr>       
1 F2849563       626-710-9060
2 I2938461       831-263-9154
3 B2293890       510-923-6869