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
» KGF.dll - demandes ou suggestions de modifications ou ajouts
par pascal10000 Aujourd'hui à 17:49

» Cartes de voeux, menus, etc.
par JL35 Aujourd'hui à 17:48

» Mah-Jong européen new-look
par jjn4 Aujourd'hui à 15:48

» a l'aide klaus
par Minibug Aujourd'hui à 11:42

» KGF_dll - nouvelles versions
par Minibug Aujourd'hui à 1:48

» bug SYNEDIT_TARGET_IS_OBJECT
par Jack Aujourd'hui à 0:16

» Jukebox : Serge Reggiani
par papydall Sam 9 Déc 2017 - 5:58

» Ecouter la radio fm sur votre pc
par pascal10000 Sam 9 Déc 2017 - 3:42

» anomalie
par Klaus Sam 9 Déc 2017 - 3:21

» hommage
par Jicehel Ven 8 Déc 2017 - 11:29

» Logiciel de soutien scolaire en langues.
par Pedro Alvarez Ven 8 Déc 2017 - 10:43

» carte son
par Klaus Ven 8 Déc 2017 - 2:37

» API Windows
par Klaus Jeu 7 Déc 2017 - 21:03

» mise a jour calculatrice
par joeeee2017 Mer 6 Déc 2017 - 22:19

» j'ai un petit problème
par JL35 Mer 6 Déc 2017 - 21:58

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Décembre 2017
LunMarMerJeuVenSamDim
    123
45678910
11121314151617
18192021222324
25262728293031
CalendrierCalendrier

Partagez | 
 

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

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

avatar

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

MessageSujet: Calcul d'expressions saisies sous forme de chaîne.   Jeu 20 Fév 2014 - 18: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 : 881
Date d'inscription : 19/01/2014

MessageSujet: Evaluateur d'expressions.   Sam 1 Mar 2014 - 11: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.
Voir le sujet précédent Voir le sujet suivant 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: