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

patricktoulon

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:
Trier par date Trier par votes
RyuAutodidacte

RyuAutodidacte

XLDnaute Impliqué
Supporter XLD
patricktoulon à dit:
re
avec ta premiere version et ma insertionbubbleGD
je suis decendu a 0.40/0.45
VB: 
'******************************************************************************************************************************************************
'    __    _  _  _   _  _       _   _ _______  ___     ___     _  ___     _       ____ _______  ____
'   // \\ // // //  // /\\     //  //   //    //  \\  // ||   // // ||   /\\     //      //    //
'  //__// \\// //  // //__\   //  //   //    //   // //  ||  // //  ||  //__\   //      //    //__
' //  \\   // //  // //   \\ //  //   //    //   // //   // // //   // //   \\ //      //    //
'//   //  // //__// //    ////__//   //     \\__// //___// // //___// //    ////___   //    //___
'******************************************************************************************************************************************************
'méthode 6
'Auteur: Ryuautodidacte et patricktoulon sur ExcelDownloads
'version1 1.0
'réécrite en une seule fonction par patricktoulon
'insertion des code sortinsertbubble intra code
' cette fonction reside sur le fait d'utiliser un object collection qui va contenir dans les valeur un array de chaine similaire
'ou commencant par les meme caractères
'ensuite on va trier chaque sub array avec la méthode sortinsertbubble de patricktoulon
'ensuite on va refaire une passe sortinserbubble sur le TAg général (qui contioent des sub arrary)
'et le trier par la valeur du premier item de chaque array
'et pour finir on recompile les sub array dans un seul tableau (celui d'origine )
'
'vous l'avez compris on est dans la catégorie de fonction de tri dite "Diviser pour mieux reigner"
'en effet les boucles sont moins longues et plus rapide a trier
'mis apart l'object collection on est tres proche de la méthode fusion coisée avec l'insertion
'*****************************************************************************************************
Option Base 1
Dim Q
Dim ch
Sub test()
    Dim TB, tim#
    Q = 0: ch = 0
    TB = Cells(1).CurrentRegion.Value
    Cells(1, 3).Resize(UBound(TB)).ClearContents
    tim = Timer
    TB = SortRyuPatKey(TB)
    MsgBox Format(Timer - tim, "#0.00") & " sec" & vbCrLf & Q & " TOURS DE BOUCLE" & vbCrLf & ch & " INTERVERTIONS"
    Cells(1, 3).Resize(UBound(TB)) = (TB)

End Sub

Function SortRyuPatKey(TB)
    Dim TA(), SortColl As New Collection, GetTA, Tmps!, L, a&, b&, x&, ref, SubTB, SubTBA, D&, W&

    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

    'tri SortInsertBubbleGD des sub array dans l'array TA
    For i = 1 To UBound(TA)
        SubTB = TA(i)
        For a = LBound(SubTB) To UBound(SubTB)
            ref = SubTB(a)
            x = a
            D = UBound(TA)
            W = (UBound(TA) - a) / 2
            For b = a + 1 To (UBound(SubTB) - W)
                Q = Q + 1
                If ref > SubTB(b) Then ref = SubTB(b): x = b:
                If ref > SubTB(D) Then ref = SubTB(D): x = D:
                D = D - 1
            Next b
            If x <> a Then TP = SubTB(a): SubTB(a) = SubTB(x): SubTB(x) = TP: ch = ch + 1
        Next a
        TA(i) = SubTB
        Q = Q + 1
    Next

    ' second tri sortinsertbubble sur le TA genéral
    ' le tri va se faire sur le premier item de chaque array dans subTBA
    SubTBA = TA
    For a = LBound(SubTBA) To UBound(SubTBA)
        ref = SubTBA(a)(1)
        x = a
        For b = a + 1 To (UBound(SubTBA))
            Q = Q + 1
            If ref > SubTBA(b)(1) Then ref = SubTBA(b)(1): x = b:

        Next b
        If x <> a Then TP = SubTBA(a): SubTBA(a) = SubTBA(x): SubTBA(x) = TP: ch = ch + 1
    Next a
    TA = SubTBA

    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
    SortRyuPatKey = Application.Transpose(TB)
End Function
Cliquez pour agrandir...
Re,
en associant ma méthode + celle la tienne ci-dessus on est à 0,40 secondes ;) pour 10 000
… je l'ai fait plusieurs fois je tombe tjs sur 0,40 et 1 à 0,39
je peux dire sur la fouchette de 0,39 à 0,43
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
ben je kiffe celui d'hier les 3 qui ont suivi mettent 0.20 de plus en moyenne et je l'ai accéléré de 0.15 en moyenne avec ma inserbubbleGD
conclusion je plafonne à 0.47/0.48 >> 0.40 0.42 quand le pc n'est pas occupé par autre chose
mais les 3 dernières non je kiffe pas du tout
tu a remplacé un insertbubble par une boucle avec application.min et c'est plus lourd visiblement
ben chez toi ca met 0.40 c'est bien non ?
 
Dernière édition:
Vote positif 0 Vote négatif
RyuAutodidacte

RyuAutodidacte

XLDnaute Impliqué
Supporter XLD
Chez moi avec Macbook pro M1 :

1699606125178.png
1699606150897.png


1699606185829.png


avec mon code tel qu'il est sans le modifier
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
pour info
la insertionbubble fait 49997500 tours sur 10 000
la insertionbubbleGD en fait 25000000
soit la moitié

bon 0.40 on est quand même loin des 0.02/0.03 pour les plus rapides(quicksort Laurent et patrick)
ca fait du 2000% quand même
mais c'est une belle performence et c'est tout nouveau tout beau ;)
 
Vote positif 0 Vote négatif
RyuAutodidacte

RyuAutodidacte

XLDnaute Impliqué
Supporter XLD
Re tous,

@patricktoulon
Avec notre combo Accélérateur Tris Ryu + sortInsertBubble3 de Patrick on a (sur MacBook Pro M1) :

1699611702936.png


VB: 
Option Base 1

Dim Q
Dim ch

Sub testQSort()
Dim TB, TA(), SortColl As New Collection, GetTA, tim!, Mn
   Cells(1, 3).Resize(10000).ClearContents
    Q = 0: ch = 0: tim = Timer
 
    n = 1: ReDim temp(1 To 1)
    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): ReDim Preserve temp(1 To n): temp(n) = CLng(cle)
            n = UBound(temp) + 1
        End If
    Next

    temp = sortInsertBubble3(temp)
    
    ReDim TB(1 To UBound(temp))
    For i = 1 To UBound(temp)
        TB(i) = TA(SortColl(CStr(temp(i))))
    Next
    
    For i = 1 To UBound(TB): TB(i) = sortInsertBubble3(TB(i)): Q = Q + 1:: Next
 
    ReDim TA(1 To 1)
    n = 0
    For Each arr In TB
        Q = Q + 1
        ReDim Preserve TA(1 To n + UBound(arr))
        For i = 1 To UBound(arr)
            Q = Q + 1
            TA(i + n) = arr(i)
        Next
        n = UBound(TA)
    Next

    MsgBox Format(Timer - tim, "#0.00") & " sec" & vbCrLf & Q & " TOURS DE BOUCLE" & vbCrLf & ch & " INTERVERTIONS"
    Cells(1, 3).Resize(UBound(TA)) = Application.Transpose(TA)
End Sub
Function sortInsertBubble3(T)
    Dim A&, B&, C&, x&, ref

    For A = LBound(T) To UBound(T)
        ref = T(A)
        x = A
        C = UBound(T)
        W = (UBound(T) - A) / 2
        'Dans une seule boucle B avance de A+1 vers le ubound et C recule du ubound vers B
        ' quand les deux se rencontrent on arrete de boucler
        ' on fait donc la moitié du nombre de tours de la hybride 1

        For B = A + 1 To UBound(T) - W
            Q = Q + 1
            If ref > T(B) Then ref = T(B): x = B:
            If ref > T(C) Then ref = T(C): x = C:
            C = C - 1
        Next
        If T(x) < T(A) Then TP = T(A): T(A) = T(x): T(x) = TP: ch = ch + 1
    Next A
    sortInsertBubble3 = T
