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
» Dessin 2D: largeur de trait (résolu !)
par papydall Aujourd'hui à 0:06

» Planétarium virtuel.
par Pedro Alvarez Hier à 19:50

» 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

» PanExpress : l'éditeur Panoramic avec création d'objet
par Jean Claude Mer 20 Juin 2018 - 20:32

» 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

» Cadre pour image
par Jean Claude Mar 12 Juin 2018 - 16:31

» Créateur d'objets Panoramic
par Minibug Mar 12 Juin 2018 - 14:02

» Planétarium gratuit.
par Jean Claude Sam 9 Juin 2018 - 18:50

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 | 
 

 Calcul d'expressions saisies sous forme de chaîne.

Aller en bas 
AuteurMessage
Pedro Alvarez

avatar

Nombre de messages : 1063
Date d'inscription : 19/01/2014

MessageSujet: Calcul d'expressions saisies sous forme de chaîne.   Jeu 20 Fév 2014 - 16:34

Bonjour.

Je soumets à la communauté Panoramic mon logiciel de calcul d'expressions mathématiques, saisies sous forme de chaîne.

Qu'en pensez-vous ?

Avis aux testeurs.

Code:
' Version du 20 fév 2014.

' http://fr.openclassrooms.com/forum/sujet/notation-polonaise-inverse-77040
' Transformation en NPI de l'expression à évaluer.

' Tant qu'il y a des tokens en entrée
' {
' 1. Examiner le token courant sur le fichier d'entrée.
' 2. Si c'est un opérande, le placer sur le fichier de sortie.
' 3. Si c'est une parenthèse ouvrante, la mettre sur la pile.
' 4. Si c'est un opérateur, alors:
' 5.
' 1. Si la pile est vide, pousser l'opérateur sur la pile
' 2. Si le sommet de la pile est une parenthèse ouvrante, pousser l'opérateur sur la pile.
' 3. Si l'opérateur est prioritaire sur celui au sommet de la pile, pousser l'opérateur sur la pile.
' 4. Sinon, enlever l'opérateur de la pile et le mettre sur le fichier de sortie. Replacer ensuite l'opérateur courant sur la pile.
' 6. Si c'est une parenthèse fermante, enlever les opérateurs de la pile et les placer sur le fichier de sortie jusqu'à ce que l'on rencontre la parenthèse ouvrante, que l'on élimine.
' }

' Enlever tous les opérateurs restants et les placer sur le fichier de sortie.

' Exemple: http://www.crlf.be/rpn01.html

dim a$, b$, c$, chaine$, expr$, fonction$, guillemet$, h$, liste_chiffres$, liste_fonctions$, liste_fonctions1$, liste_fonctions2$, liste_fonctions3$
dim param1, param2, param3, par_droite$, par_gauche$, resultat$, sauvegarde_chaine$, temporaire$
dim d%, false%, flag%, i%, kk%, n%, nb_par_gauche%, nb_par_droite%, nombre_fonctions%, nombre_memo%, nombre_parametres%, true%, y%
dim valeur, voir_message%

label calcul

guillemet$=chr$(34)
par_gauche$=chr$(40)
par_droite$=chr$(41)

true%=1
false%=0
nombre_memo%=27

voir_message%=false%

maximize 0

memo 201
  left 201,75
  top 201,50
  width 201,400
  height 201,30
  font_size 201,12
  font_bold 201
  font_color 201,255,0,255

memo 202
  left 202,75
  top 202,300
  width 202,105
  height 202,400
  font_size 202,12
  font_bold 202
  font_color 202,0,128,64

' Pile NPI.
memo 203
  left 203,185
  top 203,300
  width 203,105
  height 203,400
  font_size 203,12
  font_bold 203
  font_color 203,0,128,64

' Pour obtenir le focus sur le 1er caractère.
set_focus 201
item_insert 201,1,"":item_delete 201,1
caret_position 201,0

' Tokens.
for kk%=1 to nombre_memo%
    memo kk%
    left kk%,20+kk%*55
    top kk%,100
    width kk%,50
    height kk%,50
    font_size kk%,12
    font_color kk%,0,0,255
    bar_horizontal kk%
next kk%

' NPI.
for kk%=101 to 100+nombre_memo%
    memo kk%
    left kk%,20+(kk%-100)*55
    top kk%,160
    width kk%,50
    height kk%,50
    font_size kk%,12
    font_color kk%,0,0,255
    bar_horizontal kk%
next kk%

for kk%=301 to 300+nombre_memo%
    memo kk%
    left kk%,20+(kk%-300)*55
    top kk%,220
    width kk%,50
    height kk%,50
    font_size kk%,12
    font_color kk%,0,0,255
    bar_horizontal kk%
next kk%

button 99
  left 99,500
  top 99,400
  width 99,100
  height 99,30
  caption 99,"Calcul"
  on_click 99,calcul

liste_chiffres$="0123456789."

' Fonctions à 1, 2 ou 3 arguments.
liste_fonctions1$="#abs#acos#asin#atn#asc#chr$#cos#even#exp#frac#hcos#hex#hex$#hsin#htan#int#len#log#log2#log10#ower$#ltrim$#numeric#odd#rnd#rtrim$#sgn#sin#sqr#str$#tan#trim$#upper$#val#wrap_value#"
liste_fonctions2$="#bin_and#bin_not#bin_or#instr#left$#max#min#mod#power#right$#right_pos$#string$#"
liste_fonctions3$="#insert$#mid$#"

liste_fonctions$=liste_fonctions1$+liste_fonctions2$+liste_fonctions3$

' Suppression des doubles '#'.
while true%=1
      y%=instr(liste_fonctions$,"##")
      if y%=0 then exit_while
     
      liste_fonctions$=left$(liste_fonctions$,y%)+right_pos$(liste_fonctions$,y%+2)
