Compactage d'une série numérique

Soyez le premier à donner votre avis sur cette source.

Snippet vu 4 277 fois - Téléchargée 26 fois

Contenu du snippet

Il s'agit de 2 petites fonctions très simples, permettant de "compacter" une suite d'entiers, ou plus exactement de l'écrire sous une forme plus dense. Exemple:
1,2,3,4,6,9,10,11 ==> 1:4,6,9:11
La fonction décompacte fait le travail inverse (1:3,5 -> 1,2,3,5)

Rien de bien extraordinaire, mais à ajouter pourquoi pas à une librairie de fonctions de manipulation de texte.

Source / Exemple :


Option Explicit

'---------------------------------------------------------------------------------------
' Procedure : Compacte
' DateTime  : 24/07/2006 20:29
' Author    : Jean-Marc
' Purpose   : Compacte une "collection" de valeurs déja triées en
'             ordre croissant.
' Exemple   : 1,2,3,4,6,9,10,11 ==> 1:4,6,9:11
'
'---------------------------------------------------------------------------------------
'
Public Function Compacte(ByVal cdata As Collection) As String
Dim idx As Long             ' parcours de la collection
Dim vidx As Long            ' valeur (possible) du premier element d'une suite
Dim vc As Long              ' valeur courante
Dim vp As Long              ' valeur precedente
Dim suite As Boolean        ' flag indiquant si l'état courant est dans une suite ou non
Dim tmpResult As String     ' construction du résultat final par concaténations successives

    If cdata.Count = 0 Then     ' si il n'y a pas d'éléments, quitte et retourne une chaine vide
        Exit Function
    End If
    vidx = cdata.Item(1)        ' initialisations, avec le premier élément
    vp = vidx
    For idx = 2 To cdata.Count  ' parcours à partir du second
        vc = cdata.Item(idx)    ' récupération de la valeur courante
        If (vp + 1) = vc Then   ' si elle suit immédiatement la valeur précédente
            suite = True        ' on est dans une suite
        Else
            If suite Then       ' sinon, on regarde si on était dans une suite
                                ' si oui, on concatene la suite, qui part de vidx jusqu'à vp
                tmpResult = tmpResult & "," & CStr(vidx) & ":" & CStr(vp)
            Else                ' si non, on concatene la valeur précédente
                tmpResult = tmpResult & "," & CStr(vp)
            End If
            vidx = vc           ' on réinitialise le premier élément d'une suite potentielle
            suite = False       ' et on reset le flag de suite
        End If
        vp = vc                 ' stockage de la valeur courante dans vp
    Next idx
    If suite Then               ' traitement final, identique à celui qui est dans la boucle
        tmpResult = tmpResult & "," & CStr(vidx) & ":" & CStr(vp)
    Else
        tmpResult = tmpResult & "," & CStr(vp)
    End If
    Compacte = Mid$(tmpResult, 2)   ' élimination de la première virgule
End Function

'---------------------------------------------------------------------------------------
' Procedure : Decompacte
' DateTime  : 25/07/2006 20:15
' Author    : Jean-Marc
' Purpose   : Decompacte une chaine produite par compacte
' Exemple   : 1:4,6,9:11 ==> 1,2,3,4,6,9,10,11
'
'---------------------------------------------------------------------------------------
'
Public Function Decompacte(ByVal data As String) As String
Dim t() As String       ' split la chaine
Dim i As Long           ' parcours des éléments de la chaine
Dim j As Long           ' génération des suites
Dim p As Long           ' cherche les suites grace au signe :
Dim tmpResult As String ' résultat intermédiaire, construite par concatenation

    If data = vbNullString Then ' si chaine vide, retourne vide
        Exit Function
    End If

    t = Split(data, ",")                ' split avec les virgules
    For i = LBound(t()) To UBound(t())  ' parcours
        p = InStr(t(i), ":")
        If p <> 0 Then                  ' est ce une suite (a:b)
            ' si oui, parcours de 'a' à 'b'
            For j = Val(Mid$(t(i), 1, p - 1)) To Val(Mid$(t(i), p + 1))
                tmpResult = tmpResult & "," & CStr(j)
            Next j
        Else
            tmpResult = tmpResult & "," & CStr(t(i))    ' sinon ajoute juste l'élément
        End If
    Next i
    Decompacte = Mid$(tmpResult, 2) ' retourne le resultat, en éliminant la première virgule

