Problème de comparaison de chaînes.

Sujet: Problème de comparaison de chaînes. Mar 8 Jan 2013 - 20:41

Bonsoir.

A l'attention de Klaus.

Le résultat de la comparaison des 2 chaînes indique que la 1ère chaîne est inférieure à la seconde !!

Merci de ton aide.

Code:: a$="chat (m) = Chat (m)"
b$="base = Sockel (m) [d'une statue] [sens: pied]"

comparer(a$,b$)

sub comparer(param1$,param2$)

' Cette fonction compare deux chaînes de caractères. La comparaison est faite caractère par caractère,
' respectant la casse et les accentués, selon la valeur ASCII des caractères. Pour deux strings identiques
' par ailleurs, mais dont un est plus long, c'est le plus long qui sera plus grand que le plus court.
' res%<0 ==> string 1 < string2
' res%=0 ==> string 1 = string2
' res%>0 ==> string 1 > string2

res% = dll_call2("CompareStrA",adr(param1$),adr(param2$))
' message param1$+"*"+param2$+"*"+str$(res%)
end_sub

Sujet: Re: Problème de comparaison de chaînes. Mar 8 Jan 2013 - 22:06

Bonsoir Pan59,
J'ai fait quelques petites fonctions qui peuvent peut être t'aider:
A sauvegarder sous le nom : LibStr.bas
il ne te reste plus qu'a faire un include de ce fichier pour pouvoir utiliser les fonctions...
Wink

Code:: ' *************************************************************************************************************************
' FONCTIONS/PROCEDURES CHAINE DE CARACTERES
' LIBRAIRIE: LibStr.bas
' AUTEUR : Nardo26 18/09/12
' MODIF : 25/09/12 Maj syntaxe
'
' REFS : Divers PHP,PERL,C,etc...
'
' LISTE DES FONCTIONS/PROCEDURES:
'
' RInstr%(S1$, S2$) Renvoie la position du 1er caractère de S2 dans S1 en partant de la droite
' StrPad$(S1$,L%, S2$, F%) Complète la chaîne S1 avec les caractères prédéfinis dans S2 pour une longueur totale L%
' StrReplace$(S1$, S2$, S3$) Remplace la chaine S2 dans S1 par la chaine S3
' StrSplit$(S1$, S2$) Découpe en 2 partie la chaine S1 à partir du séparateur S2$
' StrCount%(S1$, S2$) Comptage de l'occurrence du texte S2 dans la chaine S1
' StrCmp%(S1$, S2$, case%) Comparaison de 2 chaines de caractères
' StripAccent$(S1$) Enlève les accents de la chaine de caractères S1
' UCFirst$(S1$) Met la 1ere lettre de S1 en MAJUSCULE, le reste en minuscules.
' UCWord$(S1$) Met la 1ere lettre de chaque mot de S1 en MAJUSCULE le reste en minuscule
' *************************************************************************************************************************
DIM strLib_version : strLib_version = 101
LABEL StrEndLib
GOTO StrEndLib

' ------------------------------------------------------------------------------
' EXPLODE(S1,S2,liste)
' @info Retourne une liste de chaînes, chacune d'elle étant une sous-chaîne du paramètre S2 extraite en utilisant le séparateur S1
' @param S1 séparateur
' @param S2 Chaine de caractère
' @param Liste N° de la liste de retour
' @@@@
' ------------------------------------------------------------------------------
SUB EXPLODE(delimiter$,chaine$,liste%)
WHILE INSTR(chaine$,delimiter$)<>0
ITEM_ADD liste%,LEFT$(chaine$,INSTR(chaine$,delimiter$)-1)
chaine$=RIGHT$(chaine$,LEN(chaine$)-INSTR(chaine$,delimiter$))
END_WHILE
ITEM_ADD liste%,chaine$
END_SUB

' ------------------------------------------------------------------------------
' StrCmp%(S1,S2,I)
' @info Comparaison de 2 chaines de caractères
' @param S1 Chaine de caractères
' @param S2 Chaine de caractères
' @param I 1:Ignore majuscule/minuscule
' @return StrCmp_return% -1:inf, 0:egal, 1:sup
' @@@@
' ------------------------------------------------------------------------------
SUB StrCmp%(S1$,S2$,I%)
IF VARIABLE("StrCmp_return%")=0 THEN DIM StrCmp_return%
IF I% = 1 THEN S1$ = UPPER$(S1$) : S2$ = UPPER$(S2$)
IF S1$ = S2$
StrCmp_return%=0
ELSE
StrObjectId%(): DLIST StrObjectId_return%
ITEM_ADD StrObjectId_return%, S1$
ITEM_ADD StrObjectId_return%, S2$
SORT_ON StrObjectId_return%
IF (S1$ = ITEM_READ$(StrObjectId_return%,1)) : StrCmp_return% = -1:ELSE: StrCmp_return% = 1:END_IF
DELETE StrObjectId_return%
END_IF
END_SUB
' ------------------------------------------------------------------------------
' StrCount%(S1,S2)
' @info Comptage du nb de fois qu'il y a S2 dans S1
' @param S1 Chaine de caractères
' @param S2 Chaine de caractères
' @return StrCount_return%
' @exemple
' StrCount%("abcABCaBCabc", "abc"):PRINT StrCount_return%: ' affiche 2
' StrCount(LOWER$("abcABCaBCabc"), "abc"):PRINT StrCount_return%: ' affiche 4
' @@@@
' ------------------------------------------------------------------------------
SUB StrCount%(S1$,S2$)
IF VARIABLE("StrCount_return%")=0 THEN DIM StrCount_return%
DIM_LOCAL i%:i%=0
WHILE INSTR(S1$,S2$)<>0
S1$ = MID$(S1$,INSTR(S1$,S2$)+LEN(S2$),200)
i% = i% + 1
END_WHILE
StrCount_return% = i%
END_SUB

' ------------------------------------------------------------------------------
' StrReplace$(S1,S2,S3)
' @info Remplace une chaine par une autre
' @param S1 chaine à modifier
' @param S2 chaine à remplacer
' @param S3 chaine de remplacement
' @return StrReplace_return$
' @@@@
' ------------------------------------------------------------------------------
SUB StrReplace$(S1$,S2$,S3$)
IF VARIABLE("StrReplace_return$")=0 THEN DIM StrReplace_return$
WHILE INSTR(S1$,S2$) <> 0
StrSplit$(S1$,S2$)
S1$ = StrSplit_return$(0) + S3$ + StrSplit_return$(1)
END_WHILE
StrReplace_return$ = S1$
END_SUB

' ------------------------------------------------------------------------------
' Rinstr%(S1, S2)
' @info Renvoie la position de S2 dans la chaine de caractere S1 en partant de la droite
' @param S1$ Chaine de caractères
' @param S2$ Chaine de caractères
' @return Rinstr_return%
'
' @exemple
' DIM EMail$ : EMail$ = "nardo.26@truc.fr";
' PRINT INSTR(EMail$ , ".") :' affiche 6
' RINSTR(EMail$ , ".") : PRINT Rinstr_return% : ' affiche 14
' @@@@
' ------------------------------------------------------------------------------
SUB RINSTR%(S1$,S2$)
IF VARIABLE("Rinstr_return%")=0 THEN DIM Rinstr_return%
DIM_LOCAL i%:i%=0
IF INSTR(S1$,S2$)<>0
FOR i%=LEN(S1$) TO 1 STEP -1
IF INSTR(RIGHT$(S1$,LEN(S1$)-i%+1),S2$)<> 0 THEN EXIT_FOR
NEXT i%
END_IF
Rinstr_return% = i%
END_SUB

' ------------------------------------------------------------------------------
' StrPad$(S1,L,S2,F)
' @info Complète la chaîne de caractères S1 avec un ou plusieurs caractères prédéfinis dans S2
' @param S1 La chaine de caractères à compléter
' @param L Longueur de la chaine finale
' @param S2 Chaine ou caractère de remplissage
' @param F 0:remplissage à gauche, 1:remplissage à droite
' @return StrPad_return$
' @exemple
' REM 11111111112
' REM 12345678901234567890
' REM --------------------
' StrPad$("Nardo26", 20, "-._", 0) :' -._-._-._-._-Nardo26
' strPad$("Nardo26", 20, "-._", 1) :' Nardo26-._-._-._-._-
' @@@@
' ------------------------------------------------------------------------------
SUB StrPad$(S1$,L%,S2$,F%)
IF VARIABLE("StrPad_return$")=0 THEN DIM StrPad_return$
DIM_LOCAL S3$ : S3$ = ""
WHILE LEN(S3$) < L% : S3$ = S3$ + S2$ : END_WHILE
IF F%=0
S3$ = LEFT$(S3$, L% - LEN(S1$)) + S1$
ELSE
S3$ = S1$ + LEFT$(S3$, L% - LEN(S1$))
END_IF
StrPad_return$ = S3$
END_SUB

' ------------------------------------------------------------------------------
' StrSplit$(S1,S2)
' @info Décompose en 2 la chaine de caractères S1 à partir du caractère S2
' @param S1 Chaine de caractères à découper
' @param S2 Caractère ou chaine de séparation
' @return StrPlit_return$(2) (tableau de 2 éléments)
' @@@@
' ------------------------------------------------------------------------------
SUB StrSplit$(S1$,S2$)
IF VARIABLE("StrSplit_return$")=0 THEN DIM StrSplit_return$(2)
IF INSTR(S1$,S2$)<>0
StrSplit_return$(0) = LEFT$(S1$,INSTR(S1$,S2$)-1)
StrSplit_return$(1) = RIGHT$(S1$,LEN(S1$)-LEN(StrSplit_return$(0))-LEN(S2$))
END_IF
END_SUB

' ------------------------------------------------------------------------------
' UCFirst$(S1)
' @info Met la 1ère lettre de la chaîne S1 en Majuscule, le reste en minuscule.
' @param S1 Chaine de caractères
' @return UCFirst_return$
' @exemple
' UCFirst$("salut tout le monde. ca va ?")
' PRINT UCFirst_return$ : REM affiche "Salut tout le monde. ca va ?"
' @@@@
' ------------------------------------------------------------------------------
SUB UCFirst$(S1$)
IF VARIABLE("UCFirst_return$")=0 THEN DIM UCFirst_return$
UCFirst_return$ = UPPER$(LEFT$(S1$,1)) + LOWER$(RIGHT$(S1$,LEN(S1$)-1))
END_SUB

' ------------------------------------------------------------------------------
' UCWord$(S1)
' @info Met la première lettre de chaque mot d'une chaîne en Majuscule.
' @param S1 Chaine de caractères
' @return UCWord_return$
' @exemple
' UCWord$("salut tout le monde")
' PRINT UCWord_return$ : REM Résultat : "Salut Tout Le Monde"
' @@@@
' ------------------------------------------------------------------------------
SUB UCWord$(S1$)
IF VARIABLE("UCWord_return$")=0 THEN DIM UCWord_return$
DIM_LOCAL S2$: S2$=""
UCFirst$(S1$) : S1$ = UCFirst_return$
WHILE INSTR(S1$," ")<>0
StrSplit$(S1$," "): UCFirst$(StrSplit_return$(0))
S2$ = S2$ + UCFirst_return$ + " "
UCFirst$(StrSplit_return$(1)) : S1$ = UCFirst_return$
END_WHILE
S2$ = S2$ + S1$
UCWord_return$ = S2$
END_SUB

' ------------------------------------------------------------------------------
' StripAccent$(S1)
' @info Supprime les accents dans une chaine de caractères
' @param S1 Chaine de caractères
' @return StripAccent_return$
' @exemple : "chaîne de caractères" -> "chaine de caracteres"
' @@@@
' ------------------------------------------------------------------------------
SUB StripAccent$(S1$)
IF Variable("StripAccent_return$")=0 THEN DIM StripAccent_return$
DIM_LOCAL i%,j%
DIM strAccent$(2):strAccent$(0)="àèéêëîôù":strAccent$(1)="aeeeeiou"
StripAccent_return$=""
FOR i%=1 TO LEN(S1$)
j% = INSTR(strAccent$(0),MID$(S1$,i%,1))
IF j%=0
StripAccent_return$ = StripAccent_return$+MID$(S1$,i%,1)
ELSE
StripAccent_return$ = StripAccent_return$+MID$(strAccent$(1),j%,1)
END_IF
NEXT i%
FREE strAccent$
END_SUB

' ------------------------------------------------------------------------------
' Procédure interne pour fonctionnement de la librairie
' Renvoie un numéro d'objet libre
' ------------------------------------------------------------------------------
SUB StrObjectId%()
IF VARIABLE("StrObjectId_return%")=0 THEN DIM StrObjectId_return%
StrObjectId_return% = 1
WHILE OBJECT_EXISTS(StrObjectId_return%) = 1 : StrObjectId_return% = StrObjectId_return% + 1 : END_WHILE
END_SUB
StrEndLib:

Sujet: Re: Problème de comparaison de chaînes. Mar 8 Jan 2013 - 22:56

Avec toutes les excuses, Pan59 ! C'était bien un bug, et il est corrigé. Recharge KGF.dll de MyDrive dossier DLLs !

Sujet: Problème de comparaison de chaînes. Mer 9 Jan 2013 - 10:14

Bonjour.

Merci Klaus pour la modification de la DLL.

Cependant, la fonction de comparaison de chaînes ne fonctionne pas normalement, ou alors, c'est moi qui ait omis quelque chose dans mon programme.

Quelquefois, une chaîne est bien trouvée dans le dico, d'autres fois, non !!

La chaîne a$ ci-dessous n'est pas trouvée, alors que la chaîne "Chat (m) " est bien trouvée !

Peut-être devrais-je t'envoyer mon dico allemand par mail ?

Merci de ton aide.

Code:: dlist 1

file_load 1,"c:\perso\traducteur_panoramic\dico_français_allemand.txt"

dll_on "kgf.dll"

Dim N%, true%
true%=1
Dim T$(175000)
Dim Inf%, Sup%, Milieu%
Dim longueur%,Reponse%, res%
Dim i%,xx%
Dim A$,b$,c$,separateur$
separateur$=chr$(61)

a$="recours en matière d'amende "+separateur$
longueur%=len(a$)

N%=count(1)
Inf%=1
Sup%=N%

while true%=1

a$="recours en matière d'amende "+separateur$
longueur%=len(a$)

if inf%>Sup%
Reponse%=-1

exit_while
end_if
Milieu%=int((Inf%+Sup%)/2)

b$=item_read$(1,milieu%)
xx%=instr(b$,separateur$)
b$=trim$(left$(b$,xx%-1))+" "+separateur$

If lower$(a$)=lower$(left$(b$,longueur%))
Reponse%=Milieu%
exit_while
end_if

comparer(lower$(a$),lower$(left$(b$,longueur%)))
print lower$(a$)+" * "+lower$(left$(b$,longueur%))+" * "+str$(res%)
if res%=0 then exit_while
If res%<0 then Sup%=Milieu%-1
If res%>0 then Inf%=Milieu%+1
end_while

dll_off

if res%=0
if sup%<>inf% then reponse%=int((Inf%+Sup%)/2)
end_if

print str$(Reponse%)+"*"+str$(inf%)+"*"+str$(sup%)
' terminate

end

sub comparer(param1$,param2$)

' Cette fonction compare deux chaînes de caractères. La comparaison est faite caractère par caractère,
' respectant la casse et les accentués, selon la valeur ASCII des caractères. Pour deux strings identiques
' par ailleurs, mais dont un est plus long, c'est le plus long qui sera plus grand que le plus court.
' res%<0 ==> string 1 < string2
' res%=0 ==> string 1 = string2
' res%>0 ==> string 1 > string2

res% = dll_call2("CompareStrA",adr(param1$),adr(param2$))
' message param1$+"*"+param2$+"*"+str$(res%)
end_sub

Sujet: Re: Problème de comparaison de chaînes. Mer 9 Jan 2013 - 13:33

Je serai chez moi ce soir, et je pourrai regarder cela à ce moment. Effectivement, il faudrait ton dictionnaire (ou du moins un extrait contenant la chaîne à chercher). Le plus simple serait de le uploader dans un service d'hébergement et de m'envoyer le lien par messagerie. Ainsi, je le télé-chargerai et testerai.

Je suppose que l'objet 1 est une DLIST ?

Sujet: Problème de comparaison de chaînes. Mer 9 Jan 2013 - 17:16

Bonjour.

Mon dictionnaire est téléchargeable sur mon site, à l'adresse suivante:

Et l'objet est bien un Dlist.

http://perso.numericable.fr/noipierr/exe/dico_francais_allemand.txt

Sujet: Re: Problème de comparaison de chaînes. Mer 9 Jan 2013 - 18:58

OK, j'ai téléchargé, et je vais voir ça.

Sujet: Re: Problème de comparaison de chaînes. Mer 9 Jan 2013 - 19:26

J'ai trouvé:

Le problème vient du fait que tu n'as pas entièrement trié ton dictionnaire. Les lignes 135044 à 135055 par exemple, contiennent des lignes commençant par "ré" alors que devant et derrière, ça commence par "re". Ce n'est pas normal. Un peu plus loin, tu as d'autres "ré", puis des "rê", suivis de "re". Pas étonnant que la dichotomie ne marche pas.

Il faut trier ton dictionnaire, ou faire DIM 1,DLIST : SORT_ON 1

Sujet: problème de comparaison de chaînes. Mer 9 Jan 2013 - 20:00

Bonsoir.

J'ai corrigé mon dictionnaire en omettant les lignes contenant des caractères incorrects, puis remis en ligne à la même adresse.

Une bizarrerie apparaît cependant.

Lorsque j'ajoute la ligne SORT_ON 1, le résultat n'est pas correct.
Par contre, sans cette ligne, le résultat, soit 27524 est correct !!

Pour l'édition du dictionnaire, j'utilise Context, et je trie bien comme il faut.

Code:: dlist 1
' SORT_ON 1

file_load 1,"c:\perso\traducteur_panoramic\dico_français_allemand.txt"

dll_on "kgf.dll"

Dim N%, true%
true%=1
Dim T$(175000)
Dim Inf%, Sup%, Milieu%
Dim longueur%,Reponse%, res%
Dim i%,kk%,xx%,x%,y%
Dim A$,b$,c$,e$,f$,separateur$
separateur$=chr$(61)

a$="chat (m) "+separateur$
longueur%=len(a$)

N%=count(1)
Inf%=1
Sup%=N%

while true%=1
if inf%>Sup%
Reponse%=-1
exit_while
end_if
Milieu%=int((Inf%+Sup%)/2)

b$=item_read$(1,milieu%)
xx%=instr(b$,separateur$)
b$=trim$(left$(b$,xx%-1))+" "+separateur$

If lower$(a$)=lower$(left$(b$,longueur%))
Reponse%=Milieu%
exit_while
end_if

comparer_bis(lower$(a$),lower$(b$))

if res%=0 then exit_while

If res%<0 then Sup%=Milieu%-1
If res%>0 then Inf%=Milieu%+1
end_while

dll_off

if res%=0
if sup%<>inf% then reponse%=int((Inf%+Sup%)/2)
end_if

print str$(Reponse%)+"*"+str$(inf%)+"*"+str$(sup%)
' terminate

end

sub comparer_bis(param1$,param2$)

if len(param2$)>len(param1$) then param1$=left$(param1$+string$(250," "),len(param2$))
if len(param1$)>len(param2$) then param2$=left$(param2$+string$(250," "),len(param1$))

' s' entendre à faire qc
if left$(param2$,3)="s' " then param2$="s'"+mid$(param2$,4,len(param2$))

longueur%=len(param1$)

for kk%=1 to longueur%
if param1$=param2$
res%=0
print param2$+" égale "+param1$
exit_for
end_if

e$=mid$(param1$,kk%,1)
f$=mid$(param2$,kk%,1)

if e$="à" or e$="â" or e$="ä" or e$="Ä" then e$="a"
if e$="ç" then e$="c"
if e$="é" or e$="è" or e$="ê" or e$="ë" then e$="e"
if e$="î" or e$="ï" then e$="i"
if e$="ô" or e$="ö" or e$="Ö" then e$="o"
if e$="ß" then e$="s"
if e$="û" or e$="ü" or e$="Ü" or e$="ù" then e$="u"

if f$="à" or f$="â" or f$="ä" or f$="Ä" then f$="a"
if f$="ç" then f$="c"
if f$="é" or f$="è" or f$="ê" or f$="ë" then f$="e"
if f$="î" or f$="ï" then f$="i"
if f$="ô" or f$="ö" or f$="Ö" then f$="o"
if f$="ß" then f$="s"
if f$="û" or f$="ü" or f$="Ü" or f$="ù" then f$="u"

x%=asc(e$)
y%=asc(f$)

if y%<>x% then exit_for
next kk%

if y%>x%
res%=-1
print "'"+param2$+"' plus grande que '"+param1$+"'"
end_if
if y%<x%
res%=1
print "'"+param2$+"' plus petite que '"+param1$+"'"
end_if
end_sub

sub comparer(param1$,param2$)

' Cette fonction compare deux chaînes de caractères. La comparaison est faite caractère par caractère,
' respectant la casse et les accentués, selon la valeur ASCII des caractères. Pour deux strings identiques
' par ailleurs, mais dont un est plus long, c'est le plus long qui sera plus grand que le plus court.
' res%<0 ==> string 1 < string2
' res%=0 ==> string 1 = string2
' res%>0 ==> string 1 > string2

res% = dll_call2("CompareStrA",adr(param1$),adr(param2$))
' message param1$+"*"+param2$+"*"+str$(res%)
end_sub

Sujet: Re: Problème de comparaison de chaînes. Mer 9 Jan 2013 - 20:45

Je vais voir ça.

Sujet: Re: Problème de comparaison de chaînes. Mer 9 Jan 2013 - 21:00

Exécute ce morceau de code:

Code:: dlist 1
SORT_ON 1

file_load 1,"dico_français_allemand.txt"
file_save 1,"dico_français_allemand_sort.txt"

end

avec évidemment tes chemins d'accès, et compare le résultat avec ce que tu as en entrée. Le tri de ton fichier en entrée n'est pas compatible avec la façon de trier de Panoramic, qui est basée sur le code Ascii.

Sujet: Re: Problème de comparaison de chaînes. Jeu 10 Jan 2013 - 8:27

Bonjour,

Sans vouloir relancer un vieux débat (voir ici)

L'ordre de tri de Panoramic n'est pas basé sur le poids ASCII des caractères...
Donc la procédure de comparaison de chaine de caractères de KGF.DLL n'est pas compatible avec l'ordre de tri réalisé par SORT_ON...

J'ai donné une solution dans mon avant-dernière intervention...

Sujet: Re: Problème de comparaison de chaînes. Jeu 10 Jan 2013 - 8:58

Tu as raison, Nardo26, au sujet du tri. Je me suis trompé avec ma suggestion de SORT. A oublier...

Sujet: Re: Problème de comparaison de chaînes. Jeu 10 Jan 2013 - 11:31

@Pan59:

Je suis revenu sur l'idée d'utiliser un LIST au lieu d'un DLIST. D'accord, le chargement initial est très long. Mais il est censé se faire au début du programme, puis on le garde en mémoire.

Si l'on fait ainsi, ra recherche est extrêmement rapide et se fait avec un sel appel de fonction DLL. Regarde la version ci-dessous. J'ai ajouté ma suggestion au début, tout en laissant le reste du code, même s'il ne sert plus dans ce cas de figure:

Code:: label chercher
Dim N%, true%
true%=1
Dim T$(175000)
Dim Inf%, Sup%, Milieu%
Dim longueur%,Reponse%, res%, index%
Dim i%,kk%,xx%,x%,y%
Dim A$,b$,c$,e$,f$,separateur$
separateur$=chr$(61)

' dlist 1 : ' SORT_ON 1
width 0,700

list 1 : width 1,600 : : height 1,170 : SORT_ON 1 : hide 1
edit 2 : top 2,200 : width 2,600 : hide 2
button 3 : top 3,200 : left 3,610 : hide 3
caption 3,"Chercher" : on_click 3,chercher
dll_on "kgf.dll"

print "Chargement du dictionnaire en cours..."
file_load 1,"dico_français_allemand.txt"
message "chargé"
show 1 : show 2 : show 3
end

chercher:

' a$="chat (m) "+separateur$
a$ = trim$(text$(2))+" "+separateur$

longueur%=len(a$)
index% = dll_call3("SearchListBox",handle(1),0,adr(a$))
message str$(index%)
if index%>0
res% = dll_call2("SelectListBoxItem",handle(1),index%)
else
res% = dll_call2("SelectListBoxItem",handle(1),0)
end_if
return

N%=count(1)
Inf%=1
Sup%=N%

while true%=1
if inf%>Sup%
Reponse%=-1
exit_while
end_if
Milieu%=int((Inf%+Sup%)/2)

b$=item_read$(1,milieu%)
xx%=instr(b$,separateur$)
b$=trim$(left$(b$,xx%-1))+" "+separateur$

If lower$(a$)=lower$(left$(b$,longueur%))
Reponse%=Milieu%
exit_while
end_if

comparer_bis(lower$(a$),lower$(b$))

if res%=0 then exit_while

If res%<0 then Sup%=Milieu%-1
If res%>0 then Inf%=Milieu%+1
end_while

dll_off

if res%=0
if sup%<>inf% then reponse%=int((Inf%+Sup%)/2)
end_if

print str$(Reponse%)+"*"+str$(inf%)+"*"+str$(sup%)
' terminate

end

sub comparer_bis(param1$,param2$)

if len(param2$)>len(param1$) then param1$=left$(param1$+string$(250," "),len(param2$))
if len(param1$)>len(param2$) then param2$=left$(param2$+string$(250," "),len(param1$))

' s' entendre à faire qc
if left$(param2$,3)="s' " then param2$="s'"+mid$(param2$,4,len(param2$))

longueur%=len(param1$)

if param1$=param2$
res%=0
print param2$+" égale "+param1$
exit_for
end_if

for kk%=1 to longueur%
e$=mid$(param1$,kk%,1)
f$=mid$(param2$,kk%,1)

if e$="à" or e$="â" or e$="ä" or e$="Ä" then e$="a"
if e$="ç" then e$="c"
if e$="é" or e$="è" or e$="ê" or e$="ë" then e$="e"
if e$="î" or e$="ï" then e$="i"
if e$="ô" or e$="ö" or e$="Ö" then e$="o"
if e$="ß" then e$="s"
if e$="û" or e$="ü" or e$="Ü" or e$="ù" then e$="u"

if f$="à" or f$="â" or f$="ä" or f$="Ä" then f$="a"
if f$="ç" then f$="c"
if f$="é" or f$="è" or f$="ê" or f$="ë" then f$="e"
if f$="î" or f$="ï" then f$="i"
if f$="ô" or f$="ö" or f$="Ö" then f$="o"
if f$="ß" then f$="s"
if f$="û" or f$="ü" or f$="Ü" or f$="ù" then f$="u"

x%=asc(e$)
y%=asc(f$)

if y%<>x% then exit_for
next kk%

if y%>x%
res%=-1
print "'"+param2$+"' plus grande que '"+param1$+"'"
end_if
if y%<x%
res%=1
print "'"+param2$+"' plus petite que '"+param1$+"'"
end_if
end_sub

sub comparer(param1$,param2$)

' Cette fonction compare deux chaînes de caractères. La comparaison est faite caractère par caractère,
' respectant la casse et les accentués, selon la valeur ASCII des caractères. Pour deux strings identiques
' par ailleurs, mais dont un est plus long, c'est le plus long qui sera plus grand que le plus court.
' res%<0 ==> string 1 < string2
' res%=0 ==> string 1 = string2
' res%>0 ==> string 1 > string2

res% = dll_call2("CompareStrA",adr(param1$),adr(param2$))
' message param1$+"*"+param2$+"*"+str$(res%)
end_sub

Le LIST est intentionnellement laissé visible - il faudrait le laisser cacher bien sûr, dans le programme réel. Chaque mot trouvé est "activé" comms si l'on avait cliqué dessus. Un mot non-trouvé décoche le dernier mot trouvé. La variable index% contient le numéro de ligne du mot trouvé.

Sujet: Problème de comparaison de chaînes. Jeu 10 Jan 2013 - 13:36

Bonjour Klaus.

Merci beaucoup de ton aide.

J'ai donc mis en pratique ta méthode préconisée.

Le chargement est très long au départ, mais ensuite la recherche est rapide.

Sujet: Re: Problème de comparaison de chaînes. Jeu 10 Jan 2013 - 15:37

J'ai fait un truc qui devrait résoudre complètement ton problème. On n'utilise plus, ni LIST, ni DLIST. On utilise un objet TStringList créé automatiquement par la DLL, et on l'utilise par des fonctions spécifiques:

Code:: res% = DLL_call0("CreateStringList")
res% = DLL_call1("LoadStringList",adr(fichier$))
res% = DLL_call0("DeleteStringList")
res% = DLL_call1("SearchStringList",adr(critere),adr(ligne$))
res% = DLL_call1("ReadStringList",index%,adr(ligne$))

Toutes ces fonctions retournent -1 en cas d'erreur.

Il faut lancer CreateStringList au début, pour réserver la liste en interne. En cas normal, la fonction retourne 0.

On utilise LoadStringList pour charger un fichier dans la liste interne. En cas normal, la fonction retourne le nombre de lignes chargées dans la table. Un second appel de cette fonction vide la liste éventuellement chargée auparavant, et charge le nouveau fichier dans la liste.

On utilise DeleteStringList pour libérer l'espace mémoire réservé par la liste. En cas normal, la fonction retourne 0.

On utilise SearchStringList pour chercher un critère dans la liste. La routine retourne l'indice de la ligne trouvée, ainsi que la ligne complète dans la variable ligne$. La recherche réussit si un enregistrement existe dans le fichier, dont le début est identique au critère passé. L'enregistrement trouvé est alors celui qui est le premier pour lequel ce critère est vrai.

On utilise ReadStringList pour lire une ligne dont l'indice est spécifié par le paramètre index%. La ligne est retournée dans la variable ligne$, et la fonction retourne index% comme valeur de retour. Il y a une erreur (retour de -1) si index%<1 ou index%<nombre total de lignes dans la table.

On peut utiliser ReadStringList après un SearchStringList en passant l'indexe retourné + 1 pour savoir s'il y a une autre ligne commençant avec le même critère.

Toutes ces fonctions sont ultra-rapides. Le chargement par LoadStringList est aussi rapide que le chargement dans une DLIST.

Je pense que tu as ici un compromis qui résoud tout: vitesse et gestion des accentués.

Voici le programme de démo adapté à ces fonctions:

Code:: label chercher
Dim N%, true%
true%=1
Dim T$(175000)
Dim Inf%, Sup%, Milieu%
Dim longueur%,Reponse%, res%, index%
Dim i%,kk%,xx%,x%,y%
Dim A$,b$,c$,e$,f$,separateur$
separateur$=chr$(61)

' dlist 1 : ' SORT_ON 1
width 0,700

edit 2 : top 2,200 : width 2,600 : hide 2
button 3 : top 3,200 : left 3,610 : hide 3
caption 3,"Chercher" : on_click 3,chercher
dll_on "kgf.dll"

print "Chargement du dictionnaire en cours..."

a$ = "dico_français_allemand.txt"
res% = dll_call0("CreateStringList")
res% = dll_call1("LoadStringList",adr(a$))
message "Dictionnaire: "+str$(res%)+" lignes"
show 2 : show 3
end

chercher:

' a$="chat (m) "+separateur$
a$ = trim$(text$(2))+" "+separateur$

longueur%=len(a$)
' index% = dll_call3("SearchListBox",handle(1),0,adr(a$))
b$ = string$(255," ")
index% = dll_call2("SearchStringList",adr(a$),adr(b$))
b$ = trim$(b$)
message str$(index%)+": "+b$
return

N%=count(1)
Inf%=1
Sup%=N%

while true%=1
if inf%>Sup%
Reponse%=-1
exit_while
end_if
Milieu%=int((Inf%+Sup%)/2)

b$=item_read$(1,milieu%)
xx%=instr(b$,separateur$)
b$=trim$(left$(b$,xx%-1))+" "+separateur$

If lower$(a$)=lower$(left$(b$,longueur%))
Reponse%=Milieu%
exit_while
end_if

comparer_bis(lower$(a$),lower$(b$))

if res%=0 then exit_while

If res%<0 then Sup%=Milieu%-1
If res%>0 then Inf%=Milieu%+1
end_while

dll_off

if res%=0
if sup%<>inf% then reponse%=int((Inf%+Sup%)/2)
end_if

print str$(Reponse%)+"*"+str$(inf%)+"*"+str$(sup%)
' terminate

end

sub comparer_bis(param1$,param2$)

if len(param2$)>len(param1$) then param1$=left$(param1$+string$(250," "),len(param2$))
if len(param1$)>len(param2$) then param2$=left$(param2$+string$(250," "),len(param1$))

' s' entendre à faire qc
if left$(param2$,3)="s' " then param2$="s'"+mid$(param2$,4,len(param2$))

longueur%=len(param1$)

if param1$=param2$
res%=0
print param2$+" égale "+param1$
exit_for
end_if

for kk%=1 to longueur%
e$=mid$(param1$,kk%,1)
f$=mid$(param2$,kk%,1)

