3 (**********************************************************)
\r
4 (* permet de saisir caract
\8are par caract
\8are *)
\r
6 UNIT readkey : IIUWgraph function : integer;
\r
10 if result > 0 then exit fi
\r
14 unit gotoxy : procedure(lig, col : integer);
\r
18 i := lig div 10; j := lig mod 10;
\r
19 c := chr(48+i); d := chr(48+j);
\r
20 i := col div 10; j := col mod 10;
\r
21 e := chr(48+i); f := chr(48+j);
\r
22 write( chr(27), "[", c, d, ";", e, f, "H")
\r
25 Unit mesg : procedure (message1, message2 : string);
\r
34 Unit charint : function (c : char) : integer;
\r
36 result := ord(c) - 48 ;
\r
39 (**********************************************************)
\r
40 (* UNITE IMPLANTATION DES PILES POUR EMPILER LES OPERANDES *)
\r
44 var premier : integer,
\r
45 stack : arrayof expr;
\r
47 UNIT empiler : procedure (car : expr);
\r
49 premier := premier + 1;
\r
50 stack(premier) := car;
\r
51 call display("stak = ",stack(premier));
\r
54 UNIT empty : function : boolean;
\r
56 result := premier = 0;
\r
59 UNIT sommet : function: expr;
\r
61 IF not empty then result := stack(premier);
\r
62 (* else call error (raise pile-vide) *)
\r
66 UNIT depiler : procedure;
\r
68 IF not empty then premier := premier - 1;
\r
75 array stack dim (1 : max);
\r
78 (**********************************************************)
\r
79 (* UNITE IMPLANTATION DES PILES POUR LES OPERATEURS *)
\r
83 var premier : integer,
\r
84 stack : arrayof char;
\r
87 UNIT empiler : procedure (car : char);
\r
89 premier := premier + 1;
\r
90 stack(premier) := car;
\r
93 UNIT empty : function : boolean;
\r
95 result := premier = 0;
\r
98 UNIT sommet : function: char;
\r
100 IF not empty then result := stack(premier);
\r
101 (* else call error (raise pile-vide) *)
\r
105 UNIT depiler : procedure;
\r
107 IF not empty then premier := premier - 1;
\r
113 array stack dim (1 : max);
\r
117 UNIT EXPR:CLASS; (* OUR FUNCTIONS WILL BE EXPRESSIONS *)
\r
118 UNIT VIRTUAL DERIV:FUNCTION(X:VARIABLE):EXPR;
\r
122 UNIT VARIABLE:EXPR CLASS(ID:char);
\r
123 (* DIFFERENTIATED EXPRESSION WILL OBVIOUSLY CONSIST OF VARIABLES*)
\r
124 UNIT VIRTUAL DERIV:FUNCTION(X:VARIABLE):EXPR;
\r
126 writeln("je suis dans variable");
\r
131 (*THIS IS THE DERIVATIVE OF A VARIABLE
\r
132 OTHER THEN X WITH RESPECT TO X *)
\r
137 (* DIFFERENTIATION OF A FUNCTION OF A VARIABLE X *)
\r
140 UNIT CONSTANT:EXPR CLASS(K:REAL);
\r
141 (* DIFFERENTIATED EXPRESSION WILL CONSIST OF CONSTANT *)
\r
142 UNIT VIRTUAL DERIV:FUNCTION(X:VARIABLE):EXPR;
\r
144 writeln("je suis dans constant ");
\r
149 UNIT PAIRE:EXPR CLASS(L,R:EXPR);
\r
150 (* WE WILL ALSO COMPUTE DERIVATIVES OF EXPRESSIONS WITH TWO
\r
151 ARGUMENT OPERATORS *)
\r
152 UNIT VIRTUAL DERIV: FUNCTION(X:VARIABLE):EXPR;
\r
157 UNIT SOMME : PAIRE CLASS;
\r
158 (* WE DIFFERENTIATE THE SUM OF TWO EXPRESSIONS *)
\r
159 UNIT VIRTUAL DERIV:FUNCTION(X:VARIABLE):EXPR;
\r
160 VAR LPRIM,RPRIM:EXPR;
\r
162 writeln("je suis sum");
\r
165 (*WE DELETE 0 AS THE NEUTRAL ELEMENT OF
\r
173 RESULT:=NEW SOMME(LPRIM,RPRIM)
\r
180 UNIT DIFF:PAIRE CLASS;
\r
181 (* WE DIFFERENTIATE THE DIFFERECE OF TWO EXPRESSIONS *)
\r
182 UNIT VIRTUAL DERIV:FUNCTION(X:VARIABLE):EXPR;
\r
183 VAR LPRIM,RPRIM: EXPR;
\r
187 (* WE DELETE THE SUBTRACTED ZERO *)
\r
191 RESULT:=NEW DIFF(LPRIM,RPRIM)
\r
196 UNIT PRODUIT : paire class;
\r
197 UNIT VIRTUAL deriv : function (X : variable) : expr;
\r
198 VAR UPRIMV, UVPRIM : expr;
\r
200 UPRIMV := new produit(L.deriv(X), R);
\r
201 UVPRIM := new produit(L, R.deriv(x));
\r
202 result := new somme (UPRIMV, UVPRIM);
\r
206 UNIT DIVISE : PAIRE class;
\r
207 UNIT virtual deriv : function (X : variable): expr;
\r
208 VAR UPRIMV, UVPRIM, VCARRE, NUMERA : EXPR;
\r
210 UPRIMV := new produit (L.deriv(X), R);
\r
211 UVPRIM := new produit (L, R.deriv(X));
\r
212 NUMERA := new diff (UPRIMV, UVPRIM);
\r
213 VCARRE := new produit (R, R);
\r
214 result := new divise (NUMERA, VCARRE);
\r
218 UNIT SINUS : EXPR class (L : EXPR);
\r
219 UNIT virtual deriv : function (X:variable) : expr;
\r
222 LPRIM := new cosinus (L);
\r
223 result := new produit (L.deriv(X), LPRIM);
\r
227 UNIT cosinus : expr class (L:expr);
\r
228 UNIT virtual deriv : function (X:variable) : expr;
\r
231 LPRIM := new produit (new constant(-1), new sinus (L));
\r
232 result := new produit (L.deriv(X) , LPRIM);
\r
236 UNIT LOGN : expr class (L : expr);
\r
237 UNIT virtual deriv : function (X:variable): expr;
\r
239 result := new divise (L.DERIV(X), L);
\r
243 UNIT expon : expr class (L:expr);
\r
244 UNIT virtual deriv : function(X : variable) : expr;
\r
246 result := new produit (L.deriv(X), L);
\r
250 UNIT racine : expr class (L:expr);
\r
251 UNIT virtual deriv : function (X : variable) : expr;
\r
252 VAR prod, rac : expr;
\r
254 RAC := new racine(L);
\r
255 prod := new produit (new constant (2), rac);
\r
256 result := new diff(L.deriv(X), prod);
\r
261 UNIT DISPLAY:PROCEDURE(T:STRING,E:EXPR);
\r
262 (* DISPLAY THE EXPRESSION TREE IN A READABLE FORM *)
\r
264 UNIT SCAN:PROCEDURE(E:EXPR);
\r
267 WRITE(" ("); CALL SCAN(E QUA PAIRE.L);
\r
269 CALL SCAN(E QUA PAIRE.R);
\r
274 CALL SCAN(E QUA PAIRE.L);WRITE("-");
\r
275 CALL SCAN(E QUA PAIRE.R);
\r
278 IF E is PRODUIT then
\r
280 call scan (E QUA PAIRE.L);
\r
282 call scan (E QUA PAIRE.R);
\r
285 IF E IS DIVISE then
\r
287 call scan (E QUA PAIRE.L);
\r
289 call scan (E QUA PAIRE.R);
\r
294 call scan (E QUA SINUS.L);
\r
297 IF E IS COSINUS then
\r
299 call scan (E QUA COSINUS.L);
\r
304 call scan (E QUA LOGN.L);
\r
309 call scan (E QUA EXPON.L);
\r
312 IF E IS RACINE then
\r
314 call scan (E QUA RACINE.L);
\r
317 IF E IS CONSTANT THEN
\r
318 WRITE(E QUA CONSTANT.K:6:2)
\r
320 IF E IS VARIABLE THEN
\r
321 WRITE(E QUA VARIABLE.ID);
\r
322 FI FI FI FI FI FI FI FI FI FI FI;
\r
332 (*********************************************************)
\r
333 (******* calcul de la d
\82riv
\82e **********)
\r
334 (******* les op
\82rateurs vont dans P2 ****)
\r
335 (******* et les op
\82randes vont dans P1 ****)
\r
337 UNIT expderivee : procedure (express : arrayof char,
\r
340 VAR opaux , c: char,
\r
343 const1, auxreel : real,
\r
344 decim, saisie : boolean,
\r
345 X, Y, Z, T , arg1, arg2, consta, E,U,V, F : expr,
\r
346 compt, j, cptcons : integer;
\r
352 decim, saisie := false;
\r
353 FOR j := 1 to taille
\r
359 if j = taille + 1 then exit fi;
\r
361 when '(' : j := j + 1;
\r
363 when 'X','x': X := new variable('X');
\r
364 call P1.empiler(X);
\r
367 when 'Y','y': E := new variable('Y');
\r
368 call P1.empiler(E);
\r
371 when 'Z','z': E := new variable('Z');
\r
372 call P1.empiler(E);
\r
375 when 'T','t': E := new variable('T');
\r
376 call P1.empiler(E);
\r
379 when '0','1','2','3','4','5','6','7','8','9','.' :
\r
381 auxreel := charint(express(j));
\r
382 const1 := auxreel * cptcons;
\r
385 writeln("avant test");
\r
386 while not saisie do
\r
387 writeln("dans test");
\r
389 IF (c = '0' or c = '1' or c = '2' or c='3'
\r
390 or c='4' or c='5' or c= '6' or c = '7' or
\r
394 cptcons := cptcons div 10;
\r
395 auxreel := charint(express(j));
\r
396 const1 := const1 + (auxreel * cptcons);
\r
400 THEN writeln("test1");
\r
401 const1 := const1 / cptcons;
\r
407 IF not decim then const1 := const1 / cptcons;FI;
\r
408 E := new constant (const1);
\r
409 writeln("avant empile");
\r
410 call p1.empiler(E);
\r
411 writeln("apres empile");
\r
418 when ' ' : j := j + 1;
\r
420 when 'C', 'S','E','R','L','c','s','e','r','l','+','-',
\r
421 '*','/' : writeln(express(j));
\r
422 call P2.empiler(express(j));
\r
425 when ')' : opaux := P2.sommet ;
\r
428 when '+','-','*','/' :
\r
430 call display("arg2 = ",arg2);
\r
433 call display("arg1 = ",arg1);
\r
436 when '+' : E := new somme(arg1, arg2);
\r
437 call display("E = ",E);
\r
438 when '-' : E := new diff (arg1, arg2);
\r
439 call display("E = ",E);
\r
440 when '*': E := new produit (arg1,arg2);
\r
441 when '/': E := new divise (arg1, arg2);
\r
443 call P1.empiler (E);
\r
445 when 'C','c','e','E','s','S','r','R','l','L' :
\r
447 call display("arg2 = ",arg2);
\r
456 call display ("fonction = ", E);
\r
458 call display("Derivee = ", F);
\r
463 (**********************************************************)
\r
464 (*********** Saisie de la fonction
\85 d
\82river **********)
\r
466 UNIT expsaisie : procedure (output express : arrayof char,
\r
468 VAR expression : arrayof char,
\r
470 opbool, cstbool, varbool, decibool : boolean,
\r
471 i, touche, opcpt, ligne, pouvcpt, pfermcpt : integer;
\r
474 array expression dim (1:maxi);
\r
476 writeln("Saisissez votre expression en parenth
\82sant convenablement");
\r
478 call gotoxy(ligne,1);
\r
481 car := chr (touche);
\r
483 when 'v','V': (* l'utilisateur veut valider l'expression *)
\r
484 IF (pouvcpt =/= pfermcpt)
\r
486 mes1 := "Expression incorrecte, il manque des parenth
\8ases.";
\r
487 mes2 := "Expression ignor
\82e.";
\r
489 IF pouvcpt =/= opcpt
\r
490 THEN mes1 := "Expression incorrecte. Il manque des parenth
\8ases ou des op
\82rateurs.";
\r
491 mes2 := "Expression ignor
\82e.";
\r
495 express := expression;
\r
496 mes1 := "Expression valid
\82e.";
\r
500 call mesg(mes1, mes2);
\r
502 write(" <Appuyer sur une touche pour continuer>");
\r
506 when 'i','I': mes1 := "Expression ignor
\82e";
\r
507 call mesg(mes1, blanc);
\r
509 write(" <Appuyer sur une touche pour continuer>");
\r
515 THEN mes1 := "Erreur : il manque la partie d
\82cimale.";
\r
516 call mesg(mes1, blanc);
\r
517 call gotoxy(ligne, i);
\r
520 when '(': write(car);
\r
522 THEN mes1 := "Erreur : il manque la partie d
\82cimale.";
\r
523 call mesg(mes1, blanc);
\r
524 call gotoxy(ligne, i);
\r
526 pouvcpt := pouvcpt + 1;
\r
530 expression(i) := car;
\r
532 call gotoxy(ligne,i);
\r
535 when ')' : IF decibool
\r
536 THEN mes1 := "Erreur : il manque la partie d
\82cimale.";
\r
537 call mesg(mes1, blanc);
\r
538 call gotoxy(ligne, i);
\r
540 pfermcpt := pfermcpt +1;
\r
545 expression(i) := car;
\r
547 call gotoxy(ligne,i);
\r
550 when '+', '-', '*', '/', 'C', 'c','E','e','L','l','R','r','S','s' :
\r
553 then mes1 := "2 op
\82rateurs ne peuvent pas
\88tre cons
\82cutifs.";
\r
554 mes2 := "Resaisissez le caract
\8are.";
\r
555 call mesg (mes1,mes2);
\r
556 call gotoxy(ligne,i);
\r
559 THEN mes1 := "Erreur : il manque la partie d
\82cimale.";
\r
560 call mesg(mes1, blanc);
\r
561 call gotoxy(ligne, i);
\r
566 expression (i) := car;
\r
568 opcpt := opcpt + 1;
\r
569 call mesg(blanc,blanc);
\r
570 call gotoxy(ligne,i);
\r
574 when '0','1','2', '3','4','5','6','7','8','9' :
\r
577 then mes1 := "Il manque un op
\82rateur ou une parenth
\8ase";
\r
578 mes2 := "Resaisissez le caract
\8are.";
\r
579 call mesg(mes1, mes2);
\r
580 call gotoxy(ligne, i);
\r
586 expression(i) := car;
\r
588 call mesg (blanc, blanc);
\r
589 call gotoxy(ligne,i);
\r
592 when '.' : IF decibool
\r
593 THEN mes1 := "Erreur : il manque la partie d
\82cimale.";
\r
594 call mesg(mes1, blanc);
\r
595 call gotoxy(ligne, i);
\r
597 IF (varbool or opbool or not cstbool)
\r
599 mes1 := "Expression incorrecte.";
\r
600 mes2 := "Resaisissez le caract
\8are.";
\r
601 call mesg(mes1, mes2);
\r
602 call gotoxy(ligne,i);
\r
604 (* cstbool est
\85 vraie *)
\r
607 expression(i) := car;
\r
609 call mesg(blanc, blanc);
\r
610 call gotoxy(ligne, i);
\r
614 when 'x','y','z','t','X','Y','Z','T':
\r
617 then mes1 := "On ne peut pas avoir 2 variables cons
\82cutives.";
\r
618 mes2 := "Il manque un op
\82rateur ou une parenth
\8ase.";
\r
619 call mesg (mes1, mes2);
\r
620 call gotoxy(ligne, i);
\r
623 then mes1 := "Il manque un op
\82rateur ou une parenth
\8ase.";
\r
624 mes2 := "Resaisissez le caract
\8are." ;
\r
625 call mesg(mes1, mes2);
\r
626 call gotoxy(ligne,i);
\r
629 THEN mes1 := "Erreur : il manque la partie d
\82cimale.";
\r
630 call mesg(mes1, blanc);
\r
631 call gotoxy(ligne, i);
\r
636 expression(i) := car;
\r
638 call mesg(blanc, blanc);
\r
639 call gotoxy(ligne,i);
\r
644 otherwise write(car);
\r
645 mes1 := "Caract
\8are invalide. Corrigez le.";
\r
646 call mesg(mes1,blanc);
\r
647 call gotoxy(ligne,i);
\r
653 (**********************************************************)
\r
654 (***** GUIDE UTILISATION *****)
\r
655 Unit guideutil : procedure;
\r
660 (*********************************************************************)
\r
661 (***************** EFFACEMENT DE L'ECRAN *****************************)
\r
662 UNIT Newpage : procedure;
\r
664 write(chr(27), "[2J")
\r
668 (**********************************************************)
\r
669 (****** MENU ******)
\r
670 UNIT MENU : PROCEDURE;
\r
671 VAR choix, k : integer;
\r
682 Writeln(" ³ **** CE PROGRAMME DONNE L'EXPRESSION DE LA **** ³");
\r
683 WRITELN(" ³ **** DERIVEE CORRESPONDANT A UNE FONCTION **** ³");
\r
684 Writeln(" ³ **** DONNEE **** ³");
\r
687 writeln(" ³ 1 : Saisir une fonction ³");
\r
688 Writeln(" ³ 2 : Calculer la d
\82riv
\82e d'une fonction ³");
\r
689 Writeln(" ³ 3 : Visualiser le guide d'utilisation ³");
\r
690 Writeln(" ³ 4 : Quitter ³");
\r
693 For k := 2 to 60 DO
\r
698 write(" votre choix :");
\r
702 When 1 : taille := 0;
\r
703 call expsaisie (express,taille);
\r
705 WHEN 2 : IF not sais
\r
706 then write("coucou");
\r
707 mes1 := "Aucune expression correcte n'a
\82t
\82 saisie";
\r
709 call mesg (mes1, mes2);
\r
710 write("<Appuyer sur une touche pour continuer>");
\r
713 ELSE call expderivee(express, taille);
\r
716 WHEN 3 : call guideutil;
\r
719 OTHERWISE mes1 :="le choix demand
\82 est incorrect ";
\r
720 call mesg(mes1, blanc);
\r
721 write("<Appuyer sur une touche pour continuer>");
\r
728 (**********************************************************)
\r
729 (***** PROGRAMME PRINCIPAL *****)
\r
730 (**********************************************************)
\r
735 VAR sais : boolean,
\r
736 express : arrayof char,
\r
737 mes1, mes2 : string,
\r
743 ZERO:=NEW CONSTANT(0);
\r
744 ONE:=NEW CONSTANT(1);
\r