End Function

'
' exemple de compactage
'
Private Sub Command1_Click()
Dim cc As Collection
Dim result As String
    
    Set cc = New Collection
    cc.Add (1): cc.Add (2): cc.Add (3): cc.Add (4): cc.Add (6): cc.Add (9): cc.Add (10): cc.Add (11)
    result = Compacte(cc)
    Debug.Print result;: If result = "1:4,6,9:11" Then Debug.Print "   ==> OK" Else Debug.Print "   ==> KO"
End Sub

'
' exemple décompactage
'
Private Sub Command2_Click()
Dim s As String
Dim r As String

    s = "2:5,6,7,9:13,15:17,19,20"
    r = Decompacte(s)
    Debug.Print s & " => " & r
End Sub

Conclusion :


Note: la fonction compactage prend une collection en argument d'entrée, on peut très simplement la modifier ou la décliner en différentes versions: avec un tableau, une chaine de caractère, etc.

A voir également

Ajouter un commentaire

Commentaires

Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
65
on est d'accord ^^
Messages postés
170
Date d'inscription
jeudi 11 décembre 2003
Statut
Membre
Dernière intervention
24 janvier 2009

Oui, tester le type est une bonne alternative à un wrapper (pas ma solution préférée, mais une bonne idée, c'est sur).

Concernant le tri, c'est certes une bonne idée mais ma rêgle en matière de design applicatif est "A chacun son métier, et les vaches seront bien gardées", i.e une fonction pour chaque chose. C'est pourquoi dans la description de Compacte, il est bien indiqué qu'elle attend les données déjà triées.

Cependant, je suis d'accord avec toi que c'est une bonne idée de proposer un tri. Auquel cas, une bonne façon de faire serait à mon avis de créer une fonction de plus haut niveau (publique) qui appelerait (optionellement) une fonction de tri avant d'appeler Compacte (qu'on rendrait private).

En pseudo code, ca donnerait à peu près:

Public Function SuperCompacte(data, optional must_sort As Boolean) as string
if must_sort
Call my_sort( data ) ' call sort routine
endif
SuperCompacte = Compacte( data )
End Function

Private Function Compacte ( byval data) as string

Private Sub My_sort ( byref data)
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
65
un Wrapper, oui, sympatique...

tu peux aussi tester le type de parametre en entrée...

tableau, collection, etc

et peut etre même voir à trier les chiffres, en première étape du processus, afin de compacter au maxiumum (traitement optionnel)
Messages postés
170
Date d'inscription
jeudi 11 décembre 2003
Statut
Membre
Dernière intervention
24 janvier 2009

Re,
on peut aussi par exemple ecrire des wrapper (un peu moins efficace, mais très sympa à maintenir). Par exemple avec le ParamArray:

Private Function CompacteParamArray(ParamArray t() As Variant) As String
Dim cdata As Collection
Dim i As Long

Set cdata = New Collection
For i = LBound(t()) To UBound(t())
cdata.Add t(i)
Next i
CompacteParamArray = Compacte(cdata)
Set cdata = Nothing
End Function
Messages postés
170
Date d'inscription
jeudi 11 décembre 2003
Statut
Membre
Dernière intervention
24 janvier 2009

Hello Renfield,
Oui tu as raison. C'est ce que je notais dans explicatin finale: on peut décliner la fonction en différentes versions, utilisant différentes entrées:
- tableau
- chaine de cracatères
- paramarray
- autres?

Merci du commentaire :-)
Afficher les 6 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.