Code : Tout sélectionner
; ************************************************************************************************************
; SYSTEME de calcul d'expressions ou Formule Mathématique..
; ************************************************************************************************************
; Procédure de Calcul d'une expression à CALCULER et entré dans FMU$ (Formule)
; Système de calcul de formule FMU$ = "A05+152.3^2+(SIN(30)-COS(V03)))/2" etc...
;
; Mais : FMU$="1250.36+((2280%25-125)/2)-(356.23#3) = 2668.28..." est aussi valable .......
; 2280+(2280*25/100)
; ---------------------------------------------------------------------------------------------------------------------------------------
; Conventions :
; ------------------ En plus de calculer une expression sous forme numérique normale (12+5*3/5 etc..)
; cet ensemble permet de calculer à partir de données qui sont dans des tableaux. Et ce de deux type
; L'un serait EN$(i, j) Avec A01->Ann pour EN$(1,nn) ou B01->Bnn pour EN$(2,nn) etc... jusque U
; ATTENTION : la correspondance de VAR$(i) avec i=3 s'écrit ==> V03 si i=14 alors => V14
; Nous avons donc de V01 jusque Vnn pour VAR$(i) pour i de "1" à "n".
; --------------------
; Dans une expression du type : FMU$ = "A05+152.3^2+(SIN(30)-COS(V03))/2" nous avons "A05".
; Cela représente la Case "05" d'une fiche du fichier "A" soit le premier fichier, ce qui fait que A=1 et 05 =5,
; est équivalent à I=1 et j=5 d'un tableau EN$(i,j) contenant des données venant de DATA ou d'un fichier.
; De ce fait B05 signifierais qu'un autre fichier "B" ou I=2 case 05 pourrait être calculé avec A05,
; par exemple ==> Resultat = A05*B05
;
; Que le même principe peut-être appliqué au tableau VAR$() qui est un tableaux à une dimension et
; que quelque soit LES tableaux que vous utilisez c'est vous qui déterminer les dimensions (i).
;
; J'aime particulièrement l'idée de dire que i=Nbr=fichier utilisé et j=Nbr de Case par fiche.
;
; Dans les tout les cas LA VALEUR à calculer peut êtres exprimé à partir de valeurs que vous placez
; dans l'expression ou avoir une origine de tableaux que vous utiliser dans votre programme. Et que si
; l'expression à calculer doit contenir des références de A01 A25, et VAR$(J) =Vnn est évidement numérique.
;
; Note : Les tableau étant initialisé rien ne vous empèche de "ranger" des résultats dans ceux-ci pour
; effectuer d'autre calcul ultérieurement ou même les sauver dans un fichier sur disque.
;
; ************************************************************************************************************
; En ENTREE : Les valeurs sont soit dans une expression FMU$ ou un tableau contenant ces formules :
; ------------------------------------------------------------------------------------------------------
; FM$(i) : Tableau suceptible de contenir des FMU$... (Formules à calculer)
;
; les données sur lesquelles peuvent porter les calculs sont généralement dans des tableaux qui sont :
;
; EN$(i,j) : Ou tableau contenant des valeurs sous forme Alphanumérique. Les données sont
; suceptible de venir du Fichier(I) et de ses champs de donnée du fichiers(J), d'ou EN$(I,J)
; VAR$(i) : Autre tableau de "VARIABLES" d'ou "VAR$" une dimension limité ou non et enfin
; ------------------------------------------------------------------------------------------------------
; En SORTIE : Les Variables DON$ et DONNE.d donnent le résultat
; ---------------- sous forme Alphanumérique ou double prècision
;
; J'ai réalisé ce module sous sa forme de base essentiellement pour des programmes de
; gestions diverses et ce sous GW et QB entre 1979 jusque vers 1984 (Bascom le compilateur)
; puis les Qb, QB45, QBX en 1989 ou il a été adaptés sous forme de "fonctions" et "Sub"
; ***********************************************************************************************************
; Puis maintenant a PureBasic... Etant donné son age... :-) :
; Je n'empèche personne d'améliorer ce CODE plus en concordance avec PureBasic... S'il y a lieu !
; ***********************************************************************************************************
; LES PRIORITES DE CALCUL sont..:
; -----------------------------------------------
; Dans l'ordre indiqué ci contre de P$(1) à P$(9) en cas de doute utilisez les parenthèses.
;--------------- Ainsi : 25+(30-25)*2+10 = 45 ici 30-25 est fait en premier donc =5 puis 5*2 = 10 => 25+10+10 = 45
; tandis que : 25+30-25*2+10 = 15 tandis qu'ici 25*2 est fait en premier donc 25+30-50+10= 15
; L'addition et la soustraction ont le même poids c'est donc le premier signe rencontré qui est effectué.
; P$(1) = "^" Puissance
; P$(2) = "*" Multiplication
; P$(3) = "/" Division
; P$(4) = "\" Division entière
; P$(5) = "%" Pourcentage = 1000%25 donnera => 1250
; P$(6) = "#" Racine = Soit racine carré s'écrit : 625#2 = 25 raison de l'utilisation de # valable
; pour toute racine comme : cubique 27#3 = 3 ou 5ième 625#4 = 5 etc...
; P$(7) = "+" Addition
; P$(8) = "-" Soustration
; P$(9) = "|" Modulo = 100/12 ==> 4 125/20 ==> 5
;
; Les FONCTIONS ci-dessous sont éffectués en PREMIER...
;
; FONCTION : SIN(), ASIN(), COS(), ACOS(), TAN(), ATAN()
; LOG(), LOG10(), ABS(), INT()
;
; Existe aussi : SUM(Ann,Amm) et MOY(Ann,Amm) qui donne la somme et Moyenne de tableaux...
;
; Attention : Si on peut calculer des éléments de tableau différents tel que A02*C05 ou B04/VAR(5)
; ********* Par contre on ne peut SUMmer OU Faire la MOYenne que des éléments d'un même tableau
; -----------------------------------------------------------------------------------------------------------------------------------
; NOTES : La fenetre de debuggage donne l'évolution des différents stade de l'évolution du calcul
; de la formule introduite
;
; En fin il y a une série de types de formules différentes avec leurs résultats... Un copier / coller
; peux éviter de se tracasser pour introduire une formule et tester ! Ou de vérifier la cohérence de
; ce que l'on introduit par rapport à ce qui est LA "bonne forme" d'introduire ou de solliciter ce système
; de résolution de formule...
;
; De même des lignes Data pour approvisioner un "pseudo" Tableau EN$(1,i) et VAR$(i)
; ----------------------------------------------------------------------------------------------------------------------------
;
Global X.l,Y.l,N.l,T.l,L.l,KK.l,K.l
Global Donnee.d,DON.d,M.d,MO.d,M1.d,MM.d,MR.d,R.d
Global Dim P$(20) ; Table des opérateurs du système de calcul et prioritée
Global Dim F$(20) ; Table des fonctions mathématique
Global Dim OP$(30) ; Table de mémorisation des Opérateurs de données
Global Dim FM$(50) ; Table de Formules existantes
Global Dim EN$(10,100) ; Tableau de données liée ou non à un fichier
Global Dim VAR$(50) ; Table de variable idem R.d() mais sous forme alphanumérique
Global G$="(",D$=")",OP$,PD$,PG$,FMU$,DON$
; ------------------------------------------------------------
Declare TraitementExpression()
Declare CalculExpression()
Declare CALCUL()
Declare.d Val_MO(Mo$)
Declare.i ChercheAvant(Partie$)
Declare.i ChercheApres(Partie$)
Declare.i FONCTION()
; -------------------------------------------------------------
;{- Les priorités de calcul sont donnée par préférences....
; Forme de Calul M1$ Opérateur MO$ => 12^3 ou A02^3
P$(1) = "^" ; Puissance
P$(2) = "*" ; Multiplication
P$(3) = "/" ; Division
P$(4) = "\" ; Division entière
P$(5) = "%" ; Pourcentage = 1000%25 donnera => 1250
P$(6) = "#" ; Racine = 625#2=25 ou 27#3=> 3
P$(7) = "+" ; Addition
P$(8) = "-" ; Soustration
P$(9) = "|" ; Modulo = 100/12 ==========> 4
; --------------------------------------------------------------------------------
F$(1)="SIN("
F$(2)="COS("
F$(3)="TAN("
F$(4)="LOG10("
F$(5)="ASIN("
F$(6)="ACOS("
F$(7)="ATAN("
F$(8)="LOG("
F$(9)="ABS("
F$(10)="INT("
F$(11)="SUM("
F$(12)="MOY("
;} ------------------------------------------------------------
; Donnée pour TEST.... EN$(1,I) et VAR$(i)
; -------------------------------------------------------------
Restore Adresse
Read.i Nb: For i=1 To Nb: Read.s EN$(1,I) :Next i
Restore VAR : For i=1 To Nb: Read.s VAR$(I) :Next i
; =================================================================
; >>>> Début Programme -----------
; --------------------------------------------------------------
; FMUL<>0 => La formule doit être prise dans la liste des formules a la position FM$(FMUL)
; =================================================================
If FMUL<>0:FMU$=FM$(FMUL ):EndIf ; Prise d'un tableau de formule FM$(n)
If Len(FMU$)=0
FMU$=InputRequester("ENtrée de formule","> Formule : ","") ; Sinon ICI on introduit la formule
EndIf
DON$="":DON=0:Donnee=0:OrFMU$=FMU$;ER =0:
If Len(FMU$)<2
DON$="Problème"
MessageRequester("Resultat",OrFMU$+"="+Don$)
End
EndIf
; --------------------------------------------------------------------------------
FMU$=RemoveString(FMU$," ",1) ; Elimine les blancs
FMDEP$=FMU$ ; Etat de départ
NbrG=CountString(FMU$,G$) ; Combien de parenthèse gauche ?
NbrD=CountString(FMU$,D$) ; Combien de parenthèse droite ?
If NbrG<>NbrD ; Il y a des parenthèse mais pas équilibrées.
MessageRequester("ERREUR De parenthèses dans : ",FMU$):End;ProcedureReturn
EndIf
; -----------------------------------------------------------------------------------
; 1- Traitement des 12 fonctions :
; -----------------------------------------------------------------------------------
Debug "1-Formule de départ : "+FMDEP$
FONCTION() ; Y a t'il et SI OUI ==> ALORS Traite les fonctions
; ---------------------------------------------------------------------------------------------
; Après Fonction il y a un résultat ou il reste une expression normale...
; ----------------------------------------------------------------------------------------------
Debug "2-Formule Après FONCTION : "+FMU$
;
For W=1 To Len(FMU$) ;Teste si opération valide ou possible ...
C$=Mid(FMU$,W,1)
For J=1 To 9
If C$=P$(J) : Teste=1: Break 2: EndIf ; Saute après Next
Next J
Next W
If Teste<>0
Teste=0:FLG=0
TraitementExpression()
EndIf
MessageRequester("Resultat",OrFMU$+"="+Don$)
End
; -----------------------------------------------------------------------
; 2 - Traitement des parenthèses de l'expression
; -----------------------------------------------------------------------
Procedure TraitementExpression()
;
NbrG=CountString(FMU$,G$) ; Combien de parenthèse gauche ?
NbrD=CountString(FMU$,D$) ; Combien de parenthèse droite ?
If NbrG<>NbrD ; Il y a des parenthèse mais pas équilibrées.
MessageRequester("ERREUR De parenthèses dans : ",FMU$):ProcedureReturn
EndIf
Debug "Avant Résolution "+FMU$
;
Repeat
If NbrG>0 ; Il y a au moins une parenthèse
Y =FindString(FMU$,D$,1) ; Recherche de la parenthèse de droite ")" : Position =Y
For X=Y To 1 Step -1 ; pour prendre l'expression la plus intérieure
If Mid(FMU$,X,1)="(" ; Recherche de la gauche "(" : Position =X
Break
EndIf
Next X
If X>1: PG$=Left(FMU$,X -1):EndIf ; Mémorise la partie à gauche
If Y<Len(FMU$):PD$=Mid(FMU$,Y +1):EndIf ; Mémorise la partie à droite
FMU$=Mid(FMU$,X +1,Y -(X +1)) ; Extraction de l'expression à calculer
; ;
CalculExpression() ; Calcul de l'expression entre-parenthèses........
; ;
FMU$=PG$+DON$+PD$:PD$="":FLG=1 ; Reconstitue la nouvelle formule incluant le résultat intermédiaire
NbrG=CountString(FMU$,G$) ; Combien reste t'il
Else ; ========== PLUS DE PARENTHESES ===================
;
CalculExpression():FLG=0 ; Calcul de l'expression sans parenthèse.... ou restante !
EndIf
Until FLG=0
Debug "---> Après Traitement Expression "+DON$+" ou "+FMU$
EndProcedure
; ------------------------------------------------------------------------------------------
; * Recherche des opérateurs ET séparation des opérandes *
; ------------------------------------------------------------------------------------------
Procedure CalculExpression() ; Calcul d'expressions sans parenthèses... Opérateur P$(i)
Static PG$,PD$, Np
Np+1: MO$="":M1$="":O=0
Debug Str(Np+3)+"- Avant CalculExpression : "+FMU$
;
Repeat ; Balayage des Opérateur par prioritée...
O+1 : OP$="" :N=0 ;
OP1=FindString(FMU$,P$(O),2) ; Position d'un opérateur...
If O=7
OP2=FindString(FMU$,P$(8),2) ; c'est "+" cherche si précedent c'est "-"
If OP2<OP1 And OP2>0:OP1=OP2:N=1:EndIf ; si oui on prend le premier ...
EndIf
;
If O<10 And OP1<> 0 ;
Avant$=Left(FMU$,OP1-1):opAV=ChercheAvant(Avant$)
If N=1:OP$=P$(O+1):O-1:Else:OP$=P$(O):EndIf
PG$=Left(FMU$,opAV): M1$=Mid(FMU$,opAV+1,OP1-opAV-1)
If Asc(Left(M1$,1))-64=1:M1=Val_MO(M1$):Else:M1=ValD(M1$):EndIf
;
Apres$=Mid(FMU$,OP1+1):opAP=ChercheApres(Apres$)
MO$=Apres$:PD$="":MO=ValD(MO$)
If opAP>0:PD$=Mid(FMU$,OP1+opAP):EndIf
;
If Asc(Left(MO$,1))-64=1
MO=Val_MO(MO$)
ElseIf opAP<>0
MO$=Mid(FMU$,OP1+1,(OP1+opAP)-OP1-1):MO=ValD(MO$)
EndIf
; Ici on va calculer l'expression "MO$ P$(O) M1$"
Debug "a) M1$="+StrD(M1)+" "+OP$+" "+StrD(MO)
CALCUL(): O=0
FMU$=PG$+DON$+PD$
Debug "b) FMU$="+FMU$
A+1
Else
Donnee=ValD(FMU$)
EndIf
Until O=9
; ----------------------------------------------------
DON$=Trim(StrD(Donnee))
Debug Str(Np+4)+"- Après CalculExpression ou DON$ : "+DON$
EndProcedure
; ----------------------------------------------------------------------------------------------------
; Calcul des opérations fondamentale entre opérande M1 et MO selon OP$(n)
; ----------------------------------------------------------------------------------------------------
Procedure CALCUL()
Select OP$
Case P$(1)
Donnee=Pow(M1,MO) ; Puissance P$(1)="^":
Case P$(2)
Donnee=M1*MO ; Multiplication P$(2)="*":
Case P$(3)
Donnee=M1 ; Division P$(3)="/":
If MO<>0:Donnee=M1/MO:EndIf
Case P$(4)
If MO<>0:Donnee=Int(M1/MO) ; Division entière P$(4)="\"
Else:Donnee=Int(M1): EndIf
Case P$(5)
Donnee=M1+(M1*MO/100) ; Pourcentage P$(5)="%"
Case P$(6)
Donnee=M1 ; Racine MO de M1 P$(6)="#"
If MO<>0:Donnee=Pow(M1 ,1/MO):EndIf
Case P$(7) , P$(8)
If P$(7)=OP$:Donnee=M1+MO:EndIf ; Addition P$(7)="+"
If P$(8)=OP$:Donnee=M1-MO:EndIf ; Soustraction P$(8)="-"
;Case P$(8)
; Donnee=M1-MO ; Soustraction P$(8)="-"
Case P$(9)
Donnee=M1-(Int(M1/MO)*MO) ; Modulo P$(9)="|"
EndSelect
DON=Donnee:DON$=StrD(DON)
If FONC=1
MessageRequester("RESULAT INTERMEDIAIRE",DON$)
EndIf
EndProcedure
;----------------------------------------------
; Extaction de l'expression MV$
; ---------------------------------------------
Procedure.d Val_MO(MV$)
Shared MM
KK=Asc(Left(MV$,1))-64:K=Val(Mid(MV$,2)) ; Extraction des valeurs
MM=0
If KK<1 : MM=ValD(MV$):KK=99:EndIf ; Ici non contenue valeur elle même
If KK=26 : MM=ValD(EN$( 1,K)):KK=99:EndIf ; ici dans FICHE PRINCIPALE (Z)
If KK<8 : MM=ValD(EN$(KK,K)):KK=99:EndIf ; ici dans d' AUTREs FICHIES (A->F) (G)
If KK=22 : MM=ValD(VAR$(K)) :KK=99:EndIf ; ici des VARIABLES (V)
ProcedureReturn MM
EndProcedure
; -----------------------------------------------
Procedure.i ChercheAvant(Partie$)
For O=Len(Partie$) To 1 Step -1
C$=Mid(Partie$,O,1)
For j=1 To 9
If C$=P$(j):OPx=O:Break 2:EndIf
Next j
Next O
ProcedureReturn OPx
EndProcedure
; -----------------------------------------------
Procedure.i ChercheApres(Partie$)
For O=1 To Len(Partie$)
C$=Mid(Partie$,O,1)
For j=1 To 9
If C$=P$(j):OPx=O:Break 2:EndIf
Next j
Next O
ProcedureReturn OPx
EndProcedure
;--------------------------------------------------------------------
; Traitement des Fonctions Mathématique
;--------------------------------------------------------------------
Procedure FONCTION()
Reste=1
While Reste<>0
;
For i=1 To 12
PartGauche =FindString(FMU$,F$(i),1) ; Recherche partie gauche de Fonction...
If PartGauche <>0 ; Elle existe ?
Fonct=i ; OUI alors retenons le N° de la Fonction
PartDroite =FindString(FMU$,")",PartGauche) ; Recherche la partie droite.
PG$=Left(FMU$,PartGauche -1) ; Contenu gauche
PD$=Mid(FMU$,PartDroite +1) ; Contenu droit
PartGauche+4:Longueur =PartDroite -PartGauche
EX$=Mid(FMU$,PartGauche ,Longueur) ; EX$= Contenu Milieu de FMU$
;
For J=1 To 9 ; EX$ est-elle une expression d'au moins une opération ?
Op=FindString(EX$,P$(J),1)
If Op<>0 ; OUI alors on la calcule
Old_FMU$=FMU$:FMU$=EX$
CalculExpression()
EX$=FMU$:FMU$=Old_FMU$
EX$=Trim(DON$) ; Et le résultat est placé dans EX$
EndIf
Next J
;
MX.d=ValD(EX$) ; Valeur brut de l'expression EX$
If MX=0 ; Si =0 alors EX$ => est une expression littérale ???
O=Asc(Left(EX$,1))-64:If O=26 :O=1 : EndIf ; O=valeur ASCII de la première lettre de EX$
If O=22 :MX.d=ValD(VAR$(Val(Mid(EX$,2,2))))
EndIf ; si O=22 il s'agit du tableau VAR$(i)
If O>0 And O<10 ; si O possible de A à J (1 à 10)
MX.d=ValD(EN$(O,Val(Mid(EX$,2,2)))) ; pour "i" du tableau EN$( i, Val(Mid(EX$,2,2))
EndIf
a+1
EndIf
; -----------------------------------------------------------------------------------------------
Select Fonct ; MX.d = valeur venant de EX$ ou VAR$(O) ou EN$(O, J)
Case 1
MR.d=Sin(MX.d) ; F$(1)="SIN(
Case 2
MR.d=Cos(MX.d) ; F$(2)="COS(
Case 3
MR.d=Tan(MX.d) ; F$(3)="TAN(
Case 4
MR.d=Log10(MX.d) ; F$(4)="LOG10(
Case 5
MR.d=ASin(MX.d) ; F$(5)="SIN(
Case 6
MR.d=ACos(MX.d) ; F$(6)="COS(
Case 7
MR.d=ATan(MX.d) ; F$(7)="ATAN("
Case 8
MR.d=Log(MX.d) ; F$(8)="LOG("
Case 9
MR.d=Abs(MX.d) ; F$(9)="ABS("
Case 10
MR.d=Int(MX) ; F$(10)="INT("
Case 11,12
Donnee=0 ; A02,A06
KK=Val(Mid(EX$,2,2)):KM=Val(Mid(EX$,6,2)) ; Effectue la somme de EN$(1,KK à KM)
For W=KK To KM:Donnee=Donnee+ValD(EN$(1,W)):Next W
DON=Donnee:DON$=StrD(DON):Somme.d=DON
If Fonct=12 ;="MOY" ; Faire la moyenne en plus
Donnee=Donnee/(KM-KK+1)
EndIf
MR.d=Donnee
EndSelect
;
ML$=StrD(MR.d):FMU$=PG$+ML$+PD$ ; Recomposition de FMU$
Else
Reste=0
EndIf ; Oui on va calculer cette fonction
DON$=FMU$
Next i
;
Wend
Debug "> Après les Fonctions ... : "+FMU$+" <<=== "
EndProcedure
; --------------------- Sortie principale ------------------------------------------------------
; Donnée pour alimenter les DATA ----- EN$(i,j) et VAR$(i) ICI pour TEST ...
; --------------------------------------------------------------------------------------------------
DataSection
Adresse:
Data.i 8
Data.s "125.36","223.85","12.35","62.32","33.8","15.96","854.32","1025.3"
; 1 2 3 4 5 6 7 8
VAR:
Data.s "2", "3", "4", "5", "10", "25", "50", "100", "1000", "1500", "2000"
EndDataSection
; - Soit +/- 300 lignes utiles....
; --------------------------------------------------------------------------------------------------
; - Exemples de formules : Soit pour traiter les opérations suivantes ........
; --------------------------------------------------------------------------------------------------
; 1-100+(SUM(A02,A06)%25+INT(2250#2))*2-10 = OK
; devient ...........
; 2-100+(SUM(A02,A06)%25+47)*2-10 = 1054,7
; 3-100+(348.28%25+47)*2-10 = 1054,7
; 4-100+(435.35+47)*2-10 =1054,7
; 5-100+482.5*2-10 = 1054,7
; 6-100+964.7-10 = 1054,7
; 7-1064,7-10= 1054,7
; 8- Réponse = 1054,7
;
; Data.s "125.36","223.85","12.35","62.32","33.8","15.96","854.32","1025.3" = 2227.9
;
; de A02 à A06 => 223.85+12.35+62.32+33.8+15.96= 348.28
; A07 => 348.28+854.32 = > 1202.60
; A08 => 1202.60+1025.3 => 2227,90
; ---------------------------------------------------------------------------------------------------
; Autres exemples :
; 1250.36+((2280%25-125)/2)-(356.23#3) = 2605.77113... OK
; 1050.25+((SIN(0.75)^2+220-125)/2)-(COS(356.23#3))= 1097,2897 OK
; 1050.25+((SIN(0.75)^2+220-125)/2)-(COS(7,08887)) = 1097,2897 OK
; .....
; 25+(30-25)*2+10 = 45 OK
; 1502.33+158.3*2-15^2-5=1588,93 OK
; 1502.33+A01*2+A03-10 =1755.40 OK
; ------------------------------------------------------------------------------------------------------
