在过去的30年里，我拥有一千家公司的股权回报数据。其中一些公司是＆＃34; DEAD＆＃34; （通常是退市或破产），因此他们有回报= 0.我想为这些公司的回报分配NAs，但只是在他们实际上＃34;去世后＃34;。为此，我尝试使用以下代码：
if(Returns$r == 0 & stri_detect_fixed(Returns$Company, "DEAD"), na.rm = TRUE){
Returns$r[Returns$r == 0 & stri_detect_fixed(Returns$Company, "DEAD")] <- NA
}
这非常有效，但不幸的是，即使在他们死亡和＃34;之前，DEAD /退市公司有时会返回等于0的值，而这些值我希望保持为0。
因此，我需要的是一个命令/如果条件告诉R我只想返回NAs，如果下一行的返回也等于0。你们有什么建议吗？我希望我的问题清楚，但我知道我的解释可能有点令人困惑。
Returns <- structure(list(Date = c("04.09.17", "05.09.17", "06.09.17", "01.09.17",
"02.09.17", "03.09.17", "04.09.17", "05.09.17", "06.09.17", "04.09.17",
"05.09.17", "06.09.17"), Company = c("ORKLA", "ORKLA", "ORKLA",
"VISMA DEAD 04.09.17", "VISMA DEAD 04.09.17", "VISMA DEAD 04.09.17",
"VISMA DEAD 04.09.17", "VISMA DEAD 04.09.17", "VISMA DEAD 04.09.17",
"XNEWCO", "XNEWCO", "XNEWCO"), r = c(0.04, 0, -0.02, 0.01, 0, -0.03,
0, 0, 0, 0.01, 0, 0)), .Names = c("Date", "Company", "r"), row.names = c(NA,
-12L), class = "data.frame")
（已编辑以涵盖＆＃34;直播＆＃34;公司在时间序列结束时归零的情况）
我的数据框Returns看起来像这样：
Date Company r
04.09.17 ORKLA 0.04
05.09.17 ORKLA 0.00
06.09.17 ORKLA -0.02
01.09.17 VISMA DEAD 04.09.17 0.01
02.09.17 VISMA DEAD 04.09.17 0.00
03.09.17 VISMA DEAD 04.09.17 -0.03
04.09.17 VISMA DEAD 04.09.17 0.00
05.09.17 VISMA DEAD 04.09.17 0.00
06.09.17 VISMA DEAD 04.09.17 0.00
04.09.17 XNEWCO 0.01
05.09.17 XNEWCO 0.00
06.09.17 XNEWCO 0.00
我希望它是这样的：
Date Company r
04.09.17 ORKLA 0.04
05.09.17 ORKLA 0.00
06.09.17 ORKLA -0.02
01.09.17 VISMA DEAD 04.09.17 0.01
02.09.17 VISMA DEAD 04.09.17 0.00
03.09.17 VISMA DEAD 04.09.17 -0.03
04.09.17 VISMA DEAD 04.09.17 NA
05.09.17 VISMA DEAD 04.09.17 NA
06.09.17 VISMA DEAD 04.09.17 NA
04.09.17 XNEWCO 0.01
05.09.17 XNEWCO 0.00
06.09.17 XNEWCO 0.00
我当前的代码（正如您上面所见）不会起作用，因为它会替换VISMA 02.09.17的0.00的返回值。我需要它保持0.00，因为这是在VISMA＆＃34;死亡之前＃34;
答案 0 :(得分：2)
编辑：在准备基准测试时，我注意到缺少一个条件，以防止在时间序列结束时替换零值也适用于活着的公司。遗憾的是，OP提供的原始样本数据（编辑前）未涵盖此案例，因此未被发现。我已相应修改了以下解决方案。
根据OP的话我有过去30年的数千家公司的股权回报数据集，数据集可能包含数百万行（保守估计：每年250个工作日） * 2000家公司*平均存在5年= 2.5 M行））
因此，我们需要替换一些值而不复制整个数据集。 data.table允许我们更新数据 。
OP要求在每个公司的时间序列末尾找到所有连续的零序列，并用NA替换这些零。
使用data.table，这里有两个选项：
rleid()函数library(data.table)
# coerce to data.table
setDT(Returns)
# convert character dates
Returns[, Date := as.IDate(Date, "%d.%m.%y")][]
# make sure data is ordered
setorder(Returns, Company, Date)[]
Returns[, Company %like% "DEAD" & r == 0 & rleid(r == 0) == max(rleid(r == 0)),
by = Company]
对于每个 dead 公司，选择最后一个零值序列：
Company V1 1: ORKLA FALSE 2: ORKLA FALSE 3: ORKLA FALSE 4: VISMA DEAD 04.09.17 FALSE 5: VISMA DEAD 04.09.17 FALSE 6: VISMA DEAD 04.09.17 FALSE 7: VISMA DEAD 04.09.17 TRUE 8: VISMA DEAD 04.09.17 TRUE 9: VISMA DEAD 04.09.17 TRUE 10: XNEWCO FALSE 11: XNEWCO FALSE 12: XNEWCO FALSE
V1列用于对DT进行分组和更新：
Returns[Returns[, Company %like% "DEAD" & r == 0 & rleid(r == 0) == max(rleid(r == 0)),
by = Company]$V1, r := NA_real_][]
Date Company r 1: 2017-09-04 ORKLA 0.04 2: 2017-09-05 ORKLA 0.00 3: 2017-09-06 ORKLA -0.02 4: 2017-09-01 VISMA DEAD 04.09.17 0.01 5: 2017-09-02 VISMA DEAD 04.09.17 0.00 6: 2017-09-03 VISMA DEAD 04.09.17 -0.03 7: 2017-09-04 VISMA DEAD 04.09.17 NA 8: 2017-09-05 VISMA DEAD 04.09.17 NA 9: 2017-09-06 VISMA DEAD 04.09.17 NA 10: 2017-09-04 XNEWCO 0.01 11: 2017-09-05 XNEWCO 0.00 12: 2017-09-06 XNEWCO 0.00
Returns[, {tmp <- last(which(r != 0))
if (Company %like% "DEAD" & tmp < .N) .I[seq.int(tmp + 1L, .N)]}, by = Company]
这里，挑选每个时间序列的最后一个非零值的位置，用于构建 dead 公司剩余零值的指数。 .I和.N是data.table语法中的特殊符号。如果 dead 公司的时间序列末尾没有零值，则需要检查if (Company %like% "DEAD" & tmp < .N)。
Company V1 1: VISMA DEAD 04.09.17 7 2: VISMA DEAD 04.09.17 8 3: VISMA DEAD 04.09.17 9
如上所述，V1用于对Returns进行分组和更新：
Returns[Returns[, {tmp <- last(which(r != 0))
if (Company %like% "DEAD" & tmp < .N) .I[seq.int(tmp + 1L, .N)]},
by = Company]$V1, r := NA_real_][]
Date Company r 1: 2017-09-04 ORKLA 0.04 2: 2017-09-05 ORKLA 0.00 3: 2017-09-06 ORKLA -0.02 4: 2017-09-01 VISMA DEAD 04.09.17 0.01 5: 2017-09-02 VISMA DEAD 04.09.17 0.00 6: 2017-09-03 VISMA DEAD 04.09.17 -0.03 7: 2017-09-04 VISMA DEAD 04.09.17 NA 8: 2017-09-05 VISMA DEAD 04.09.17 NA 9: 2017-09-06 VISMA DEAD 04.09.17 NA 10: 2017-09-04 XNEWCO 0.01 11: 2017-09-05 XNEWCO 0.00 12: 2017-09-06 XNEWCO 0.00
Hack-R声称his solutions 应该可以运行最多1M行。所以，我想用基准验证这个声明。
library(data.table)
# create benchmark data
n_days <- 100L
n_comp <- 100L
n_dead <- round(0.1 * n_comp) # 10 per cent of companies are dead
Date <- seq(from = as.IDate("2015-01-01"), length.out = n_days, by = "1 day")
# company "names" consist of 4 digits at least
Company <- sprintf("%04i", seq_len(n_comp))
# cross join to create all combinations
Returns <- CJ(Date = Date, Company = Company)
set.seed(1L) # reuired for reproducible result
Returns[, r := round(rnorm(.N)/10.0, 2L)][]
# dead companies
dead <- data.table(Company = sample(Company, n_dead),
dead.date = sample(Date, n_dead))
# modify Returns
Returns[dead, on = .(Company, Date >= dead.date), r := 0]
# modify compay names
Returns[dead, on = "Company", Company := paste(Company, "DEAD", dead.date)]
# IMPORTANT: set order
setorder(Returns, Company, Date)
# keep original version
R0 <- copy(Returns)
microbenchmark::microbenchmark(
copy = Returns <- copy(R0),
hackr1 = {
mydat <- setDF(copy(R0))
for(i in 1:nrow(mydat)){
if(i==nrow(mydat) & mydat$r[i]==0) {mydat$r[i] <- NA
} else if(!is.na(mydat$r[i]) & mydat$r[i]==0 & mydat$r[i+1]==0) mydat$r[i] <- NA
}
res_hackr1 <- mydat
},
hackr2 = {
mydat <- copy(R0)
tmp0 <- mydat[0,]
for(c in unique(mydat$Company)){
tmp <- mydat[mydat$Company==c,]
for(i in 1:nrow(tmp)){
if(!is.na(tmp$r[i]) & tmp$r[i]==0 & tmp$r[i+1]==0){
tmp$r[i:nrow(tmp)] <- NA
}
}
tmp0 <- rbind(tmp0, tmp)
}
res_hackr2 <- tmp0
},
dt_rleid1 = {
Returns <- copy(R0)
Returns[Returns[, Company %like% "DEAD" & r == 0 & rleid(r == 0) == max(rleid(r == 0)),
by = Company]$V1, r := NA_real_]
res_dt_rleid1 <- copy(Returns)
},
dt_rleid2 = {
Returns <- copy(R0)
Returns[Company %like% "DEAD" & Returns[, r == 0 & rleid(r == 0) == max(rleid(r == 0)),
by = Company]$V1, r := NA_real_]
res_dt_rleid2 <- copy(Returns)
},
dt_last = {
Returns <- copy(R0)
Returns[Returns[, {
tmp <- last(which(r != 0))
if (Company %like% "DEAD") .I[tmp + seq_len(.N - tmp)]
},
by = Company]$V1, r := NA_real_]
res_dt_last <- copy(Returns)
},
dt_last2 = {
Returns <- copy(R0)
Returns[Returns[, {
tmp <- last(which(r != 0))
if (Company %like% "DEAD" & tmp < .N) .I[seq.int(tmp + 1L, .N)]
},
by = Company]$V1, r := NA_real_]
res_dt_last2 <- copy(Returns)
},
times = 11L
)
当代码修改数据集到位时，copy()用于在每次运行之前创建“新的”未修改数据集，并存储结果以供以后比较。因此，copy()也是时间。
dt_rleid1和dt_rleid2以及dt_last和dt_last2是相应解决方案的代码变体。
不幸的是， hackr2 停止执行并显示错误消息：
if（！is.na（tmp $ r [i]）＆amp; tmp $ r [i] == 0＆amp; tmp $ r [i + 1] == 0）{：
缺少需要TRUE / FALSE的值
其余解决方案的时间安排如下：
Unit: microseconds expr min lq mean median uq max neval cld copy 46.065 48.331 53.75427 52.485 58.1475 66.077 11 a hackr1 267515.143 269559.179 277240.15827 271093.857 275196.8435 329919.874 11 b dt_rleid1 2203.942 2404.060 3130.73218 2690.267 3728.9925 4813.783 11 a dt_rleid2 2577.370 2665.346 5750.63073 2700.839 2741.0510 36395.429 11 a dt_last 1605.098 1627.564 1718.85318 1654.561 1724.6030 2036.296 11 a dt_last2 1665.134 1718.372 1945.67645 1764.438 1769.5350 3909.476 11 a
对于100 x 100 = 10 K行的相当小的问题大小，data.table解决方案比Hack-R方法快两个数量级。我尝试运行Hack-R的1000 x 1000 = 1 M行的解决方案，但我没有耐心等待结果。
对于1M行，找到最后一个非零值的方法比rleid()方法快5到6倍。
Unit: milliseconds expr min lq mean median uq max neval cld copy 6.602008 6.843094 21.23383 7.297889 13.61614 141.5794 11 a dt_rleid1 63.282609 70.239165 142.21568 193.972143 199.32077 224.5657 11 b dt_rleid2 157.939571 281.185658 266.62148 288.184692 291.61445 309.5796 11 c dt_last 35.826792 39.198781 101.66298 48.387030 172.40187 182.2354 11 b dt_last2 36.507194 43.754676 103.95414 48.879018 173.66035 183.1639 11 b
答案 1 :(得分：0)
可能有一个更简单的解决方案，但我在没有循环/功能的情况下一步一步地采取它。
library( data.table )
library( stringr )
# Create a dummy variable **status_delisting** to show if the company is dead.
df$status_delisting = ifelse( grepl( "DEAD", df$Company ), 1, 0 )
# Find names with numbers in it, check if the numbers are dates and convert to format. Sometimes the company has numbers in the name.
df$Company = as.character( df$Company )
check_values = c( unique( df$Company ) )
setDT(check_values)
names( check_values ) = "check_memo"
# You might need this as well.
# Sys.getlocale()
# Sys.setlocale(locale="C")
# Check if there are dates in the name
# The date format we check is N.N.N at least.
check_values$Date_Flag = ifelse( grepl("([0-9]+)(.)([0-9]+)([0-9]+)",
check_values$check_memo), 1, 0 )
# Create new column with the proposed format of date
# dd . mm . yy
pat <- "[0-9][0-9][.][0-9][0-9][.][0-9][0-9]"
check_values[,Date_Flag := str_count( check_memo, pat ) == 1 ]
check_values[(Date_Flag), paste0( "Date", 1 ) := transpose( str_extract_all( check_memo, pat ))]
删除未退市的公司（没有退市日期）。
setDF( check_values )
check_values = filter( check_values, !is.na(Date1))
将死去的公司与数据框合并
df = left_join( x = df, y = check_values, by = c("Company" = "check_memo"))
将两个日期格式化为日期
df$Date = as.Date( df$Date, format = "%d.%m.%y")
df$Date1 = as.Date( df$Date1, format = "%d.%m.%y")
根据需要使用返回创建一个新列。您可以删除冗余列。
df$returns = ifelse(
df$status_delisting == 1,
ifelse(df$Date <= df$Date1, df$r, NA), df$r )
答案 2 :(得分：0)
这可以通过修改数据来完成：
# Please use dput() or a reproducible way of sharing your data
mydat <-
read.table(text="Date Company r
'04.09.17' ORKLA 0.04
'05.09.17' ORKLA 0.00
'06.09.17' ORKLA -0.02
'01.09.17' VISMA 0.01
'02.09.17' VISMA 0.00
'03.09.17' VISMA -0.03
'04.09.17' VISMA 0.00
'05.09.17' VISMA 0.00
'06.09.17' VISMA 0.00",header=T)
for(i in 1:nrow(mydat)){
if(i==nrow(mydat) & mydat$r[i]==0) {mydat$r[i] <- NA
} else if(!is.na(mydat$r[i]) & mydat$r[i]==0 & mydat$r[i+1]==0) mydat$r[i] <- NA
}
Date Company r 1 04.09.17 ORKLA 0.04 2 05.09.17 ORKLA 0.00 3 06.09.17 ORKLA -0.02 4 01.09.17 VISMA 0.01 5 02.09.17 VISMA 0.00 6 03.09.17 VISMA -0.03 7 04.09.17 VISMA NA 8 05.09.17 VISMA NA 9 06.09.17 VISMA NA
逻辑说明了这一点：
如果值r不是NA（由于您无法对NA进行逻辑评估，我们必须检查）并且值现在为0且在下一行中，那么公司是死了，所以让r = NA。
如果这是数据集的最后一行并且值为0那么我将来看不到，所以我认为它已经死了。将NA更改为0以反转此假设。如果我们愿意，我们还可以添加一些公司级逻辑来改善这一点：
# Same result as above, but handles the last row better by considering company
tmp0 <- mydat[0,]
for(c in unique(mydat$Company)){
tmp <- mydat[mydat$Company==c,]
for(i in 1:nrow(tmp)){
if(!is.na(tmp$r[i]) & tmp$r[i]==0 & tmp$r[i+1]==0){
tmp$r[i:nrow(tmp)] <- NA
}
}
tmp0 <- rbind(tmp0, tmp)
}
tmp0
我喜欢第二种方式的逻辑略微更好，但两者都应该工作，并且应该可以执行最多1M行。如果你想超越它，我们可以sapply使用相同的逻辑而不是使用循环，和/或使用任意数量的大数据类型，如tibble或data.table。