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 <= d，则返回a +（c-a）×sqr（d×U）作为随机数。（Sqr（x）是一个VBA函数，它返回x的平方根。
如果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-向列中复制/粘贴单元格

Answer 3

在第二种情况下，请注意（1-概率）。 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

VBA中的三角分布

3 个答案: