【问题标题】:R name cleanup to get correct unique variablesR 名称清理以获得正确的唯一变量
【发布时间】:2020-11-22 06:13:16
【问题描述】:

您好,我有一个包含名称和一些数字的数据框。 “t1”列中的数字对于每个人来说应该是唯一的,但在某些情况下它们不是。所以我想找到那些“t1”列中的一个数字对应于两个不同的人的行,以便我可以从我的数据框中删除这些数据以供将来分析。

这是一些看起来像我的原始数据的玩具数据:

           name t1 t2 t3
1      John Doe  1  a  a
2      Doe John  1  a  a
3    John Doe A  1  b  b
4 David Freeman  2  b  b
5 Freeman David  2  b  b
6     Jack Chen  3  b  b
7     John Chen  3  b  b
8 Chris Baker F  4  b  b
9 Baker O Chris  4  b  b
> 

这是所需的输出:

          name t1 
1     Jack Chen  3  
2     John Chen  3  
3 Chris Baker F  4  
4 Baker O Chris  4  

以下是我得到的代码和输出:

bio_share_id <- bio %>% 
  distinct(name, t1, .keep_all = T) %>% 
  group_by(t1) %>% 
  filter(n() > 1) %>% 
  ungroup() %>%
  select(c(name,t1))

  name          t1   
  <chr>         <chr>
1 John Doe      1    
2 Doe John      1    
3 John Doe A    1    
4 David Freeman 2    
5 Freeman David 2    
6 Jack Chen     3    
7 John Chen     3    
8 Chris Baker F 4    
9 Baker O Chris 4 

如您所见,只要名称格式有一些变化,我的代码就会将每个名称读取为唯一变量。它将 John Doe、Doe John 和 John Doe A 解读为不同的人,但我希望将它们解读为一个人。

由于我拥有的原始数据如此之大,我无法手动修复名称,因此我想找到一种使用 R 清理这些名称的方法。John Doe、Doe John 和 John Doe A 应该被视为一个个人,但 Chris Baker F 和 Bake O Chris 应该被视为两个不同的独特个体。

提前致谢!

【问题讨论】:

  • "Jone Doe A" 还是"John Doe A"
  • 对不起,我是 John Doe A!我会编辑

标签: r dataframe dplyr


【解决方案1】:

这不是一件容易的事。但是你可以充分利用 R 中的adist 函数:

a <- sapply(strsplit(trimws(dat$name),"\\s+"), function(x)paste0(sort(x), collapse = " "))
b <- adist(a, a, partial = TRUE, ignore.case = TRUE)
dat[colSums(! b * t(b)) == 1,]
            name t1 t2 t3
6      Jack Chen  3  b  b
7      John Chen  3  b  b
8  Chris Baker F  4  b  b
9  Baker O Chris  4  b  b

注意:由于adist 函数的时间复杂度为 O(n^2),因此您可能会考虑将问题分解。并且可能不适用于大型数据集

【讨论】:

    【解决方案2】:

    这是我的尝试:

    library(tidyverse)
    
    # Toy data
    toy_data <- tribble(
      ~ name, ~ t1, ~ t2, ~ t3,
      "John Doe", 1,  "a",  "a",
      "Doe John",  1,  "a",  "a",
      "John Doe A",  1,  "b",  "b",
      "David Freeman",  2,  "b",  "b",
      "Freeman David",  2,  "b",  "b",
      "Jack Chen",  3,  "b",  "b",
      "John Chen",  3,  "b",  "b",
      "Chris Baker F",  4,  "b",  "b",
      "Baker O Chris",  4,  "b",  "b"
    )
    
    # Step 1: Nest data by t1
    toy_data_nested <- toy_data %>%
      select(name, t1) %>%
      group_by(t1) %>%
      nest() %>%
      ungroup()
    
    # Step 2: Define a function to find name differences
    find_name_diff <- function(data) {
      name_pieces <- data %>%
        pull(name) %>%
        str_split(pattern = " ") %>%
        as_vector()
      
      count_by_piece <- name_pieces %>% 
        enframe() %>% 
        count(value)
      
      if (all(count_by_piece$n > 1)) { # handle cases like t1 == 2
        return("none")
      } else {
        count_by_piece %>%
          filter(n == 1) %>%
          pull(value)
      }
    }
    
    # Step 3: Get the desired output
    toy_data_nested %>%
      mutate(name_diff = map(data, ~ find_name_diff(.x))) %>%
      rowwise() %>%
      mutate(diff_length = length(name_diff)) %>%
      filter(diff_length > 1) %>%
      select(data, t1) %>%
      unnest(cols = c(data))
    #> # A tibble: 4 x 2
    #>   name             t1
    #>   <chr>         <dbl>
    #> 1 Jack Chen         3
    #> 2 John Chen         3
    #> 3 Chris Baker F     4
    #> 4 Baker O Chris     4
    

    reprex package (v0.3.0) 于 2020 年 11 月 22 日创建

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 2020-07-17
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2020-04-07
      • 1970-01-01
      • 1970-01-01
      • 2021-06-02
      相关资源
      最近更新 更多