将行与列上差异最小的其他行匹配
Match rows with other row with smallest difference on a column
我想在数据框中执行两个组之间的匹配,其中属于一个组(二进制)的所有行都与另一组的观察值(替换)匹配,如果它们在另一列上的差异小于预设阈值。让我们使用下面的玩具数据集:
set.seed(123)
df <- data.frame(id = c(1:10),
group = rbinom(10,1, 0.3),
value = round(runif(10),2))
threshold <- round(sd(df$value),2)
看起来像这样
> df
id group value
1 1 0 0.96
2 2 1 0.45
3 3 0 0.68
4 4 1 0.57
5 5 1 0.10
6 6 0 0.90
7 7 0 0.25
8 8 1 0.04
9 9 0 0.33
10 10 0 0.95
> threshold
[1] 0.35
在这种情况下,我想将具有 group==1
的行与具有 group==2
的行进行匹配,其中 value
之间的差异小于 threshold
(0.35)。这应该导致一个看起来像这样的数据框(对潜在的错误表示歉意,手动完成)。
id matched_id
1 2 3
2 2 7
3 2 9
4 4 3
5 4 6
6 4 7
7 4 9
8 5 7
9 5 9
10 8 7
11 8 9
谢谢!
更新答案: 在较大的数据集上运行缓慢,因此我尝试使代码更高效一些。
提出了一个似乎可以满足我要求的解决方案。不确定此代码在较大数据上的效率如何,但似乎有效。
library(tidyverse)
library(data.table)
# All values
dist_mat <- df$value
# Adding identifier
names(dist_mat) <- df$id
# Dropping combinations that are not of interest
dist_mat_col <-dist_mat[df$group == 0]
dist_mat_row <- dist_mat[df$group == 1]
# Difference between each value
dist_mat <- abs(outer(dist_mat_row, dist_mat_col, "-"))
# Identifying matches that fulfills the criteria
dist_mat <- dist_mat <= threshold
# From matrix to a long dataframe
dist_mat <- melt(dist_mat)
# Tidying up the dataframe and dropping unneccecary columns and rows.
dist_mat <- dist_mat %>%
rename(id = Var1,
matched_id = Var2,
cond = value) %>%
filter(cond == TRUE) %>%
left_join(df, by = "id") %>%
select(id, matched_id)
这导致以下数据框:
> arrange(dist_mat, id)
id matched_id
1 2 3
2 2 7
3 2 9
4 4 3
5 4 6
6 4 7
7 4 9
8 5 7
9 5 9
10 8 7
11 8 9
您可以使用 df |> left_join(df, by = character())
,这是执行笛卡尔积的简洁方法。然后根据threshold
.
过滤
library(dplyr)
df |>
left_join(df, by = character()) |>
filter(group.x != group.y,
id.x < id.y,
abs(value.x - value.y) < threshold)
#>+ id.x group.x value.x id.y group.y value.y
#>1 2 1 0.45 3 0 0.68
#>2 2 1 0.45 7 0 0.25
#>3 2 1 0.45 9 0 0.33
#>4 3 0 0.68 4 1 0.57
#>5 4 1 0.57 6 0 0.90
#>6 4 1 0.57 7 0 0.25
#>7 4 1 0.57 9 0 0.33
#>8 5 1 0.10 7 0 0.25
#>9 5 1 0.10 9 0 0.33
#>10 7 0 0.25 8 1 0.04
#>11 8 1 0.04 9 0 0.33
我想在数据框中执行两个组之间的匹配,其中属于一个组(二进制)的所有行都与另一组的观察值(替换)匹配,如果它们在另一列上的差异小于预设阈值。让我们使用下面的玩具数据集:
set.seed(123)
df <- data.frame(id = c(1:10),
group = rbinom(10,1, 0.3),
value = round(runif(10),2))
threshold <- round(sd(df$value),2)
看起来像这样
> df
id group value
1 1 0 0.96
2 2 1 0.45
3 3 0 0.68
4 4 1 0.57
5 5 1 0.10
6 6 0 0.90
7 7 0 0.25
8 8 1 0.04
9 9 0 0.33
10 10 0 0.95
> threshold
[1] 0.35
在这种情况下,我想将具有 group==1
的行与具有 group==2
的行进行匹配,其中 value
之间的差异小于 threshold
(0.35)。这应该导致一个看起来像这样的数据框(对潜在的错误表示歉意,手动完成)。
id matched_id
1 2 3
2 2 7
3 2 9
4 4 3
5 4 6
6 4 7
7 4 9
8 5 7
9 5 9
10 8 7
11 8 9
谢谢!
更新答案: 在较大的数据集上运行缓慢,因此我尝试使代码更高效一些。
提出了一个似乎可以满足我要求的解决方案。不确定此代码在较大数据上的效率如何,但似乎有效。
library(tidyverse)
library(data.table)
# All values
dist_mat <- df$value
# Adding identifier
names(dist_mat) <- df$id
# Dropping combinations that are not of interest
dist_mat_col <-dist_mat[df$group == 0]
dist_mat_row <- dist_mat[df$group == 1]
# Difference between each value
dist_mat <- abs(outer(dist_mat_row, dist_mat_col, "-"))
# Identifying matches that fulfills the criteria
dist_mat <- dist_mat <= threshold
# From matrix to a long dataframe
dist_mat <- melt(dist_mat)
# Tidying up the dataframe and dropping unneccecary columns and rows.
dist_mat <- dist_mat %>%
rename(id = Var1,
matched_id = Var2,
cond = value) %>%
filter(cond == TRUE) %>%
left_join(df, by = "id") %>%
select(id, matched_id)
这导致以下数据框:
> arrange(dist_mat, id)
id matched_id
1 2 3
2 2 7
3 2 9
4 4 3
5 4 6
6 4 7
7 4 9
8 5 7
9 5 9
10 8 7
11 8 9
您可以使用 df |> left_join(df, by = character())
,这是执行笛卡尔积的简洁方法。然后根据threshold
.
library(dplyr)
df |>
left_join(df, by = character()) |>
filter(group.x != group.y,
id.x < id.y,
abs(value.x - value.y) < threshold)
#>+ id.x group.x value.x id.y group.y value.y
#>1 2 1 0.45 3 0 0.68
#>2 2 1 0.45 7 0 0.25
#>3 2 1 0.45 9 0 0.33
#>4 3 0 0.68 4 1 0.57
#>5 4 1 0.57 6 0 0.90
#>6 4 1 0.57 7 0 0.25
#>7 4 1 0.57 9 0 0.33
#>8 5 1 0.10 7 0 0.25
#>9 5 1 0.10 9 0 0.33
#>10 7 0 0.25 8 1 0.04
#>11 8 1 0.04 9 0 0.33