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
» Un prg Panoramic s'abime avec le temps
par papydall Aujourd'hui à 3:14

» Planétarium virtuel.
par Pedro Alvarez Hier à 16:58

» Dessin 2D: largeur de trait (résolu !)
par Jicehel Hier à 15:16

» Promenade dans le Ciel
par papydall Hier à 3:13

» PanExpress : l'éditeur Panoramic avec création d'objet
par Minibug Sam 23 Juin 2018 - 17:00

» Nouvelle version 0.34
par jean_debord Sam 23 Juin 2018 - 9:39

» Quantité de mémoire utilisée par un exe
par mindstorm Jeu 21 Juin 2018 - 21:22

» Projet de planétarium virtuel.
par Jean Claude Jeu 21 Juin 2018 - 19:02

» Animation: Feux de signalisation
par Minibug Mer 20 Juin 2018 - 20:28

» Problème avec 'file_load'.
par Pedro Alvarez Lun 18 Juin 2018 - 8:12

» Version instantanée V 0.9.28i20 du 13/06/2018
par jjn4 Sam 16 Juin 2018 - 14:25

» string$(0,chr$(32)) sans erreur
par silverman Ven 15 Juin 2018 - 19:56

» Version instantanée V 0.9.28i19 du 13/06/2018
par Minibug Ven 15 Juin 2018 - 19:14

» Mes souhaits d'amélioration de Panoramic.
par Pedro Alvarez Jeu 14 Juin 2018 - 20:17

» [RÉSOLU] Message d'erreur impossible à indentifier
par Minibug Mer 13 Juin 2018 - 20:52

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

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

Partagez | 
 

 majuscule rapide

Aller en bas 
AuteurMessage
silverman

avatar

Nombre de messages : 645
Age : 46
Localisation : Picardie
Date d'inscription : 18/03/2015

MessageSujet: majuscule rapide   Lun 19 Sep 2016 - 14: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
Revenir en haut 
Page 1 sur 1
 Sujets similaires
-
» G2R : Google Recherche Rapide
» Rendre un train rapide prioritaire
» Itinéraire rapide
» Le meilleur choix entre plus de mémoire ou moins mais plus rapide ?
» TUTO/AIDE REGLAGE PARAMETRE RENDU ARTLANTIS V5 ET PP SUR RAPIDE CAMERA RAW

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: