FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC

Développement d'applications avec le langage Panoramic
 
AccueilAccueil  FAQFAQ  RechercherRechercher  S'enregistrerS'enregistrer  MembresMembres  GroupesGroupes  Connexion  
Derniers sujets
» Pourquoi le compilateur stagne
par papydall Hier à 23:23

» Immortaliser les photos de famille
par jjn4 Hier à 18:29

» Concours de Morpions
par jjn4 Hier à 18:11

» Compilateur FBPano
par jean_debord Hier à 10:12

» Tout est tranquille
par Jean Claude Ven 22 Sep 2017 - 21:41

» Texte en gif animé
par JL35 Ven 22 Sep 2017 - 13:29

» BasicEditor
par Yannick Mer 20 Sep 2017 - 17:17

» Simuler l’appui d'une touche ou combinaison de touches.
par pascal10000 Lun 18 Sep 2017 - 19:30

» Utilisation de HVIEWER pour afficher des images
par papydall Lun 18 Sep 2017 - 17:43

» Panoramic et les gifs animés.
par papydall Lun 18 Sep 2017 - 16:32

» recover source
par pascal10000 Dim 17 Sep 2017 - 14:21

» Recent dans vos menu
par Jean Claude Sam 16 Sep 2017 - 11:41

» Comment centrer un texte 3D.
par pascal10000 Ven 15 Sep 2017 - 20:20

» Carte interface 16 entrées et 16 sorties
par Jicehel Ven 15 Sep 2017 - 16:30

» Version instantanée V 0.9.28i9 possédant l'objet SYNEDIT
par pascal10000 Ven 15 Sep 2017 - 16:20

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Septembre 2017
LunMarMerJeuVenSamDim
    123
45678910
11121314151617
18192021222324
252627282930 
CalendrierCalendrier

Partagez | 
 

 majuscule rapide

Voir le sujet précédent Voir le sujet suivant Aller en bas 
AuteurMessage
silverman

avatar

Nombre de messages : 465
Age : 45
Localisation : Picardie
Date d'inscription : 19/03/2015

MessageSujet: majuscule rapide   Lun 19 Sep 2016 - 15:43

Bonjour à tous

Voici 3 algorithmes pour transformer une chaîne de caractère en majuscule. Par rapport au premier algorithme, le 2ème est ~8 fois plus rapide, et ~14 fois plus pour le trosième(sur mon PC). C'est 100% panoramic!
Je crois savoir que KGF peut effectuer cela, et qu'il existe un algorithme qui traine dans le forum, mais j'ai fait ça pour montrer d'autres façon de faire, cela sera peut être utile à quelqu'un. N'oublions pas que panoramic est lent, et qu'un peu d'optimisation ne peut que lui faire du bien!
La sub 'FAST_Uppercase(txt$)' est polyvalente, il suffit de remplacer 'upper$' par 'lower$' et d'inverser les 2 lignes de datas pour transformer une chaîne de caractère en sa version minuscule.
Code:
'
'
'   Silverman, septembre 2016
'
' 3 algorithmes de mise en majuscule d'une chaîne de caratère(du - rapide au + rapide)



label choix,test1,test2,test3
label VERY_FAST_Uppercase

dim choix%,result$,ch$,start%,tim%, nb_accent% , info$



full_space 0


' un bouton
button 1 : on_click 1,choix : hide 1


' un memo
memo 2
full_space 2
font_name 2,"dejavu sans mono"


' fabriquer une longue chaine
ch$="L'accent aigu : Cet accent n'est employé que sur le e     - Au début ou à l'intérieur d'un mot : le é se trouve uniquement en finale de syllabe     ex : cé/lé/bri/té     - En fin de mot le é est utilisé : soit en finale absolue : animé  soit devant e             : animée  soit devant s             : animés     L'accent grave : - sur le e C'est là son emploi principal. La règle générale est de mettre un accent grave sur le e que lorsqu'il est précédé d'une autre lettre et aussi suivi d'une syllabe qui comporte un e muet. Dans le cas contraire on met un accent aigu     Ex : une pièce ==> une piécette     - Sur le a     Dans ce cas l'accent permet de distinguer a (verbe avoir) de à (préposition)     - Sur le u     Dans ce cas l'accent permet de distinguer ou (conjonction de coordination) de où (pronom relatif)"
for start%=1 to 5
   ch$=ch$+ch$
next start%



' l'écrire dans le memo
text 2,ch$
COMPTE_ACCENT(ch$)
info$ = str$(len(ch$))+" caractères dont "+str$(nb_accent%)+" caractères accentués "
caption 0,info$


' Test des algorithmes

' test1
message "Premier test : algorithme classique dit 'naïf'"
choix%=1
trigger_click 1

' test2
message "Second test : algorithme optimisé"
text 2,ch$
choix%=2
trigger_click 1

' test3
message "Troisième test : algorithme optimisé + utilisation de la commande POKE"
text 2,ch$
choix%=3
trigger_click 1

' fini
message "Démo terminé!"
terminate


END
' ################################################## sous-routines et subs ##################################################
'
' choix
choix:
   select choix%
      case 1: gosub test1
      case 2: gosub test2
      case 3: gosub test3
   end_select
return


' conversions
test1:
   tim%=number_ticks
   ch$=text$(2)
   '
   Uppercase(ch$)
   '
   text 2,result$
   caption 0,info$+" : premier test réalisé en "+str$(number_ticks-tim%)+" millisecondes"
return


test2:
   tim%=number_ticks
   ch$=text$(2)
   '
   FAST_Uppercase(ch$)
   '
   text 2,result$
   caption 0,info$+" : second test réalisé en "+str$(number_ticks-tim%)+" millisecondes"
return


test3:
   tim%=number_ticks
   ch$=text$(2)
   '
   gosub VERY_FAST_Uppercase
   '
   text 2,result$
   caption 0,info$+" : troisième test réalisé en "+str$(number_ticks-tim%)+" millisecondes"
return


sub compte_accent(txt$)
' le résultat est retourné dans la variable globale 'nb_accent%'
   nb_accent% = 0
   '
   IF txt$<>""
      ' déclaration des variables
      dim_local max_char% , i% , lasti% , cpt% , newtxt$ , entre_2_accent$

      ' remplissage d'un tableau contenant les caractères à traiter(16 diacritiques et 2 ligatures)
      if variable("diacritique$") = 0
         dim_local i$
         '
         data "COMPTE_ACCENT:"
         data "é","à","è","ê","î","ç","â","ô","û","ù","œ","ï","ë","ü","ö","ä","æ","ÿ"
         data "É","À","È","Ê","Î","Ç","Â","Ô","Û","Ù","Œ","Ï","Ë","Ü","Ö","Ä","Æ","Ÿ"
         '
         data "END_OF_DATA"
         '
         ' compter les datas
         restore : repeat : read i$ : until i$="COMPTE_ACCENT:"   :' émule une commande inexistante : RESTORE_LABEL
         i%=0 : read newtxt$
         while newtxt$<>"END_OF_DATA"
            read newtxt$ : i%=i%+1
         end_while
         max_char% = i%
         '
         dim_local diacritique$(max_char%)
         '
         ' lecture des datas
         restore : repeat : read i$ : until i$="COMPTE_ACCENT:"   :' émule une commande inexistante : RESTORE_LABEL
         for i%=1 to max_char%
            read newtxt$
            diacritique$(i%) = newtxt$
         next i%
      end_if

      ' initialisation
      cpt% = 0

      ' traitement
      repeat
         cpt% = cpt% + 1
         i%=0
         repeat
            i% = instr_pos(txt$,diacritique$(cpt%),i%+1)
            if i%>0   :' si un caractère accentué est trouvé
               nb_accent%=nb_accent%+1
            end_if
         until i%=0
      until cpt%=max_char%   :' jusqu'à ce qu'il soient tous traités
      '
   END_IF
end_sub


' ################################################## TEST1 ##################################################
'
sub Uppercase(txt$)
  dim_local cup$, clow$, i%, l%, c%, t$
  if variable("UpperCase$")=0 then dim UpperCase$
  cup$ = "ÀÇÉÈÊÎÏÔÛ"
  clow$  = "àçéèêîïôû"
  UpperCase$ = upper$(txt$)   :' chaîne de travail
  l% = len(UpperCase$)
  if l%=0 then exit_sub
  ' lit les caractères de la chaîne, un par un
  for i%=1 to l%
    c% = instr(clow$,mid$(UpperCase$,i%,1))   :' si c'est un caractère accentué
    if c%>0
      if i%>1   :' si la chaîne contient plus d'un caratère
        t$ = left$(UpperCase$,i%-1)   :' récupère la partie gauche de la chaîne de travail sans le caractère accentué, et écrit là dans une chaîne temporaire
      else
        t$ = ""   :' sinon c'est déjà fini
      end_if
      t$ = t$ + mid$(cup$,c%,1)   :' ' ajoute le caracère version majuscule
      if i%<l% then t$ = t$ + mid$(UpperCase$,i%+1,len(UpperCase$))   :' puis la partie droite de la chaîne de travail
      UpperCase$ = t$   :' reconstruit la chaîne de travail
    end_if
  next i%   :' jusqu'à ce que tous les caractères aient été lu
  result$ = UpperCase$
end_sub


' ################################################## TEST2 ##################################################
'
sub FAST_Uppercase(txt$)
' le résultat est retourné dans la variable globale 'result$'
'
   IF txt$<>""
      ' déclaration des variables
      dim_local max_char% , i% , lasti% , cpt% , newtxt$ , entre_2_accent$

      ' remplissage d'un tableau contenant les caractères à traiter(16 diacritiques et 2 ligatures)
      if variable("diacritique$") = 0
         dim_local i$
         '
         data "TEST2:"
         '
         data "é","à","è","ê","î","ç","â","ô","û","ù","œ","ï","ë","ü","ö","ä","æ","ÿ"
         data "É","À","È","Ê","Î","Ç","Â","Ô","Û","Ù","Œ","Ï","Ë","Ü","Ö","Ä","Æ","Ÿ"
         '
         data "END_OF_DATA"
         '
         ' compter les datas
         restore : repeat : read i$ : until i$="TEST2:"   :' émule une commande inexistante : RESTORE_LABEL
         i%=0 : read newtxt$
         while newtxt$<>"END_OF_DATA"
            read newtxt$ : i%=i%+1
         end_while
         max_char% = i%
         '
         dim_local diacritique$(max_char%)
         '
         ' lecture des datas
         restore : repeat : read i$ : until i$="TEST2:"   :' émule une commande inexistante : RESTORE_LABEL
         for i%=1 to max_char%
            read newtxt$
            diacritique$(i%) = newtxt$
         next i%
         max_char% = (max_char%-1)/2
      end_if

      ' initialisation
      cpt% = 0

      ' traitement
      repeat
         lasti% = 0
         i%=0
         cpt% = cpt% + 1
         newtxt$ = ""   :' chaine temporaire
         repeat
            i% = instr_pos(txt$,diacritique$(cpt%),i%+1)
            if i%>0   :' si un caractère accentué est trouvé
               ' traitement d'un bug de panoramic
               if (i%-lasti%)>1   :' !!! ATTENTION !!! : le 3ème paramètre de la fonction mid$() = 0 si 2 accents consécutif trouvé ---> panoramic retourne une erreur mais ne devrait pas(bug!)
                  entre_2_accent$ = mid$(txt$,lasti%+1,i%-lasti%-1)
               else
                  entre_2_accent$ = ""
               end_if
               newtxt$ = newtxt$ + entre_2_accent$ + diacritique$(cpt%+18)   :' remplace le caratère par sa version majuscule
               lasti% = i%
            end_if
         until i%=0
         newtxt$ = newtxt$ + right$(txt$,len(txt$)-lasti%)   :' complète la chaine temporaire
         txt$ = newtxt$   :' réaffecte la chaine originale et passe au caractère accentué suivant
      until cpt%=max_char%   :' jusqu'à ce qu'il soient tous traités
   end_if

   ' résultat
   result$ = upper$(txt$)   :' maintenant que tous les caractères accentués sont en majuscules, on met le reste aussi en majuscule
   '
end_sub


' ################################################## TEST3 ##################################################
'
VERY_FAST_Uppercase:
      ' préparation
      ' remplissage d'un tableau contenant les caractères à traiter(16 diacritiques et 2 ligatures)
      if variable("diacritique$") = 0
         dim max_char% , i% , txt$ , tmptxt$ , newtxt% , newtxt$ , cpt%
         tmptxt$=ch$
         '
         data "TEST3:"
         data "é","à","è","ê","î","ç","â","ô","û","ù","œ","ï","ë","ü","ö","ä","æ","ÿ"
         data 201,192,200,202,206,199,194,212,219,217,140,207,203,220,214,196,198,159
         '
         data "END_OF_DATA"
         '
         ' compter les datas
         RESTORE_LABEL("test3:")   :'   :-/   !!!
         i%=0 : read newtxt$
         while newtxt$<>"END_OF_DATA"
            read newtxt$ : i%=i%+1
         end_while
         max_char% = i%
         max_char% = max_char%/2
         '
         dim diacritique$(max_char%)
         dim diacritique%(max_char%)
         '
         ' lecture des datas : ligne 1
         RESTORE_LABEL("test3:")   :'   :-/   !!!
         for i%=1 to max_char%
            read txt$
            diacritique$(i%) = txt$
         next i%
         '
         ' lecture des datas : ligne 2
         for i%=1 to max_char%
            read newtxt%
            diacritique%(i%) = newtxt%
         next i%
      end_if

      ' initialisation
      tmptxt$ = upper$(tmptxt$)
      txt$ = tmptxt$
      '
      cpt% = 0
      i% = 0
      GET_STRING_PTR(adr(start%),adr(txt$))
      start%=start%-1

      ' traitement
      repeat
         cpt% = cpt% + 1
         i%=0
         repeat
            i% = instr_pos(txt$,diacritique$(cpt%),i%+1)
            if i%>0   :' si un caractère accentué est trouvé
               poke start%+i%,diacritique%(cpt%)   :' remplace le caratère par sa version majuscule
            end_if
         until i%=0
      until cpt%=max_char%   :' jusqu'à ce qu'il soient tous traités
      result$=tmptxt$

      ' libère les ressources
      free max_char%
      free i%
      free txt$
      free newtxt%
      free cpt%
      free tmptxt$
      free diacritique$
      free diacritique%
return


sub GET_STRING_PTR(adr_destination%,adr_source%)
' retrouve l'adresse du pointeur de chaîne
  poke adr_destination%,peek(adr_source%)
  poke adr_destination%+1,peek(adr_source%+1)
  poke adr_destination%+2,peek(adr_source%+2)
  poke adr_destination%+3,peek(adr_source%+3)
end_sub


sub restore_label(etiq$)
' émule une commande inexistante
 dim_local i$
   restore
   repeat
      read i$
   until lower$(i$)=lower$(etiq$)
end_sub
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
 
majuscule rapide
Voir le sujet précédent Voir le sujet suivant Revenir en haut 
Page 1 sur 1
 Sujets similaires
-
» G2R : Google Recherche Rapide
» Rendre un train rapide prioritaire
» Itinéraire rapide
» Navigation Rapide
» Connexion rapide

Permission de ce forum:Vous ne pouvez pas répondre aux sujets dans ce forum
FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC :: PANORAMIC :: Vos sources, vos utilitaires à partager-
Sauter vers: