PROGRAM DERIVATION;

(**********************************************************)
(*    permet de saisir caractŠre par caractŠre            *)

  UNIT readkey : IIUWgraph function : integer;
  begin
    do
      result := inkey;
      if result > 0 then exit fi
    od
 end readkey;

 unit  gotoxy : procedure(lig, col : integer);
    var c,d,e,f : char,
        i,j     : integer;
  begin
    i := lig div 10; j := lig mod 10;
    c := chr(48+i);  d := chr(48+j);
    i := col div 10; j := col mod 10;
    e := chr(48+i);  f := chr(48+j);
    write( chr(27), "[", c, d, ";", e, f, "H")
  end gotoxy;

  Unit mesg : procedure (message1, message2 : string);
  begin
     call gotoxy(23,1);
     write(message1);
     call gotoxy(24,1);
     write(message2);
     return;
  end mesg;

  Unit charint : function (c : char) : integer;
  begin
    result := ord(c) - 48 ;
 end charint;

(**********************************************************)
(*  UNITE IMPLANTATION DES PILES POUR EMPILER LES OPERANDES *)

  UNIT pile1 : class;
  const max = 100;
  var premier : integer,
      stack : arrayof expr;

     UNIT empiler : procedure (car : expr);
     BEGIN
           premier := premier + 1;
           stack(premier) := car;
           call display("stak = ",stack(premier));
     END empiler;

     UNIT empty : function : boolean;
     BEGIN
       result := premier = 0;
     END EMPTY;

     UNIT sommet : function: expr;
     BEGIN
       IF not empty then result := stack(premier);
                     (* else call error (raise pile-vide) *)
       FI;
     END sommet;

     UNIT depiler : procedure;
     BEGIN
       IF not empty then premier := premier - 1;
       writeln(premier);
       FI;
     END depiler;

BEGIN
     premier := 0;
     array stack dim (1 : max);
END pile1;

(**********************************************************)
(*  UNITE IMPLANTATION DES PILES POUR LES OPERATEURS      *)

  UNIT pile2 : class;
    const max = 100;
    var premier : integer,
        stack : arrayof char;
  

     UNIT empiler : procedure (car : char);
     BEGIN
           premier := premier + 1;
           stack(premier) := car;
     END empiler;

     UNIT empty : function : boolean;
     BEGIN
       result := premier = 0;
     END EMPTY;

     UNIT sommet : function: char;
     BEGIN
       IF not empty then result := stack(premier);
                     (* else call error (raise pile-vide) *)
       FI;
     END sommet;

     UNIT depiler : procedure;
     BEGIN
       IF not empty then premier := premier - 1;
       writeln(premier);
       FI;
     END depiler;
BEGIN
     premier := 0;
     array stack dim (1 : max);
END pile2;

 
UNIT EXPR:CLASS; (* OUR FUNCTIONS WILL BE EXPRESSIONS *)
     UNIT VIRTUAL DERIV:FUNCTION(X:VARIABLE):EXPR;
                               END DERIV;
END EXPR;

       UNIT VARIABLE:EXPR CLASS(ID:char);
           (* DIFFERENTIATED EXPRESSION WILL OBVIOUSLY CONSIST OF VARIABLES*)
            UNIT VIRTUAL DERIV:FUNCTION(X:VARIABLE):EXPR;
                               BEGIN
                                 writeln("je suis dans variable");
                                 IF X.ID=ID THEN
                                    RESULT:=ONE
                                 ELSE
                                    RESULT:=ZERO
                                    (*THIS IS THE DERIVATIVE OF A VARIABLE
                                     OTHER THEN X WITH RESPECT TO X       *)
                                 FI
                               END DERIV;
                 END VARIABLE;

     (* DIFFERENTIATION OF A FUNCTION OF A VARIABLE X *)

 
       UNIT CONSTANT:EXPR CLASS(K:REAL);
           (* DIFFERENTIATED EXPRESSION WILL CONSIST OF CONSTANT *)
            UNIT VIRTUAL DERIV:FUNCTION(X:VARIABLE):EXPR;
                               BEGIN
                                 writeln("je suis dans constant ");
                                 RESULT:=ZERO;
                               END DERIV;
       END CONSTANT;

       UNIT PAIRE:EXPR CLASS(L,R:EXPR);
           (* WE WILL ALSO COMPUTE DERIVATIVES OF EXPRESSIONS WITH TWO
              ARGUMENT OPERATORS                                        *)
           UNIT VIRTUAL DERIV: FUNCTION(X:VARIABLE):EXPR;
           END;
       END PAIRE;
 
 
       UNIT SOMME : PAIRE CLASS;
           (* WE DIFFERENTIATE THE SUM OF TWO EXPRESSIONS *)
            UNIT VIRTUAL DERIV:FUNCTION(X:VARIABLE):EXPR;
                               VAR LPRIM,RPRIM:EXPR;
                               BEGIN
                                writeln("je suis sum");
                                 LPRIM:=L.DERIV(X);
                                 RPRIM:=R.DERIV(X);
                                 (*WE DELETE 0 AS THE NEUTRAL ELEMENT OF
                                   ADDITION                             *)
                                 IF LPRIM=ZERO THEN
                                    RESULT:=RPRIM
                                 ELSE
                                 IF RPRIM=ZERO THEN
                                    RESULT:=LPRIM
                                 ELSE
                                    RESULT:=NEW SOMME(LPRIM,RPRIM)
                                 FI
                                 FI;
                               END DERIV;
                END SOMME;
 
 
        UNIT DIFF:PAIRE CLASS;
            (* WE DIFFERENTIATE THE DIFFERECE OF TWO EXPRESSIONS *)
             UNIT VIRTUAL DERIV:FUNCTION(X:VARIABLE):EXPR;
                                VAR LPRIM,RPRIM: EXPR;
                                BEGIN
                                  LPRIM:=L.DERIV(X);
                                  RPRIM:=R.DERIV(X);
                                  (* WE DELETE THE SUBTRACTED ZERO *)
                                  IF RPRIM=ZERO THEN
                                     RESULT:=LPRIM
                                  ELSE
                                     RESULT:=NEW DIFF(LPRIM,RPRIM)
                                  FI
                                END DERIV;
                 END DIFF;

        UNIT PRODUIT : paire class;
            UNIT VIRTUAL deriv : function (X : variable) : expr;
            VAR UPRIMV, UVPRIM : expr;
            BEGIN
              UPRIMV := new produit(L.deriv(X), R);
              UVPRIM := new produit(L, R.deriv(x));
              result := new somme (UPRIMV, UVPRIM);
            END DERIV;
        END PRODUIT;

        UNIT DIVISE : PAIRE class;
           UNIT virtual deriv : function (X : variable): expr;
           VAR UPRIMV, UVPRIM, VCARRE, NUMERA : EXPR;
           BEGIN
             UPRIMV := new produit (L.deriv(X), R);
             UVPRIM := new produit (L, R.deriv(X));
             NUMERA := new diff (UPRIMV, UVPRIM);
             VCARRE := new produit (R, R);
             result := new divise (NUMERA, VCARRE);
          END DERIV;
       END DIVISE;

       UNIT SINUS : EXPR class (L : EXPR);
          UNIT virtual deriv : function (X:variable) : expr;
          VAR LPRIM : EXPR;
          BEGIN
            LPRIM := new cosinus (L);
            result := new produit (L.deriv(X), LPRIM);
         END deriv;
      END sinus;

      UNIT cosinus : expr class (L:expr);
        UNIT virtual deriv : function (X:variable) : expr;
        VAR LPRIM : expr;
        BEGIN
          LPRIM := new produit (new constant(-1), new sinus (L));
          result := new produit (L.deriv(X) , LPRIM);
        END deriv;
     END cosinus;

     UNIT LOGN : expr class (L : expr);
       UNIT virtual deriv : function (X:variable): expr;
       BEGIN
         result := new divise (L.DERIV(X), L);
      END DERIV;
    END logn;

    UNIT expon : expr class (L:expr);
      UNIT virtual deriv : function(X : variable) : expr;
      BEGIN
        result := new produit (L.deriv(X), L);
      END deriv;
   END expon;

   UNIT racine : expr class (L:expr);
     UNIT virtual deriv : function (X : variable) : expr;
     VAR prod, rac : expr;
     BEGIN
        RAC := new racine(L);
        prod := new produit (new constant (2), rac);
        result := new diff(L.deriv(X), prod);
     END deriv;
  END racine;


        UNIT DISPLAY:PROCEDURE(T:STRING,E:EXPR);
           (* DISPLAY THE EXPRESSION TREE IN A READABLE FORM *)
 
                  UNIT SCAN:PROCEDURE(E:EXPR);
                  BEGIN
                     IF E IS SOMME THEN
                                 WRITE(" ("); CALL SCAN(E QUA PAIRE.L);
                                 WRITE("+");
                                 CALL SCAN(E QUA PAIRE.R);
                                 WRITE(" )");
                    ELSE
                      IF E IS DIFF THEN
                                 WRITE(" (");
                                 CALL SCAN(E QUA PAIRE.L);WRITE("-");
                                 CALL SCAN(E QUA PAIRE.R);
                                 WRITE(" )")
                      ELSE
                        IF E is PRODUIT then
                                 write(" (");
                                 call scan (E QUA PAIRE.L);
                                 write("*");
                                 call scan (E QUA PAIRE.R);
                                 write(" )");
                        ELSE
                          IF E IS DIVISE then
                                 write(" (");
                                 call scan (E QUA PAIRE.L);
                                 write("/");
                                 call scan (E QUA PAIRE.R);
                                 write(" )");
                          ELSE
                          IF E IS SINUS then
                             write(" ( sin(");
                             call scan (E QUA SINUS.L);
                             write(" )");
                          ELSE
                              IF E IS COSINUS then
                              write(" ( cos(");
                              call scan (E QUA COSINUS.L);
                              write(" )");
                           ELSE
                             IF E IS LOGN then
                             write(" ( LN(");
                             call scan (E QUA LOGN.L);
                             write(" )");
                             ELSE
                               IF E IS EXPON then
                               write(" ( EXP(");
                               call scan (E QUA EXPON.L);
                               write(" )");
                               ELSE
                                 IF E IS RACINE then
                                 write(" ( û (");
                                 call scan (E QUA RACINE.L);
                                 write(" )");
                                ELSE
                                 IF E IS CONSTANT THEN
                                   WRITE(E QUA CONSTANT.K:6:2)
                                  ELSE
                                  IF E IS VARIABLE THEN
                                     WRITE(E QUA VARIABLE.ID);
                   FI FI FI FI FI FI FI FI FI FI FI;
                      END SCAN;
 
                          BEGIN
                              WRITE(T);
                              CALL SCAN(E);
                              WRITELN;
         END DISPLAY;
 

(*********************************************************)
(*******         calcul de la d‚riv‚e             **********)
(*******      les op‚rateurs vont dans P2               ****)
(*******      et les op‚randes vont dans P1             ****)

UNIT expderivee : procedure (express : arrayof char,
                              taille : integer);
  CONST max = 100;
  VAR   opaux , c: char,
        P1 : pile1,
        P2 : pile2,
        const1, auxreel : real,
        decim, saisie : boolean,
        X, Y, Z, T , arg1, arg2, consta, E,U,V, F : expr,
        compt, j, cptcons : integer;

  BEGIN
     compt := 0;
     P1 := new pile1;
     P2 := new pile2;
     decim, saisie := false;
     FOR j := 1 to taille
     do
        write(express(j));
     od;
     j := 1;
     DO
       if  j = taille + 1 then exit fi;
       case express(j)
       when '(' : j := j + 1;

       when 'X','x': X := new variable('X');
                     call P1.empiler(X);
                     j := j + 1;

       when 'Y','y': E := new variable('Y');
                     call P1.empiler(E);
                     j := j + 1;

       when 'Z','z': E := new variable('Z');
                     call P1.empiler(E);
                     j := j + 1;

      when 'T','t': E := new variable('T');
                    call P1.empiler(E);
                    j := j + 1;

      when '0','1','2','3','4','5','6','7','8','9','.' :
                     cptcons := 100;
                     auxreel := charint(express(j));
                     const1 :=  auxreel * cptcons;
                     j := j + 1;
                     writeln("j = ",j);
                     writeln("avant test");
                     while not saisie do
                       writeln("dans test");
                       c := express(j);
                       IF (c = '0' or c = '1' or c = '2' or c='3'
                          or c='4' or c='5' or c= '6' or c = '7' or
                          c = '8' or c='9')
                       THEN
                         writeln("test0");
                         cptcons := cptcons div 10;
                         auxreel := charint(express(j));
                         const1 := const1 + (auxreel * cptcons);
                         j := j + 1;
                       ELSE
                         IF ( c ='.' )
                         THEN writeln("test1");
                              const1 := const1 / cptcons;
                              cptcons := 1;
                              j := j + 1;
                              decim := true;
                         ELSE
                           writeln("test2");
                           IF not decim then const1 := const1 / cptcons;FI;
                           E := new constant (const1);
                           writeln("avant empile");
                           call p1.empiler(E);
                           writeln("apres empile");
                           saisie := true;
                           writeln("j = ",j);
                         FI;
                       FI;
                     OD;

      when ' ' : j := j + 1;

      when 'C', 'S','E','R','L','c','s','e','r','l','+','-',
           '*','/' : writeln(express(j));
                     call P2.empiler(express(j));
                     j := j + 1;

      when ')' : opaux := P2.sommet ;
                 call P2.depiler;
                 case opaux
                 when '+','-','*','/' :
                       arg2 := P1.sommet;
                       call display("arg2 = ",arg2);
                       call P1.depiler;
                       arg1 :=P1.sommet;
                       call display("arg1 = ",arg1);
                       call P1.depiler;
                       case opaux
                         when  '+' : E := new somme(arg1, arg2);
                                     call display("E = ",E);
                        when  '-' :  E := new diff (arg1, arg2);
                                     call display("E = ",E);
                        when '*': E := new produit (arg1,arg2);
                        when '/': E := new divise (arg1, arg2);
                      esac;
                     call P1.empiler (E);

                when 'C','c','e','E','s','S','r','R','l','L' :
                      arg2 := P1.sommet;
                      call display("arg2 = ",arg2);
                      call P1.depiler;


                 esac;
                 j := j + 1;

     esac;
   od;
   call display ("fonction = ", E);
   F := E.deriv(X);
   call display("Derivee = ", F);
   readln;
END expderivee;


(**********************************************************)
(***********   Saisie de la fonction … d‚river   **********)

UNIT expsaisie : procedure (output express : arrayof char,
                            taille : integer);
VAR expression : arrayof char,
    car : char,
    opbool, cstbool, varbool, decibool : boolean,
    i, touche, opcpt, ligne, pouvcpt, pfermcpt : integer;

BEGIN
  array expression dim (1:maxi);
  ligne := 5;
  writeln("Saisissez votre expression en parenth‚sant convenablement");
  i := 1;
  call gotoxy(ligne,1);
  DO
   touche := readkey;
   car := chr (touche);
   case car
       when 'v','V': (* l'utilisateur veut valider l'expression *)
                   IF (pouvcpt =/= pfermcpt)
                   then
                     mes1 := "Expression incorrecte, il manque des parenthŠses.";
                     mes2 := "Expression ignor‚e.";
                   ELSE
                     IF pouvcpt =/= opcpt
                     THEN mes1 := "Expression incorrecte. Il manque des parenthŠses ou des op‚rateurs.";
                          mes2 := "Expression ignor‚e.";
                     ELSE
                       sais := true;
                       taille := i - 1;
                       express := expression;
                       mes1 := "Expression valid‚e.";
                       mes2 := blanc;
                     FI;
                   FI;
                   call mesg(mes1, mes2);
                   call gotoxy(25,1);
                   write(" <Appuyer sur une touche pour continuer>");
                   readln;
                   exit;

     when 'i','I': mes1 := "Expression ignor‚e";
                   call mesg(mes1, blanc);
                   call gotoxy(25,1);
                   write(" <Appuyer sur une touche pour continuer>");
                   readln;
                   exit;

      when ' ': (*rien*)
                IF decibool
                THEN mes1 := "Erreur : il manque la partie d‚cimale.";
                     call mesg(mes1, blanc);
                     call gotoxy(ligne, i);
                FI;

      when '(': write(car);
                IF decibool
                THEN mes1 := "Erreur : il manque la partie d‚cimale.";
                     call mesg(mes1, blanc);
                     call gotoxy(ligne, i);
                ELSE
                  pouvcpt := pouvcpt + 1;
                  opbool := false;
                  cstbool := false;
                  varbool := false;
                  expression(i) := car;
                  i := i + 1;
                  call gotoxy(ligne,i);
                FI;

      when ')' : IF decibool
                 THEN mes1 := "Erreur : il manque la partie d‚cimale.";
                     call mesg(mes1, blanc);
                     call gotoxy(ligne, i);
                 ELSE
                   pfermcpt := pfermcpt +1;
                   opbool := false;
                   cstbool := false;
                   varbool := false;
                   write(car);
                   expression(i) := car;
                   i := i + 1;
                   call gotoxy(ligne,i);
                 FI;

      when '+', '-', '*', '/', 'C', 'c','E','e','L','l','R','r','S','s' :
                 write(car);
                 IF opbool
                 then mes1 := "2 op‚rateurs ne peuvent pas ˆtre cons‚cutifs.";
                      mes2 := "Resaisissez le caractŠre.";
                      call mesg (mes1,mes2);
                      call gotoxy(ligne,i);
                 ELSE
                   IF decibool
                   THEN mes1 := "Erreur : il manque la partie d‚cimale.";
                     call mesg(mes1, blanc);
                     call gotoxy(ligne, i);
                   ELSE
                     opbool := true;
                     varbool := false;
                     cstbool := false;
                     expression (i) := car;
                     i := i + 1;
                     opcpt := opcpt + 1;
                     call mesg(blanc,blanc);
                     call gotoxy(ligne,i);
                   FI;
                 FI;

      when '0','1','2', '3','4','5','6','7','8','9' :
                write(car);
                IF varbool
                then mes1 := "Il manque un op‚rateur ou une parenthŠse";
                     mes2 := "Resaisissez le caractŠre.";
                     call mesg(mes1, mes2);
                     call gotoxy(ligne, i);
                ELSE
                  decibool := false;
                  cstbool := true;
                  varbool := false;
                  opbool := false;
                  expression(i) := car;
                  i := i + 1;
                  call mesg (blanc, blanc);
                  call gotoxy(ligne,i);
               FI;

      when '.' : IF decibool
                 THEN mes1 := "Erreur : il manque la partie d‚cimale.";
                       call mesg(mes1, blanc);
                       call gotoxy(ligne, i);
                 ELSE
                   IF (varbool or opbool or not cstbool)
                   THEN
                     mes1 := "Expression incorrecte.";
                     mes2 := "Resaisissez le caractŠre.";
                     call mesg(mes1, mes2);
                     call gotoxy(ligne,i);
                   ELSE
                     (*  cstbool   est … vraie *)
                       decibool := true;
                       cstbool := false;
                       expression(i) := car;
                       i := i + 1;
                       call mesg(blanc, blanc);
                       call gotoxy(ligne, i);
                   FI;
                FI;

      when 'x','y','z','t','X','Y','Z','T':
             write(car);
             IF varbool
             then mes1 := "On ne peut pas avoir 2 variables cons‚cutives.";
                  mes2 := "Il manque un op‚rateur ou une parenthŠse.";
                  call mesg (mes1, mes2);
                  call gotoxy(ligne, i);
             ELSE
                IF cstbool
                then mes1 := "Il manque un op‚rateur ou une parenthŠse.";
                     mes2 := "Resaisissez le caractŠre." ;
                     call mesg(mes1, mes2);
                     call gotoxy(ligne,i);
                ELSE
                  IF decibool
                  THEN mes1 := "Erreur : il manque la partie d‚cimale.";
                       call mesg(mes1, blanc);
                       call gotoxy(ligne, i);
                  ELSE
                    cstbool := false;
                    opbool := false;
                    varbool := true;
                    expression(i) := car;
                    i := i + 1;
                    call mesg(blanc, blanc);
                    call gotoxy(ligne,i);
                  FI;
                FI;
              FI;

      otherwise write(car);
                mes1 := "CaractŠre invalide. Corrigez le.";
                call mesg(mes1,blanc);
                call gotoxy(ligne,i);
    esac;
  OD;