End Function
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
RyuAutodidacte à dit:
oui les tris lents sont moins à la traine comme ça 🤣
qd on passe de 7 - 8 secondes à 0,40 c'est vraiment énorme !!!
Cliquez pour agrandir...
re
non les hybride insertbubble 2 et 3 n'on jamais fait 7/8 secondes mais 2.6 / 2.8 sec
c'est la insertion et bubble simple qui font 6/8 secondes
tu pense bien sinon ça vaudrait pas le coup de s'atarder sur cette méthode
donc arrête de confondre insertion et mon hybride insertbubble(1,2,3)

je répète
la bubble
boucle 1 de 1 a ubound-1 et boucle 2 de index boucle1 à ubound
et comparaison des deux index(inversion selon le sens de tri
total 6/8 secondes 49997500 tours et 9990 echanges

l'insertion
boucle1 de 1 abound et boucle 2 de 1 a index boucle1
et comparaison index boucle1 avec tout les index boucle2
à l'image d'un chenillard à led repétitif
a peu près pareil pour les decomptes
total 6/7 sec

l'hybride inserbubble1
boucel 1 de 1 à ubound et boucle 2 de index boucle1+1 à ubound
comparaison index boucle1 et boucle1et memo de l'index plus petit


echange uniquement en sortie de boucle 2
total2.70/2.90 sec


l'hybride insertbbuble2 et 3 la DG
boucel 1 de 1 à ubound et boucle 2 de index boucle1+1 à ubound
comparaison index boucle1 et boucle1et memo de l'index plus petit
incrementaion a reculons de ubound vers index boucle2 et memo si plus petit que index boucle2
echange uniquement en sortie de boucle 2
total 2 fois moins de tours 2.50/2.60 sec( je sais on gagne pas beaucoup) et en plus ca peut augmenter en fonction si le pc est charger de travail

la 3 c'est la même que l'hybride2 sauf que j'utilise des boucles do/loop
car en effet après investigations bien poussées
une boucle for i= 1 to 1000000000
ira plus vite que
do while i<1000000000:i=i+1:loop
pour la simple et bonne raison est qu'a chaque tour la variable i est itéré alors que l'itération dans une boucle for est en interne testé des dizaine de fois




j'ai testé ce matin un hybride de la fusion et hybride
pour tester si vraiment c'etait le nombre de tour en sectionant la recheche par part de l'array
sur 10000 items que j'ai scruté par 5 boucles de 20000 je met plus de temps
conclusion la rapidité comme mes hybride le confirment aussi ne reside pas dans le nombre de tours
mais bel et bien les operations qui sont faites dans ces boucles aussi benines ou simples soient elles
 
Vote positif 0 Vote négatif
RyuAutodidacte

RyuAutodidacte

XLDnaute Impliqué
Supporter XLD
je parlais de ces là non hybride :
1699617163628.png


je ne sais pas si tu a fais la modif avec la partie temp :
VB: 
 n = 1: ReDim temp(1 To 1)
    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): ReDim Preserve temp(1 To n): temp(n) = CLng(cle)
            n = UBound(temp) + 1
        End If
    Next

    temp = sortInsertBubble3(temp)
    
    ReDim TB(1 To UBound(temp))
    For i = 1 To UBound(temp)
        TB(i) = TA(SortColl(CStr(temp(i))))
    Next
    
    For i = 1 To UBound(TB): TB(i) = sortInsertBubble3(TB(i)): Q = Q + 1:: Next
 
Dernière édition:
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Il y a quand même aussi l'insertion avec recherche dichotomique de la position d'insertion, qui reste la plus performante entre 5 et 40 éléments environ, et même extensible jusqu'au alentours de 1000 éléments si ce qui est à décaler pour insertion sont des Integer ou des Long, à condition que le décalage puisse se faire avec un MoveMemory (Alias RtlMoveMemory de la kernel32.dll). Ne voudriez vous faire des recherches dans ce sens avec des Variant (dont je ne connais pour le moment la longueur fixe) ? Parce que c'est la voie royale pour optimiser toutes les autres méthodes de tri lorsqu'elles reçoivent la charge de petits ensembles (au début pour la fusion, vers la fin pour pratiquement tous les autres algorithmes).
 
Vote positif 0 Vote négatif

Membres actuellement en ligne

18 membres et 106 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 207
Messages
2 086 233
Membres
103 161
dernier inscrit
Rogombe bryan