Function 用于 R 中的二进制序列

Question

如何在 R 中写一个 function 给定一个 integer n，它找到所有长度为 2n 的二进制序列，使得最后 n 位的总和与第一个 n 位相同。

Example:
For   n = 2, the sequences are:
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    0    1    1    0    0    1
[2,]    0    0    0    1    1    1
[3,]    0    1    0    1    0    1
[4,]    0    0    1    0    1    1

Answer 1

以下 function 是GeeksforGeeks 帖子中函数的 R 翻译。

findAllSeq2n <- function(n){
  f <- function(d, out, start, end){
    if (abs(d) > (end - start + 1) / 2) return(NULL)
    if (start > end) { 
      if (d == 0) {
        #cat(out, "\n")
        return(out)
      }
    }

    out[start] <- 0L
    out[end] <- 1L
    s01 <- f(d + 1L, out, start + 1L, end - 1L)
    
    out[start] <- 1L
    out[end] <- 1L
    s11 <- f(d, out, start + 1L, end - 1L)
    
    out[start] <- 0L
    out[end] <- 0L
    s00 <- f(d, out, start + 1L, end - 1L)
    
    out[start] <- 1L
    out[end] <- 0L
    s10 <- f(d - 1L, out, start + 1L, end - 1L)

    do.call(cbind, list(s01, s11, s00, s10))
  }
  out <- integer(2*n)
  f(0, out, 1, 2*n)
}

findAllSeq2n(2)
#     [,1] [,2] [,3] [,4] [,5] [,6]
#[1,]    0    1    1    0    0    1
#[2,]    1    1    0    1    0    0
#[3,]    0    1    0    1    0    1
#[4,]    1    1    1    0    0    0

findAllSeq2n(3)
findAllSeq2n(4)

Answer 2

这是一个简单的解决方案。

f <- function(n){
    bit_list <- rep(list(0:1),2*n)
    df <- expand.grid(bit_list)
    result <- df %>% filter(rowSums(df[1:n]) == rowSums(df[(n+1):(2*n)]))
    return(result)
  }

Answer 3

这是使用expand.grid的基本 R 选项

f_TIC <- function(n) {
  df <- expand.grid(rep(list(0:1), n))
  do.call(
    cbind,
    Map(
      function(x) {
        v <- unname(as.matrix(x))
        inds <- expand.grid(rep(list(seq(nrow(v))), 2))
        with(inds, t(cbind(v[Var1, , drop = FALSE], v[Var2, , drop = FALSE])))
      },
      split(df, rowSums(df))
    )
  )
}

你会看到

> f_TIC(2)
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    0    1    0    1    0    1
[2,]    0    0    1    0    1    1
[3,]    0    1    1    0    0    1
[4,]    0    0    0    1    1    1

> f_TIC(3)
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14]
[1,]    0    1    0    0    1    0    0    1    0     0     1     1     0     1
[2,]    0    0    1    0    0    1    0    0    1     0     1     0     1     1
[3,]    0    0    0    1    0    0    1    0    0     1     0     1     1     0
[4,]    0    1    1    1    0    0    0    0    0     0     1     1     1     1
[5,]    0    0    0    0    1    1    1    0    0     0     1     1     1     0
[6,]    0    0    0    0    0    0    0    1    1     1     0     0     0     1
     [,15] [,16] [,17] [,18] [,19] [,20]
[1,]     1     0     1     1     0     1
[2,]     0     1     1     0     1     1
[3,]     1     1     0     1     1     1
[4,]     1     1     0     0     0     1
[5,]     0     0     1     1     1     1
[6,]     1     1     1     1     1     1

---

基准测试对帖子的所有给出的答案如下

f_TIC <- function(n) {
  df <- expand.grid(rep(list(0:1), n))
  do.call(
    cbind,
    Map(
      function(x) {
        v <- unname(as.matrix(x))
        inds <- expand.grid(rep(list(seq(nrow(v))), 2))
        with(inds, t(cbind(v[Var1, , drop = FALSE], v[Var2, , drop = FALSE])))
      },
      split(df, rowSums(df))
    )
  )
}

f_PW <- function(n) {
  bit_list <- rep(list(0:1), 2 * n)
  df <- expand.grid(bit_list)
  result <- df %>% filter(rowSums(df[1:n]) == rowSums(df[(n + 1):(2 * n)]))
  return(result)
}

f_RB <- function(n) {
  f <- function(d, out, start, end) {
    if (abs(d) > (end - start + 1) / 2) {
      return(NULL)
    }
    if (start > end) {
      if (d == 0) {
        # cat(out, "\n")
        return(out)
      }
    }

    out[start] <- 0L
    out[end] <- 1L
    s01 <- f(d + 1L, out, start + 1L, end - 1L)

    out[start] <- 1L
    out[end] <- 1L
    s11 <- f(d, out, start + 1L, end - 1L)

    out[start] <- 0L
    out[end] <- 0L
    s00 <- f(d, out, start + 1L, end - 1L)

    out[start] <- 1L
    out[end] <- 0L
    s10 <- f(d - 1L, out, start + 1L, end - 1L)

    do.call(cbind, list(s01, s11, s00, s10))
  }
  out <- integer(2 * n)
  f(0, out, 1, 2 * n)
}

你会看见

Unit: relative
     expr      min        lq     mean    median        uq       max neval
 f_TIC(8)  1.00000  1.000000  1.00000  1.000000  1.000000  1.000000   100
  f_PW(8)  3.00963  2.982558  3.04141  3.048198  3.414973  1.708085   100
  f_RB(8) 33.84919 33.294016 29.94054 31.868353 30.959561 15.716849   100

Unit: relative
     expr      min       lq     mean   median       uq      max neval
 f_TIC(5) 1.429396 1.454938 1.395263 1.435046 1.427896 1.284587   100
  f_PW(5) 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000   100
  f_RB(5) 1.964645 1.997190 2.032348 1.973493 1.932053 3.413937   100

Unit: relative
     expr      min       lq     mean   median       uq       max neval
 f_TIC(2) 17.08527 16.34189 3.558179 14.19286 13.83643 0.4397982   100
  f_PW(2) 17.50388 16.96616 4.020926 14.90068 14.66048 0.4361216   100
  f_RB(2)  1.00000  1.00000 1.000000  1.00000  1.00000 1.0000000   100