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

patricktoulon · 17 Octobre 2023

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

patricktoulon · 18 Octobre 2023

allez version finale

RyuAutodidacte · 10 Novembre 2023

Donc conclusion :
trier des ensembles restreins quasi identiques avec un pré tri permet d’accélérer énormément les tris de faibles niveaux et lent qui sont plus accessibles aux utilisateurs lambdas

RyuAutodidacte · 10 Novembre 2023

Alors c’est pas beau ça Patrick
Tu kiffe ?

RyuAutodidacte · 10 Novembre 2023

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

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

patricktoulon · 10 Novembre 2023

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 ?

RyuAutodidacte · 10 Novembre 2023

Chez moi avec Macbook pro M1 :

avec mon code tel qu'il est sans le modifier

RyuAutodidacte · 10 Novembre 2023

Re, avec la der maj sur Macbook pro M1 :

patricktoulon · 10 Novembre 2023

tes 3 derniers 0.60/0.8/0 chez moi
celui d'huier 0.40/0.45 environ
et chez toi 0.40/0.39
le choix est vite fait à 5 centièmes de seconde je garde celui d'hier qui est a peu près constant sur Mac et Win

patricktoulon · 10 Novembre 2023

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

mapomme · 10 Novembre 2023

Bonjour aux TRIfouillEURS ,

Juste pour vous saluer très amicalement ...

RyuAutodidacte · 10 Novembre 2023

patricktoulon à dit:
mais c'est une belle performence et c'est tout nouveau tout beau

oui les tris lents sont moins à la traine comme ça
qd on passe de 7 - 8 secondes à 0,40 c'est vraiment énorme !!!

RyuAutodidacte · 10 Novembre 2023

Re tous,

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

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

patricktoulon · 10 Novembre 2023

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 !!!

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

RyuAutodidacte · 10 Novembre 2023

je parlais de ces là non hybride :

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

patricktoulon · 10 Novembre 2023

avec la partie temp je te l'ai dis je suis 0.70/0.80
je les ai testé toutes les 3
celle de hier reste ta meilleure

Dranreb · 10 Novembre 2023

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).

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

patricktoulon

XLDnaute Barbatruc

Pièces jointes

patricktoulon

RyuAutodidacte

XLDnaute Impliqué

RyuAutodidacte

XLDnaute Impliqué

RyuAutodidacte

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc

RyuAutodidacte

XLDnaute Impliqué

RyuAutodidacte

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

RyuAutodidacte

XLDnaute Impliqué

RyuAutodidacte

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc

RyuAutodidacte

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc