R中二元序列的函数

如何在R中编写一个函数，给定一个整数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

---

以下函数是中函数的R翻译

findallsen-end）{
如果（d==0）{
#cat（out，“\n”）
返回（输出）
}
}
out[start]这里有一个简单的解决方案

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)
  }

f这里有一个基本R选项，使用
expand.grid

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 <- 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)
}

比我的要简单得多，但是
expand.grid
会占用大量内存以获得足够大的
n
。向上投票。如果你有大的
n
，这是低效的，但无论如何，这是一个很好的尝试，+1！你是对的。对于大型
n
，它的效率很低。这只是一个简单的演示来展示我的想法。我做了基准测试，所以你可以看到性能如何。感谢你的基准测试。很好的解决方案，向上投票！我在回答中添加了基准测试，因此我们可以看到性能比较。
> 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