R 不采用转置矩阵处理集合

该算法使用一组骰子生成所有可能的滚动和，以及它们发生的概率。然而，我为适应下降的最小值和最大值所做的添加大大减慢了速度。我想解决的具体问题是，有没有一种方法可以处理我的数字集，而不必使用所有可能的转置矩阵？我不知道如何处理其他方向的数据。当你达到n^6个可能性时，这会变得非常笨拙。欢迎提供任何其他建议

diceroller <- function(dicenumber, dicesize, mindrop, maxdrop)
{
  parallel_rolls <- matrix(1:dicesize, dicesize, dicenumber)
  tmat <- t(parallel_rolls)
  all_possible_rolls <-
    do.call(expand.grid, split(tmat, rep(1:nrow(tmat),     ncol(tmat))))
  if (mindrop > 0)
  {
    for (j in 1:mindrop)
    {
      for (i in 1:(dicesize ^ dicenumber))
      {
        all_possible_rolls[i, which.min(all_possible_rolls[i, ])] <- NA
      }
    }
  }
  if (maxdrop > 0)
  {
    for (l in 1:maxdrop)
    {
      for (i in 1:(dicesize ^ dicenumber))
      {
        all_possible_rolls[i, which.max(all_possible_rolls[i, ])] <- NA
      }
    }
  }
  rollsum     <- apply(all_possible_rolls, 1, sum, na.rm = TRUE)
  truedicenum <- (dicenumber - (mindrop + maxdrop))
  hist(rollsum, breaks = c((truedicenum - 1):(truedicenum * dicesize)))

  rollfreq    <- as.data.frame(table(rollsum))
  rollfreqpct <- c((rollfreq[2] / (dicesize ^ dicenumber)) * 100)
  fulltable   <- cbind(rollfreq, rollfreqpct)

  print(fulltable)
  print(paste("total possible roll sets:", sum(rollfreq[2]), sep = " "))
  print(paste("mean roll:", mean(rollsum), sep = " "))
  print(paste("roll sd:", sd(rollsum), sep = " "))
}

基准：

rbenchmark::benchmark(diceroller(3, 6, 1, 2))

---

使用

lappy

直接将

parallel_角色构建为一个列表，并使用apply替换一些for循环，可以稍微提高速度

diceroller <- function(dicenumber, dicesize, mindrop, maxdrop) 
{
  all_possible_rolls <- do.call(expand.grid, lapply(1:dicenumber, function(x) 1:dicesize))

  if (mindrop > 0) {
    all_possible_rolls <- t(apply(all_possible_rolls, 1, function(x) {
      for (i in 1:mindrop) {
        x[which.min(x)] <- NA
      }
      x
    }))
  }

  if (maxdrop > 0) {
    all_possible_rolls <- t(apply(all_possible_rolls, 1, function(x) {
      for (i in 1:maxdrop) {
        x[which.max(x)] <- NA
      }
      x
    }))
  }

  rollsum <- rowSums(all_possible_rolls, na.rm = TRUE)
  truedicenum <- dicenumber - (mindrop + maxdrop)
  rollfreq <- as.data.frame(table(rollsum))
  rollfreqpct <- c((rollfreq[2]/(dicesize^dicenumber))*100)
  fulltable <- cbind(rollfreq, rollfreqpct)
  hist(rollsum, breaks = c((truedicenum - 1):(truedicenum * dicesize)))
  return()
}

rbenchmark::benchmark(diceroller_old(3, 6, 1, 1))
                     test replications elapsed relative user.self sys.self user.child sys.child
1 diceroller_old(3, 6, 1, 1)          100    4.64        1      3.95     0.37         NA        NA

rbenchmark::benchmark(diceroller(3, 6, 1, 1))
                    test replications elapsed relative user.self sys.self user.child sys.child
1 diceroller(3, 6, 1, 1)          100    1.86        1      1.19     0.44         NA        NA

你能发布一个函数运行的示例吗？最好也发布你的基准测试代码，并让我们运行一个标准示例来与基准测试进行比较。另外，解释滴水的用途也会很有帮助。@Krivand谢谢你的解释，现在我明白了。无需发布模式代码。我现在要编辑您的问题，添加一个示例函数run。请随意编辑我的编辑。
所有可能的卷
哪有转置？为什么有两个外部
用于
循环，以
j
和
l
作为迭代变量，但它们从不使用它们，因此似乎不会改变任何东西？
                    test replications elapsed relative user.self sys.self user.child sys.child
1 diceroller(3, 6, 1, 2)          100    7.33        1      7.12     0.08         NA        NA

diceroller <- function(dicenumber, dicesize, mindrop, maxdrop) 
{
  all_possible_rolls <- do.call(expand.grid, lapply(1:dicenumber, function(x) 1:dicesize))

  if (mindrop > 0) {
    all_possible_rolls <- t(apply(all_possible_rolls, 1, function(x) {
      for (i in 1:mindrop) {
        x[which.min(x)] <- NA
      }
      x
    }))
  }

  if (maxdrop > 0) {
    all_possible_rolls <- t(apply(all_possible_rolls, 1, function(x) {
      for (i in 1:maxdrop) {
        x[which.max(x)] <- NA
      }
      x
    }))
  }

  rollsum <- rowSums(all_possible_rolls, na.rm = TRUE)
  truedicenum <- dicenumber - (mindrop + maxdrop)
  rollfreq <- as.data.frame(table(rollsum))
  rollfreqpct <- c((rollfreq[2]/(dicesize^dicenumber))*100)
  fulltable <- cbind(rollfreq, rollfreqpct)
  hist(rollsum, breaks = c((truedicenum - 1):(truedicenum * dicesize)))
  return()
}

rbenchmark::benchmark(diceroller_old(3, 6, 1, 1))
                     test replications elapsed relative user.self sys.self user.child sys.child
1 diceroller_old(3, 6, 1, 1)          100    4.64        1      3.95     0.37         NA        NA

rbenchmark::benchmark(diceroller(3, 6, 1, 1))
                    test replications elapsed relative user.self sys.self user.child sys.child
1 diceroller(3, 6, 1, 1)          100    1.86        1      1.19     0.44         NA        NA