文章/答案/技术大牛

发布

社区首页 >问答首页 >R_Finding是向量数中最接近的匹配

问R_Finding是向量数中最接近的匹配
EN

Stack Overflow用户

提问于 2014-05-08 12:44:24

回答 2查看 939关注 0票数 1

我有以下向量

> X <- c(1,1,3,4)
> a <- c(1,1,2,2)
> b <- c(2,1,4,3)
> c <- c(2,1,4,6)

我想将X的每个元素与a、b和c的对应元素进行比较，最后，我需要为X的每一行分配一个类。

X的第一个元素是1，它在对应的元素向量a中有一个匹配，然后我需要将一个类赋值为'1-1‘(不管它是从哪个向量得到匹配)。
X的第二个元素是1，它也有匹配(实际上是3)，所以，这个类也是'1-1‘。
X的第三个元素是3，它没有匹配，那么我应该查找下一个整数值，即4和4(在b和c中)。所以这门课应该是3-4
X的第四个元素是4，它没有匹配。另外，没有5(下一个整数)，它应该查找前一个整数，即3和3。所以类应该是'4-3‘。

实际上，每个向量有上千行，每一行我都要这样做。任何以不那么复杂的方式做这件事的建议。我更喜欢使用R的基函数。

match

回答 2

Stack Overflow用户

回答已采纳

发布于 2014-05-08 15:54:12

根据rbatt的评论和回答，我意识到我原来的答案非常缺乏。这是重拍..。

match_nearest <- function( x, table )
{
  dist <- x - table
  tgt <- which( dist < 0, arr.ind=TRUE, useNames=F )
  dist[tgt] <- abs( dist[tgt] + .5 )
  table[ cbind( seq_along(x), max.col( -dist, ties.method="first" ) ) ]
}

X <- c(1,1,3,4)
a <- c(1,1,2,2)
b <- c(2,1,4,3)
c <- c(2,1,4,6)

paste(X, match_nearest(X, cbind(a,b,c) ), sep="-")

## [1] "1-1" "1-1" "3-4" "4-3"

和原来的答案相比，我们发现两者都不正确！

set.seed(1)
X <- rbinom(n=1E4, size=10, prob=0.5)
a <- rbinom(n=1E4, size=10, prob=0.5)
b <- rbinom(n=1E4, size=10, prob=0.5)
c <- rbinom(n=1E4, size=10, prob=0.5)

T <- current_solution(X,a,b,c)
R <- rbatt_solution(X,a,b,c)
all.equal( T, R )

## [1] "195 string mismatches"

# Look at mismatched rows...
mismatch <- head( which( T != R ) )
cbind(X,a,b,c)[mismatch,]

##      X a b c
## [1,] 4 6 3 3
## [2,] 5 7 4 7
## [3,] 5 8 3 9
## [4,] 5 7 7 4
## [5,] 4 6 3 7
## [6,] 5 7 4 2

T[mismatch]

## [1] "4-3" "5-4" "5-3" "5-4" "4-3" "5-4"

R[mismatch]

## [1] "4-6" "5-7" "5-8" "5-7" "4-6" "5-7"

毫无必要的慢下来..。

library(microbenchmark)
bm <- microbenchmark( current_solution(X,a,b,c),
                      previous_solution(X,a,b,c),
                      rbatt_solution(X,a,b,c) )
print(bm, order="median")

## Unit: milliseconds
##                           expr    min     lq  median      uq    max neval
##   current_solution(X, a, b, c)  7.088  7.298   7.996   8.268  38.25   100
##     rbatt_solution(X, a, b, c) 33.920 38.236  46.524  53.441  85.50   100
##  previous_solution(X, a, b, c) 83.082 93.869 101.997 115.961 135.98   100

看起来current_solution是正确的；但是没有预期的输出.

这是功能..。

current_solution <- function(X,a,b,c) {
  paste(X, match_nearest(X, cbind(a,b,c) ), sep="-")
}

# DO NOT USE... it is wrong!
previous_solution <- function(X,a,b,c) {
  dat <- rbind(X,a,b,c)
  v <- apply(dat,2, function(v) {
    v2 <- v[1] - v
    v2[v2<0] <- abs( v2[v2<0]) - 1
    v[ which.min( v2[-1] ) + 1 ]
  })
  paste("X", v, sep="-")
}

