Question 173

Comment réaliser des allocations dynamiques ?

Le fonctionnement de très nombreuses applications repose sur l'utilisation des tableaux. Lorsque le nombre d'éléments contenus est connu lors de la réalisation du logiciel, des tableaux de dimensions fixes peuvent être employés et on parle alors d'allocation statique de mémoire. Cependant, il arrive très fréquemment que le nombre d'éléments auxquels l'application doit référer ne soit pas connu à l'avance. Il faut alors, durant l'exécution, ajouter à un tableau des éléments, opération connue sous le nom d'allocation dynamique. Nous allons ici discuter des techniques permettant en VB de réaliser une telle allocation dynamique.

Les objets

L'allocation dynamique, ou création, d'objets de VB est principalement réalisée par le mot clé New, suivi du type de l'objet à allouer. D'autres classes sont construites par une fonction spécifique du modèle objet utilisé. L'affectation d'un objet à une variable est effectuée par le mot clé Set.

    Dim a As Object
    
    'Allocation dynamique classique d'un objet de type collection
    Set a = New Collection

    'Allocation d'un objet StdPicture à l'aide de la fonction spécifique LoadPicture
    Set a = LoadPicture("c:\images\toto.jpg")

L'allocation d'objet en elle-même est donc assez simple. Il est néanmoins souvent nécessaire de garder trace d'objets précédemment créés dans des structures dynamiques, dont des Collections.

Le tableau dynamique

Visual Basic permet l'allocation dynamique de tableaux à l'aide de l'instruction Redim. Il est important de constater que l'utilisation de Redim force la réallocation et, par conséquent, les données précédemment contenues seront simplement perdues (nous verrons plus loin comment palier à cet inconvénient). Il est à noter que chaque réallocation a un coût en temps d'exécution. Plus la plage à allouer est grande, plus il sera difficile pour le système d'exploitation de trouver et préparer une zone mémoire suffisamment large.

    Dim a() As Integer
    Dim i As Long
     
    'Alloue un tableau unidimensionnel, ou vecteur,
    'de 18 entiers (indexés 0 à 17)
    ReDim a(17)
     
    'La manipulation des données se fait de la même
    'façon que pour un tableau statique
    a(5) = 4
     
    For i = LBound(a) To UBound(a)
        Debug.Print i, a(i)
    Next i
     
    'Alloue un nouveau tableau à 2 dimensions, ou matrice
    ReDim a(18, 5)
     
    'Affecte à l'élément 3,4 une nouvelle valeur
    a(3, 4) = 5
     
    'Alloue un nouveau tableau à 2 dimensions
    ReDim a(19, 7)
     
    'La valeur de 3,4 n'a pas été préservée et vaut donc 0,
    'tel que montré par l'exécution de la ligne suivante
    Debug.Print "Elément 3,4", a(3, 4)

Comment empêcher la destruction des données lors d'une réallocation

Lorsqu'uniquement la dernière dimension du tableau change, il est possible de forcer Visual Basic à recopier les valeurs précédemment contenues à l'aide du mot clé Preserve. Dans les autres cas de redimensionnement, s'il faut assurer la persistance des données initialement inscrites, la copie devra être effectuée manuellement. Dans tous les cas, chaque copie de données a elle aussi un coût en temps d'exécution. Voici un exemple d'utilisation :

    Dim a() As Long     

    ReDim a(5)
    a(3) = 555     

    ReDim Preserve a(10)
    a(8) = 999     

    Debug.Print a(3)    ' la valeur de a(3) a été préservée

Mise en œvre

Le code suivant résume, en un exemple concret, l'utilisation et les recommandations d'utilisation d'allocations dynamique de tableau à l'aide de Redim et Redim Preserve. Il s'agit de filtrer une série de données pour ne conserver que celles entre deux bornes :

Private Function Filtre(a() As Integer, Min As Integer, Max As Integer) As Integer()
    Dim Result() As Integer 'Tableau des éléments restant après filtrage
    Dim Count As Long       'Nombre d'éléments déjà retenus après filtrage
    Dim i As Long           'Indice de parcours du tableau a
     
    'Effectue une première allocation suffisante pour contenir tous les éléments
    'On emploie les mêmes bornes que celles du vecteur a
    ReDim Result(LBound(a) To UBound(a))

    For i = LBound(a) To UBound(a)
        'Condition de filtrage : Min <= élément <= Max
        If (a(i) >= Min And a(i) <= Max) Then
            Result(LBound(a) + Count) = a(i)
            Count = Count + 1
        End If
    Next i
     
    If (Count = 0) Then
        'Aucun élément n'a été retenu, renvoie un tableau vide
        Erase Result
    Else
        'Un ou plusieurs éléments ont été retenus, on tronque le
        'tableau de résultats à une taille juste suffisante pour
        'contenir tous les éléments
        ReDim Preserve Result(LBound(Result) To (LBound(Result) + Count - 1))
    End If
     
    Filtre = Result
End Function

Tableau de tableaux, ou le tableau dynamique d'UDT dynamiques

Plusieurs applications nécessitent l'utilisation de tableau de tableaux, afin d'obtenir pour chaque entrée plusieurs sous-entrées donc le nombre n'est, au départ, pas défini. Dans certains cas, notamment le cas d'école de la matrice symétrique, il est possible d'aplanir les données dans un seul vecteur après quelques manipulations mathématiques. L'idée est d'établir une relation de correspondance ente une entrée x,y de la matrice et l'index du vecteur. Ce genre de résolution n'a malheureusement que de rares applications. Dans un cadre plus général, Visual Basic de réaliser des tableaux de tableaux en utilisant des UDT (User Defined Type) contenant eux-même un tableau dynamique.

Cette technique est illustrée par le stockage de gains, reçu par reçu, par exemple pour un magasin. On ne sait, a priori, pas combien de récépissés seront stockés, ni combien d'objets achetés seront indiqués sur le ticket. Nous emploierons donc un tableau dynamique de reçus contenant chacun un tableau dynamique de prix.

Option Explicit

'Structure contenant chacun des objets achetés
'par ticket produit
Private Type BoughtItems
    ItemPrice() As Long
End Type

'Ensemble des tickets produits
Private Receipts() As BoughtItems

'Renvoie la borne supérieure d'un tableau
'ou -1 si celui-ci n'a pas été initialisé
'Suppose la borne inférieure nulle
Private Function MyUBoundBoughtItems(Data() As BoughtItems) As Long
    MyUBoundBoughtItems = -1
    On Error Resume Next
    MyUBoundBoughtItems = UBound(Data)
End Function

Private Function MyUBoundLong(Data() As Long) As Long
    MyUBoundLong = -1
    On Error Resume Next
    MyUBoundLong = UBound(Data)
End Function

Private Function ReceiptTotal(Receipt As Long) As Long
    Dim i As Long
     
    ReceiptTotal = 0

    'Vérifie que le ticket demandé existe
    If (Receipt <= MyUBoundBoughtItems(Receipts) And Receipt > -1) Then
        'Parcours tous les prix et effectue la somme
        For i = 0 To MyUBoundLong(Receipts(Receipt).ItemPrice)
            ReceiptTotal = ReceiptTotal + Receipts(Receipt).ItemPrice(i)
        Next i
    Else
        'Subscript out of range
        Err.Raise 9
    End If
End Function

Private Function NewReceipt() As Long
    'Ajoute un reçu à la liste existante, ou initialise la liste
    If (MyUBoundBoughtItems(Receipts) = -1) Then
        'Initialise la liste des reçus, si aucun n'était présent
        ReDim Receipts(0)
    Else
        'Ajoute un reçu à la liste
        ReDim Preserve Receipts(MyUBoundBoughtItems(Receipts) + 1)
    End If
     
    NewReceipt = MyUBoundBoughtItems(Receipts)
End Function

Private Sub AddItem(Amount As Long)
    'Ajoute un paiement réalisé sur le dernier ticket
    Dim CurrentDayIndex As Long, CurrentTransactionIndex As Long
     
    If (MyUBoundBoughtItems(Receipts) <> -1) Then
        With Receipts(MyUBoundBoughtItems(Receipts))
            'Ajoute un objet au reçu
            If MyUBoundLong(.ItemPrice) = -1 Then
                ReDim .ItemPrice(0)
            Else
                ReDim Preserve .ItemPrice(MyUBoundLong(.ItemPrice) + 1)
            End If
             
            'Enregistre le montant
            .ItemPrice(MyUBoundLong(.ItemPrice)) = Amount
        End With
    Else
        'Génère une erreur si aucun ticket n'est présent
        Err.Raise 100, , "No receipt exists!"
    End If
End Sub

Public Sub Commerce()
    Dim i As Long

    'Efface tous les reçus existant précédemment
    Erase Receipts

    'Un premier client passe à la caisse
    'enregistre un premier reçu
    NewReceipt
    AddItem 10
    AddItem 15
    AddItem 20
    AddItem 25
     
    'second client
    NewReceipt
    AddItem 2
     
    'troisième client
    NewReceipt
    AddItem 40
    AddItem 3
    AddItem 5
     
    'Affiche le montant total pour chaque reçu
    For i = 0 To MyUBoundBoughtItems(Receipts)
        Debug.Print "Montant du ticket " & i & " : " & ReceiptTotal(i)
    Next i
End Sub

Bien entendu, dépendant du type d'opérations à effectuer ainsi que des contraintes de vitesses, il est tout aussi possible de réaliser la même opération à l'aide de tableaux de collections, collections de tableaux et collections de collections. L'UDT devient alors facultatif. Fonction de ce que doit réaliser le logiciel, il est aussi possible d'utiliser des classes en place des UDT.

Pour aller plus loin

• Documentation de l'objet Collection
• Documentation de l'instruction Redim

Voir aussi :

• Comment réaliser et utiliser une liste sur base d'un tableau dynamique ?