if e$="à" or e$="â" or e$="ä" or e$="Ä" then e$="a"
if e$="ç" then e$="c"
if e$="é" or e$="è" or e$="ê" or e$="ë" then e$="e"
if e$="î" or e$="ï" then e$="i"
if e$="ô" or e$="ö" or e$="Ö" then e$="o"
if e$="ß" then e$="s"
if e$="û" or e$="ü" or e$="Ü" or e$="ù" then e$="u"

if f$="à" or f$="â" or f$="ä" or f$="Ä" then f$="a"
if f$="ç" then f$="c"
if f$="é" or f$="è" or f$="ê" or f$="ë" then f$="e"
if f$="î" or f$="ï" then f$="i"
if f$="ô" or f$="ö" or f$="Ö" then f$="o"
if f$="ß" then f$="s"
if f$="û" or f$="ü" or f$="Ü" or f$="ù" then f$="u"

x%=asc(e$)
y%=asc(f$)

if y%<>x% then exit_for
next kk%

if y%>x%
res%=-1
print "'"+param2$+"' plus grande que '"+param1$+"'"
end_if
if y%<x%
res%=1
print "'"+param2$+"' plus petite que '"+param1$+"'"
end_if
end_sub

sub comparer(param1$,param2$)

' Cette fonction compare deux chaînes de caractères. La comparaison est faite caractère par caractère,
' respectant la casse et les accentués, selon la valeur ASCII des caractères. Pour deux strings identiques
' par ailleurs, mais dont un est plus long, c'est le plus long qui sera plus grand que le plus court.
' res%<0 ==> string 1 < string2
' res%=0 ==> string 1 = string2
' res%>0 ==> string 1 > string2

res% = dll_call2("CompareStrA",adr(param1$),adr(param2$))
' message param1$+"*"+param2$+"*"+str$(res%)
end_sub

EDIT

j'ai noté quelques fautes d'orthographe erreurs de majuscules et quelques erreurs de traduction, pour le texte allemand. A l'occasion, je vais tenter de produire une version corrigée, mais avec ce nombre de lignes, ce sera un peu plus long que de produire ces quelques fonctions...

Sujet: Problème de comparaison de chaînes. Jeu 10 Jan 2013 - 15:44

Bonjour.

J'obtiens le message d'erreur suivant:

Not correct arithmetic expression: error in fonction ligne 22

Merci de ton aide.

Sujet: Re: Problème de comparaison de chaînes. Jeu 10 Jan 2013 - 15:59

Eh bien, ce sont de nouvelles fonctions de KGF.dll ! Recharge KGF.dll à partir de MyDrive dossier DLLs, et ça marchera !

Sujet: Re: Problème de comparaison de chaînes. Jeu 10 Jan 2013 - 17:45

Et voici une nouvelle version, cette fois plus "pérenne": elle permet de gérer entre 1 et 20 listes indépendantes de ce genre ! Pour cela, j'ai ajouté un premier paramètre à chacune de ces fonctions: N entre 1 et 20 représentant le numéro de la liste choisie. Voici le programme de démo, épuré et adapté pour fonctionner avec la liste 1:

Code:: label chercher, suivant
Dim res%, index%
Dim a$,b$, separateur$
separateur$=chr$(61)

width 0,700

edit 2 : top 2,200 : width 2,600 : hide 2
button 3 : top 3,200 : left 3,610 : hide 3
caption 3,"Chercher" : on_click 3,chercher
button 4 : top 4,230 : left 4,610 : hide 4
caption 4,"Chercher" : on_click 4,suivant

dll_on "kgf.dll"

print "Chargement du dictionnaire en cours..."

a$ = "dico_français_allemand.txt"
res% = dll_call1("CreateStringList",1)
res% = dll_call2("LoadStringList",1,adr(a$))
message "Dictionnaire: "+str$(res%)+" lignes"
show 2 : show 3 : show 4
end

chercher:
a$ = trim$(text$(2))+" "+separateur$
b$ = string$(255," ")
index% = dll_call3("SearchStringList",1,adr(a$),adr(b$))
b$ = trim$(b$)
message str$(index%)+": "+b$
return

suivant:
b$ = string$(255," ")
index% = dll_call3("ReadStringList",1,index%+1,adr(b$))
b$ = trim$(b$)
message str$(index%)+": "+b$
return

Et voici la nouvelle doc des fonctions concernées:

Code:: res% = DLL_call1("CreateStringList",N%)
res% = DLL_call2("LoadStringList",N%,adr(fichier$))
res% = DLL_call1("DeleteStringList",N%)
res% = DLL_call3("SearchStringList",N%,adr(critere),adr(ligne$))
res% = DLL_call3("ReadStringList",N%,index%,adr(ligne$))

Tu verras, chargement et recherche sont ultra-rapides, et avec 20 listes simultanées possibles, tu as de quoi faire !

Sujet: Problème de comparaison de chaînes. Jeu 10 Jan 2013 - 20:32

Bonsoir.

Désolé, mais la méthode ne fonctionne pas correctement.

Déjà, le programme indique que le fichier contient 173.070 lignes, alors qu'il en contient 173.852.

Et, lorsque je recherche "chat (m)", il m'indique la position 27.397, alors que le mot se trouve à la ligne 25.703.

Merci de ton aide à nouveau.

Sujet: Re: Problème de comparaison de chaînes. Jeu 10 Jan 2013 - 21:49

Bon? Cela venait du fait que tu avais des lignes identiques, à la casse près. Je n'avais pas fait attentiion ) cela. J'ai donc supprimé le contrôle de la casse et autorisé les doublons.

Mais il faut aussi que tu fasses quelque chose avec la dernière ligne du fichier qui contient simplement "fin". Je l'ai transformée en "ZZZfin", et ça marche. Tu peux aussi la retirer tout simplement.

Voici le programme de démo adapté, et il faut recharger KGF.dll:

Code:: label chercher, suivant, lire
Dim res%, index%
Dim a$,b$, separateur$
separateur$=chr$(61)

width 0,700

edit 2 : top 2,200 : width 2,600 : hide 2
button 3 : top 3,200 : left 3,610 : hide 3
caption 3,"Chercher" : on_click 3,chercher
button 4 : top 4,230 : left 4,610 : hide 4
caption 4,"Suivant" : on_click 4,suivant
button 5 : top 5,230 : left 5,150 : hide 5
caption 5,"Lire" : on_click 5,suivant
edit 6 : top 6,230 : width 6,120 : hide 6

dll_on "kgf.dll"

print "Chargement du dictionnaire en cours..."

a$ = "dico_français_allemand.txt"
res% = dll_call1("CreateStringList",1)
res% = dll_call2("LoadStringList",1,adr(a$))
message "Dictionnaire: "+str$(res%)+" lignes"
show 2 : show 3 : show 4 : show 5 : show 6
end

chercher:
a$ = trim$(text$(2))+" "+separateur$
b$ = string$(255," ")
index% = dll_call3("SearchStringList",1,adr(a$),adr(b$))
b$ = trim$(b$)
message str$(index%)+": "+b$
return

suivant:
b$ = string$(255," ")
index% = dll_call3("ReadStringList",1,index%+1,adr(b$))
b$ = trim$(b$)
message str$(index%)+": "+b$
return

lire:
index% = val(text$(6))
index% = dll_call3("ReadStringList",1,index%+1,adr(b$))
b$ = trim$(b$)
message str$(index%)+": "+b$
return

J'ai ajouté une zone de saisie pour saisir un indexe, et le bouton "Lire" pour lire spécifiquement cet enregistrement. Les indexes (numéros de ligne) se rapportent au fichier trié selon le critère interne. Si tu as un doute, donne le numéro de ligne que tu veux lire et appuie sur "Lire" pour voir ce qu'il y a à cet endroit.

Pour les anomalies en allemand, une info, à titre d'exemple: un mot commun allemand avec le diminutif "chen" à la fin ne prend jamais de t derrière: Dummchen et non Dummchent, contrairement à un adverbe qui se termine par chent comme entsprechent etc.

Sujet: Re: Problème de comparaison de chaînes. Jeu 10 Jan 2013 - 23:25

Pour info: ma revue des lignes 1 à 1000:

Citation :: à ce qu'on dit (v) = dem Vernehmen t nach geh (n) [ou d'après] [sens: prétendre>
==> à ce qu'on dit (v) = dem Vernehmen nach (n) [ou d'après] [sens: prétendre]

à éclipses phare à éclipses = Blinkfeuert (n)
==> à éclipses phare à éclipses = Blinkfeuer (n)

à gros poiss = mit großen Tupfen [ou Punkten]
==> à gros pois = mit großen Tupfen [ou Punkten]

à l'ordre de = an die Order von
==> à l'ordre de = zu Händen von jdn (courrier)

à l'outrance = bis zum Ã„ußersten (f) [sens: caractère excessif]
==> à l'outrance = bis zum Äußersten (f) [sens: caractère excessif]

à mon grand déplaisir (contrariété) = zu meinem großen Ã„rger
==> à mon grand déplaisir (contrariété) = zu meinem großen Ärger

à qui est ce livre ? â€“ C'est à lui/à moi = wem gehört das Buch? â€“ [Es gehört] ihm/mir [sens: pour désigner un pronom]
==> à qui est ce livre ? C'est à lui/à moi = wem gehört das Buch? [Es gehört] ihm/mir [sens: pour désigner un pronom]

Je continue, à mes moments perdus...

Sujet: Problème de comparaison de chaînes. Ven 11 Jan 2013 - 10:13

Bonjour.

J'ai remanié le dictionnaire en supprimant les doublons, et rechargé ensuite la DLL.

Voici la réponse du programme lorsque je recherche "chat (m)": 27.397 alors que l'élément se trouve à la ligne 25.576.

Merci de recharger le dictionnaire sur mon site à la même adresse que précédemment, et d'effectuer le même test.

Merci de ton aide.

Sujet: Re: Problème de comparaison de chaînes. Ven 11 Jan 2013 - 11:16

J'ai rechargé et je vais essayer.

%ai, comme j'ai dit ci-dessus, j'ai adapté le programme pour tenir compte des doublons. Cela marche sans problème.

Je vais vérifier quand-même, mais je suis certain que la différence de numérotation tient au fait que le fichier est trié automatiquement façon "Windows" par le composant TStringList utilisé de façon interne, et l'indexe fourni se rapporte évidemment à la position de la ligne dans la liste triée, et pas forcément à la position dans fe fichier d'origine.

As-tu essayé de prendre le boutin "Suivant" pour parcourir la liste, ligne par ligne, de sorte à comparer avec le contenu de ton fichier initial ? Je crois que tu vas constater que tu es au bon endroit. Mais je vais approfondir cela.

Sujet: Problème de comparaison de chaînes. Ven 11 Jan 2013 - 11:30

Bonjour Klaus.

Oui, je pense que l problème vient du tri.

J'ai essayé en lisant les éléments suivants à l'aide du bouton 'suivant' et la l'affichage des éléments suit bien le dictionnaire.

» Problème de comparaison de chaînes.
» Comparaison de chaînes.
» Comparaison des chaînes de caractères
» Problème avec select case Probleme réglé merci
» Comparaison de deux chaînes de caractères