创建唯一的ID变量作为变量的组合

时间:2017-07-25 09:55:37

标签: r dataframe data.table

我有一个数据框(df)或数据表(dt),比方说1000个变量和1000个观察值。我检查了观察结果中没有重复项,因此dt[!duplicated(dt)]与原始文件的长度相同。

我想为所有这些观察创建一个ID变量,并结合我拥有的1000个变量。 与其他SO问题不同,因为我不知道哪些变量更适合创建ID,而且我可能需要组合至少3或4个变量。

R中是否有任何包/函数可以让我获得最有效的变量组合来创建ID变量?在我的实际例子中,我正在努力手动创建一个ID,可能它不是变量的最佳组合。

使用mtcars的示例:

require(data.table)
example <- data.table(mtcars)
rownames(example) <- NULL # Delete mtcars row names
example <- example[!duplicated(example),]
example[,id_var_wrong := paste0(mpg,"_",cyl)]
length(unique(example$id_var_wrong)) # Wrong ID, there are only 27 different values for this variable despite 32 observations

example[,id_var_good := paste0(wt,"_",qsec)]
length(unique(example$id_var_good)) # Good ID as there are equal number of unique values as different observations.

是否有任何功能可以自动而非手动查找wtqsec

3 个答案:

答案 0 :(得分:2)

自制算法:原则是贪婪地获取具有最多不同数量元素的变量,然后仅过滤具有重复项的剩余行并进行迭代。这不是最好的解决方案,但它是一种快速获得相当好的解决方案的简单方法。

set.seed(1)
mat <- replicate(1000, sample(c(letters, LETTERS), size = 100, replace = TRUE))

library(dplyr)

columnsID <- function(mat) {
  df <- df0 <- as_data_frame(mat)
  vars <- c()
  while(nrow(df) > 0) {
    var_best <- names(which.max(lapply(df, n_distinct)))[[1]]
    vars <- append(vars, var_best)
    df <- group_by_at(df0, vars) %>% filter(n() > 1)
  }
  vars
}

columnsID(mat)
[1] "V68" "V32"

答案 1 :(得分:1)

在许多情况下,有一个唯一标识每个观察的自然键。例如,mtcars数据集具有唯一的行名称。

library(data.table)
data.table(mtcars, keep.rownames = "id")
                     id  mpg cyl  disp  hp drat    wt  qsec vs am gear carb
 1:           Mazda RX4 21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4
 2:       Mazda RX4 Wag 21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4
 3:          Datsun 710 22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1
 4:      Hornet 4 Drive 21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1
 5:   Hornet Sportabout 18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2
 6:             Valiant 18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1
 ...

如果没有可用的自然键,我建议通过简单地连续编号行并将其存储在一个附加列中来创建一个清晰的键:

data.table(mtcars)[, rn := .I][]
     mpg cyl  disp  hp drat    wt  qsec vs am gear carb rn
 1: 21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4  1
 2: 21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4  2
 3: 22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1  3
 4: 21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1  4
 5: 18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2  5
 6: 18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1  6
 ...

其他任何可能都不值得付出努力,或者存在属性值可能变得相同的风险,例如,当它们被舍入时。

答案 2 :(得分:0)

基于@F。私人的答案;如果您对最佳方法有所了解,则可以选择指定“ startVar”,否则,只需选择具有最大数量的不同值的变量即可。

library(dplyr)
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union

columnsID <- function(dataset,
                      startVar = NULL,
                      frac = 1) {
  #Set up some temporary dataframes
  #Remove any total duplicates with distinct
  #Take a sample if not working on the full data
  tibb <- as_tibble(dataset) %>%
    distinct() %>%
    sample_frac(frac)

  #Set up the vars which will be used
  if (is.null(startVar)) {
    startVar <- names(which.max(lapply(tibb, n_distinct)))[[1]]
  }
  vars_agg <- c(startVar)
  vars_all <- names(tibb)

  #Filter out any rows which are already uniquely identified
  tibb <- tibb %>% group_by_at(vars(vars_agg)) %>%
    filter(n() > 1)

  while (nrow(tibb) > 0) {
    #Keep track of the vars we haven't used yet
    vars_unused <- setdiff(vars_all, vars_agg)

    #Find the variable which has the most distinct number of values on average
    #for the grouping we have so far
    var_best <-
      tibb %>%
      group_by(!!!syms(vars_agg)) %>%
      mutate_at(vars(vars_unused), funs(n_distinct(.))) %>%
      ungroup() %>%
      summarise_at(vars(vars_unused), funs(mean)) %>%
      which.max() %>%
      names()

    #Add the 'best variable' to the list
    vars_agg <- c(vars_agg, var_best)

    #Filter out any rows which are now uniquely identified
    tibb <- tibb %>%
      group_by_at(vars(vars_agg)) %>%
      filter(n() > 1)
  }
  vars_agg
}

columnsID(mtcars)
#> [1] "qsec" "mpg"

reprex package(v0.2.1)于2019-04-02创建