用于查找恰好1位数的所有行的简单公式

时间:2015-05-21 21:46:34

标签: r

我有一个矩阵,其中每行是一个10位数的字符串,由0和1组成。:

library(gtools)
a <- permutations(2, 10, v=c(0,1), repeats.allowed=TRUE)

我想为每一行找到正好相差1位的所有其他行。我需要的只是一个向量,每个字符串的行ID正好相差1个数字。

这可能以某种方式吗?

3 个答案:

答案 0 :(得分:3)

我这样做:

b = t(apply(a, MARGIN = 1, FUN = function(x) which(colSums(x != t(a)) == 1)))

    > head(b)
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,]    2    3    5    9   17   33   65  129  257   513
[2,]    1    4    6   10   18   34   66  130  258   514
[3,]    1    4    7   11   19   35   67  131  259   515
[4,]    2    3    8   12   20   36   68  132  260   516
[5,]    1    6    7   13   21   37   69  133  261   517
[6,]    2    5    8   14   22   38   70  134  262   518

答案 1 :(得分:2)

如果数字按原样排序,您可以解释&#34;字符串&#34;在base-2数字系统中为0:1023数字序列。如果我们找到&#34;数字&#34;它们相差1位数,然后它们的位置由十进制系统中的数字定义。

b <- t(apply(a,1,function(x) {
  colSums(xor(diag(1, 10, 10)[,10:1], x) * (2^(9:0)) ) + 1
}))

# > head(b)
#      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
# [1,]    2    3    5    9   17   33   65  129  257   513
# [2,]    1    4    6   10   18   34   66  130  258   514
# [3,]    4    1    7   11   19   35   67  131  259   515
# [4,]    3    2    8   12   20   36   68  132  260   516
# [5,]    6    7    1   13   21   37   69  133  261   517
# [6,]    5    8    2   14   22   38   70  134  262   518

您可以通过

检查上述假设
strtoi(apply(a,1,paste, collapse = ""), base = 2)

更新

弗兰克(见评论)提供了更快,更漂亮的解决方案:

seq(2^10)-sweep(a-!a,2,as.integer(2^(9:0)),`*`)

基准:

library(microbenchmark)
library(microbenchmark)
microbenchmark(times = 100,
  which = t(apply(a, MARGIN = 1, FUN = function(x) which(colSums(x != t(a)) == 1))),
  symmetric = {
      aa    <- t(a)
      n <- nrow(a)
      neigh <- vector(n,mode="list")
      for (i in 1:(n-1)){
        rem        <- (i+1):n
        remmatch   <- rem[which(colSums(abs(aa[,rem,drop=FALSE]-aa[,i]))==1L)]
        neigh[[i]] <- c(neigh[[i]],remmatch)
        for (j in remmatch) neigh[[j]] <- c(neigh[[j]],i)
      }
  }, 
  numeral = t(apply(a,1,function(x) {
    colSums(xor(diag(1, 10, 10)[,10:1], x) * (2^(9:0)) ) + 1
  })),
  numeral_frank = seq(2^10)-sweep(a-!a,2,as.integer(2^(9:0)),`*`)
)

# Unit: microseconds
#          expr        min          lq        mean      median          uq        max neval  cld
#         which 163788.673 172454.3010 186222.9216 176371.6670 181390.4095 279304.441   100    d
#     symmetric  93525.411  96990.5505 104213.3545 100045.1590 101388.7930 193337.935   100   c 
#       numeral  26359.094  27974.7050  32738.9575  31785.5885  32383.6380 129262.575   100  b  
# numeral_frank    283.951    342.7515    506.8013    373.3275    420.5815   5199.634   100 a   

答案 2 :(得分:2)

在给出的例子中(排列列举的详尽列举),答案更简单,但这里我将如何解决问题中提出的一般情况:

  

我想为每一行找到正好相差1位的所有其他行。

因为作为邻居的测试是对称的,function(x,y) sum(abs(x-y)) == 1,我们应该只对每对行xy进行一次比较。我们可以在循环中执行此操作,将行1与行2..n进行比较;然后比较2对3..n;等等:

n     <- nrow(a)
aa    <- t(a)

neigh <- vector(n,mode="list")
for (i in 1:(n-1)){

  # find matches
  rem        <- (i+1):n
  remmatch   <- rem[which(colSums(abs(aa[,rem,drop=FALSE]-aa[,i]))==1L)]

  # append matches
  neigh[[i]] <- c(neigh[[i]],remmatch)
  for (j in remmatch) neigh[[j]] <- c(neigh[[j]],i)
}

效率。可能会有进一步的改进。例如,我们知道我们的邻居不能成为彼此的邻居,因此无需进行比较。但是,我猜想利用这一点会产生更多的代码。