不采用转置矩阵处理集合答案

【问题标题】：Processing sets without taking transpose matrix不采用转置矩阵处理集合
【发布时间】：2018-07-19 16:05:03
【问题描述】：

该算法使用一组骰子生成所有可能的掷骰和，以及它们出现的概率。但是，我为适应删除最小值和最大值所做的添加大大减慢了它。我想解决的具体问题是，有没有一种方法可以处理我的号码集，而不必采用所有可能滚动的转置矩阵？我无法弄清楚如何处理另一个方向的数据。当您达到甚至 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 = " "))
}

例子：

diceroller(1, 8, 0, 0)

基准测试：

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

                    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

【问题讨论】：

你能发布一个函数运行的例子吗？
也可以发布您的基准测试代码并运行一个标准示例供我们与该基准进行比较。此外，解释一下什么是掉落也会很有帮助。
@Krivand 谢谢你的解释，现在我明白了。无需发布模式代码。我现在将编辑您的问题以添加示例函数运行。请随时编辑我的编辑。
all_possible_rolls 甚至转置在哪里？
为什么有 2 个外部 for 循环，其中 j 和 l 作为迭代变量，但从不使用它们，因此似乎没有任何改变？

标签： r matrix optimization combinatorics dice

【解决方案1】：

使用lapply 直接将parallel_roles 构造为列表并用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

【讨论】：