END expsaisie;


(**********************************************************)
(*****    GUIDE UTILISATION                           *****)
Unit guideutil : procedure;
BEGIN
END guideutil;


(*********************************************************************)
(***************** EFFACEMENT DE L'ECRAN *****************************)
UNIT Newpage : procedure;
begin
  write(chr(27), "[2J")
end newpage;


(**********************************************************)
(******                MENU                          ******)
UNIT MENU : PROCEDURE;
VAR choix, k : integer;
         
BEGIN
DO
  call newpage; 
  Write  ("     Ú");
  For k:= 3 to 61 DO
  Write("Ä");
  OD;
  writeln("¿");
  Writeln("     ³                                                            ³");
  Writeln("     ³ ****     CE PROGRAMME DONNE L'EXPRESSION DE LA        **** ³");
  WRITELN("     ³ ****     DERIVEE CORRESPONDANT A UNE FONCTION         **** ³");
  Writeln("     ³ ****                 DONNEE                           **** ³");
  writeln("     ³                                                            ³");
  writeln("     ³                                                            ³");
  writeln("     ³        1 : Saisir une fonction                             ³");
  Writeln("     ³        2 : Calculer la d‚riv‚e d'une fonction              ³");
  Writeln("     ³        3 : Visualiser le guide d'utilisation               ³");
  Writeln("     ³        4 : Quitter                                         ³");
  writeln("     ³                                                            ³");
  Write  ("     À");
  For k := 2 to 60 DO
    write ("Ä");
  OD;
  writeln("Ù");
  writeln;
  write("       votre choix :");
  readln (choix);
  call newpage;
  CASE choix
    When 1 : taille := 0;
             call expsaisie (express,taille);

    WHEN 2 : IF not sais
             then  write("coucou");
                   mes1 := "Aucune expression correcte n'a ‚t‚ saisie";
                   mes2 := blanc;
                   call mesg (mes1, mes2);
                   write("<Appuyer sur une touche pour continuer>");
                   readln;
                   call menu;
             ELSE call expderivee(express, taille);
             FI;

    WHEN 3 : call guideutil;

    WHEN 4 : exit ;
    OTHERWISE  mes1 :="le choix demand‚ est incorrect ";
              call mesg(mes1, blanc);
              write("<Appuyer sur une touche pour continuer>");
              readln;
  ESAC;
OD;
END MENU;


(**********************************************************)
(*****        PROGRAMME PRINCIPAL                     *****)
(**********************************************************)
CONST MAXI = 80,
      MAX  = 50,
      BLANC = "                                                                      ";

VAR sais : boolean,
    express : arrayof char,
    mes1, mes2 : string,
    taille : integer,
     ZERO,ONE:CONSTANT;
       

BEGIN
     ZERO:=NEW CONSTANT(0);
     ONE:=NEW CONSTANT(1);
     sais := false;
     call menu;
END;