VBA : Génère un tableau avec une séquence de valeurs décimales non incrémentale

[Lu76Fer]

Bonjour,

Pour pouvoir tester certain algorithme, il est utile d'avoir une série de valeur organisée de façon non incrémentale afin de reproduire le cas pratique dont voici une illustration : Arbre AVL.​

Algorithme permettant de générer cette série dans un tableau et de vérifier sa validité :

'Génère un tableau avec une séquence de valeurs décimales non incrémentale (selon shift et addSeq)
'   tb() : tableau à dimensionné selon le nombre de Digit. 1:0-9, 2:0-99, 3:0-999, 4:0-9999 ...
'   shift : tableau de variant définissant le décalage de chaque digit
'   addSeq : tableau de variant définissant la séquence de chaque digit => 1:Inc(+1), 2:+3, 3:+7, 4:inversé(-1)
'   min : défini la valeur minimale généré => max = min + taille(tb)
Sub GenDecNotInc(tb() As Integer, shift As Variant, addSeq As Variant, Optional min As Integer = 0)
Dim digit() As Integer, v() As Integer
Dim pos As Integer, n As Integer, tot As Integer
Dim rk As Integer, inc As Boolean, calc As Integer, fact As Integer
    n = UBound(shift): tot = 10 * (10 ^ n) - 1
    ReDim tb(tot)
    ReDim digit(n): ReDim v(n)
    'Décalage de départ
    For rk = 0 To n
        v(rk) = shift(n - rk)
        addSeq(rk) = Choose(addSeq(rk), 1, 3, 7, 9)
    Next rk
    'Remplissage
    For pos = 0 To tot
        inc = True: calc = 0: fact = 1
        For rk = 0 To n
            v(rk) = ((v(rk) + addSeq(rk)) Mod 10)
            calc = calc + v(rk) * fact: fact = fact * 10
            If inc Then If digit(rk) = 9 Then digit(rk) = 0: v(rk) = v(rk) + 1 Else digit(rk) = digit(rk) + 1: inc = False
        Next rk
        tb(pos) = calc + min
    Next pos
End Sub

'Vérifie que le tableau contient toutes les valeurs séquentielles de façon unique
Sub CheckDecNotInc(tb() As Integer, min As Integer)
Dim max As Integer, cnt As Integer, chk() As Boolean
    On Error GoTo badGen
    max = UBound(tb): ReDim chk(max)
    For cnt = 0 To max
        chk(tb(cnt) - min) = True
    Next cnt
    cnt = 0
    Do While chk(cnt)
        cnt = cnt + 1
        If cnt > max Then Exit Do
    Loop
    If cnt > max Then Debug.Print "Génération non incrémentale réussie !" Else Debug.Print "ECHEC GEN : doublon(s)"
    Exit Sub
badGen:
    Debug.Print "ECHEC GEN : valeur(s) hors-interval générée(s)"
End Sub

Utilisation de la fonction : il faut choisir le décalage souhaité pour chaque digit au départ ainsi que la séquence employée pour chaque digit.
Il est aussi possible de définir la valeur minimale qui sera calculé.

'1:Inc(+1) 2:+3 3:+7 4:Inverse(-1)
Sub TestGen()
Dim tb() As Integer, min As Integer
    min = 1
    GenDecNotInc tb, Array(7, 1, 4, 3), Array(2, 3, 4, 2), min
    CheckDecNotInc tb, min
End Sub