end_while

nombre_fonctions%=0
temporaire$=right_pos$(liste_fonctions$,2)
while true%=1
      y%=instr(temporaire$,"#")
      if y%=0 then exit_while

      nombre_fonctions%=nombre_fonctions%+1
      temporaire$=right_pos$(temporaire$,y%+1)
end_while

dim tableau_fonctions$(nombre_fonctions%)

i%=0
temporaire$=right_pos$(liste_fonctions$,2)
while true%=1
      y%=instr(temporaire$,"#")
      if y%=0 then exit_while
     
      i%=i%+1
      tableau_fonctions$(i%)=left$(temporaire$,y%-1)
      temporaire$=right_pos$(temporaire$,y%+1)
end_while

end

calcul:

  expr$=item_read$(201,1)

  supprimer_espaces()

  nb_par_gauche%=0
  nb_par_droite%=0

  verifier_parentheses()

  placer_tokens_en_entree()

  transformer_en_NPI()

  for n%=301 to 300+nombre_memo%
      item_add n%,item_read$(n%-200,1)
   
      focus_sur_memo()
  next n%

  evaluer_expression()

  expr$=item_read$(201,1)
  clear 201
  item_add 201,expr$+" = "+item_read$(301,1)
  n%=201
  focus_sur_memo()

  ' Pour obtenir le focus sur le 1er caractère.
  set_focus 202
  item_insert 202,1,"":item_delete 202,1
  caret_position 202,0

  ' Pour obtenir le focus sur le 1er caractère.
  for kk%=nombre_memo% to 1 step -1
      set_focus kk%
      item_insert kk%,1,"":item_delete kk%,1
      caret_position kk%,0
  next kk%

  ' Pour obtenir le focus sur le 1er caractère.
  for kk%=100+nombre_memo% to 101 step -1
      set_focus kk%
      item_insert kk%,1,"":item_delete kk%,1
      caret_position kk%,0
  next kk%

return

sub verifier_parentheses()
    if instr(expr$,par_gauche$)+instr(expr$,par_droite$)=0 then exit_sub
   
    for kk%=1 to len(expr$)
        if mid$(expr$,kk%,1)=par_gauche$ then nb_par_gauche%=nb_par_gauche%+1
        if mid$(expr$,kk%,1)=par_droite$ then nb_par_droite%=nb_par_droite%+1
    next kk%
   
    if nb_par_gauche%<>nb_par_droite%
      voir_message("Vérifiez le nombre de parenthèses.")
      terminate
    end_if
end_sub

sub supprimer_espaces()
    temporaire$=""

    y%=1
    if left$(expr$,1)=" " then temporaire$=" " : y%=2

    for kk%=y% to len(expr$)
        a$=mid$(expr$,kk%,1)
        if a$=guillemet$
          temporaire$=temporaire$+a$
         
          for i%=kk%+1 to len(expr$)
              a$=mid$(expr$,i%,1)
              if a$=guillemet$ then exit_for
                   
              temporaire$=temporaire$+a$
          next i%

          kk%=i%
        end_if
       
        if a$<>" " then temporaire$=temporaire$+a$

    next kk%

    expr$=temporaire$

end_sub

sub placer_tokens_en_entree()

    i%=0
   
    n%=1
    if left$(expr$,1)=" " then expr$=right_pos$(expr$,2)
    if left$(expr$,2)="  " then expr$=right_pos$(expr$,3)
   
    ' Le token est une chaîne entre guillemets ?
    while true%=1
        if len(expr$)=0 then exit_sub
       
        a$=left$(expr$,1)

        item_add 202,a$

        ' Le token est une chaîne ?
        if a$=guillemet$
          chaine$=""
          for y%=2 to len(expr$)
              if mid$(expr$,y%,1)=guillemet$
                  exit_for
                    else
                  chaine$=chaine$+mid$(expr$,y%,1)
              end_if
          next y%
         
          ' ¤ est un caractère réservé pour identifier les chaînes.
          chaine$="¤"+chaine$

          i%=i%+1
          item_add i%,chaine$
          expr$=right_pos$(expr$,len(chaine$)+2)
        end_if
       
        ' Le token est un nombre ?
        if numeric(a$)=1
          chaine$=""

          while true%=1
              a$=left$(expr$,1)
              if numeric(a$)=1
                  chaine$=chaine$+a$
                  expr$=right_pos$(expr$,2)
                    else
                  exit_while
              end_if
          end_while
          i%=i%+1
          item_add i%,chaine$
        end_if

        ' Le token est un opérateur, un séparateur de paramètre ou une parenthèse ?
        if instr("+-*/,()",a$)>0
          i%=i%+1
          item_add i%,a$
          expr$=right_pos$(expr$,2)
        end_if
       
        ' Le token est une fonction ?
        for y%=1 to nombre_fonctions%
            chaine$=tableau_fonctions$(y%)
           
            if left$(expr$,len(chaine$)+1)=chaine$+par_gauche$ or left$(expr$,len(chaine$))=chaine$
              i%=i%+1
              item_add i%,chaine$
              expr$=right_pos$(expr$,len(chaine$)+1)
              exit_for
            end_if

        next y%
       
    end_while
end_sub

sub transformer_en_NPI()

    ' Index du memo de sortie.
    n%=100

    for kk%=1 to nombre_memo%
        if count(kk%)=0 then exit_for

        a$=item_read$(kk%,1)

        ' Opérateur.
        if instr("+-*/",a$)>0
          ' Si la pile est vide, placer l'opérateur sur la pile.
          if count(203)=0
              item_add 203,a$
              voir_message("Pile vide, on place '"+a$+"' sur la pile.")
                else

              flag%=false%

              ' Si le sommet de la pile est une parenthèse ouvrante, pousser l'opérateur sur la pile.
              temporaire$=item_read$(203,count(203))
              if temporaire$=par_gauche$
                flag%=true%
                item_add 203,a$
                voir_message("Le sommet de la pile est une parenthèse ouvrante, on pousse '"+a$+"' sur la pile.")
              end_if

              ' Si le token n'est pas prioritaire sur le l'opérateur au sommet de la pile:
              ' Il faut dépiler l'opérateur du sommet, le mettre sur la sortie, et empiler le token.
              if flag%=false%
                if a$="+" or a$="-"
                    if temporaire$="*" or temporaire$="/"
                      voir_message("L'opérateur '"+a$+"' n'est pas prioritaire sur celui du sommet de la pile '"+temporaire$+"', on dépile l'opérateur du sommet, on le mets sur la sortie, et on empile '"+a$+"'.")
                      n%=n%+1
                      item_add n%,temporaire$
                      focus_sur_memo()
                      item_delete 203,count(203)
                      item_add 203,a$
                      flag%=true%
                    end_if
                end_if
              end_if
             
              if flag%=false%
                ' Si l'opérateur est prioritaire sur celui au sommet de la pile, pousser l'opérateur sur la pile.
                if temporaire$="+" or temporaire$="-"
                    if a$="*" or a$="/"
                      voir_message("L'opérateur '"+a$+"' est prioritaire sur celui au sommet de la pile '"+temporaire$+"', on pousse donc l'opérateur '"+a$+"' sur la pile.")
                      item_add 203,a$
                      flag%=true%
                    end_if
                end_if
              end_if

              ' Opérateurs de même priorité.
              ' On place en sortie l'opérateur situé au sommet de la pile, et on empile l'opérateur courant.
              if flag%=false%
                if (a$="+" or a$="-") and (temporaire$="+" or temporaire$="-")
                    n%=n%+1
                    item_add n%,temporaire$
                    focus_sur_memo()
                    item_delete 203,count(203)
                    item_add 203,a$
                end_if

                if (a$="*" or a$="/") and (temporaire$="*" or temporaire$="/")
                    n%=n%+1
                    item_add n%,temporaire$
                    focus_sur_memo()
                    item_delete 203,count(203)
                    item_add 203,a$
                end_if
                voir_message("'"+a$+"' et '"+temporaire$+"' ont la même priorité. On place '"+temporaire$+"' en sortie et on empile '"+a$+"'.")
              end_if

          end_if
        end_if

        ' Nombre ou chaîne: on les place dans le prochain memo de sortie.
        if numeric(a$)=1or left$(a$,1)="¤"
          n%=n%+1
          item_add n%,a$
          focus_sur_memo()
         
          if left$(a$,1)="¤"
              voir_message("Chaîne de caractères: on la place en sortie.")
                else
              voir_message("'"+a$+"' est un nombre, on le place en sortie.")
          end_if
        end_if

        ' Parenthèse ouvrante ou fonction: on les empile.
        if a$=par_gauche$ or instr(liste_fonctions$,"#"+a$+"#")>0
          item_add 203,a$

          if a$=par_gauche$
              voir_message("Parenthèse ouvrante: on la place sur la pile.")
                else
              voir_message("'"+a$+"' est une fonction, on la place sur la pile.")
          end_if
        end_if
       
        ' Si c'est une parenthèse fermante, enlever les opérateurs de la pile et les placer sur le fichier de sortie
        ' jusqu'à ce que l'on rencontre la parenthèse ouvrante, que l'on élimine.
        ' Après cela, si le token au sommet de la pile est une fonction, le dépiler également pour l'ajouter à la sortie.
        if a$=par_droite$
          voir_message("Parenthèse fermante.")
          while true%=1
                temporaire$=item_read$(203,count(203))

                if temporaire$=par_gauche$
                    item_delete 203,count(203)
                   
                    if count(203)>0
                      temporaire$=item_read$(203,count(203))
                      if instr(liste_fonctions$,"#"+temporaire$+"#")>0
                          n%=n%+1
                          item_add n%,temporaire$
                          focus_sur_memo()
                          item_delete 203,count(203)
                      end_if
                    end_if

                    exit_while
                end_if

                n%=n%+1
                item_add n%,temporaire$
                focus_sur_memo()
                item_delete 203,count(203)
          end_while
        end_if

    next kk%

    ' Si il n'y a plus de token à lire, on dépile sur la sortie tous les opérateurs restés dans la pile (sauf les parenthèses).
    while count(203)>0
          temporaire$=item_read$(203,count(203))
          if temporaire$<>par_droite$ and temporaire$<>par_gauche$
            n%=n%+1
            item_add n%,temporaire$
          end_if
          item_delete 203,count(203)
    end_while

end_sub

sub voir_message(param1$)
    if voir_message%=true% then message param1$
end_sub

sub focus_sur_memo()
    set_focus n%
    item_insert n%,1,"":item_delete n%,1
    caret_position n%,0
end_sub

sub evaluer_expression()

    kk%=300
    while true%=1
          kk%=kk%+1
   
          a$=item_read$(kk%,1)
          if a$="" then exit_while

          if left$(a$,1)="¤" then a$=right_pos$(a$,2)

          ' Opérateurs: on évalue l'expression avec les 2 nombres précédents.
          if instr("+-*/",a$)>0
            b$=item_read$(kk%-2,1)
            c$=item_read$(kk%-1,1)

            if numeric(b$)+numeric(c$)=2
                if a$="+" then resultat$=str$(val(b$)+val(c$))
                if a$="-" then resultat$=str$(val(b$)-val(c$))
                if a$="*" then resultat$=str$(val(b$)*val(c$))
                if a$="/" then resultat$=str$(val(b$)/val(c$))
            end_if

            ' On remplace l'opération par le résultat.
            ' Et on décale vers la gauche tous les autres memo.
            clear kk%-2
            item_add kk%-2,resultat$

            for y%=kk%-1 to 300+nombre_memo%-2
                clear y%
                item_add y%,item_read$(y%+2,1)
            next y%

            for n%=301 to 300+nombre_memo%
                focus_sur_memo()
            next n%

            kk%=301
          end_if

          ' Fonctions.
          if instr(liste_fonctions$,"#"+a$+"#")>0
            if instr(liste_fonctions1$,"#"+a$+"#")>0
                nombre_parametres%=1
                b$=item_read$(kk%-1,1)

                if numeric(b$)=1 then valeur=val(b$)
                if left$(b$,1)="¤" then b$=right_pos$(b$,2)

                if a$="abs" then resultat$=str$(abs(valeur))
                if a$="acos" then resultat$=str$(acos(valeur))
                if a$="asc" then resultat$=str$(asc(left$(b$,1)))
                if a$="asin" then resultat$=str$(asin(valeur))
                if a$="atn" then resultat$=str$(atn(valeur))
                if a$="chr$" then resultat$=chr$(b$)
                if a$="cos" then resultat$=str$(cos(valeur))
                if a$="even" then resultat$=str$(even(valeur))
                if a$="exp" then resultat$=str$(exp(valeur))
                if a$="frac" then resultat$=str$(frac(valeur))
                if a$="hcos" then resultat$=str$(hcos(valeur))
                if a$="hex" then resultat$=hex(b$)
                if a$="hex$" then resultat$=str$(hex$(valeur))
                if a$="hsin" then resultat$=str$(hsin(valeur))
                if a$="htan" then resultat$=str$(htan(valeur))
                if a$="int" then resultat$=str$(int(valeur))
                if a$="log" then resultat$=str$(log(valeur))
                if a$="log2" then resultat$=str$(log2(valeur))
                if a$="log10" then resultat$=str$(log10(valeur))
                if a$="len" then resultat$=str$(len(b$))
                if a$="lower$" then resultat$=lower$(b$)
                if a$="ltrim$" then resultat$=ltrim$(b$)
                if a$="numeric" then resultat$=str$(numeric(b$))
                if a$="odd" then resultat$=str$(odd(valeur))
                if a$="rnd" then resultat$=str$(rnd(valeur))
                if a$="rtrim$" then resultat$=rtrim$(b$)
                if a$="sgn" then resultat$=str$(sgn(valeur))
                if a$="sin" then resultat$=str$(sin(valeur))
                if a$="sqr" then resultat$=str$(sqr(valeur))
                if a$="str$" then resultat$=b$
                if a$="tan" then resultat$=str$(tan(valeur))
                if a$="trim$" then resultat$=trim$(b$)
                if a$="upper$" then resultat$=upper$(b$)
                if a$="val" then resultat$=b$
                if a$="wrap_value" then resultat$=str$(wrap_value(valeur))
            end_if

            if instr(liste_fonctions2$,"#"+a$+"#")>0
                nombre_parametres%=2
                b$=item_read$(kk%-2,1)
                if left$(b$,1)="¤" then b$=right_pos$(b$,2)
                if numeric(b$)=1 then param1=val(b$)
                c$=item_read$(kk%-1,1)
                if left$(c$,1)="¤" then c$=right_pos$(c$,2)
                if numeric(c$)=1 then param2=val(c$)

                if a$="bin_and" then resultat$=str$(bin_and(param1,param2))
                if a$="bin_not" then resultat$=str$(bin_not(param1,param2))
                if a$="bin_or" then resultat$=str$(bin_or(param1,param2))
                if a$="instr" then resultat$=str$(instr(b$,c$))
                if a$="left$" then resultat$=left$(b$,param2)
                if a$="max" then resultat$=str$(max(param1,param2))
                if a$="min" then resultat$=str$(min(param1,param2))
                if a$="mod" then resultat$=str$(mod(param1,param2))
                if a$="power" then resultat$=str$(power(param1,param2))
                if a$="right$" then resultat$=right$(b$,param2)
                if a$="right_pos$" then resultat$=right_pos$(b$,param2)
                if a$="string$" then resultat$=string$(param1,b$)
            end_if

            if instr(liste_fonctions3$,"#"+a$+"#")>0
                nombre_parametres%=3
                b$=item_read$(kk%-3,1)
                if left$(b$,1)="¤" then b$=right_pos$(b$,2)
                c$=item_read$(kk%-2,1)
                if left$(c$,1)="¤" then c$=right_pos$(c$,2)
                if numeric(c$)=1 then i%=val(c$)
                h$=item_read$(kk%-1,1)
                if numeric(h$)=1 then y%=val(h$)

                if a$="insert$" then resultat$=insert$(b$,c$,y%)
                if a$="mid$" then resultat$=mid$(b$,i%,y%)
            end_if

            ' On remplace l'opération par le résultat.
            ' Et on décale vers la gauche tous les autres memo.
            clear kk%-nombre_parametres%
            item_add kk%-nombre_parametres%,resultat$

            for y%=kk%-nombre_parametres%+1 to 300+nombre_memo%-2
                clear y%
                item_add y%,item_read$(y%+nombre_parametres%,1)
            next y%

            for n%=301 to 300+nombre_memo%
                focus_sur_memo()
            next n%
           
            kk%=301
          end_if

    end_while

end_sub
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Pedro Alvarez

avatar

Nombre de messages : 1063
Date d'inscription : 19/01/2014

MessageSujet: Evaluateur d'expressions.   Sam 1 Mar 2014 - 9:19

Bonjour à tous.

Voici la nouvelle version de mon logiciel d'évaluation d'expressions saisies sous forme de chaîne.

Il permet maintenant de créer et évaluer des fonctions inconnues de Panoramic.

Testez donc cette expression: dec(sqr(2)*neg(1)) qui donne bien -2,414...

dec décrémente de 1.
neg calcule la valeur négative.

Code:
' Version du 1er mars 2014.

' http://fr.openclassrooms.com/forum/sujet/notation-polonaise-inverse-77040
' Transformation en NPI de l'expression à évaluer.

' Tant qu'il y a des tokens en entrée
' {
' 1. Examiner le token courant sur le fichier d'entrée.
' 2. Si c'est un opérande, le placer sur le fichier de sortie.
' 3. Si c'est une parenthèse ouvrante, la mettre sur la pile.
' 4. Si c'est un opérateur, alors:
' 5.
' 1. Si la pile est vide, pousser l'opérateur sur la pile
' 2. Si le sommet de la pile est une parenthèse ouvrante, pousser l'opérateur sur la pile.
' 3. Si l'opérateur est prioritaire sur celui au sommet de la pile, pousser l'opérateur sur la pile.
' 4. Sinon, enlever l'opérateur de la pile et le mettre sur le fichier de sortie. Replacer ensuite l'opérateur courant sur la pile.
' 6. Si c'est une parenthèse fermante, enlever les opérateurs de la pile et les placer sur le fichier de sortie jusqu'à ce que l'on rencontre la parenthèse ouvrante, que l'on élimine.
' }

' Enlever tous les opérateurs restants et les placer sur le fichier de sortie.

' Exemple: http://www.crlf.be/rpn01.html

dim a$, b$, c$, chaine$, expr$, fonction$, guillemet$, h$, liste_chiffres$, liste_fonctions$, liste_fonctions1$, liste_fonctions2$, liste_fonctions3$
dim param1, param2, param3, par_droite$, par_gauche$, resultat$, sauvegarde_chaine$, temporaire$
dim d%, false%, flag%, i%, kk%, n%, nb_par_gauche%, nb_par_droite%, nombre_fonctions%, nombre_memo%, nombre_parametres%, true%, y%
dim valeur, voir_message%

label calcul

guillemet$=chr$(34)
par_gauche$=chr$(40)
par_droite$=chr$(41)

true%=1
false%=0
nombre_memo%=27

voir_message%=false%

maximize 0

memo 201
  left 201,75
  top 201,50
  width 201,400
  height 201,30
  font_size 201,12
  font_bold 201
  font_color 201,255,0,255

memo 202
  left 202,75
  top 202,300
  width 202,105
  height 202,400
  font_size 202,12
  font_bold 202
  font_color 202,0,128,64

' Pile NPI.
memo 203
  left 203,185
  top 203,300
  width 203,105
  height 203,400
  font_size 203,12
  font_bold 203
  font_color 203,0,128,64

' Pour obtenir le focus sur le 1er caractère.
set_focus 201
item_insert 201,1,"":item_delete 201,1
caret_position 201,0

' Tokens.
for kk%=1 to nombre_memo%
    memo kk%
    left kk%,20+kk%*55
    top kk%,100
    width kk%,50
    height kk%,50
    font_size kk%,12
    font_color kk%,0,0,255
    bar_horizontal kk%
next kk%

' NPI.
for kk%=101 to 100+nombre_memo%
    memo kk%
    left kk%,20+(kk%-100)*55
    top kk%,160
    width kk%,50
    height kk%,50
    font_size kk%,12
    font_color kk%,0,0,255
    bar_horizontal kk%
next kk%

for kk%=301 to 300+nombre_memo%
    memo kk%
    left kk%,20+(kk%-300)*55
    top kk%,220
    width kk%,50
    height kk%,50
    font_size kk%,12
    font_color kk%,0,0,255
    bar_horizontal kk%
next kk%

button 99
  left 99,500
  top 99,400
  width 99,100
  height 99,30
  caption 99,"Calcul"
  on_click 99,calcul

liste_chiffres$="0123456789."

' Fonctions à 1, 2 ou 3 arguments.
liste_fonctions1$="#abs#acos#asin#atn#asc#chr$#cos#dec#even#exp#frac#hcos#hex#hex$#hsin#htan#inc#int#len#log#log2#log10#ower$#ltrim$#neg#numeric#odd#rnd#rtrim$#sgn#sin#sqr#str$#tan#trim$#upper$#val#wrap_value#"
liste_fonctions2$="#bin_and#bin_or#bin_xor#instr#left$#max#min#mod#power#right$#right_pos$#string$#"
liste_fonctions3$="#insert$#mid$#"

liste_fonctions$=liste_fonctions1$+liste_fonctions2$+liste_fonctions3$

' Suppression des doubles '#'.
while true%=1
      y%=instr(liste_fonctions$,"##")
      if y%=0 then exit_while
     
      liste_fonctions$=left$(liste_fonctions$,y%)+right_pos$(liste_fonctions$,y%+2)
end_while

nombre_fonctions%=0
temporaire$=right_pos$(liste_fonctions$,2)
while true%=1
      y%=instr(temporaire$,"#")
      if y%=0 then exit_while

      nombre_fonctions%=nombre_fonctions%+1
      temporaire$=right_pos$(temporaire$,y%+1)
end_while

dim tableau_fonctions$(nombre_fonctions%)

i%=0
temporaire$=right_pos$(liste_fonctions$,2)
while true%=1
      y%=instr(temporaire$,"#")
      if y%=0 then exit_while
     
      i%=i%+1
      tableau_fonctions$(i%)=left$(temporaire$,y%-1)
      temporaire$=right_pos$(temporaire$,y%+1)
end_while

end

calcul:

  expr$=item_read$(201,1)

  if left$(expr$,1)="+"
      expr$=right_pos$(expr$,2)
      clear 201
      item_add 201,expr$
  end_if

  if left$(expr$,1)="-"
      expr$="0"+expr$
      clear 201
      item_add 201,expr$
  end_if

  while true%=1
        y%=instr(expr$,"(+")
        if y%=0 then exit_while
        expr$=left$(expr$,y%)+right_pos$(expr$,y%+2)
        clear 201
        item_add 201,expr$
  end_while

  while true%=1
        y%=instr(expr$,"(-")
        if y%=0 then exit_while
        expr$=left$(expr$,y%)+"0"+right_pos$(expr$,y%+1)
        clear 201
        item_add 201,expr$
  end_while

  supprimer_espaces()

  nb_par_gauche%=0
  nb_par_droite%=0

  verifier_parentheses()

  placer_tokens_en_entree()

  transformer_en_NPI()

  for n%=301 to 300+nombre_memo%
      item_add n%,item_read$(n%-200,1)
   
      focus_sur_memo()
  next n%

  evaluer_expression()

  expr$=item_read$(201,1)
  clear 201
  item_add 201,expr$+" = "+item_read$(301,1)
  n%=201
  focus_sur_memo()

  ' Pour obtenir le focus sur le 1er caractère.
  set_focus 202
  item_insert 202,1,"":item_delete 202,1
  caret_position 202,0

  ' Pour obtenir le focus sur le 1er caractère.
  for kk%=nombre_memo% to 1 step -1
      set_focus kk%
      item_insert kk%,1,"":item_delete kk%,1
      caret_position kk%,0
  next kk%

  ' Pour obtenir le focus sur le 1er caractère.
  for kk%=100+nombre_memo% to 101 step -1
      set_focus kk%
      item_insert kk%,1,"":item_delete kk%,1
      caret_position kk%,0
  next kk%

return

sub verifier_parentheses()
    if instr(expr$,par_gauche$)+instr(expr$,par_droite$)=0 then exit_sub
   
    for kk%=1 to len(expr$)
        if mid$(expr$,kk%,1)=par_gauche$ then nb_par_gauche%=nb_par_gauche%+1
        if mid$(expr$,kk%,1)=par_droite$ then nb_par_droite%=nb_par_droite%+1
    next kk%
   
    if nb_par_gauche%<>nb_par_droite%
      voir_message("Vérifiez le nombre de parenthèses.")
      terminate
    end_if
end_sub

sub supprimer_espaces()
    temporaire$=""

    y%=1
    if left$(expr$,1)=" " then temporaire$=" " : y%=2

    for kk%=y% to len(expr$)
        a$=mid$(expr$,kk%,1)
        if a$=guillemet$
          temporaire$=temporaire$+a$
         
          for i%=kk%+1 to len(expr$)
              a$=mid$(expr$,i%,1)
              if a$=guillemet$ then exit_for
                   
              temporaire$=temporaire$+a$
          next i%

          kk%=i%
        end_if
       
        if a$<>" " then temporaire$=temporaire$+a$

    next kk%

    expr$=temporaire$

end_sub

sub placer_tokens_en_entree()

    i%=0
   
    n%=1
    if left$(expr$,1)=" " then expr$=right_pos$(expr$,2)
    if left$(expr$,2)="  " then expr$=right_pos$(expr$,3)
   
    ' Le token est une chaîne entre guillemets ?
    while true%=1
        if len(expr$)=0 then exit_sub
       
        a$=left$(expr$,1)

        item_add 202,a$

        ' Le token est une chaîne ?
        if a$=guillemet$
          chaine$=""
          for y%=2 to len(expr$)
              if mid$(expr$,y%,1)=guillemet$
                  exit_for
                    else
                  chaine$=chaine$+mid$(expr$,y%,1)
              end_if
          next y%
         
          ' ¤ est un caractère réservé pour identifier les chaînes.
          chaine$="¤"+chaine$

          i%=i%+1
          item_add i%,chaine$
          expr$=right_pos$(expr$,len(chaine$)+2)
        end_if
       
        ' Le token est un nombre ?
        if numeric(a$)=1
          chaine$=""

          while true%=1
              a$=left$(expr$,1)
              if numeric(a$)=1
                  chaine$=chaine$+a$
                  expr$=right_pos$(expr$,2)
                    else
                  exit_while
              end_if
          end_while
          i%=i%+1
          item_add i%,chaine$
        end_if

        ' Le token est un opérateur, un séparateur de paramètre ou une parenthèse ?
        if instr("+-*/,()",a$)>0
          i%=i%+1
          item_add i%,a$
          expr$=right_pos$(expr$,2)
        end_if
       
        ' Le token est une fonction ?
        for y%=1 to nombre_fonctions%
            chaine$=tableau_fonctions$(y%)
           
            if left$(expr$,len(chaine$)+1)=chaine$+par_gauche$ or left$(expr$,len(chaine$))=chaine$
              i%=i%+1
              item_add i%,chaine$
              expr$=right_pos$(expr$,len(chaine$)+1)
              exit_for
            end_if

        next y%
       
    end_while
end_sub

