繁体   English   中英

如何匹配 R 中彼此相差 +/- 5 的观察值?

[英]How to match observations that are within +/- 5 of each other in R?

假设我有一个 dataframe,如下所示:

dat <- data.frame("firstName" = c("John", "John", "Mary", "Bob", "Mary", "Bob"), "age"= c(21, 24, 35, 30, 20, 27))

如果观察的年龄在另一个观察的 +/- 5 年内并且具有相同的名字,我想创建第三个变量dat$id分配相同的数字。 所以 dataframe 将如下所示:

dat <- data.frame("firstName" = c("John", "John", "Mary", "Bob", "Mary", "Bob"), "age"= c(21, 24, 35, 30, 20, 27), "id"= c(1,1,2,3,4,3))

我有一个非常大的姓名和年龄数据集,并希望找到一种更自动化的分配 id 的方法。 我考虑从 20 岁开始每 5 年创建一次年龄分档,但这与在不同分档中但仍在 5 岁以内的观察结果不匹配。

1) sqldf/igraph将每一行与具有相同名称、年龄在 5 以内且该行不是自身的行匹配。 如果没有这样的匹配,则将该行与其自身匹配,以便考虑所有行。 然后可以将行及其匹配项转换为边缘列表,然后转换为 igraph,g。 查找连接的组件并将成员ID分配给原始数据框的行。

在示例数据中,每个连接的组件的大小为 1 或 2,但这种方法可以处理任何大小,而不仅仅是那些。

library(igraph)
library(sqldf)

s <- sqldf("select a.rowid, a.*, b.rowid as match 
  from dat a left join dat b
    on a.firstname = b.firstname and 
      abs(a.age - b.age) < 5 and
      a.rowid != b.rowid")
e <- cbind(s$rowid, s$match) # edgelist
e[is.na(s$match), 2] <- e[is.na(s$match), 1]  
g <- graph_from_edgelist(e)
transform(dat, id = components(g)$membership)

给予:

  firstName age id
1      John  21  1
2      John  24  1
3      Mary  35  2
4       Bob  30  3
5      Mary  20  4
6       Bob  27  3

我们可以像这样可视化图表:

plot(g)

(图后续)

截屏

2) 基础 R该解决方案部分由其他解决方案推动,但具有显着优势,因为它仅使用基础 R,只有 2 行代码,如(1)也处理任何大小的连接组件,产生正确答案并且是完全矢量化的。 它的工作原理是对数据进行排序,然后根据显示的条件将 id 向前拉或生成一个新的。

o <- with(dat, order(firstName, age))
transform(dat[o,], id = cumsum(c(1, diff(xtfrm(firstName)) | diff(age) > 5)))

给予:

  firstName age id
6       Bob  27  1
4       Bob  30  1
1      John  21  2
2      John  24  2
5      Mary  20  3
3      Mary  35  4

无需额外的软件包

dat <- data.frame("firstName" = c("John", "John", "Mary", "Bob", "Mary", "Bob"), "age"= c(21, 24, 35, 30, 20, 27))
n <- length(dat$firstName)

vals <- list()
for (i in 1:n) {
    fname <- dat$firstName[i]
    age <- dat$age[i]
    index <- which(fname == dat$firstName &
     (age > dat$age - 5) &
     (age < dat$age + 5))
    vals[[i]] <- index
}

vals <- unique(vals)
dat$id <- NA

for (i in 1:length(vals)) {
    dat$id[vals[[i]]] <- i
}

结果

  firstName age id
1      John  21  1
2      John  24  1
3      Mary  35  2
4       Bob  30  3
5      Mary  20  4
6       Bob  27  3

这是dplyr lag的方法:

library(dplyr)
dat %>%
  group_by(firstName) %>%
  arrange(firstName,age) %>%
  mutate(id = cumsum(!(age - (lag(age,default = -Inf) ) <= 5)))
# A tibble: 6 x 3
# Groups:   firstName [3]
  firstName   age    id
  <fct>     <dbl> <int>
1 Bob          27     1
2 Bob          30     1
3 John         21     1
4 John         24     1
5 Mary         20     1
6 Mary         35     2

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM