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

RyuAutodidacte · 9 Novembre 2023

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 · 9 Novembre 2023

re
Bonjour
oui cette page web je l'ai enregistré en pdf c'est la dessus que je suis parti pour faire mon recueil
ryu:
chez moi c'est toujours 3:26 secondes
j'ai testé ton code tel quel

RyuAutodidacte · 9 Novembre 2023

Lequel y a 3 messages de tests de suite ?

patricktoulon · 9 Novembre 2023

re
non j'ai lancé la sub tout simplement sur 10 000 items

RyuAutodidacte · 9 Novembre 2023

Tu as testé les 2 autres ? Avec buble et insert (la 3ème étant le mélange des 2 , celle que tu a essayé)
Je suis dans les transports en commun, je re test pour voir si j’ai le même résultat

RyuAutodidacte · 9 Novembre 2023

Re Patrick,
j'ai même fais un peu mieux au 1er lancer ce matin :

RyuAutodidacte · 9 Novembre 2023

pour montrer que c'est pas truquer :

patricktoulon · 9 Novembre 2023

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

patricktoulon · 9 Novembre 2023

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 · 9 Novembre 2023

patricktoulon à dit:
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

patricktoulon · 9 Novembre 2023

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à ?

RyuAutodidacte · 9 Novembre 2023

patricktoulon à dit:
tu a du le modifier entre temps mais pas posté

Pourtant si regardes (ou il y a un bug alors … ??) :

c'est bien le post 331

patricktoulon · 9 Novembre 2023

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

patricktoulon · 9 Novembre 2023

bon le quicksort reste le plus rapide mais
tu es quand même au niveau de la fusion en terme de mecanique
et au niveau fusion et shelmetzner en terme de temps
là c'est @Dranreb qui va en rester baba

RyuAutodidacte · 9 Novembre 2023

patricktoulon à dit:
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

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

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Impliqué

XLDnaute Impliqué

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Impliqué

Partager cette page

Statistiques des forums