5

I got this code which create two vectors and for each element from a I want to get the closest element in b :

a = rnorm(100)
b = rnorm(100)
c = vapply(a, function(x) which.min(abs(b - x)), 1)
table(duplicated(c))

FALSE  TRUE 
   61    39

As you can see this method is prompt to give a lot of duplicates which is normal but I would like to not have duplicates. I thought of deleting occurence from b once an index has been selected but I don't know how to do it under vapply.

Wicelo
  • 2,358
  • 2
  • 28
  • 44
  • So to be clear, you a looking for a permutation, `p`, such that `sum(abs(a-b[p]))` is minimised? – James Sep 24 '14 at 10:51
  • well I guess you can put it that way indeed – Wicelo Sep 24 '14 at 10:52
  • My guess is that `data.table`'s joining function `roll = "nearest"` will be useful here, ala http://stackoverflow.com/questions/15712826/join-r-data-tables-where-key-values-are-not-exactly-equal-combine-rows-with-clo – Chase Sep 24 '14 at 10:52
  • @Chase That was my first thought as well. But I don't see how that helps with avoiding duplicates in the matches. They want to have a one-one relationsship between the vectors' values. – Roland Sep 24 '14 at 11:42
  • @Wicelo Please provide reproducible input and output and explain how you want to determine the matches if each value of `b` can occure only once as a match. Is a `b` value the match to the first `a` value to which it is the closest match or is it a the match to the `a` value that is the closest match to the `b` value? – Roland Sep 24 '14 at 11:45
  • @Roland - doh, good catch! This is a little more tricky than I thought (and nice deleted answer, that's exactly what I had in mind) – Chase Sep 24 '14 at 11:46

4 Answers4

5

The closest match you are going to get is by sorting the vectors and then pairing them off. The following permuation on b should allow you to do that.

p <- order(b)[order(order(a))] # order on b and then back transform the ordering of a

sum(abs(a-b[p]))
[1] 20.76788

Clearly, allowing duplicates does make things much closer:

sum(abs(a-b[c]))
[1] 2.45583
James
  • 65,548
  • 14
  • 155
  • 193
2

I believe this is the best you can get: sum(abs(sort(a) - sort(b)))

I am using data.table to preserve the original sorting of a:

require(data.table)

set.seed(1)

a <- rnorm(100)
b <- rnorm(100)

sum(abs(a - b))
sum(abs(sort(a) - sort(b)))

dt <- data.table(a = a, b = b)
dt[, id := .I]

# sort dt by a
setkey(dt, a)

# sort b
dt[, b := sort(b)]

# return to original order
setkey(dt, id)

dt
dt[, sum(abs(a - b))]

This solution gives better result if compared to Chase's solution:

dt2 <- as.data.table(foo(a,b))
dt2[, sum(abs(a - bval))]
dt[, sum(abs(a - b))]

Result:

> dt2[, sum(abs(a - bval))]
[1] 24.86731
> dt[, sum(abs(a - b))]
[1] 20.76788
djhurio
  • 5,437
  • 4
  • 27
  • 48
  • 1
    Good call - sorting by `a` is in fact smarter and will yield better results. If the initial order isn't important, simply `cbind(sort(a), sort(b)` is the most straight forward. – Chase Sep 24 '14 at 12:51
  • well I liked nicola's solution a lot but you are right your solution gives a better difference sum. I'll have to study the `data.format` as well as the `setkey` and the `:=` operator, I didn't know those things **edit** : well in fact James solution give the same difference sum and is a on liner – Wicelo Sep 24 '14 at 15:52
2

This is very bad programming, but may work and is vectorized...

   a <- rnorm(100)
   b <- rnorm(100)
   #make a copy of b (you'll see why)
   b1<-b
   res<- vapply(a, function(x) {ret<-which.min(abs(b1 - x));b1[ret]<<-NA;return(ret)}, 1)
nicola
  • 24,005
  • 3
  • 35
  • 56
  • nice that's exactly what I was doing before posting but with `=` instead of `<<` it wasn't working, what is the difference between those two operators ? Also why you call it bad programming ? – Wicelo Sep 24 '14 at 13:57
  • See `?"<<-"` for the meaning of the `<-` and `<<-` operators. The `<<-` is dangerous since it changes object outside the scope of a function. – nicola Sep 24 '14 at 14:45
1

This can almost certainly be improved upon through vectorization, but appears to work and may get the job done:

set.seed(1)
a = rnorm(5)
b = rnorm(5)

foo <- function(a,b) {

  out <- cbind(a, bval = NA)

  for (i in seq_along(a)) {
    #which value of B is closest?
    whichB <- which.min(abs(b - a[i]))
    #Assign that value to the bval column
    out[i, "bval"] <- b[whichB]
    #Remove that value of B from being chosen again
    b <- b[-whichB]
  }

  return(out)

}

#In action
foo(a,b)
---
              a       bval
[1,] -0.6264538 -0.8204684
[2,]  0.1836433  0.4874291
[3,] -0.8356286 -0.3053884
[4,]  1.5952808  0.7383247
[5,]  0.3295078  0.5757814
Chase
  • 67,710
  • 18
  • 144
  • 161