मान लीजिए हमारे पास नीचे जैसा मैट्रिक्स है,
A <- matrix(c(1,7,13,19,9,5,8,14,20,10,3,4,15,21,1,2,4,16,22,2,8,3,17,23,1,6,3,18,24,2), nrow=5)
A
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1 5 3 2 8 6
[2,] 7 8 4 4 3 3
[3,] 13 14 15 16 17 18
[4,] 19 20 21 22 23 24
[5,] 9 10 1 2 1 2
dist फ़ंक्शन dist(A, method = "maximum") का उपयोग करके मैट्रिक्स A और वापसी दूरी मैट्रिक्स D की प्रत्येक पंक्ति के बीच अधिकतम पूर्ण दूरी की गणना कर सकता है। D[i,j] = \max_{k}(|A[i,k]-A[j,k]|) उदाहरण के लिए,
D[1,2] = max( abs( A[1,] - A[2,] ) ) = max(6, 3, 1, 2, 5, 3) = 6
हालांकि, मेरे मामले में, मुझे सबसे पहले i, j तत्व, यानी D[i,j] = \max_{k not equal to i or j}(|A[i,k]-A[j,k]|) को हटाना होगा, उदाहरण के लिए, उपरोक्त उदाहरण में, उत्तर
D[1,2] = max( abs( A[1,] - A[2,] ) ) = max( 1, 2, 5, 3) = 5
मुझे नहीं पता कि इसे कुशल तरीके से कैसे किया जाए, मुझे पता है कि मैं लूप के लिए उपयोग कर सकता हूं, लेकिन डेटा सेट बड़ा है, क्योंकि लूप बेहद धीमा है।
2 जवाब
मान लें कि आपके वास्तविक मैट्रिक्स में पंक्तियों से अधिक कॉलम हैं। आपके इच्छित फ़ंक्शन का आधार R कार्यान्वयन यहां दिया गया है:
max_dist <- function(mat, i, j) {
mat <- mat[c(i, j), -c(i, j)]
max(abs(mat[1L, ] - mat[2L, ]))
}
dist1 <- function(mat) {
n <- nrow(mat)
ids <- do.call(rbind, lapply(2:n, function(i, e) cbind(i:e, rep.int(i - 1L, e - i + 1L)), n))
out <- apply(ids, 1L, function(i) max_dist(mat, i[[1L]], i[[2L]]))
attributes(out) <- list(
Size = n, Labels = dimnames(mat)[[1L]], Diag = FALSE,
Upper = FALSE, method = "dist1", call = match.call(),
class = "dist"
)
out
}
यदि आपको लगता है कि R आपके मामले के लिए पर्याप्त तेज़ नहीं है, तो आप पैकेज parallelDist का उपयोग कर सकते हैं, जो उपयोगकर्ता द्वारा परिभाषित C++ दूरी के कार्यों की अनुमति देता है। निम्नलिखित कार्यान्वयन पर विचार करें:
library(parallelDist)
library(RcppXPtrUtils)
library(RcppArmadillo)
mydist_ptr <- cppXPtr("double mydist(const arma::mat &A, const arma::mat &B) {
arma::uvec ids = {0, (unsigned int)A(0, 0), (unsigned int)B(0, 0)};
arma::mat A_ = A, B_ = B;
A_.shed_cols(ids); B_.shed_cols(ids);
return abs((A_ - B_)).max();
}", depends = "RcppArmadillo")
dist2 <- function(mat) {
# prepend row numbers to the matrix
# this later allows cpp function `mydist` to identify which rows to drop
parDist(cbind(seq_len(nrow(mat)), mat), method = "custom", func = mydist_ptr)
}
निम्नलिखित मैट्रिक्स के साथ परीक्षण करें (small_m आपकी पोस्ट में उदाहरण है):
small_m <- matrix(c(1,5,3,2,8,6,7,8,4,4,3,3,13,14,15,16,17,18,19,20,21,22,23,24,9,10,1,2,1,2), 5, 6, byrow = TRUE)
large_m <- matrix(rnorm(1000000), 10, 100000)
बेंचमार्क
# no real difference between these two implementations when the input matrix is small
> microbenchmark::microbenchmark(dist1(small_m), dist2(small_m))
Unit: microseconds
expr min lq mean median uq max neval cld
dist1(small_m) 77.4 87.10 112.403 106.5 125.95 212.2 100 a
dist2(small_m) 145.5 160.25 177.786 170.2 183.80 286.7 100 b
# `dist2` is faster with large matrix input. However, the efficiency of `dist1` is also acceptable IMO.
> microbenchmark::microbenchmark(dist1(large_m), dist2(large_m))
Unit: milliseconds
expr min lq mean median uq max neval cld
dist1(large_m) 129.7531 139.3909 152.13154 143.0549 149.5870 322.0173 100 b
dist2(large_m) 48.8025 52.5081 55.84333 55.5175 58.6095 67.6470 100 a
आउटपुट इस प्रकार है
> dist1(small_m)
1 2 3 4
2 5
3 14 15
4 18 21 6
5 5 3 16 22
> dist2(small_m)
1 2 3 4
2 5
3 14 15
4 18 21 6
5 5 3 16 22
यहां dist + combn + as.dist का उपयोग करते हुए एक आधार R विकल्प दिया गया है
r <- diag(0,nrow(m))
r[lower.tri(r)] <- combn(1:nrow(m),2,function(k) max(abs(do.call(`-`,asplit(m[k,],1)))[-k]))
out <- as.dist(r)
जो देता है
1 2 3 4
2 5
3 14 15
4 18 21 6
5 5 3 16 22
डेटा
> dput(m)
structure(c(1, 7, 13, 19, 9, 5, 8, 14, 20, 10, 3, 4, 15, 21,
1, 2, 4, 16, 22, 2, 8, 3, 17, 23, 1, 6, 3, 18, 24, 2), .Dim = 5:6)