我有一个capitals
capitals<-data.table(capital=c(100,50,25,5))
capitals
capital
1: 100
2: 50
3: 25
4: 5
和损失的数据表
losses<-data.table(loss=c(45,10,5,1))
losses
loss
1: 45
2: 10
3: 5
4: 1
我想随意将每笔资金与亏损（无需替换）联系起来，使损失小于或等于资本。在伪代码中，一种可能的实现方式是
Set all capitalLoss to NA (i.e. capitals[, capitalLoss:=NA])
Order losses from largest to smallest
For each loss in losses
randomly pick from capitals where capital>=loss and is.na(capitalLoss)
set capitalLoss to loss
Next
我如何实现这一点，以便它非常有效？您可以假设capitals和losses具有相同的行数，并且至少可以按照我的描述进行一次映射。
此示例的可能随机关联是
capital capitalLoss
1: 100 10
2: 50 45
3: 25 1
4: 5 5
和
capital capitalLoss
1: 100 45
2: 50 1
3: 25 10
4: 5 5
答案 0 :(得分：1)
一个易于理解的答案：您可以先在大写data.frame中构建一个列丢失，然后重复采样那些需要纠正的行：
capitals<-data.frame(capital=c(100,50,25,5))
loss=c(45,10,5,1)
capitals$loss <- sample(loss,replace=F)
capitals
capital loss
1 100 5
2 50 10
3 25 1
4 5 45
for(i in 1:nrow(capitals)) {
while(capitals[i,2]>capitals[i,1]){
capitals[i,2] <- sample(loss, 1)
}
}
capitals
capital loss
1 100 5
2 50 10
3 25 1
4 5 5
（注意最后一行已经更正）
如果需要replace = F，可以重复整个数据帧的采样，直到所有行都满足标准：
capitals<-data.frame(capital=c(100,50,25,5))
loss=c(45,10,5,1)
capitals$loss <- sample(loss,replace=F)
capitals
capital loss
1 100 5
2 50 10
3 25 1
4 5 45
while (any(capitals$loss > capitals$capital)) {
capitals$loss <- sample(loss,replace=F)}
capitals
capital loss
1 100 10
2 50 45
3 25 5
4 5 1
答案 1 :(得分：1)
首先，谢谢大家的尝试。我已经实现了一个简单的算法，它比目前为止的答案更快（我认为更容易理解）。
ffben<-function(capitals, losses){ #note, the inputs here are vectors, not data.tables
lossSamples<-numeric()
capitals<-sort(capitals)
for(i in 1:(length(capitals)-1)){
lossSamples[i]<-sample(x=losses[losses<=capitals[i]],1)
losses<-losses[-which(losses==lossSamples[i])[1]]
}
lossSamples[i+1]<-losses[1]
return(data.table(capitals=capitals, losses=lossSamples))
}
针对亚历克西斯的解决方案的基准
cap2 = 1:10000; los2 = pmax(0,1:10000-10) #10 capitals and losses
microbenchmark::microbenchmark(ffalex(cap2, los2), ffben(cap2, los2), times = 5)
Unit: seconds
expr min lq median uq max neval
ffalex(cap2, los2) 3.725 3.775 3.792 3.977 5.606 5
ffben(cap2, los2) 2.680 2.868 2.890 2.897 3.056 5
但是，我认识到我的解决方案仍有很大的改进空间，所以我不会接受它作为最佳答案，除非它在一周左右仍然是最快的解决方案。特别是，我希望有人可以开发一个基于data.table的解决方案，利用data.table固有的二进制搜索算法。
答案 2 :(得分：1)
这个问题的天真解决方案涉及n个大写值的循环，并且对于每个大写值，搜索n个损失值，使得求解时间变化n ^ 2。关于资本循环可能做得不多，但损失搜索时间可以通过两种方式减少。首先，找到需要搜索的损失的上限，可以通过排序和使用findInterval（）找到Alex和Shambho，然后在大写循环中找到可以传递给sample（）的可能损失列表。我在下面更新，而不是从整个列表中重新创建。由于可能损失列表的大小总是远小于n，因此使用该方法的执行时间与n的线性增加更接近，这导致该范围的n的执行时间显着减少。创建具有完整空间的损失跟踪向量而不是在循环中的每次迭代中分配空间也是有帮助的。我的函数也以与输入的资本值相同的顺序返回结果，这似乎是正确的。 Microbenchmark报告了ffben和ffwalt的时间，如下所示Ben的数据集。请注意，时间以毫秒为单位。
Unit: milliseconds
expr min lq median uq max neval
ffben(cap2, los2) 1549.8289 1556.113 1565.7139 1592.3230 1593.9527 5
ffwalt(cap2, los2) 205.4834 206.267 206.5975 207.0464 212.9808 5
ffben(capital, loss) 154235.8823 154855.444 154969.9196 155052.6070 156250.5489 5
ffwalt(capital, loss) 2071.3610 2074.692 2099.4889 2100.1091 2117.4721 5
由于资本数据集是cap2数据集大小的10倍，因此ffben的时间增加为n ^ 2，而ffwalt的时间仅按预期线性增加。
ffwalt <- function( caps, loss) {
len_cap <- length(caps)
loss_srt <- sort(loss)
caps_ord <- order(caps)
caps_srt <- caps[caps_ord]
cap_mx_ls_idx <- findInterval(caps_srt, loss_srt) # find upper loss bounds for each value of capital
loss_picked <- vector("numeric",len_cap) # alocate space for full loss vector to avoid mem alloc time in capital loop
samp <- seq_len(cap_mx_ls_idx[1])
for( i in seq_len(len_cap-1) ) {
loss_picked[i] <- sample(x=samp,1, replace=FALSE)
if(cap_mx_ls_idx[i+1] > cap_mx_ls_idx[i])
add_samp <- seq(cap_mx_ls_idx[i]+1,cap_mx_ls_idx[i+1],1)
else add_samp <- NULL
samp <- c(samp[samp != loss_picked[i]], add_samp)
}
loss_picked[len_cap] <- samp # avoid problem with sample() when x has length 1
results <- data.frame(capital=caps_srt, loss=loss_srt[loss_picked])
results[caps_ord,] <- results # restore original caps order
return(results)
}
答案 3 :(得分：0)
尝试使用小矢量：
capital=c(100,50,25,5)
loss=c(45,10,5,1)
posC<- order(capital)
posC
lossN <- NULL
for(i in posC){
temp <- sample(which(loss<=capital[i]),1)
lossN <- c(lossN, loss[temp])
loss <-loss[-temp]
}
data.table(capital=capital,loss=lossN[posC])
修改
这个适用于大型载体：
set.seed(100)
loss=sort(sample(1:5000,100000,replace = T))
capitals = sort(sample(1:100000,100000,replace=T))
capU <- unique(capitals)
length(capU)
splitLoss <- split(loss,findInterval(loss,sort(c(0,capU))))
head(splitLoss)
splitCap <- split(capitals,findInterval(capitals,sort(c(0,capU))))
head(splitCap)
lossN <- NULL
temp <- NULL
for(i in 1:length(splitLoss)){
temp <- c(temp,splitLoss[[i]])
for(j in 1:length(splitCap[[i]])){
id <- sample(1:length(temp),1)
lossN <- c(lossN, temp[id])
temp <-temp[-id]
}
}
lossN <- c(lossN,ifelse(length(temp)==1,temp,sample(temp)))
data.table(capital=capitals,loss=lossN)
我的机器大约需要7秒钟。
这里唯一的假设是capitals被排序和增加。如果需要，您可以使用order函数在另外两行中对capitals的无序值进行此操作。
希望这会有所帮助!!
答案 4 :(得分：0)
除非我错过了什么，否则这是一种看起来有效的方法：
capital = c(100, 50, 25, 5); loss = c(45, 10, 5, 1)
sc = sort(capital)
sl = sort(loss)
allowed = lapply(findInterval(sc, sl), seq_len)
replicate(10, { #just to replicate the process
tmp = seq_along(loss)
sams = rep(NA, length(loss))
for(i in seq_along(allowed)) {
intsec = intersect(allowed[[i]], tmp)
s = intsec[sample(length(intsec), 1)]
tmp[s] = NA
sams[i] = s
}
sl[sams]
})
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
#[1,] 1 1 1 5 1 1 1 5 5 1
#[2,] 10 10 5 1 10 10 10 1 1 5
#[3,] 45 5 10 45 5 45 45 10 45 45
#[4,] 5 45 45 10 45 5 5 45 10 10
上面每列中的每个元素对应于“sc”（已排序的大写）[5 25 50 100]中的相应元素。
与rnso的回答相比较的一些基准：
cap2 = sample(100:500, 10); los2 = sample(50:250, 10) #10 capitals and losses
microbenchmark::microbenchmark(ffalex(cap2, los2), ffrnso(cap2, los2), times = 5)
#Unit: microseconds
# expr min lq median uq max neval
# ffalex(cap2, los2) 385.589 396.377 399.162 434.309 591.608 5
# ffrnso(cap2, los2) 14.964 21.577 27.492 42.456 80.389 5
cap2 = sample(100:500, 50); los2 = sample(50:250, 50) #50
microbenchmark::microbenchmark(ffalex(cap2, los2), ffrnso(cap2, los2), times = 5)
#Unit: milliseconds
# expr min lq median uq max neval
# ffalex(cap2, los2) 1.62031 1.64467 1.949522 1.966226 3.508583 5
# ffrnso(cap2, los2) 283.27681 538.50515 971.273262 3348.542296 4279.280326 5
cap2 = sample(100:500, 2e2); los2 = sample(50:250, 2e2) #200
system.time({ ans1 = ffalex(cap2, los2) })
# user system elapsed
# 0.01 0.02 0.03
system.time({ ans2 = ffrnso(cap2, los2) })
#Timing stopped at: 77.69 0.14 78.22
并检查确实所有损失都是“＆lt; =”到资本：
#head(ans1)
# sc
#[1,] 100 83
#[2,] 101 92
#[3,] 103 59
#[4,] 107 52
#[5,] 109 74
#[6,] 110 79
sum(ans1[, 2] > ans1[, 1])
#[1] 0 #none is greater
这两个功能：
ffalex = function (capital, loss)
{
sc = sort(capital)
sl = sort(loss)
allowed = lapply(findInterval(sc, sl), seq_len)
tmp = seq_along(loss)
sams = rep(NA, length(loss))
for (i in seq_along(allowed)) {
intsec = intersect(allowed[[i]], tmp)
s = intsec[sample(length(intsec), 1)]
tmp[s] = NA
sams[i] = s
}
cbind(sc, sl[sams])
}
ffrnso = function (capital, loss)
{
while (any(loss > capital)) {
loss <- sample(loss, replace = F)
}
cbind(capital, loss)
}