आर-आर, मर्ज, डेटाफ्रेम में विलय के दौरान संख्यात्मक तुलना

डेटा ढांचा d1:

x  y
4 10
6 20
7 30

डेटा ढांचा d2:

x   z
3 100
6 200
9 300

मैं कैसे विलीन होऊं? d1 तथा d2 द्वारा "x" कहा पे d1$x सटीक मिलान या अगले उच्च संख्या के साथ मिलान किया जाना चाहिए d2$x। आउटपुट जैसा दिखना चाहिए:

x   y    z
4  10  200 # (4 is matched against next higher value that is 6)
6  20  200 # (6 is matched against 6)
7  30  300 # (7 is matched against next higher value that is 9)

अगर merge() ऐसा नहीं कर सकते, तो क्या ऐसा करने का कोई और तरीका है? छोरों के लिए दर्द धीमा है।

उत्तर:

जवाब के लिए 2 № 1

इनपुट डेटा:

d1 <- data.frame(x=c(4,6,7), y=c(10,20,30))
d2 <- data.frame(x=c(3,6,9), z=c(100,200,300))

आप मूल रूप से विस्तार करना चाहते हैं d1 एक नए कॉलम के द्वारा। तो चलो इसे कॉपी करते हैं।

d3 <- d1

आगे मैं मान लेता हूं d2$x nondecreasingly और वह हल हैmax(d1$x) <= max(d2$x).

d3$z <- sapply(d1$x, function(x) d2$z[which(x <= d2$x)[1]])

जो पढ़ता है: प्रत्येक के लिए x में d1$x, से सबसे छोटा मान प्राप्त करें d2$x जो से छोटा नहीं है x.

इन मान्यताओं के तहत, ऊपर भी लिखा जा सकता है (और थोड़ा तेज़ होना चाहिए):

d3$z <- sapply(d1$x, function(x) d2$z[which.max(x <= d2$x)])

परिणाम में हम प्राप्त करते हैं:

d3
##   x  y   z
## 1 4 10 200
## 2 6 20 200
## 3 7 30 300

EDIT1: @MatthewLundberg से प्रेरित है cutआधारित समाधान, यहाँ एक और एक का उपयोग कर रहा है findInterval:

d3$z <- d2$z[findInterval(d1$x, d2$x+1)+1]

EDIT2: (बेंचमार्क)

अनुकरणीय डेटा:

set.seed(123)
d1 <- data.frame(x=sort(sample(1:10000, 1000)), y=sort(sample(1:10000, 1000)))
d2 <- data.frame(x=sort(c(sample(1:10000, 999), 10000)), z=sort(sample(1:10000, 1000)))

परिणाम:

microbenchmark::microbenchmark(
{d3 <- d1; d3$z <- d2$z[findInterval(d1$x, d2$x+1)+1] },
{d3 <- d1; d3$z <- sapply(d1$x, function(x) d2$z[which(x <= d2$x)[1]]) },
{d3 <- d1; d3$z <- sapply(d1$x, function(x) d2$z[which.max(x <= d2$x)]) },
{d1$x2 <- d2$x[as.numeric(cut(d1$x, c(-Inf, d2$x, Inf)))]; merge(d1, d2, by.x="x2", by.y="x")},
{d1a <- d1; setkey(setDT(d1a), x); d2a <- d2; setkey(setDT(d2a), x); d2a[d1a, roll=-Inf] }
)
## Unit: microseconds
##         expr       min            lq    median        uq       max neval
## findInterval   221.102      1357.558  1394.246  1429.767  17810.55   100
## which        66311.738     70619.518 85170.175 87674.762 220613.09   100
## which.max    69832.069     73225.755 83347.842 89549.326 118266.20   100
## cut           8095.411      8347.841  8498.486  8798.226  25531.58   100
## data.table    1668.998      1774.442  1878.028  1954.583  17974.10   100

---

जवाब के लिए 4 № 2

यह बहुत सीधा उपयोग है लुढ़कते जोड़ साथ में data.table:

require(data.table)   ## >= 1.9.2
setkey(setDT(d1), x)  ## convert to data.table, set key for the column to join on
setkey(setDT(d2), x)  ##  same as above

d2[d1, roll=-Inf]

#    x   z  y
# 1: 4 200 10
# 2: 6 200 20
# 3: 7 300 30

---

जवाब के लिए 2 № 3

cut में उपयुक्त मैच खोजने के लिए इस्तेमाल किया जा सकता है d2$x में मूल्यों के लिए d1$x.

के साथ मैच खोजने के लिए गणना cut इस प्रकार है:

as.numeric(cut(d1$x, c(-Inf, d2$x, Inf)))
## [1] 2 2 3

ये मूल्य हैं:

d2$x[as.numeric(cut(d1$x, c(-Inf, d2$x, Inf)))]
[1] 6 6 9

इनमें जोड़ा जा सकता है d1 और मर्ज किया गया:

d1$x2 <- d2$x[as.numeric(cut(d1$x, c(-Inf, d2$x, Inf)))]
merge(d1, d2, by.x="x2", by.y="x")
##   x2 x  y   z
## 1  6 4 10 200
## 2  6 6 20 200
## 3  9 7 30 300

यदि वांछित हो, तो जोड़ा गया कॉलम हटाया जा सकता है।

---

उत्तर के लिए 1 № 4

प्रयत्न: sapply(d1$x,function(y) d2$z[d2$x > y][which.min(abs(y - d2$x[d2$x > y]))])

---