sub transformer_en_NPI()

    ' Index du memo de sortie.
    n%=100

    for kk%=1 to nombre_memo%
        if count(kk%)=0 then exit_for

        a$=item_read$(kk%,1)

        ' Opérateur.
        if instr("+-*/",a$)>0
          ' Si la pile est vide, placer l'opérateur sur la pile.
          if count(203)=0
              item_add 203,a$
              voir_message("Pile vide, on place '"+a$+"' sur la pile.")
                else

              flag%=false%

              ' Si le sommet de la pile est une parenthèse ouvrante, pousser l'opérateur sur la pile.
              temporaire$=item_read$(203,count(203))
              if temporaire$=par_gauche$
                flag%=true%
                item_add 203,a$
                voir_message("Le sommet de la pile est une parenthèse ouvrante, on pousse '"+a$+"' sur la pile.")
              end_if

              ' Si le token n'est pas prioritaire sur le l'opérateur au sommet de la pile:
              ' Il faut dépiler l'opérateur du sommet, le mettre sur la sortie, et empiler le token.
              if flag%=false%
                if a$="+" or a$="-"
                    if temporaire$="*" or temporaire$="/"
                      voir_message("L'opérateur '"+a$+"' n'est pas prioritaire sur celui du sommet de la pile '"+temporaire$+"', on dépile l'opérateur du sommet, on le mets sur la sortie, et on empile '"+a$+"'.")
                      n%=n%+1
                      item_add n%,temporaire$
                      focus_sur_memo()
                      item_delete 203,count(203)
                      item_add 203,a$
                      flag%=true%
                    end_if
                end_if
              end_if
             
              if flag%=false%
                ' Si l'opérateur est prioritaire sur celui au sommet de la pile, pousser l'opérateur sur la pile.
                if temporaire$="+" or temporaire$="-"
                    if a$="*" or a$="/"
                      voir_message("L'opérateur '"+a$+"' est prioritaire sur celui au sommet de la pile '"+temporaire$+"', on pousse donc l'opérateur '"+a$+"' sur la pile.")
                      item_add 203,a$
                      flag%=true%
                    end_if
                end_if
              end_if

              ' Opérateurs de même priorité.
              ' On place en sortie l'opérateur situé au sommet de la pile, et on empile l'opérateur courant.
              if flag%=false%
                if (a$="+" or a$="-") and (temporaire$="+" or temporaire$="-")
                    n%=n%+1
                    item_add n%,temporaire$
                    focus_sur_memo()
                    item_delete 203,count(203)
                    item_add 203,a$
                end_if

                if (a$="*" or a$="/") and (temporaire$="*" or temporaire$="/")
                    n%=n%+1
                    item_add n%,temporaire$
                    focus_sur_memo()
                    item_delete 203,count(203)
                    item_add 203,a$
                end_if
                voir_message("'"+a$+"' et '"+temporaire$+"' ont la même priorité. On place '"+temporaire$+"' en sortie et on empile '"+a$+"'.")
              end_if

          end_if
        end_if

        ' Nombre ou chaîne: on les place dans le prochain memo de sortie.
        if numeric(a$)=1or left$(a$,1)="¤"
          n%=n%+1
          item_add n%,a$
          focus_sur_memo()
         
          if left$(a$,1)="¤"
              voir_message("Chaîne de caractères: on la place en sortie.")
                else
              voir_message("'"+a$+"' est un nombre, on le place en sortie.")
          end_if
        end_if

        ' Parenthèse ouvrante ou fonction: on les empile.
        if a$=par_gauche$ or instr(liste_fonctions$,"#"+a$+"#")>0
          item_add 203,a$

          if a$=par_gauche$
              voir_message("Parenthèse ouvrante: on la place sur la pile.")
                else
              voir_message("'"+a$+"' est une fonction, on la place sur la pile.")
          end_if
        end_if
       
        ' Si c'est une parenthèse fermante, enlever les opérateurs de la pile et les placer sur le fichier de sortie
        ' jusqu'à ce que l'on rencontre la parenthèse ouvrante, que l'on élimine.
        ' Après cela, si le token au sommet de la pile est une fonction, le dépiler également pour l'ajouter à la sortie.
        if a$=par_droite$
          voir_message("Parenthèse fermante.")
          while true%=1
                temporaire$=item_read$(203,count(203))

                if temporaire$=par_gauche$
                    item_delete 203,count(203)
                   
                    if count(203)>0
                      temporaire$=item_read$(203,count(203))
                      if instr(liste_fonctions$,"#"+temporaire$+"#")>0
                          n%=n%+1
                          item_add n%,temporaire$
                          focus_sur_memo()
                          item_delete 203,count(203)
                      end_if
                    end_if

                    exit_while
                end_if

                n%=n%+1
                item_add n%,temporaire$
                focus_sur_memo()
                item_delete 203,count(203)
          end_while
        end_if

    next kk%

    ' Si il n'y a plus de token à lire, on dépile sur la sortie tous les opérateurs restés dans la pile (sauf les parenthèses).
    while count(203)>0
          temporaire$=item_read$(203,count(203))
          if temporaire$<>par_droite$ and temporaire$<>par_gauche$
            n%=n%+1
            item_add n%,temporaire$
          end_if
          item_delete 203,count(203)
    end_while

end_sub

sub voir_message(param1$)
    if voir_message%=true% then message param1$
end_sub

sub focus_sur_memo()
    set_focus n%
    item_insert n%,1,"":item_delete n%,1
    caret_position n%,0
end_sub

