Inverse Loi Normale et Loi Normale

[philben]

bonjour,

je vous propose une petite fonction qui calcule l'inverse de la loi normale, standard ou non, c'est à dire donne Z pour une probabilité donnée.

 
Option Compare Database
Option Explicit
Private Const gcUMax As Double = 55.5
Private Const gcInvNCRMax As Single = 99
'---------------------------------------------------------------------------------------
' Procédure    : NormaleInverse   [Function]
' Retour       : Single
' Version      : 1.01
' Création/Maj : Le samedi 21 juillet 2007 à 11:36
' Objet        : Détermine la variable Z d'une distribution normale en fonction de
'              : sa probabilité, de la moyenne et de l'écart-type de la distribution
' Historique   :
'---------------------------------------------------------------------------------------
Public Function NormaleInverse(ByVal fProb As Single, ByVal dMean As Double, _
                               ByVal dEcartType As Double) As Single
   NormaleInverse = NormaleStdInverse(fProb)
   If NormaleInverse > -gcInvNCRMax And NormaleInverse < gcInvNCRMax Then
      NormaleInverse = (NormaleInverse * dEcartType) + dMean
   End If
End Function
'---------------------------------------------------------------------------------------
' Procédure    : NormaleStdInverse [Function]
' Retour       : Single
' Version      : 1.01
' Création/Maj : Le samedi 21 juillet 2007 à 11:37
' Objet        : Détermine la variable Z d'une distribution normale centrée réduite
'              : en fonction de sa probabilité
'              : Renvoie 0 si p <= 0 et 99 si p >= 1
' Historique   :
'---------------------------------------------------------------------------------------
Public Function NormaleStdInverse(ByVal fProb As Single) As Single
   Const cdEPSILON As Double = 0.0000001
   Const ciMaxIter As Integer = 50
   Dim dMax As Double, dMin As Double, dCalcZ As Double
   Dim i As Integer
   Dim bSign As Boolean
   If fProb <= 0 Then
      NormaleStdInverse = -gcInvNCRMax
   ElseIf fProb >= 1 Then
      NormaleStdInverse = gcInvNCRMax
   Else
      dMin = -Sqr(gcUMax)
      If fProb > 0.5 Then
         fProb = 1 - fProb
         bSign = True
      End If
      While Abs(dMax - dMin) >= cdEPSILON And i < ciMaxIter
         dCalcZ = (dMax + dMin) * 0.5
         If AireZ(dCalcZ) < fProb Then
            dMin = dCalcZ
         Else
            dMax = dCalcZ
         End If
         i = i + 1
      Wend
      NormaleStdInverse = IIf(bSign, -dCalcZ, dCalcZ)
   End If
End Function
'---------------------------------------------------------------------------------------
' Procédure    : AireZ  [Function]
' Retour       : Single
' Version      : 1.0
' Création/Maj : Le samedi 21 juillet 2007 à 11:38
' Objet        : Calcul l'aire sous la courbe de la loi normale centrée réduite
'              : en fonction d'une variable Z.
'              : La probabilité unilatérale est : Prob = 1 - AireZ(Z)
' Historique   :
'---------------------------------------------------------------------------------------
Public Function AireZ(z As Double) As Single
   Dim f As Double, u As Double, s As Double, t As Double, s1 As Double
   u = z * z
   If u > gcUMax Then
      AireZ = IIf(z > 0, 1, 0)
   Else
      s1 = 1   'Pour passer le test while initial
      t = 1
      f = 3
      While s <> s1
         s1 = s
         s = s + t
         t = t * u / f
         f = f + 2
      Wend
      AireZ = z * s / ((8 * Atn(1) * Exp(u)) ^ 0.5) + 0.5
   End If
End Function
 

si vous référencez Excel dans Access, vous pouvez comparer les résultats via cette fonction de test :

 
Public Function TestLoiNormaleInverse()
Dim dExcel As Double, dMaxErr As Double, dMaxDiff As Double
   Dim dTmpDiff As Double, dDiffErr As Double
   Dim v As Single, fAccess As Single, fMaxDiffAt As Single, fMaxErrAt As Single
   Dim l As Long
   Dim t0 As Single
   v = 0.000001
   Do While v <= 1 And l < 100000
      dExcel = WorksheetFunction.NormSInv(v)
      fAccess = NormaleStdInverse(v)
      dTmpDiff = Abs(dExcel - fAccess)
      If dTmpDiff > dMaxDiff Then
         dMaxDiff = dTmpDiff
         fMaxDiffAt = v
      End If
      If (dTmpDiff / dExcel) > dMaxErr Then
         dMaxErr = dTmpDiff / dExcel
         fMaxErrAt = v
         dDiffErr = dTmpDiff
      End If
      l = l + 1
      v = v + 0.00001
      If l Mod 1000 = 0 Then Debug.Print "Boucle n°" & l & " Val = " & v
      DoEvents
   Loop
Debug.Print "Max Diff. :" & Format(dMaxDiff, "0.00E+00") & " pour v=" & fMaxDiffAt
Debug.Print "Max Err. relative % :" & Format(dMaxErr, "0.0000%") & _
            " pour v=" & fMaxErrAt & " Différence :" & dDiffErr
End Function
 
 

Résultats :

 
Max Diff. :2,28E-07 pour v=0,000031
Max Err. relative % :1,2035% pour v=0,5000017 Différence :5,21464904139617E-08
 

Pourquoi ne pas utiliser directement Excel en référence ?
1) Indépendance par rapport à Excel
2) Excel est 10 fois plus lent d'après des tests

Inconvénients ?
1) Précision limitée au type Single contrairement à Excel (Double)
2) Autres ? Vous allez me le dire !

cordialement,

Philippe

[philben]

re bonjour,

En complément, voici la fonction <LoiNormale> qui calcule la probabilité (cumulée ou non) de la loi normale, centrée réduite (standard) ou non (cf fonction Excel équivalente).

 
'---------------------------------------------------------------------------------------
' Procédure    : LoiNormale   [Function]
' Retour       : Single
' Version      : 1.0
' Objet        : Détermine la probabilité (<= X) d'une distribution normale en fonction de
'              : d'une variable X, de la moyenne et de l'écart-type de la distribution
' Historique   : Nécessite la fonction AireZ
'---------------------------------------------------------------------------------------
Public Function LoiNormale(ByVal dValeur As Double, _
                           Optional ByVal dEsperance As Double = 0, _
                           Optional ByVal dEcartType As Double = 1, _
                           Optional bCumul As Boolean = True) As Single
   If dEcartType <= 0 Then
      LoiNormale = -1
   Else
      If dEsperance <> 0 Or dEcartType <> 1 Then
         dValeur = (dValeur - dEsperance) / dEcartType
      End If
      If bCumul Then
         LoiNormale = AireZ(dValeur)
      Else
        LoiNormale = Exp(-0.5 * (dValeur ^ 2)) / (dEcartType * Sqr(8 * Atn(1)))
      End If
   End If
End Function
 

Après avoir activé la référence Excel dans Access, on peut comparer les résultats et la performance.

 
Public Function TestLoiNormaleStandard()
   Const cdInc As Double = 1 / 1000
   Dim dExcel As Double, dMaxErr As Double, dMaxDiff As Double
   Dim dTmpDiff As Double, dDiffErr As Double, v As Double
   Dim fAccess As Single, fMaxDiffAt As Single, fMaxErrAt As Single
   Dim l As Long
   v = -7.4
   While v <= 7.4
      dExcel = WorksheetFunction.NormSDist(v)
      fAccess = AireZ(v)
      dTmpDiff = Abs(dExcel - fAccess)
      If dTmpDiff > dMaxDiff Then
         dMaxDiff = dTmpDiff
         fMaxDiffAt = v
      End If
      If (dTmpDiff / dExcel) > dMaxErr Then
         dMaxErr = dTmpDiff / dExcel
         fMaxErrAt = v
         dDiffErr = dTmpDiff
      End If
      l = l + 1
      v = v + cdInc
      If l Mod 1000 = 0 Then Debug.Print "Boucle n°" & l & " Val = " & v
      DoEvents
   Wend
Debug.Print vbCrLf & "Max Diff. :" & Format(dMaxDiff, "0.00E+00") & " pour v=" & fMaxDiffAt
Debug.Print "Max Err. relative % :" & Format(dMaxErr, "0.0000%") & _
          " pour v=" & fMaxErrAt & " Différence :" & dDiffErr
End Function
Public Function ComparePerf()
   Const cdMin As Double = -7
   Const cdMax As Double = 7
   Const cdInc As Double = 1 / 300
   Dim t As Single, tExcel As Single, tAccess As Single
   Dim dCurVal As Double, dRes As Double
   Dim lEval As Long
   Dim i As Integer
   For i = 1 To 2
      dCurVal = cdMin
      t = Timer()
      While dCurVal <= cdMax
         If i = 1 Then
            dRes = WorksheetFunction.NormSDist(dCurVal)
         Else
            dRes = AireZ(dCurVal)
         End If
         dCurVal = dCurVal + cdInc
         lEval = lEval + 1
      Wend
      If i = 1 Then
         tExcel = Timer() - t
      Else
         tAccess = Timer() - t
      End If
   Next i
   t = tExcel + tAccess
 
Debug.Print vbCrLf & "Evaluations : " & lEval * 0.5, _
            "Temps Excel : " & tExcel & " sec", _
            "Temps Access : " & tAccess & " sec"
Debug.Print "Temps Total : " & t & " sec", _
            "Temps Excel (%) " & Format(tExcel / t, "0.00%"), _
            "Temps Access (%) " & Format(tAccess / t, "0.00%")
Debug.Print "*** La fonction Access est " & Format(tExcel / tAccess, "0") & " fois plus rapide ***"
End Function
 

Philippe