1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163
|
'********** Tâche # 1 : Programmation de fonctions VBA **********
Function z_i(x_i As Double) As Double
'Fonction permettant de calculer la nouvelle variable z_i (suite au changement de variable)
'Déclaration des variables
Dim C As Double, D As Double
C = 0 'Borne inférieure de l'intégrale
D = 1 'Borne supérieure de l'intégrale
'Déclaration d'une nouvelle variable
Quotient = (D - C) / 2
'Calcul de la nouvelle variable
z_i = (Quotient * x_i) + ((C + D) / 2)
'Fin de la procédure
End Function
Function fonction(z_i, a As Double, b As Double) As Double
'Fonction permettant de calculer le bêta
'Calcul
fonction = (z_i ^ (a - 1)) * ((1 - z_i) ^ (b - 1))
'Fin de la procédure
End Function
Function Beta(a As Double, b As Double, Optional n As Long = 10, Optional m As Byte = 5) As Variant
'Fonction permettant de calculer la fonction bêta
'Référence : http://en.wikipedia.org/wiki/Gaussian_quadrature
'Déclaration des variables
Dim w_i_1 As Double, w_i_2 As Double, w_i_3 As Double, w_i_4 As Double, w_i_5 As Double 'Poids
Dim c_i As Double
Dim x_i_1 As Double, x_i_2 As Double, x_i_3 As Double, x_i_4 As Double, x_i_5 As Double 'Points
Dim i As Long
Dim Somme As Double, Somme1 As Double, Somme2 As Double, Somme3 As Double, Somme4 As Double, Somme5 As Double
Dim Quotient As Double, delta_x As Double
Dim C As Double, D As Double
C = 0 'Borne inférieure de l'intégrale
D = 1 'Borne supérieure de l'intégrale
'Message si a est négatif
If a < 0 Then
Message1 = MsgBox("La valeur de a est négative.", vbRetryCancel + vbCritical, "Problématique")
If Message1 = vbCancel Then Exit Function
If Message1 = vbRetry Then
Message2 = MsgBox("Veuillez réessayer votre calcul avec un a positif.", vbOKOnly + vbInformation, "Problématique")
If Message2 = vbOK Then Exit Function
End If
End If
'Message si b est négatif
If b < 0 Then
Message3 = MsgBox("La valeur de b est négative.", vbRetryCancel + vbCritical, "Problématique")
If Message3 = vbCancel Then Exit Function
If Message3 = vbRetry Then
Message4 = MsgBox("Veuillez réessayer votre calcul avec un b positif.", vbOKOnly + vbInformation, "Problématique")
If Message4 = vbOK Then Exit Function
End If
End If
'Message si a est nul
If a = 0 Then
Message5 = MsgBox("La valeur de a est nulle.", vbRetryCancel + vbCritical, "Problématique")
If Message5 = vbCancel Then Exit Function
If Message5 = vbRetry Then
Message6 = MsgBox("Veuillez réessayer votre calcul avec un a positif.", vbOKOnly + vbInformation, "Problématique")
If Message6 = vbOK Then Exit Function
End If
End If
'Message si b est nul
If b = 0 Then
Message7 = MsgBox("La valeur de b est nulle.", vbRetryCancel + vbCritical, "Problématique")
If Message7 = vbCancel Then Exit Function
If Message7 = vbRetry Then
Message8 = MsgBox("Veuillez réessayer votre calcul avec un b positif.", vbOKOnly + vbInformation, "Problématique")
If Message8 = vbOK Then Exit Function
End If
End If
'Longueur des n sous-intervalles de l'intervalle [C,D]
delta_x = (D - C) / n 'n est le nombre de sous-intervalles
'Déclaration d'une nouvelle variable
Quotient = (D - C) / 2
For i = 1 To n
'Borne inférieure des n sous-intervalles
c_i = C + (i - 1) * delta_x
If m = 1 Then 'm est le nombre de points de la quadrature gaussienne
'Déclaration des points et des poids qui sont déterminés grâce aux polynômes de Legendre
x_i_1 = c_i + 0
w_i_1 = 2
'Somme du produit des poids et de f(z_i)
Somme1 = w_i_1 * fonction(z_i(x_i_1), a, b)
ElseIf m = 2 Then
'Déclaration des points et des poids
x_i_1 = c_i - ((3 ^ 0.5) / 3)
w_i_1 = 1
x_i_2 = c_i + ((3 ^ 0.5) / 3)
w_i_2 = 1
'Somme du produit des poids et de f(z_i)
Somme2 = w_i_1 * fonction(z_i(x_i_1), a, b) + w_i_2 * fonction(z_i(x_i_2), a, b)
ElseIf m = 3 Then
'Déclaration des points et des poids
x_i_1 = c_i + 0
w_i_1 = 8 / 9
x_i_2 = c_i - ((3 / 5) ^ 0.5)
w_i_2 = 5 / 9
x_i_3 = c_i + ((3 / 5) ^ 0.5)
w_i_3 = 5 / 9
'Somme du produit des poids et de f(z_i)
Somme3 = w_i_1 * fonction(z_i(x_i_1), a, b) + w_i_2 * fonction(z_i(x_i_2), a, b) + w_i_3 * fonction(z_i(x_i_3), a, b)
ElseIf m = 4 Then
'Déclaration des points et des poids
x_i_1 = c_i + (((3 - (2 * (6 / 5) ^ 0.5)) / 7) ^ 0.5)
w_i_1 = (18 + (30 ^ 0.5)) / 36
x_i_2 = c_i - (((3 - (2 * (6 / 5) ^ 0.5)) / 7) ^ 0.5)
w_i_2 = (18 + (30 ^ 0.5)) / 36
x_i_3 = c_i + (((3 + (2 * (6 / 5) ^ 0.5)) / 7) ^ 0.5)
w_i_3 = (18 - (30 ^ 0.5)) / 36
x_i_4 = c_i - (((3 + (2 * (6 / 5) ^ 0.5)) / 7) ^ 0.5)
w_i_4 = (18 - (30 ^ 0.5)) / 36
'Somme du produit des poids et de f(z_i)
Somme4 = w_i_1 * fonction(z_i(x_i_1), a, b) + w_i_2 * fonction(z_i(x_i_2), a, b) + w_i_3 * fonction(z_i(x_i_3), a, b) + w_i_4 * fonction(z_i(x_i_4), a, b)
ElseIf m = 5 Then
'Déclaration des points et des poids
x_i_1 = c_i + 0
w_i_1 = 128 / 225
x_i_2 = c_i + (((5 - (2 * (10 / 7) ^ 0.5)) ^ 0.5) / 3)
w_i_2 = (322 + (13 * (70 ^ 0.5))) / 900
x_i_3 = c_i - (((5 - (2 * (10 / 7) ^ 0.5)) ^ 0.5) / 3)
w_i_3 = (322 + (13 * (70 ^ 0.5))) / 900
x_i_4 = c_i + (((5 + (2 * (10 / 7) ^ 0.5)) ^ 0.5) / 3)
w_i_4 = (322 - (13 * (70 ^ 0.5))) / 900
x_i_5 = c_i - (((5 + (2 * (10 / 7) ^ 0.5)) ^ 0.5) / 3)
w_i_5 = (322 - (13 * (70 ^ 0.5))) / 900
'Somme du produit des poids et de f(z_i)
Somme5 = w_i_1 * fonction(z_i(x_i_1), a, b) + w_i_2 * fonction(z_i(x_i_2), a, b) + w_i_3 * fonction(z_i(x_i_3), a, b) + w_i_4 * fonction(z_i(x_i_4), a, b) + w_i_5 * fonction(z_i(x_i_5), a, b)
End If
'Somme de la quadrature gaussienne
Somme = Somme + Somme1 + Somme2 + Somme3 + Somme4 + Somme5
Next i
'Approximation de la fonction bêta avec la quadrature gaussienne
Beta = Somme * Quotient
'Fin de la procédure
End Function |
Partager