Question

此算法使用一组骰子及其出现的概率生成所有可能的滚动总和。但是，我为减少最小值和最大值而添加的内容大大减慢了它。我想解决的具体问题是，有没有办法处理我的数字集而不必采用我所有可能的卷的转置矩阵？我无法弄清楚如何处理其他方向的数据。当你达到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

Answer 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

处理集而不采用转置矩阵

1 个答案: