枚举R

如何解决枚举R

为说明问题，让我们定义以下矩阵（其中NA表示在t时段内该选项不可用）

set.seed(1)
x <- matrix(NA,4,dimnames = list(paste0("t=",seq_len(4)),LETTERS[seq_len(4)]))
x[lower.tri(x,diag = TRUE)] <- rnorm(10)

哪个给出的矩阵如下：

              A           B          C         D
t=1  0.91897737          NA         NA        NA
t=2  0.78213630  0.61982575         NA        NA
t=3  0.07456498 -0.05612874 -1.4707524        NA
t=4 -1.98935170 -0.15579551 -0.4781501 0.4179416

目标是计算每个值在每个时间段$ t $中最高的概率，但是，这些值取决于先前时间段中的值。例如，在从期间t=2移至t=3并假设A最高的情况下，A仅与C进行比较，而不与{{1 }}，因为在B中假定它更高。我们可以将问题构造成这样的树：

因此，对于t=2，概率为1；对于t=1，我们从1个分组中计算出2个概率；在t=2中，我们从2个分组中计算出4个概率（请注意，如何从由于顺序相关性和固有假设（在t=3和t-1中不是最高的），我们从4个分组中计算了8个概率。然后，最终概率是构成8条路径的每个t=4中的概率乘积。在实际问题中，t越来越大，手动识别这些分组变得不可行。

我一直试图提出一种识别这些路径并计算概率的聪明方法。一个想法是为每种可能的模式使用一组“掩蔽矩阵”。这样，我可以简单地将掩码矩阵相乘并执行行操作。但是，随着层数的增加，我找不到一种可靠的方法来填充不同的掩蔽矩阵。

例如，假设可以通过以下掩蔽矩阵来描述直到最后一个时期的所有时期中选择t的模式：

看起来像这样（在这种情况下，是4种可能的比较中的1种）：

mask <- matrix(c(
1,NA,1,1
),ncol = 4,byrow = TRUE,LETTERS[seq_len(4)]))

我们可以像这样计算每个期间的概率（所有行应合计为一个）：

    A  B  C  D
t=1 1 NA NA NA
t=2 1  1 NA NA
t=3 1 NA  1 NA
t=4 1 NA NA  1

exp_x <- exp(x * mask)
sum_exp_x <- rowSums(exp_x,na.rm = TRUE)
pr_x <- exp_x / sum_exp_x

在A B C D t=1 1.00000000 NA NA NA t=2 0.54048879 0.4595112 NA NA t=3 0.82423638 NA 0.1757636 NA t=4 0.08261824 NA NA 0.9173818增长的情况下，是否存在针对所有可能路径的明智方法？还是填充一组掩蔽矩阵进行循环的好方法？我正在努力避免问题变得一发不可收拾。完整的路径枚举和消除是否可能是更好的选择，即更快，更健壮？任何帮助，想法和指示都是有帮助的。

解决方法

这是您想要的吗？

find_path <- function(nperiods,opts = LETTERS[seq_len(period)]) {
  stopifnot(length(opts) == nperiods)
  out <- matrix(nrow = 2 ^ (nperiods - 1L),ncol = nperiods)
  r <- 1L
  recur_ <- function(period,branch,outcome) {
    if (period > length(branch)) {
      out[r,] <<- opts[branch]
      r <<- r + 1L
      return(NULL)
    }
    for (i in c(outcome,period)) {
      branch[[period]] <- i
      recur_(period + 1L,i)
    }
  }
  recur_(1L,integer(nperiods),NULL)
  out
}

calc_prob <- function(mat) {
  ps <- dimnames(mat)[[1L]]; if (is.null(ps)) ps <- seq_len(nrow(mat))
  ops <- dimnames(mat)[[2L]]; if (is.null(ops)) ops <- seq_len(ncol(mat))
  paths <- find_path(nrow(mat),ops)
  out <- vapply(seq_len(ncol(paths))[-1L],function(i) {
    comp <- ops[[i]]
    comp <- ifelse(paths[,i] == comp,paths[,i - 1L],comp)
    x <- exp(mat[i,i]])
    y <- exp(mat[i,comp])
    x / (x + y)
  },numeric(nrow(paths)))
  dimnames(out) <- NULL; out <- cbind(1,out)
  dimnames(out)[[2L]] <- dimnames(paths)[[2L]] <- ps
  list(paths = paths,probs = out)
}

输出

> calc_prob(x) # x is the same lower-triangular matrix as shown in your example.

$paths
     t=1 t=2 t=3 t=4
[1,] "A" "A" "A" "A"
[2,] "A" "A" "A" "D"
[3,] "A" "A" "C" "C"
[4,] "A" "A" "C" "D"
[5,] "A" "B" "B" "B"
[6,] "A" "B" "B" "D"
[7,] "A" "B" "C" "C"
[8,] "A" "B" "C" "D"

$probs
     t=1       t=2       t=3        t=4
[1,]   1 0.5404888 0.8242364 0.08261823
[2,]   1 0.5404888 0.8242364 0.91738177
[3,]   1 0.5404888 0.1757636 0.28985432
[4,]   1 0.5404888 0.1757636 0.71014568
[5,]   1 0.4595112 0.8044942 0.36037495
[6,]   1 0.4595112 0.8044942 0.63962505
[7,]   1 0.4595112 0.1955058 0.28985432
[8,]   1 0.4595112 0.1955058 0.71014568

变量paths为您提供每个时期 t 的所有可能结果； probs告诉您相应结果的可能性。但是，请注意，这种概率树随着周期数的增加而呈指数增长。等式是

其中， N 是周期 t 中所有可能路径的数量。在仅20个期间内，您将拥有524288条不同的路径。如果周期数达到30，则将有536870912个不同的路径，而R只是无法处理该数量的计算。我建议您重新考虑预期的输出。您是否在运行模拟时还考虑了其他一些约束，而不仅仅是时间相关性，以便我们进一步削减一些不必要的路径？或者，也许您只需要一些汇总统计信息（例如期望值），这样我们就不必生成所有可能的路径了？除了使用像这样的暴力手段之外，还必须有更好的方法。

如何解决枚举R

解决方法

相关推荐