Tri de chaîne dans l'ordre strict Ascii

Sujet: Tri de chaîne dans l'ordre strict Ascii Lun 14 Nov 2011 - 17:00

On a vu par ailleurs (voir le post de Nardo: mise en forme de source) que les algorithmes de tri standard prennent des libertés avec la valeur Ascii des caractères, par exemple mélangent les majuscules et les minuscules (case insensible) et classent les caractères spéciaux, ponctuation, etc d'une manière un peu imprévisible.

C'est sûrement justifié dans la grande majorité des cas (sinon ça se saurait !), mais parfois on peut avoir besoin d'un classement rigoureux selon la valeur Ascii des caractères.

J'ai évoqué ailleurs une solution qui consiste à traduire chaque chaîne en équivalent hexadécimal des caractères, auquel cas on se retrouve avec des chaînes qui ne contiennent que les caractères 0 à 9 et A à F, on leur applique alors une méthode de tri standard (ex. SORT de Panoramic), puis on reconvertit le résultat en caractères normaux, et le tour est joué.
Inconvénient: le traitement de conversion en hexa et inverse est assez long, proportionnel à la taille du fichier.

Une autre solution que j'ai trouvé est d'utiliser un script vbs de tri, incorporé au programme Panoramic (j'aime bien), c'est un peu plus rapide (2 à 3 fois).

Je vous soumets les deux solutions, à choisir.
C'est évidemment à n'utiliser que si on a besoin d'un tri strictement dans l'ordre Ascii, le tri standard étant infiniment plus rapide (d'un autre côté ce n'est pas trop gênant, un tri ne s'effectuant généralement qu'une seule fois dans un programme).

Code:: DIM a$, h$, i%, j%, f1$, f2$, t1, t2
DIM scr$, script$: scr$ = "Tri.vbs"
LABEL Trih, Trivbs

DATA "Tri.vbs"
DATA "Option Explicit"
DATA "' Tri de chaînes dans l'ordre des valeurs Ascii"
DATA "' Paramètres: fichieràtrier fichierrésultat"
DATA "' (peuvent être identiques)"
DATA "Dim objFso, objTextFile"
DATA "Dim arrLines "
DATA "Dim bpermute, cprovisoire, i, j"
DATA "Dim MyFile, MySortedFile"
DATA "MyFile = wscript.Arguments(0)"
DATA "MySortedFile = wscript.Arguments(1) "
DATA ""
DATA "Set objFso = CreateObject("+CHR$(34)+"Scripting.FileSystemObject"+CHR$(34)+")"
DATA "Set objTextFile = objFso.OpenTextFile(MyFile, 1)"
DATA "arrLines = Split(objTextFile.ReadAll,vbCrLf)"
DATA "objTextFile.Close "
DATA ""
DATA "bpermute = True"
DATA "Do While bpermute = True "
DATA " bpermute = False "
DATA " For i = UBound(arrLines) To 1 Step -1 "
DATA " If Len(arrLines(i)) > 1 Then"
DATA " For j = 0 To i - 1 "
DATA " If Len(arrLines(j)) > 1 Then"
DATA " If Split(arrLines(j), Chr(44))(0) > _"
DATA " Split(arrLines(j + 1), Chr(44))(0) Then "
DATA " cprovisoire = arrLines(j) "
DATA " arrLines(j) = arrLines(j + 1) "
DATA " arrLines(j + 1) = cprovisoire "
DATA " bpermute = True "
DATA " End If"
DATA " End If "
DATA " Next "
DATA " End If "
DATA " Next "
DATA "Loop"
DATA "'Write File"
DATA "Set objTextFile = objFso.CreateTextFile(MySortedFile, 2)"
DATA "For i = 0 To UBound(arrLines) "
DATA " objTextFile.WriteLine arrLines(i)"
DATA "Next"
DATA "objTextFile.Close"
DATA "Set objTextFile = Nothing"
DATA "Set objFso = Nothing"
DATA "f"
READ script$
WHILE script$ <> scr$: READ script$: END_WHILE: ' rephasage sur les datas
FILE_OPEN_WRITE 9, "C:\Temp\" + scr$
READ script$
WHILE script$ <> "f"
FILE_WRITELN 9, script$: READ script$
END_WHILE
FILE_CLOSE 9
script$ = "C:\Temp\" + scr$: ' script à exécuter

HEIGHT 0, 900: WIDTH 0, 840
LIST 1: HEIGHT 1, 800: WIDTH 1, 400
DLIST 2
LIST 3: HEIGHT 3, 800: LEFT 3, 410: WIDTH 3, 400

f1$ = "C:\Temp\Test.txt": ' ***** Fichier à trier
f2$ = "C:\Temp\FTrie.txt": ' ***** Fichier résultat

FILE_LOAD 1, f1$
t1 = VAL(RIGHT$(TIME$,2))+60*VAL(MID$(TIME$,4,2))+3600*VAL(LEFT$(TIME$,2))
' GOSUB Trih: ' tri par la méthode conversion hexa
GOSUB Trivbs: ' tri par la méthode script vbs
t2 = VAL(RIGHT$(TIME$,2))+60*VAL(MID$(TIME$,4,2))+3600*VAL(LEFT$(TIME$,2))
FILE_LOAD 3, f2$
MESSAGE "Durée= " + STR$(t2-t1) + " s."
END

Trih:
FILE_LOAD 1, f1$
FOR i% = 1 TO COUNT(1)
a$ = ITEM_READ$(1, i%): h$ = ""
FOR j% = 1 TO LEN(a$)
h$ = h$ + RIGHT$("0"+HEX$(ASC(MID$(a$, j%, 1))), 2)
NEXT j%
ITEM_ADD 2, h$
NEXT i%
SORT 2
FOR i% = 1 TO COUNT(2)
h$ = ITEM_READ$(2, i%): a$ = ""
FOR j% = 1 TO LEN(h$) STEP 2
a$ = a$ + CHR$(HEX(MID$(h$, j%, 2)))
NEXT j%
ITEM_ADD 3, a$
NEXT i%
FILE_SAVE 3, f2$
RETURN

Trivbs:
EXECUTE_WAIT "Wscript.exe " + script$ + " " + f1$ + " " + f2$
RETURN

» [Truc&Astuce]Lire une chaine dans la base de registre
» pb d'affichage de quote dans une chaine
» Rechercher une chaîne de caractère dans un fichier.
» Recherche d'une chaîne de caractères dans une arborescence
» Recherche d'une chaîne dans tous les fichiers d'un dossier