我是R的新手,对于stackoverflow来说是一个新手(因为我之前在Stata,Excel,VBA和小C方面有过一些经验,所以在这里已经进行了很多研究。)
我有一个R数据帧df1,看起来像下面的例子,只有几千行:
ID Date Value Class ZIP
TRA0001 2007-09-25 150 1 75019
TRA0002 2002-08-09 200 2 30152
TRA0003 2010-08-31 500 3 12451
TRA0004 2005-06-17 75 1 45242
TRA0005 2010-08-26 410 3 14618
TRA0006 2008-07-07 155 1 70139
TRA0007 2010-01-15 450 3 12883
TRA0008 2000-11-03 80 4 45242
TRA0009 2003-05-01 120 2 63017
TRA0010 2000-10-01 85 5 23712
每行代表一次交易。我需要找到的是基于以下“匹配标准”组合(AND连接)的每笔交易的类似交易:
请注意,每个事务/行都不能匹配,一个匹配或多个匹配。我最终需要的是关于上述三个标准组合的匹配列表。
对于给定的示例,结果df2将如下所示:
ID ID_Match ZIP_Match
TRA0001 TRA0006 70139
TRA0003 TRA0005 14618
TRA0003 TRA0007 12883
TRA0005 TRA0007 12883
TRA0006 TRA0001 75019
TRA0007 TRA0003 12451
TRA0007 TRA0005 14618
到目前为止,我尝试了重复搜索的各种组合,以通过满足至少一个匹配条件来接近我期望的结果,然后根据其他约束“过滤”该结果。我从 Class 条件开始,因为在我看来这是最简单的标准(也可能是最具选择性的标准)。我最后提出的是例如所有具有重复项的类的列表以及可以找到重复项的相应索引位置。为此,我使用了以下代码(在stackoverflow上找到,用户名为“eddi”):
dups = duplicated(df1$Class) | duplicated(d1$Class, fromLast = T)
split(which(dups), df1$Class[dups])
然而,这仍然让我离开了我想要的结果数英里,我不知道如何“整合”其他条件。希望我能提供所有必要的信息,并明确我的问题。任何提示,建议或解决方案都非常受欢迎!提前谢谢!
此外:如果有人想出如何使用Stata完成所需的工作,这也是受欢迎的 - 我对Stata的了解略多于R。
答案 0 :(得分:2)
我想我找到了一种可以做到的方法。基本上,我们定义一个函数,它将为一个ID执行您想要的操作,然后使用sapply
遍历所有ID,然后使用rbind
调用将结果放在一起。
月份函数来自@Dirk,this post
df <- read.table(text =
"ID Date Value Class ZIP
TRA0001 2007-09-25 150 1 75019
TRA0002 2002-08-09 200 2 30152
TRA0003 2010-08-31 500 3 12451
TRA0004 2005-06-17 75 1 45242
TRA0005 2010-08-26 410 3 14618
TRA0006 2008-07-07 155 1 70139
TRA0007 2010-01-15 450 3 12883
TRA0008 2000-11-03 80 4 45242
TRA0009 2003-05-01 120 2 63017
TRA0010 2000-10-01 85 5 23712",
header = T)
# turn a date into a 'monthnumber' relative to an origin
monnb <- function(d) {
lt <- as.POSIXlt(as.Date(d, origin="1900-01-01"))
lt$year*12 + lt$mon
}
# compute a month difference as a difference between two monnb's
mondf <- function(d1, d2) { monnb(d2) - monnb(d1) }
find_fxn <- function(data, origID){
#create subset with ID of interest
orig_data <- subset(data, ID == origID)
#subset of all other IDs
other_data <- subset(data, ID != origID)
#three matching criteria
find_first <- which(abs(mondf(orig_data$Date, other_data$Date)) <= 18)
find_second <- which(other_data$Value >= 0.8 * orig_data$Value & other_data$Value <= 1.2 * orig_data$Value)
find_third <- which(other_data$Class == orig_data$Class)
#use intersect to remove dups
find_all <- intersect(intersect(find_first, find_second), find_third)
if(length(find_all) > 0){
cbind.data.frame(ID = orig_data$ID,
IDMatch = other_data[find_all, 1],
ZipMatch = other_data[find_all, 5])
}
}
do.call('rbind', sapply(df$ID, FUN = function(x) find_fxn(data = df, origID = x)))
ID IDMatch ZipMatch
1 TRA0001 TRA0006 70139
2 TRA0003 TRA0005 14618
3 TRA0003 TRA0007 12883
4 TRA0005 TRA0007 12883
5 TRA0006 TRA0001 75019
6 TRA0007 TRA0003 12451
7 TRA0007 TRA0005 14618
答案 1 :(得分:1)
有一个名为rangejoin
的新用户编写程序(来自SSC)可用于在Stata中轻松解决此问题。要使用rangejoin
,您还必须安装rangestat
(也来自SSC)。要同时安装它们,请键入Stata的命令窗口:
ssc install rangestat
ssc install rangejoin
rangejoin
形成落在指定范围内的所有观察的成对组合。由于您希望匹配具有相同 Class 值的观察值,因此可以在 Class 组中执行连接。由于您有每日日期,因此我将解决方案设置为使用+/- 548天的窗口(基于一年365.25天)。一旦形成所有成对组合(在每个观察的指定时间窗口内),您可以删除那些与值的20%阈值不匹配的组合。
这是一个使用您发布的数据的完整功能示例:
* Example generated by -dataex-. To install: ssc install dataex
clear
input str7 ID str10 Date int Value byte Class str5 ZIP
"TRA0001" "2007-09-25" 150 1 "75019"
"TRA0002" "2002-08-09" 200 2 "30152"
"TRA0003" "2010-08-31" 500 3 "12451"
"TRA0004" "2005-06-17" 75 1 "45242"
"TRA0005" "2010-08-26" 410 3 "14618"
"TRA0006" "2008-07-07" 155 1 "70139"
"TRA0007" "2010-01-15" 450 3 "12883"
"TRA0008" "2000-11-03" 80 4 "45242"
"TRA0009" "2003-05-01" 120 2 "63017"
"TRA0010" "2000-10-01" 85 5 "23712"
end
* convert string date to Stata numeric date
gen ndate = daily(Date, "YMD")
format %td ndate
* save a copy to disk
save "using_copy.do", replace
* match, within the same Class, obs +/- 18 months (365.25 * 1.5 =~ 548 days)
rangejoin ndate -548 548 using "using_copy.do", by(Class) suffix(_Match)
* drop matched ID if amount is off by 20% and match to self
drop if (abs(Value - Value_Match) / Value) > .2
drop if ID == ID_Match
* final results
sort ID ID_Match
list ID ID_Match ZIP_Match, sepby(ID) noobs
结果:
. list ID ID_Match ZIP_Match, sepby(ID) noobs
+-------------------------------+
| ID ID_Match ZIP_Ma~h |
|-------------------------------|
| TRA0001 TRA0006 70139 |
|-------------------------------|
| TRA0003 TRA0005 14618 |
| TRA0003 TRA0007 12883 |
|-------------------------------|
| TRA0005 TRA0007 12883 |
|-------------------------------|
| TRA0006 TRA0001 75019 |
|-------------------------------|
| TRA0007 TRA0003 12451 |
| TRA0007 TRA0005 14618 |
+-------------------------------+
答案 2 :(得分:0)
首先使用data.table包。
然后你可以编写简单的函数,查找所提供的所有类似的事务。
在结束循环中,您的数据集将获得所有类似的集合:
dt1 <- data.table::fread('ID Date Value Class ZIP
TRA0001 2007-09-25 150 1 75019
TRA0002 2002-08-09 200 2 30152
TRA0003 2010-08-31 500 3 12451
TRA0004 2005-06-17 75 1 45242
TRA0005 2010-08-26 410 3 14618
TRA0006 2008-07-07 155 1 70139
TRA0007 2010-01-15 450 3 12883
TRA0008 2000-11-03 80 4 45242
TRA0009 2003-05-01 120 2 63017
TRA0010 2000-10-01 85 5 23712')
dt1[, Date:=as.POSIXct(Date)]
myTransaction <- dt1[1]
dt1[Class==myTransaction$Class & abs(difftime(Date, myTransaction$Date, units='weeks')) < 4*18 & abs((Value-myTransaction$Value)/pom$Value) < .2]
similar <- lapply(1:nrow(dt1), function(x)
{
myTransaction <- dt1[x]
dt1[ID!=myTransaction$ID & Class==myTransaction$Class & abs(difftime(Date, myTransaction$Date, units='weeks')) < 4*18 & abs((Value-myTransaction$Value)/pom$Value) < .2]
})
names(similar) <- dt1$ID
使用similar[['TRA0006']]
检查类似的交易。