sub evaluer_expression()

    kk%=300
    while true%=1
          kk%=kk%+1
   
          a$=item_read$(kk%,1)
          if a$="" then exit_while

          if left$(a$,1)="¤" then a$=right_pos$(a$,2)

          ' Opérateurs: on évalue l'expression avec les 2 nombres précédents.
          if instr("+-*/",a$)>0
            b$=item_read$(kk%-2,1)
            c$=item_read$(kk%-1,1)

            if numeric(b$)+numeric(c$)=2
                if a$="+" then resultat$=str$(val(b$)+val(c$))
                if a$="-" then resultat$=str$(val(b$)-val(c$))
                if a$="*" then resultat$=str$(val(b$)*val(c$))
                if a$="/" then resultat$=str$(val(b$)/val(c$))
            end_if

            ' On remplace l'opération par le résultat.
            ' Et on décale vers la gauche tous les autres memo.
            clear kk%-2
            item_add kk%-2,resultat$

            for y%=kk%-1 to 300+nombre_memo%-2
                clear y%
                item_add y%,item_read$(y%+2,1)
            next y%

            for n%=301 to 300+nombre_memo%
                focus_sur_memo()
            next n%

            kk%=301
          end_if

          ' Fonctions.
          if instr(liste_fonctions$,"#"+a$+"#")>0
            if instr(liste_fonctions1$,"#"+a$+"#")>0
                nombre_parametres%=1
                b$=item_read$(kk%-1,1)

                if numeric(b$)=1 then valeur=val(b$)
                if left$(b$,1)="¤" then b$=right_pos$(b$,2)

                if a$="abs" then resultat$=str$(abs(valeur))
                if a$="acos" then resultat$=str$(acos(valeur))
                if a$="asc" then resultat$=str$(asc(left$(b$,1)))
                if a$="asin" then resultat$=str$(asin(valeur))
                if a$="atn" then resultat$=str$(atn(valeur))
                if a$="chr$" then resultat$=chr$(b$)
                if a$="cos" then resultat$=str$(cos(valeur))
                if a$="dec" then resultat$=str$(valeur-1)
                if a$="even" then resultat$=str$(even(valeur))
                if a$="exp" then resultat$=str$(exp(valeur))
                if a$="frac" then resultat$=str$(frac(valeur))
                if a$="hcos" then resultat$=str$(hcos(valeur))
                if a$="hex" then resultat$=str$(hex(b$))
                if a$="hex$" then resultat$=str$(hex$(valeur))
                if a$="hsin" then resultat$=str$(hsin(valeur))
                if a$="htan" then resultat$=str$(htan(valeur))
                if a$="inc" then resultat$=str$(valeur+1)
                if a$="int" then resultat$=str$(int(valeur))
                if a$="log" then resultat$=str$(log(valeur))
                if a$="log2" then resultat$=str$(log2(valeur))
                if a$="log10" then resultat$=str$(log10(valeur))
                if a$="len" then resultat$=str$(len(b$))
                if a$="lower$" then resultat$=lower$(b$)
                if a$="ltrim$" then resultat$=ltrim$(b$)
                if a$="neg" then resultat$=str$(valeur*(-1))
                if a$="numeric" then resultat$=str$(numeric(b$))
                if a$="odd" then resultat$=str$(odd(valeur))
                if a$="rnd" then resultat$=str$(rnd(valeur))
                if a$="rtrim$" then resultat$=rtrim$(b$)
                if a$="sgn" then resultat$=str$(sgn(valeur))
                if a$="sin" then resultat$=str$(sin(valeur))
                if a$="sqr" then resultat$=str$(sqr(valeur))
                if a$="str$" then resultat$=b$
                if a$="tan" then resultat$=str$(tan(valeur))
                if a$="trim$" then resultat$=trim$(b$)
                if a$="upper$" then resultat$=upper$(b$)
                if a$="val" then resultat$=b$
                if a$="wrap_value" then resultat$=str$(wrap_value(valeur))
            end_if

            if instr(liste_fonctions2$,"#"+a$+"#")>0
                nombre_parametres%=2
                b$=item_read$(kk%-2,1)
                if left$(b$,1)="¤" then b$=right_pos$(b$,2)
                if numeric(b$)=1 then param1=val(b$)
                c$=item_read$(kk%-1,1)
                if left$(c$,1)="¤" then c$=right_pos$(c$,2)
                if numeric(c$)=1 then param2=val(c$)

                if a$="bin_and" then resultat$=str$(bin_and(param1,param2))
                if a$="bin_or" then resultat$=str$(bin_or(param1,param2))
                if a$="bin_xor" then resultat$=str$(bin_xor(param1,param2))
                if a$="instr" then resultat$=str$(instr(b$,c$))
                if a$="left$" then resultat$=left$(b$,param2)
                if a$="max" then resultat$=str$(max(param1,param2))
                if a$="min" then resultat$=str$(min(param1,param2))
                if a$="mod" then resultat$=str$(mod(param1,param2))
                if a$="power" then resultat$=str$(power(param1,param2))
                if a$="right$" then resultat$=right$(b$,param2)
                if a$="right_pos$" then resultat$=right_pos$(b$,param2)
                if a$="string$" then resultat$=string$(param1,b$)
            end_if

            if instr(liste_fonctions3$,"#"+a$+"#")>0
                nombre_parametres%=3
                b$=item_read$(kk%-3,1)
                if left$(b$,1)="¤" then b$=right_pos$(b$,2)
                c$=item_read$(kk%-2,1)
                if left$(c$,1)="¤" then c$=right_pos$(c$,2)
                if numeric(c$)=1 then i%=val(c$)
                h$=item_read$(kk%-1,1)
                if numeric(h$)=1 then y%=val(h$)

                if a$="insert$" then resultat$=insert$(b$,c$,y%)
                if a$="mid$" then resultat$=mid$(b$,i%,y%)
            end_if

            ' On remplace l'opération par le résultat.
            ' Et on décale vers la gauche tous les autres memo.
            clear kk%-nombre_parametres%
            item_add kk%-nombre_parametres%,resultat$

            for y%=kk%-nombre_parametres%+1 to 300+nombre_memo%-2
                clear y%
                item_add y%,item_read$(y%+nombre_parametres%,1)
            next y%

            for n%=301 to 300+nombre_memo%
                focus_sur_memo()
            next n%
           
            kk%=301
          end_if

    end_while

end_sub
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
 
Calcul d'expressions saisies sous forme de chaîne.
Revenir en haut 
Page 1 sur 1
 Sujets similaires
-
» Calcul d'expressions saisies sous forme de chaîne.
» [Résolu] une anime sous forme d'un arbre de recherche
» ANIMATION
» Enigme musicale N°49.......sous forme de Quizzz
» Vos stats ADSL sous forme de Widget (Mac)

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: