Philben - Ms Access » Aléatoire

Un meilleur RNG…

philben — Sun, 11 Mar 2012 21:47:59 +0000

En parcourant le web, j’ai lu de nombreuses critiques concernant les générateurs de nombres aléatoires livrés avec les systèmes d’exploitation, les langages de programmation…

Et notre couple Randomize/Rnd que vaut-il ?

Tester un RNG (Random Number Generator) nécessite de lui faire passer une batterie de tests statistiques qui permettent de mesurer leur qualité.
le plus célèbre jeu de tests est DieHards tests de G. Marsaglia mais je me suis amusé à tester notre générateur avec le programme de fourmilab (explications sur les résultats).

Résultats

Entropy = 6.960137 bits per byte.

Optimum compression would reduce the size
of this 11469916 byte file by 12 percent.

Chi square distribution for 11469916 samples is 91767249.86, and randomly
would exceed this value less than 0.01 percent of the times.

Arithmetic mean value of data bytes is 111.6449 (127.5 = random).
Monte Carlo value for Pi is 3.304316894 (error 5.18 percent).
Serial correlation coefficient is -0.036392 (totally uncorrelated = 0.0).

Les résultats démontrent que notre RNG n’est pas à la hauteur de nos espérances…

Si vous avez besoin d’un bon générateur de nombres aléatoires, vous avez deux possibilités :

Récupérer un code VBA existant sur le web
Depuis la fin des années 90, il existe d’excellents algorithmes qui utilisent nativement des variables ‘unsigned long’ voir des ‘unsigned long long’ ce qui ne facilite pas le portage en VBA avec notre type ‘long’…

J’ai quand même péché sur le web deux RNG de qualité.

Le fameux ‘Mersenne twister’ porté ici en VBA.
et ISAAC de qualité cryptographique

Ces deux RNG codés en VBA passent sans problème les tests qualité de Fourmilab.

Exemple avec ISAAC :

Entropy = 7.999985 bits per byte.

Optimum compression would reduce the size
of this 11469916 byte file by 0 percent.

Chi square distribution for 11469916 samples is 236.35, and randomly
would exceed this value 79.31 percent of the times.

Arithmetic mean value of data bytes is 127.4950 (127.5 = random).
Monte Carlo value for Pi is 3.141571792 (error 0.00 percent).
Serial correlation coefficient is -0.000191 (totally uncorrelated = 0.0).

En adapter un…
Je dis bien ‘adapter’ et non ‘programmer’ car se sont des algorithmes très pointus.
Je me suis d’abord penché sur des sources qui utilisaient des variables ‘uint32′ dans le but de simplifier l’adaptation.
Leur qualité dépassait rarement celle de notre Rnd et j’ai du me résoudre à explorer les sources ‘modernes’ qui exploitent les ‘uint64′.
Je me suis intéressé à la méthode MWC ‘Multiply with carry’ de G. Marsaglia tout particulièrement à l’algorithme MWC256.

Voici donc mon adaptation de son code :

'Random number generator - MWC256 - Multiply with Carry
'Author : George Marsaglia
' Reference : http://school.anhb.uwa.edu.au/personalpages/kwessen/shared/Marsaglia03.html
' Period about 2^8222. Uses a static array Q[256] and an initial carry 'c',
' the Q array filled with 256 random 32-bit integers in the calling program
' and an initial carry c<809430660 for the multiply-with-carry operation
'Adapted from C to VBA : Philben - v1.0 - 03/2012
Public Function MWC256_UINT32(Optional ByVal Start As Boolean = False) As Double
Const ULL As Double = 2 ^ 64
Const UL As Double = 2 ^ 32
Static Q(1 To 256) As Variant, c As Variant, a As Variant, i As Integer
Dim t As Variant, v As Variant

If Start Or i = 0 Then
Randomize

'c < 809430660 - 0 <= Rnd < 1 - Marsaglia : c=362436
c = CDec(CLng((809430660 - 2 ^ 12) * Rnd() + 2 ^ 11))
a = CDec(809430660)

For i = 1 To 256
Q(i) = CLng(Rnd() * (2 ^ 31 - 1))
Next i

'warm up
Do
MWC256_UINT32
Loop Until i = 256
End If

i = i + 1
If i > 256 Then i = 1

v = a * Q(i) + c
t = CDec(v - Int(v / ULL) * ULL)
c = CDec(Int(t / UL))
Q(i) = v - Int(v / UL) * UL

MWC256_UINT32 = Q(i)
End Function

'Signed integer : (-2^31 to 2^31-1) ?
'author : philben
Public Function MWC256_INT32(Optional ByVal Start As Boolean = False) As Long
MWC256_INT32 = CLng(MWC256_UINT32(Start) - &H7FFFFFFF)
End Function

'Double : (0.0, 1.0) ?
'author : philben - v1.01
Public Function MWC256_Dbl(Optional ByVal Start As Boolean = False) As Double
MWC256_Dbl = MWC256_UINT32(Start) * 2.32830643653869E-10
End Function

et le résultat des tests :

Entropy = 7.999985 bits per byte.

Optimum compression would reduce the size
of this 11469916 byte file by 0 percent.

Chi square distribution for 11469916 samples is 245.85, and randomly
would exceed this value 64.83 percent of the times.

Arithmetic mean value of data bytes is 127.4586 (127.5 = random).
Monte Carlo value for Pi is 3.144400759 (error 0.09 percent).
Serial correlation coefficient is -0.000303 (totally uncorrelated = 0.0).

Il semble que cette adaptation fonctionne bien et à l’avantage d’être plus rapide que les deux précédentes mais beaucoup plus lente que son équivalent en C et que Rnd…
Pour avoir un ordre d’idée, compter moins de 2 secondes par million de nombres générés.

Un autre inconvénient de mon portage est qu’il n’est validé que par moi (!) et je ne suis pas particulièrement fier de l’initialisation de l’algorithme…

Philippe

Générer des nombres aléatoires gaussiens

philben — Mon, 30 Jul 2012 18:01:55 +0000

Je vous présente ici deux petites fonctions écrites en VBA qui permettent de générer des nombres pseudo-aléatoires à distribution normale. Une fonction de visualisation accompagne le tout.

La 1ère méthode implémentée est celle de Box-Muller

Public Function NormalRandomBM(Optional ByVal Esperance As Double = 0, _
Optional ByVal EcartType As Double = 1, _
Optional ByVal ForceRandomize As Boolean = False) As Double
'Générateur de nombres pseudo-aléatoires à distribution normale selon la méthode de Box-Muller - Forme polaire
'Référence : http://en.wikipedia.org/wiki/Box%E2%80%93Muller_transform
'Implementation en VBA par Philben - v1.1 - Free to use
Static isRandomize As Boolean, isNextRandom As Boolean, nextRandom As Double
Dim u As Double, v As Double, s As Double

If Not isRandomize Or ForceRandomize Then
Randomize
isRandomize = True
End If

If isNextRandom Then
NormalRandomBM = Esperance + (nextRandom * EcartType)
Else
Do
u = Rnd() * 2 - 1 'nombres aléatoires entre -1 et 1
v = Rnd() * 2 - 1
s = u ^ 2 + v ^ 2
Loop Until s > 0 And s < 1
s = Sqr(-2 * Log(s) / s)

nextRandom = v * s
NormalRandomBM = Esperance + (u * s * EcartType)
End If
isNextRandom = Not isNextRandom
End Function

Particularité
Cet algorithme génère deux nombres pseudo-aléatoires gaussiens d’où la possibilité d’en conserver un pour l’appel suivant de la fonction.
On conserve un des deux nombres générés dans une variable Static qui sera utilisée au prochain appel pour réduire le temps de calcul de la fonction.

Paramètres de la fonction de Box-Muller
Le premier paramètre est la moyenne mu ou l’espérance de la distribution normale.
Le deuxième est l’écart-type de la distribution gaussienne (doit être supérieur à 0)
Par défaut, l’espérance est égale à 0 et l’écart-type à 1 ce qui correspond aux paramètres de la loi normale centrée réduite N(0;1).
Le troisième paramètre (par défaut à faux) permet de forcer la réinitialisation du générateur de nombre aléatoires de VBA (Randomize). Dans tous les cas, le premier appel de la fonction lance Randomize. Cette première initialisation est sauvegardée dans la variable Static isRandomize qui passe alors à l’état Vrai.

2ème méthode de Kinderman – Monahan
J’ai ajouté cet algorithme car il est 30% plus rapide en VBA que le précédent et me permet de générer plus de 3 millions de nombres gaussiens par seconde.

Public Function NormalRandomKM(Optional ByVal Esperance As Double = 0, _
Optional ByVal EcartType As Double = 1, _
Optional ByVal ForceRandomize As Boolean = False) As Double
'Générateur de nombres pseudo-aléatoires à distribution normale : Ratio method (Kinderman - Monahan)
'Implementation en VBA par Philben - v1.0 - Free to use
Const c As Double = 1.71552776992141 + 3.59296E-15 'sqrt(8/e)
Static isRandomize As Boolean
Dim u As Double, v As Double, x As Double

If Not isRandomize Or ForceRandomize Then
Randomize
isRandomize = True
End If

Do
v = Rnd()
Do: u = Rnd(): Loop While u = 0
x = (v - 0.5) * c / u
Loop Until (x * x < -4 * Log(u))

NormalRandomKM = Esperance + (x * EcartType)
End Function

Les paramètres de la fonction sont identiques à la précédente.

Limite des générateurs
Notre couple Randomize/Rnd n’est pas une source parfaitement aléatoire de nombres entre 0 et 1[, on ne peut donc espérer un miracle concernant les nombres gaussiens générés… Dans l’état, ces fonctions ne peuvent pas être utilisées pour un usage ‘scientifique’.
Dans ce cas, il faudrait utiliser un meilleur générateur de nombres aléatoires type Mersenne Twister ou autres (voir billet précédent) et vérifier que la distribution est qualitativement correcte.

Visualiser la distribution normale
La fonction suivante génère un visuel de la distribution normale centrée réduite des nombres aléatoires dans la fenêtre ‘Exécution’ de l’éditeur Visual Basic :

Public Function VisuelNormalRandom()
'Visuel de la distribution des nombres aléatoires gaussiens - v1.1
Const cNbClasse As Long = 16, cNbEcartType As Double = 4, cRangeClasse As Double = cNbEcartType / cNbClasse
Dim i As Long, aCompte(-cNbClasse To cNbClasse) As Long, NumClasse As Long, lMax As Long
Dim r As Double

For i = 1 To 50000
r = NormalRandomKM() / cRangeClasse
NumClasse = Int(Abs(r))
If Abs(r) > NumClasse + 0.5 Then NumClasse = NumClasse + 1

If NumClasse <= cNbClasse Then
NumClasse = NumClasse * Sgn(r)
aCompte(NumClasse) = aCompte(NumClasse) + 1
If aCompte(NumClasse) > lMax Then lMax = aCompte(NumClasse)
End If
Next i

'Affiche la distribution
Debug.Print "Distribution des nombres aléatoires" & vbCrLf & "-----------------------------------"
For i = LBound(aCompte) To UBound(aCompte)
r = i * cRangeClasse
Debug.Print IIf(Sgn(r) >= 0, " ", "") & Format(r, "0.0#"), String(CDbl(aCompte(i)) / lMax * 50 + 1, "=")
Next i
End Function

Coller l’ensemble des fonctions dans un module standard. Si la fenêtre d’exécution n’est pas visible, appuyer sur Ctrl+G puis mettre le focus dans la fonction précédente et appuyer sur F5 pour l’exécuter.

Vous devriez obtenir à peu près ceci :

Théoriquement, 68% des nombres générés sont dans l’intervalle + ou – 1 écart-type autour de la moyenne, 95% entre 2 écarts-types et 99,7% entre 3 écarts-types.

Pour aller plus loin sur le sujet, cette publication récente passe en revue de nombreuses méthodes et algorithmes.

Philippe

TOP 3 aléatoire avec regroupement

philben — Sat, 26 May 2012 08:50:06 +0000

Un internaute souhaitait extraire aléatoirement 3 Id d’une table pour chaque personne. C’est possible !

Création de la table et insertion des données
La table tTop contient une colonne Id (clef primaire) et le nom de la personne

Public Function CreationTableTop()
Const cInsert As String = "INSERT INTO tTop (Nom) VALUES "
Dim i As Long, Maxi As Long
Dim aNoms As Variant

With DoCmd
.SetWarnings False

.RunSQL "CREATE TABLE tTop (Id AUTOINCREMENT CONSTRAINT PrimaryKey PRIMARY KEY, Nom CHAR);"

'VBA.Array impose que le tableau débute à l'indice 0 (Array de la librairie VBA)
'Autre solution : OPTION BASE 0 en tête du module
aNoms = VBA.Array("Albert", "Marcel", "Bernard")
Maxi = UBound(aNoms) + 1

Randomize
For i = 1 To 50
.RunSQL cInsert & "('" & aNoms(Int(Rnd() * Maxi)) & "');"
Next i
.RunSQL cInsert & "('Dominique');"

.SetWarnings True
End With
MsgBox "Création terminée"
End Function

Difficultés
La première difficulté est d’obtenir un top 3 pour chaque Nom. Une solution consiste à filtrer les enregistrements en imposant les Id par Nom grâce à une sous-requête corrélée (WHERE T.Nom=T1.Nom) dans la clause IN :

SELECT *
FROM tTop AS T1
WHERE T1.Id IN
(SELECT TOP 3 Id
FROM tTop T
WHERE T.Nom = T1.Nom
ORDER BY T.Id)
ORDER BY T1.Nom,
T1.Id;

Le problème du Top 3 par Nom étant résolu, le plus compliqué reste à faire… Comment obtenir aléatoirement des Id pour chaque Nom ?
En effet, on souhaite suffisamment d’aléatoire pour que la liste des Id différe d’un appel à l’autre de la requête mais pas trop non plus pour que la sous-requête sorte la même liste des Id pour chaque T1.Id.
L’idée de base est d’utiliser la fonction RND(T.Id) dans la clause ORDER BY pour trier aléatoirement les enregistrements en sachant que T.Id est unique :

SELECT *
FROM tTop AS T1
WHERE T1.Id IN
(SELECT TOP 3 Id
FROM tTop T
WHERE T.Nom = T1.Nom
ORDER BY Rnd(T.Id),
t.Id
)
ORDER BY T1.Nom,
T1.Id;

Comme vous pouvez le constater, on perd la notion de Top 3 par Nom car pour chaque T1.Id, la sous-requête recalcule une liste d’Id différente…

La requête SQL finale

SELECT *
FROM tTop AS T1
WHERE T1.Id IN
(SELECT TOP 3 Id
FROM tTop T
WHERE T.Nom = T1.Nom
ORDER BY Rnd(-( T.Id + Timer())),
t.Id
)
ORDER BY T1.Nom,
T1.Id;

Explications
On s’appuie sur deux particularités d’Access :

La première est que si l’on passe un nombre négatif en argument à la fonction Rnd(), elle retourne toujours le même nombre aléatoire. Ceci permet d’avoir une liste constante d’Id pour chaque Nom.

La deuxième va nous permettre d’obtenir une liste différente d’Id entre chaque appel de la requête principale. Pour ajouter un zeste d’aléatoire on utilise la fonction Timer() en argument de la fonction Rnd(). Heureusement, Access ne met pas à jour le timer() pendant tout le temps d’exécution de la requête. La valeur du timer au démarrage de la requête est conservé jusqu’à la fin de son exécution ou de sa prochaine actualisation (dans un formulaire prendre un recordset avec snapshot pour éviter une mise à jour via modification du jeu d’enregistrements sous-jacent).

Remarques
L’ajout d’une deuxième colonne de tri (T.Id) dans la sous-requête permet de s’assurer que le top 3 retournera toujours que 3 lignes au maximum même si des ex-aequo subsistent après ORDER BY RND(-(T.Id+Timer())).

La présence de la sous-requête entraîne un temps d’exécution long de la requête qui sera donc réservée pour des tables ayant peu de lignes (~1000).
@+

Philippe