Accueil > > > MODULE DE FONCTIONS STATISTIQUES EN VB6
MODULE DE FONCTIONS STATISTIQUES EN VB6
Information sur la source
Description
Ce code contient les fonctions de Statistiques suivantes : - Fonction de la table inverse de la loi normale centrée réduite - Fonction renvoyant la probabilité d'une variable aléatoire z suivant la loi normale centrée réduite - Fonction de la loi du Khi-deux - Fonction de la loi inverse du Khi-deux
Source
- ' L'algorithme du codage de la loi inverse du Chi-deux provient de la traduction d'un code source
- ' en JavaScript sur le site internet suivant :
- ' http://www.fourmilab.ch/rpkp/experiments/analysis/chiCalc.html
-
- 'The following JavaScript functions for calculating normal and
- 'chi-square probabilities and critical values were adapted by
- 'John Walker from C implementations
- 'written by Gary Perlman of Wang Institute, Tyngsboro, MA 01879.
- 'Both the original C code and this JavaScript edition
- 'are in the public domain.
-
-
-
- 'Public Const Pi = 3.14159265359
-
-
-
-
- 'densité de probabilité de la loi normale centrée réduite
- Function PHI(ByVal u As Double) As Double
- PHI = (1 / ((2 * Pi) ^ 0.5)) * Exp(-0.5 * (u ^ 2))
- End Function
-
-
-
- 'Fonction de la table inverse de la loi normale centrée réduite
- Function NORMAL(ByVal p As Double) As Double
-
- Dim xo, xx, y, h, f, f1, f2, fd, r, s As Double
- Dim N, i, k As Integer
- xo = 0.5
- y = 0
- xx = xo
- N = 200
- 'Suite convergente de Newton
- Do While Abs(xx - y) > 0.00001
- y = xx
- h = 2 * xx / N
- f1 = 0
- f2 = 0
- 'Résolution d'une intégrale numérique
- For i = 0 To ((N - 2) / 2)
- r = -xx + 2 * i * h
- s = -xx + (2 * i + 1) * h
- If i = 0 Then
- f1 = f1 + 0
- f2 = f2 + PHI(s)
- Else
- f1 = f1 + PHI(r)
- f2 = f2 + PHI(s)
- End If
- Next
- f = (h / 3) * (PHI(-xx) + PHI(xx) + 2 * f1 + 4 * f2) - p
- fd = 2 * PHI(xx)
- xx = xx - f / fd
- Loop
- NORMAL = xx
-
- End Function
-
-
-
- ' Renvoie la probabilité d'une variable aléatoire z suivant la loi normale centrée réduite
- Function poz(ByVal z As Double) As Double
- 'POZ -- probability of normal z value
-
- 'Adapted from a polynomial approximation in:
- 'Ibbetson D, Algorithm 209
- 'Collected Algorithms of the CACM 1963 p. 616
-
- 'Note:
- 'This routine has six digit accuracy, so it is only useful for absolute
- 'z values < 6. For z values >= to 6.0, poz() returns 0.0.
-
-
- Dim y, x, w As Double
- Dim z_max As Double
- z_max = 6
- If z = 0 Then
- x = 0
- Else
- y = 0.5 * Abs(z)
- If y >= z_max * 0.5 Then
- x = 1
- ElseIf y < 1 Then
- w = y * y
- x = ((((((((0.000124818987 * w - 0.001075204047) * w _
- + 0.005198775019) * w - 0.019198292004) * w _
- + 0.059054035642) * w - 0.151968751364) * w _
- + 0.319152932694) * w - 0.5319230073) * w _
- + 0.797884560593) * y * 2
- Else
- y = y - 2
- x = (((((((((((((-0.000045255659 * y + 0.00015252929) * y _
- - 0.000019538132) * y - 0.000676904986) * y _
- + 0.001390604284) * y - 0.00079462082) * y _
- - 0.002034254874) * y + 0.006549791214) * y _
- - 0.010557625006) * y + 0.011630447319) * y _
- - 0.009279453341) * y + 0.005353579108) * y _
- - 0.002141268741) * y + 0.000535310849) * y _
- + 0.999936657524
- End If
- End If
- If z > 0 Then
- poz = ((x + 1) * 0.5)
- Else
- poz = ((1 - x) * 0.5)
- End If
- Dim bigx As Double
- bigx = 20
-
- End Function
-
-
-
-
- Function pochisq(ByVal x As Double, ByVal df As Integer) As Double
- ' Adapted From:
- 'Hill, I. D. and Pike, M. C. Algorithm 299
- 'Collected Algorithms for the CACM 1967 p. 243
- 'Updated for rounding errors based on remark in
- 'ACM TOMS June 1985, page 185
-
- Dim a, y, s, e, c, v As Double
- Dim even As Boolean
- 'even correspond à la parité de df, le degré de liberté
- Dim lnpi, ipi As Double
- lnpi = Log(Pi ^ 0.5)
- ipi = 1 / Log(Pi)
- If ((x <= 0) Or (df < 1)) Then
- pochisq = 1
- End If
- a = 0.5 * x
- If Fix(df / 2) = df / 2 Then
- even = True
- Else
- even = False
- End If
- If df > 1 Then
- y = Exp(-a)
- End If
- If even = True Then
- s = y
- Else
- s = 2 * poz(-(x ^ 0.5))
- End If
- If df > 2 Then
- x = 0.5 * (df - 1)
- If even = True Then
- z = 1
- Else
- z = 0.5
- End If
- If (a > bigx) Then
- If even = True Then
- e = 0
- Else
- e = lnpi
- End If
-
- c = Log(a)
-
- Do While (z <= x)
- e = Log(z) + e
- s = s + Exp(c * z - a - e)
- z = z + 1
- Loop
- pochisq = s
- Else
- If even = True Then
- e = 1
- Else
- e = ipi / (a ^ 0.5)
- End If
- c = 0
- Do While (z <= x)
- e = e * (a / z)
- c = c + e
- z = z + 1
- Loop
- pochisq = c * y + s
- End If
- Else
- pochisq = s
- End If
-
- End Function
-
-
- Function critchi(ByVal p As Double, ByVal df As Integer) As Double
-
- Dim epsilon, chimax, minchisq, maxchisq, chisqval As Double
- epsilon = 0.000001
- chimax = 99999
- minchisq = 0
- maxchisq = chimax
- If p <= 0 Then
- critchi = maxchisq
- Else
- If p >= 1 Then
- critchi = 0
- End If
- End If
- chisqval = df / (p ^ 0.5)
- Do While ((maxchisq - minchisq) > epsilon)
- If (pochisq(chisqval, df) < p) Then
- maxchisq = chisqval
- Else
- minchisq = chisqval
- End If
- chisqval = (maxchisq + minchisq) * 0.5
- Loop
- critchi = chisqval
-
- End Function
-
- 'renvoie, pour la probabilité p et le degré de liberté df, la variable
- Function invchi2(ByVal p As Double, ByVal df As Double) As Double
-
- invchi2 = critchi(p, df)
-
- End Function
-
- 'renvoie, pour la variable x et le degré de liberté df, la probabilité
- Function chi2(ByVal x As Double, ByVal df As Integer) As Double
-
- chi2 = pochisq(x, df)
-
- End Function
' L'algorithme du codage de la loi inverse du Chi-deux provient de la traduction d'un code source
' en JavaScript sur le site internet suivant :
' http://www.fourmilab.ch/rpkp/experiments/analysis/chiCalc.html
'The following JavaScript functions for calculating normal and
'chi-square probabilities and critical values were adapted by
'John Walker from C implementations
'written by Gary Perlman of Wang Institute, Tyngsboro, MA 01879.
'Both the original C code and this JavaScript edition
'are in the public domain.
'Public Const Pi = 3.14159265359
'densité de probabilité de la loi normale centrée réduite
Function PHI(ByVal u As Double) As Double
PHI = (1 / ((2 * Pi) ^ 0.5)) * Exp(-0.5 * (u ^ 2))
End Function
'Fonction de la table inverse de la loi normale centrée réduite
Function NORMAL(ByVal p As Double) As Double
Dim xo, xx, y, h, f, f1, f2, fd, r, s As Double
Dim N, i, k As Integer
xo = 0.5
y = 0
xx = xo
N = 200
'Suite convergente de Newton
Do While Abs(xx - y) > 0.00001
y = xx
h = 2 * xx / N
f1 = 0
f2 = 0
'Résolution d'une intégrale numérique
For i = 0 To ((N - 2) / 2)
r = -xx + 2 * i * h
s = -xx + (2 * i + 1) * h
If i = 0 Then
f1 = f1 + 0
f2 = f2 + PHI(s)
Else
f1 = f1 + PHI(r)
f2 = f2 + PHI(s)
End If
Next
f = (h / 3) * (PHI(-xx) + PHI(xx) + 2 * f1 + 4 * f2) - p
fd = 2 * PHI(xx)
xx = xx - f / fd
Loop
NORMAL = xx
End Function
' Renvoie la probabilité d'une variable aléatoire z suivant la loi normale centrée réduite
Function poz(ByVal z As Double) As Double
'POZ -- probability of normal z value
'Adapted from a polynomial approximation in:
'Ibbetson D, Algorithm 209
'Collected Algorithms of the CACM 1963 p. 616
'Note:
'This routine has six digit accuracy, so it is only useful for absolute
'z values < 6. For z values >= to 6.0, poz() returns 0.0.
Dim y, x, w As Double
Dim z_max As Double
z_max = 6
If z = 0 Then
x = 0
Else
y = 0.5 * Abs(z)
If y >= z_max * 0.5 Then
x = 1
ElseIf y < 1 Then
w = y * y
x = ((((((((0.000124818987 * w - 0.001075204047) * w _
+ 0.005198775019) * w - 0.019198292004) * w _
+ 0.059054035642) * w - 0.151968751364) * w _
+ 0.319152932694) * w - 0.5319230073) * w _
+ 0.797884560593) * y * 2
Else
y = y - 2
x = (((((((((((((-0.000045255659 * y + 0.00015252929) * y _
- 0.000019538132) * y - 0.000676904986) * y _
+ 0.001390604284) * y - 0.00079462082) * y _
- 0.002034254874) * y + 0.006549791214) * y _
- 0.010557625006) * y + 0.011630447319) * y _
- 0.009279453341) * y + 0.005353579108) * y _
- 0.002141268741) * y + 0.000535310849) * y _
+ 0.999936657524
End If
End If
If z > 0 Then
poz = ((x + 1) * 0.5)
Else
poz = ((1 - x) * 0.5)
End If
Dim bigx As Double
bigx = 20
End Function
Function pochisq(ByVal x As Double, ByVal df As Integer) As Double
' Adapted From:
'Hill, I. D. and Pike, M. C. Algorithm 299
'Collected Algorithms for the CACM 1967 p. 243
'Updated for rounding errors based on remark in
'ACM TOMS June 1985, page 185
Dim a, y, s, e, c, v As Double
Dim even As Boolean
'even correspond à la parité de df, le degré de liberté
Dim lnpi, ipi As Double
lnpi = Log(Pi ^ 0.5)
ipi = 1 / Log(Pi)
If ((x <= 0) Or (df < 1)) Then
pochisq = 1
End If
a = 0.5 * x
If Fix(df / 2) = df / 2 Then
even = True
Else
even = False
End If
If df > 1 Then
y = Exp(-a)
End If
If even = True Then
s = y
Else
s = 2 * poz(-(x ^ 0.5))
End If
If df > 2 Then
x = 0.5 * (df - 1)
If even = True Then
z = 1
Else
z = 0.5
End If
If (a > bigx) Then
If even = True Then
e = 0
Else
e = lnpi
End If
c = Log(a)
Do While (z <= x)
e = Log(z) + e
s = s + Exp(c * z - a - e)
z = z + 1
Loop
pochisq = s
Else
If even = True Then
e = 1
Else
e = ipi / (a ^ 0.5)
End If
c = 0
Do While (z <= x)
e = e * (a / z)
c = c + e
z = z + 1
Loop
pochisq = c * y + s
End If
Else
pochisq = s
End If
End Function
Function critchi(ByVal p As Double, ByVal df As Integer) As Double
Dim epsilon, chimax, minchisq, maxchisq, chisqval As Double
epsilon = 0.000001
chimax = 99999
minchisq = 0
maxchisq = chimax
If p <= 0 Then
critchi = maxchisq
Else
If p >= 1 Then
critchi = 0
End If
End If
chisqval = df / (p ^ 0.5)
Do While ((maxchisq - minchisq) > epsilon)
If (pochisq(chisqval, df) < p) Then
maxchisq = chisqval
Else
minchisq = chisqval
End If
chisqval = (maxchisq + minchisq) * 0.5
Loop
critchi = chisqval
End Function
'renvoie, pour la probabilité p et le degré de liberté df, la variable
Function invchi2(ByVal p As Double, ByVal df As Double) As Double
invchi2 = critchi(p, df)
End Function
'renvoie, pour la variable x et le degré de liberté df, la probabilité
Function chi2(ByVal x As Double, ByVal df As Integer) As Double
chi2 = pochisq(x, df)
End Function
Conclusion
Pour la loi inverse de la loi normale centrée réduite, il s'agit d'un calcul de résolution d'une suite numérique convergente (méthode des tangentes de Newton). Je pense qu'il peut être optimisé.
Pour la loi du Khi-deux, j'avoue, ce n'est pas de moi (les info sur le code source sont en commentaires...), d'ailleurs, il est vraiment efficace. Il fonctionne à partir d'approximation polynomiales. Il fonctionne jusqu'à plus de 10000 degrés de liberté !!!
Historique
- 18 mai 2005 10:28:46 :
- problème de mise en page des commentaires
- 03 juin 2009 09:05:42 :
- 3 juin 2009 : Mise a jour
- definition des variables plus academique,
- constante Pi necessaire activee,
- test de parite de df plus elegant.
Sources du même auteur
Sources de la même categorie
Commentaires et avis
Discussions en rapport avec ce code source dans le forum
Urgent!! Fonctions Statistiques en VB [ par pulley60 ]
Bonjour a tous, je voudrais savoir s'il existe une bibliothèque en VB pour VB6 qui permet d'utiliser des fonctions statistiques telles que la Loi F et
études statistiques par requète SQL [ par arpege ]
j'ai fait un prog en VB6 utilisant une BDD access et je souhaiterai faire des études statistiques par le biais d'une requète SQL. Je souhaiterais calc
Statistiques réseau [ par S2R ]
Bonjour à tous, je voudrait savoir si il existe un moyen simple d'avoir les statistiques réseau d'une machine (pourcentage utilisé, vitesse max,....)M
Requete complexe avec groupements ... [ par Djoul6 ]
Bonjour,je fais appel a vous car je bloque actuellement sur une requete SQL !Je m'explique :J'ai une table "facture" sur laquelle effectuer des statis
Requete SQL complexe avec groupements ... [ par Djoul6 ]
Bonjour,je fais appel a vous car je bloque actuellement sur une requete SQL !Je m'explique :J'ai une table "facture" sur laquelle effectuer des statis
Requete SQL complexe avec groupements ... [ par Djoul6 ]
Bonjour,je fais appel a vous car je bloque actuellement sur une requete SQL !Je m'explique :J'ai une table "facture" sur laquelle effectuer des statis
Rapport statistiques [ par nr ]
Salut,Voila je souhaiterai créer des rapports de stats dont les données sources se situent dans une table access. Simplement je voudrai que les feuill
Les stats on fait comment ? [ par gfritz ]
Bien le bonjour, grâce à vous mon appli tourne !! :) c'est cool ! mais bon me reste le plus chiant il me semble . En résumé j'ai f
erreur socket [ par neo66 ]
Bonsoir :) Encore moi :p mais cette fois c'est ma socket qui me fait tourner en bourrique :s cette socket est censée ce connecter sur http://neoblaste
urgent :macro et statistiques [ par dadou20 ]
bonjour a tous:je doit consevoir un outil en VB qui traite le contenu des fichiers excel(qui contient des mesures de parametre en fonction du temps)
|
Derniers Blogs
TECHDAYS PARIS 2012 : SESSION PLEINIèRE JOUR 3TECHDAYS PARIS 2012 : SESSION PLEINIèRE JOUR 3 par ROMELARD Fabrice
Speaker: Bernard Ourghanlian Cette session est comme chaque jour transmise en live par BrainSonic, et j'ai donc suivi cette troisième pleinière par ce moyen sur mon iPad . Elle est dédiée comme chaque année à la mise en perspective de l'é...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice MISHRA READER : UN LECTEUR RSS TRèS ZUNE STYLE EN OPEN SOURCE !MISHRA READER : UN LECTEUR RSS TRèS ZUNE STYLE EN OPEN SOURCE ! par Vko
Hier durant une session dédiée aux Techdays 2012, j'ai eu le plaisir d'annoncer la sortie de la Béta 2 de Mishra Reader. C'est quoi ? Pour les utilisateurs, c'est une vraie expérience de lecture de flux RSS sur Windows. Rien à voir avec les produit...
Cliquez pour lire la suite de l'article par Vko [FRAMEWORK 4] LES TASKS ET LE THREAD UI[FRAMEWORK 4] LES TASKS ET LE THREAD UI par fathi
Je viens de passer quelques temps au TechDay's et j'ai pu voir pas mal de session intéressante. Par contre une chose m'a un peu étonné lors de certaines de ces sessions qui abordaient les améliorations du framework .NET (donc le 4.5) : en gros, bea...
Cliquez pour lire la suite de l'article par fathi WORKFLOW FOUNDATION 3 A UN PIED DANS LA TOMBEWORKFLOW FOUNDATION 3 A UN PIED DANS LA TOMBE par JeremyJeanson
Depuis déjà un an, je conseille vivement les utilisateurs de Workflow Foundation 3 à migrer vers la version 4. L'information qui va suivre ne devrait donc pas trop prendre au dépourvu les personnes qui m'ont suivi. Je profite de ce poste, pour faire le re...
Cliquez pour lire la suite de l'article par JeremyJeanson TECHDAYS PARIS 2012 : NOUVELLES TENDANCES DU POSTE DE TRAVAIL - BRING YOUR OWN PCTECHDAYS PARIS 2012 : NOUVELLES TENDANCES DU POSTE DE TRAVAIL - BRING YOUR OWN PC par ROMELARD Fabrice
Speakers: Thierry Rapatout, Antoine Petit et Xavier Trebbia Cette session entre dans le cadre des RDV Décideurs des TechDays 2012, elle est liée à la consumérisation de l'IT et la mise en place du "DeskTop as a Service" dans de plus en ...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice
Logiciels
Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System Easy-Planning (1.0.0.1)EASY-PLANNING (1.0.0.1)Basé sur les mêmes principes que MyPlanning, Easy-Planning permet de créer des plannings sous la ... Cliquez pour télécharger Easy-Planning COLLECTOR PLUS (3.00B)COLLECTOR PLUS (3.00B)COLLECTOR PLUS version 3.00B est un logiciel utilisant une base de données alimentée par :
- L... Cliquez pour télécharger COLLECTOR PLUS PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V7.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V7.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO LettresFaciles 2011 (8.0.0.1)LETTRESFACILES 2011 (8.0.0.1)LettresFaciles est un logiciel facilitant la création et la rédaction de lettres types.
Son inte... Cliquez pour télécharger LettresFaciles 2011
|