VBA中的三角分布

Question

我目前拥有的：

Option Explicit

Function Triangular(a As Double, b As Double, c As Double) As Double

Randomize
Application.Volatile

Dim d As Double
Dim uniform As Double
Dim retval as Double 



d = (b - a) / (c - a)
    uniform = Rnd()

    If uniform <= d Then
    Triangular = a + (c - a) * Sqr(d * uniform)

Else

    Triangular = a + (c - a) * (1 - Sqr(1 - d) * (1 - uniform))

End If

End Function

我在 VBA 中创建三角分布函数时遇到了麻烦，该函数根据以下参数计算随机数：

• 计算 d = ( b - a )/( c - a )

• 使用 VBA 的 Rnd 函数生成一个介于 0 和 1 之间的均匀分布的随机数 U。

• 如果 U

• 如果 U > d ，则返回 a + ( c - a ) × (1 - sqr((1- d )×(1-U))) 作为随机数。

参数 a 和 c 分别是最小和最大可能值，并且 参数 b 是最可能的值（您可以看到三角形中的最高点）。

我不确定如何创建此功能，想知道是否有人可以帮忙？在处理函数时，我意识到我需要使用 randomize 函数，以便在每次调用函数时不生成类似的结果，以及 application.volatile 操作。

Answer 1

您的代码中有错误。应该在第二个分支

Triangular = a + (c - a) * (1 - Sqr((1 - d) * (1 - uniform)))

Answer 2

不确定生成方程的正确性。查看Here 以获取正确的方程式；不同之处在于b 和c 根据您的定义进行切换。这是一个使该页面的公式适应您自己对 a、b 和 c 的定义的实现：

Function Triangular(a As Double, b As Double, c As Double) As Double
    Application.Volatile
    Dim U As Double: U = Rnd()
    If U < (b - a) / (c - a) Then
      Triangular = a + sqrt(U * (b - a) * (c - a))
    Else
      Triangular = c - sqrt(U * (c - b) * (c - a))
    End If
End Function

---

要在新工作表中从上述分布生成序列，您可以

1- 创建新工作表

2- 在单元格 A1、B1 和 C1 中写入参数

3- 把这个公式写在A2:=Triangular($A$1, $B$1, $C$1)

4- 将单元格 A2 复制/粘贴到列下

Answer 3

请注意第二种情况下的(1-Prob)。 Wikipedia link 显示了正确的公式，但 A.S.H. 没有正确实现。

Function Triangular(ByVal Min As Single, ByVal ML As Single, ByVal Max As Single) As Single
    Application.Volatile
    Dim Prob As Single
    Prob = Rnd
    If Prob < (ML - Min) / (Max - Min) Then
      Triangular = Min + Sqr(Prob * (ML - Min) * (Max - Min))
    Else
      Triangular = Max - Sqr((1 - Prob) * (Max - ML) * (Max - Min))
    End If
End Function