# DO NOT USE... it is wrong!
rbatt_solution <- function(X,a,b,c) {
    mat <- cbind(X,a,b,c)
    diff.signed <- mat[,"X"]-mat[,c("a","b","c")]
    diff.break <- abs(diff.signed) + sign(diff.signed)*0.5
    min.ind <- apply(diff.break, 1, which.min)
    ind.array <- matrix(c(1:nrow(mat),min.ind), ncol=2)
    match.value <- mat[,c("a","b","c")][ind.array]
    ref.class <- paste(X, match.value, sep="-")
    ref.class
}

票数 2

Stack Overflow用户

发布于 2014-05-08 20:03:20

此解决方案应提供所需的输出。而且，它比Thell的解决方案快3倍，因为这些差异是矢量化的，不能用apply逐行计算。

我比较了下面两种方法的时间。注意，如果您希望将"class“作为data.frame中的另一列，只需取消注释我函数的最后一行。我将其注释掉是为了使这两个答案之间的计算时间更具可比性(创建data.frame相当慢)。

# Example data from Thell, plus 1 more
X1 <- c(1,1,3,4,7,1, 5)
a1 <- c(1,1,2,2,2,2, 9)
b1 <- c(2,1,4,3,3,3, 3)
c1 <- c(2,1,4,6,6,6, 7)

# Random example data, much larger
# X1 <- rbinom(n=1E4, size=10, prob=0.5)
# a1 <- rbinom(n=1E4, size=10, prob=0.5)
# b1 <- rbinom(n=1E4, size=10, prob=0.5)
# c1 <- rbinom(n=1E4, size=10, prob=0.5)

我的答案是：

rbTest <- function(){
    mat <- cbind(X1,a1,b1,c1)

    diff.signed <- mat[,"X1"]-mat[,c("a1","b1","c1")] # differences (with sign)
    diff.break <- abs(diff.signed) + sign(diff.signed)*0.5 # penalize for differences that are negative by adding 0.5 to them (break ties by preferring higher integer)

    min.ind <- apply(diff.break, 1, which.min) # index of smallest difference (prefer larger integers when there is a tie)
    ind.array <- matrix(c(1:nrow(mat),min.ind), ncol=2) # array index format

    match.value <- mat[,c("a1","b1","c1")][ind.array] # value of the smallest difference (value of the match)
    ref.class <- paste(X1, match.value, sep="-") # the 'class' in the format 'ref-match'
    ref.class
    # data.frame(class=ref.class, mat)
}

Thell answer

thTest <- function(){
    dat <- rbind(X1,a1,b1,c1)
    apply(dat,2, function(v) {
      # Get distance
      v2 <- v[1] - v
      # Prefer values >= v[1]
      v2[v2<0] <- abs( v2[v2<0]) - 1
      # Obtain and return nearest v excluding v[1]
      v[ which.min( v2[-1] ) + 1 ]
    })
}

大型矩阵的基准测试(10,000行)

# > microbenchmark(rbTest(), thTest())
# Unit: milliseconds
#      expr       min        lq    median        uq      max neval
#  rbTest()  47.95451  52.01729  59.36161  71.94076 103.1314   100
#  thTest() 167.49798 180.69627 195.02828 204.19916 315.0610   100

小矩阵基准(7行)

# > microbenchmark(rbTest(), thTest())
# Unit: microseconds
#      expr     min       lq   median       uq     max neval
#  rbTest() 108.299 112.3550 115.4225 119.4630 146.722   100
#  thTest() 147.727 152.2015 155.9005 159.3115 235.898   100

示例输出(小矩阵)：

# > rbTest()
# [1] "1-1" "1-1" "3-4" "4-3" "7-6" "1-2" "5-7" "6-1"
# > thTest()
# [1] 1 1 4 3 6 2 7

票数 1

页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持

原文链接：

https://stackoverflow.com/questions/23542123

复制

相似问题

问R_Finding是向量数中最接近的匹配
EN

回答 2

Stack Overflow用户

Stack Overflow用户

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问R_Finding是向量数中最接近的匹配EN

回答 2

Stack Overflow用户

Stack Overflow用户

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问R_Finding是向量数中最接近的匹配
EN