Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2013 les machistes (utilisateurs de Mac OS peuvent ils tester ceci

patricktoulon

XLDnaute Barbatruc
Bonjour à tous
@RyuAutodidacte m' a rappelé un lien vers un amis de l'autre monde concernant une classe pseudo dictionnaire pour MAC
malgré que j'apprécie beaucoup l'auteur (avec qui j'ai même collaboré sur l’accélérateur de requête entre autres ) ,je trouve que c'est un peu usine à gaz

j'ai donc fait les choses à ma façon
mais avant d'aller plus loin car des idées j'en ai plein ,si vous êtes un utilisateur sur MAC pouvez vous tester ce pseudo dictionnaire
sur Windows ça match il me faut confirmation sur MAC

Merci pour vos retours
 

Pièces jointes

  • classe dictionary pour Mac.xlsm
    18.3 KB · Affichages: 10
Dernière édition:

RyuAutodidacte

XLDnaute Impliqué
Avec le sortInsertBubble :
Avant :

3,80 sec
49995000 tours
9992 intervertions
Après :
0,54 sec
4377681 TOURS DE BOUCLE
7469 INTERVERTIONS
VB:
Option Base 1

Dim Q
Dim ch

Sub testQSort()
Dim TB, TA(), SortColl As New Collection, GetTA, Tmps!

   Cells(1, 3).Resize(10000).ClearContents
    Q = 0: ch = 0: tim = Timer
 
    TB = Cells(1).CurrentRegion.Value
    For Each t In TB
        ReDim NewTB(1 To 1)
        L = Mid(t, 1, Len(t) - 1): S = Len(t): cle = L & "|" & S
        On Error Resume Next
        SortColl.Add IIf(SortColl.Count = 0, 1, SortColl.Count + 1), cle
        If Err Then
            GetTA = TA(SortColl(cle)):  ReDim Preserve GetTA(1 To UBound(GetTA) + 1): GetTA(UBound(GetTA)) = t: TA(SortColl(cle)) = GetTA
        Else
            ReDim Preserve TA(1 To SortColl.Count): TA(SortColl(cle)) = Array(t)
        End If
    Next
 
    For i = 1 To UBound(TA): TA(i) = sortInsertBubble(TA(i)): Q = Q + 1:: Next
 
    TA = sortInsertBubbleTB(TA)
    ReDim TB(1 To 1)
    n = 0
    For Each arr In TA
        Q = Q + 1
        ReDim Preserve TB(1 To n + UBound(arr))
        For i = 1 To UBound(arr)
            Q = Q + 1
            TB(i + n) = arr(i)
        Next
        n = UBound(TB)
    Next

    MsgBox Format(Timer - tim, "#0.00") & " sec" & vbCrLf & Q & " TOURS DE BOUCLE" & vbCrLf & ch & " INTERVERTIONS"
    Cells(1, 3).Resize(UBound(TB)) = Application.Transpose(TB)
End Sub
Function sortInsertBubble(t)
    Dim a&, b&, C&, x&, D&, Z&, ref, refD
    For a = LBound(t) To UBound(t)
        ref = t(a): refD = t(a)
        x = a
        For b = a + 1 To (UBound(t))
            Q = Q + 1
            If ref > t(b) Then ref = t(b): x = b:
          
        Next b
        If x <> a Then TP = t(a): t(a) = t(x): t(x) = TP: ch = ch + 1
    Next a
    sortInsertBubble = t
End Function
Function sortInsertBubbleTB(t)
    Dim a&, b&, C&, x&, D&, Z&, ref, refD
    For a = LBound(t) To UBound(t)
        ref = t(a)(1): refD = t(a)(1)
        x = a
        For b = a + 1 To (UBound(t))
            Q = Q + 1
            If ref > t(b)(1) Then ref = t(b)(1): x = b:
          
        Next b
        If x <> a Then TP = t(a): t(a) = t(x): t(x) = TP: ch = ch + 1
    Next a
    sortInsertBubbleTB = t
End Function
 

patricktoulon

XLDnaute Barbatruc
non je n'ai pas testé les deux autres
j'ai du mal à comprendre l'intention

par contre depuis un moment déjà j'essaie de résoudre une énigme de taille
on a vu pas mal de méthode y compris mes hybrides
et même si je comprends les méthodes je ne comprends pas pourquoi
une double recherche en une sur la moitié restant de la boucle 1 est plus longue(pas de beaucoup mais quand même) alors que finalement ca devrait durer 2 fois moins longtemps

par exemple ici je reprends l'insertionsort mais je lui fait faire la moitié de boucle de moins
en ajouant le principe du pivot c'est a dire que je cherche en avancant et à reculons dans une seule et même boucle
surprise c'est un tout petit peu plus long en terme de temps

alors mes premier constat
les boucle do while/loop sont plus longues que les boucle for x= y to (va savoir pourquoi)
dans l'hybride2 je cherche donc a reculons et en avançant jusqu’à que les indexs se rencontrent
don je fait la moitié du nombre de boucle c'est pas rien
et ben c'est plus long


je t'ai donc préparé un fichier
avec 4 méthode d’écriture pour la même méthode de tri a savoir mon hybride insert bubble
la première tu la connais

la seconde c'est la même mais avec une boucle doloop a la place d'une boucle for

la 3me c'est la même que la première sauf que je fait un double shearch (avance et recule
donc 2 fois moins de tours puisque je m'arrête quand l'index du recul est le même que l'index avançant

la 4eme c'est la même que la 3eme mais avec de boucle do/loop a la place des boucles for

au final on se rend compte que les 3 et 4 qui tournent 2 fois moins sont plus longue que la 1
bref c'est une énigme
 

Pièces jointes

  • demo hybride.xlsm
    193.3 KB · Affichages: 2

patricktoulon

XLDnaute Barbatruc
re
bon j'ai regarder la tienne et testé
chez moi entre 3.80 et 4.4 on est loin des 0.54
de plus je crois que tu t'es emmêlé les pinceaux
tu confond le bubble et l'insertion
ce code ci n'est pas l'insertion mais le bubble
VB:
Function SortInsertion1(t)
    Dim temp, i&, a&
    For i = LBound(t) + 1 To UBound(t)
        For a = LBound(t) To i - 1
            If t(i) < t(a) Then TP = t(i): t(i) = t(a): t(a) = TP: ch = ch + 1
            Q = Q + 1
        Next
    Next
    SortInsertion1 = t
End Function
l'insertion replace en sortie de boucle pas a chaque pas de boucle

de plus en l'ocurence ce même code est sensé de trier le tableau (même si il est lent )
pourquoi en faire plus ?

donc pour moi tes 0.54 sont impossible avec le code que tu a fourni en post329
démonstration de ton code tel quel testé ssur 10 000 items
 

RyuAutodidacte

XLDnaute Impliqué
donc pour moi tes 0.54 sont impossible avec le code que tu a fourni en post329
démonstration de ton code tel quel testé ssur 10 000 items
Re j'ai l'impression que l'on a pas le même code, c'est celui-ci :
ha oui moins de 0,60 sde c'est ce post => 331 pas le 329

VB:
Option Base 1

Dim Q
Dim ch

Sub testQSort()
Dim TB, TA(), SortColl As New Collection, GetTA, Tmps!

   Cells(1, 3).Resize(10000).ClearContents
    Q = 0: ch = 0: tim = Timer
 
    TB = Cells(1).CurrentRegion.Value
    For Each t In TB
        ReDim NewTB(1 To 1)
        L = Mid(t, 1, Len(t) - 1): S = Len(t): cle = L & "|" & S
        On Error Resume Next
        SortColl.Add IIf(SortColl.Count = 0, 1, SortColl.Count + 1), cle
        If Err Then
            GetTA = TA(SortColl(cle)):  ReDim Preserve GetTA(1 To UBound(GetTA) + 1): GetTA(UBound(GetTA)) = t: TA(SortColl(cle)) = GetTA
        Else
            ReDim Preserve TA(1 To SortColl.Count): TA(SortColl(cle)) = Array(t)
        End If
    Next
 
    For i = 1 To UBound(TA): TA(i) = sortInsertBubble(TA(i)): Q = Q + 1:: Next
 
    TA = sortInsertBubbleTB(TA)
    ReDim TB(1 To 1)
    n = 0
    For Each arr In TA
        Q = Q + 1
        ReDim Preserve TB(1 To n + UBound(arr))
        For i = 1 To UBound(arr)
            Q = Q + 1
            TB(i + n) = arr(i)
        Next
        n = UBound(TB)
    Next

    MsgBox Format(Timer - tim, "#0.00") & " sec" & vbCrLf & Q & " TOURS DE BOUCLE" & vbCrLf & ch & " INTERVERTIONS"
    Cells(1, 3).Resize(UBound(TB)) = Application.Transpose(TB)
End Sub
Function sortInsertBubble(t)
    Dim a&, b&, C&, x&, D&, Z&, ref, refD
    For a = LBound(t) To UBound(t)
        ref = t(a): refD = t(a)
        x = a
        For b = a + 1 To (UBound(t))
            Q = Q + 1
            If ref > t(b) Then ref = t(b): x = b:
        
        Next b
        If x <> a Then TP = t(a): t(a) = t(x): t(x) = TP: ch = ch + 1
    Next a
    sortInsertBubble = t
End Function
Function sortInsertBubbleTB(t)
    Dim a&, b&, C&, x&, D&, Z&, ref, refD
    For a = LBound(t) To UBound(t)
        ref = t(a)(1): refD = t(a)(1)
        x = a
        For b = a + 1 To (UBound(t))
            Q = Q + 1
            If ref > t(b)(1) Then ref = t(b)(1): x = b:
        
        Next b
        If x <> a Then TP = t(a): t(a) = t(x): t(x) = TP: ch = ch + 1
    Next a
    sortInsertBubbleTB = t
End Function
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
ben c'est le tient copié en post 329
et pour te faire plaisir je teste celui du post 331
a effectivement c'est pas le même tu a du le modifier entre temps mais pas posté
bon je suis bien à 0.54 pour 10 000 items
là je dis bravo je sais pas encore comment ca marche mais je vais l'etudier
enfin tu nous sort un truc bien bien

elle mérite d'être dans le recueil celle là
mais il faut que je l’étudie pour pouvoir l'expliquer
comment tu veux l'appeler celle là ?
 

patricktoulon

XLDnaute Barbatruc
bon alors voir si j'ai bien compris
1°tu prends le tableau TB
2°tu le met dans une collection
a° si la clé existe tu ajoute dans l'item de la clé sous la forme d'un array​
b°si il n'existe pas tu l'ajoute a la collection​
3° tu tri chaque chaque array de la collection avec ma fonction hybride sortInsertBubble
4°tu crée un new tableau (de reversion)
5°tu reprend ma fonction hybride pour trier chaque sub array de TA
6°tu recompile en redimant et préservant dans TB
là je dis bravo bravo

on est donc dans un hybride fusionInsertionbubbleByKey

j'aurais jamais cru aussi rapide si je n'avais pas essayé

c'est comme ça que je veux que tu travaille tout le temps
 

RyuAutodidacte

XLDnaute Impliqué
on est donc dans un hybride fusionInsertionbubbleByKey

j'aurais jamais cru aussi rapide si je n'avais pas essayé

c'est comme ça que je veux que tu travaille tout le temps
ben je ten ai parlé de mon pré-tri mais tu n y a pa cru
la logique sur une seule boucle te permettant de trier des ensembles quasi identiques, permet un travail plus rapide et moindre sur le processus de tri choisi par la suite
ce tri des ensembles ne fait que 0,0859375 secondes pour 10 000
C'est pour cela que je l'ai testé sur les Tris les moins rapide car le principe sert d'accélérateur

Mais le principe ne s'arrête pas là, comme on était sur des chiffres la meilleure formule est :
Mid(t, 1, Len(t) - 1)
mais selon le type de donnée on peut avoir une variable permettant d'établir sur quel limite on se place … pour du texte par exemple on peut aisément modifier la limite, ce qui fera que l'on est des ensembles plus ou moins grand avec tjs moins de boucles et d'interventions sur le tri pour un ensemble
je pense avoir une idée d'amélioration … à voir

je pense revenir plutôt ce soir car pas mal de taf en ce moment
 
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…