program projet;

(****************************************************)
(* LI1 - Projet : Structure de Polynome             *)
(* Thierry D‚l‚ris                                  *)
(* Licence d'Informatique - Groupe 1                *)
(****************************************************)

var t:table,
    g:gestion,
    fini:boolean,
    choix:integer;

(****************************************************)
(** D‚clarations des Objets de Base *****************)
(****************************************************)

  (*================================================*)
  (*= D‚claration de l'Objet ELEMENT ===============*)
  (*================================================*)
  unit element:class;
  var a:real,
      k:integer;

    (*- D‚claration de l'Unit‚ SAISIE --------------*)
    unit saisie:procedure;
    begin
      write("Entrez la Valeur du Coefficient de x  : ");
      readln(a);
      write("Entrez la Valeur de la Puissance de x : ");
      readln(k);
    end saisie;

    (*- D‚claration de l'Unit‚ VALEUR --------------*)
    unit valeur:function(x:integer):real;

      (*+ D‚claration de l'Unit‚ PUISS +++++++++++++*)
      unit puiss:function(x,k:integer):real;
      var i:integer;
      begin
        result:=1;
        if k > 0 then
          for i:=1 to k
          do
            result:=result*x;
          od;
        else
          if k < 0 then
            for i:=1 to (-1*k)
            do
              result:=result*x;
            od;
            result:=1/result;
          fi;
        fi;
      end puiss;

    begin
      result:=a*puiss(x,k);
    end valeur;

    (*- D‚claration de l'Unit‚ MULT ----------------*)
    unit mult:function(i:real;j:integer):element;
    begin
      result:=new element;
      result.a:=a*i;
      result.k:=k+j;
    end mult;

    (*- D‚claration de l'Unit‚ DERIVE --------------*)
    unit derive:function:element;
    begin
      result:=new element;
      result.a:=a*k;
      result.k:=k-1;
    end derive;

  end element;

  (*================================================*)
  (*= D‚claration de l'Objet POLYNOME ==============*)
  (*================================================*)
  unit polynome:class;
  var nom:char,
      nbr:integer,
      exp:arrayof element;

    (*- D‚claration de l'Unit‚ TRIE ----------------*)
    unit trie:procedure;
    var i,j,h:integer,
        trouve:boolean;

      (*+ D‚claration de l'Unit‚ ECHANGER ++++++++++*)
      unit echanger:procedure(inout a,b:element);
      var buffer:element;
      begin
        buffer:=a;
        a:=b;
        b:=buffer;
      end echanger;

    begin
      if nbr > 1 then
        for i:=2 to nbr
        do
          trouve:=false;
          j:=1;
          while j < i and not trouve
          do
            if exp(i).k > exp(j).k then
              for h:=j to i-1
              do
                call echanger(exp(h),exp(i));
              od;
              trouve:=true;
            else
              j:=j+1;
            fi;
          od;
        od;
      fi;
    end trie;

    (*- D‚claration de l'Unit‚ SAISIE --------------*)
    unit saisie:procedure;
    var i:integer;
    begin
      write("Nombre d'El‚ments ... : ");
      readln(nbr);
      array exp dim (1:nbr);
      for i:=1 to nbr
      do
        writeln("El‚ment Nø ",i:2," : ");
        writeln("-------------");
        exp(i):=new element;
        call exp(i).saisie;
      od;
      call factorise;
    end saisie;

    (*- D‚claration de l'Unit‚ AFFICHE -------------*)
    unit affiche:procedure;
    var j:integer;
    begin
      if nbr > 0 then
        write("                    ");
        for j:=1 to nbr
        do
          if exp(j).k=0 or exp(j).k=1 then
            write("          ");
          else
            write("        ",exp(j).k:2);
          fi;
        od;
        writeln;
        write("Polynome de Nom ",nom," : ");
        for j:=1 to nbr
        do
          if exp(j).a > 0 then
            if exp(j).k=0 then
              write("+",exp(j).a:5:2,"    ");
            else
              write("+",exp(j).a:5:2," x  ");
            fi;
          else
            if exp(j).k=0 then
              write("-",-1*exp(j).a:5:2,"    ");
            else
              write("-",-1*exp(j).a:5:2," x  ");
            fi;
          fi;
        od;
      else
        writeln;
        writeln("Polynome de Nom ",nom," :  0 ");
      fi;
      writeln;
    end affiche;

    (*- D‚claration de l'Unit‚ EVALUATION ----------*)
    unit evaluation:function(x:integer):real;
    var j:integer;
    begin
      result:=0;
      for j:=1 to nbr
      do
        result:=result+exp(j).valeur(x);
      od;
    end evaluation;

    (*- D‚claration de l'Unit‚ FACTORISE -----------*)
    unit factorise:procedure;
    var i,j:integer;

      (*+ D‚claration de l'Unit‚ COMPACTE ++++++++++*)
      unit compacte:procedure;
      var b:arrayof element,
          i,j:integer;
      begin
        j:=1;
        for i:=1 to nbr
        do
          if exp(i) =/= none then
            exp(j):=exp(i);
            j:=j+1;
          fi;
        od;
        nbr:=j-1;
        if nbr > 0 then
          array b dim (1:nbr);
          for i:=1 to nbr
          do
            b(i):=exp(i);
          od;
          exp:=b;
        fi;
      end compacte;

    begin
      for i:=1 to nbr
      do
        for j:=i+1 to nbr
        do
          if exp(j) =/= none and exp(i) =/= none then
            if exp(j).k=exp(i).k then
               exp(i).a:=exp(i).a+exp(j).a;
               kill(exp(j));
            fi;
          fi;
        od;
        if exp(i) =/= none then
          if exp(i).a = 0 then
            kill(exp(i));
          fi;
        fi;
      od;
      call compacte;
      if exp =/= none then
        call trie;
      fi;
    end factorise;

    (*- D‚claration de l'Unit‚ DERIVE ------------*)
    unit derive:function:polynome;
    var i:integer;
    begin
      result:=new polynome;
      result.nom:='R';
      result.nbr:=nbr;
      array result.exp dim (1:nbr);
      for i:=1 to nbr
      do
        result.exp(i):=exp(i).derive;
      od;
      call result.factorise;
    end derive;

  end polynome;

  (*==============================================*)
  (*= D‚claration de l'Objet TABLE ===============*)
  (*==============================================*)
  unit table:class;
  var pol:arrayof polynome;

    (*- D‚claration de l'Unit‚ VIDE --------------*)
    unit vide:function:boolean;
    begin
      result:= pol=none;
    end vide;

    (*- D‚claration de l'Unit‚ AFFMEM ------------*)
    unit affmem:procedure;
    var i:integer;
    begin
      if vide then
        writeln("Aucun Polynome en M‚moire");
      else
        write("Les Polynomes en M‚moire sont : ");
        for i:=1 to upper(pol)
        do
          write(pol(i).nom,", ");
        od;
      fi;
      writeln;
    end affmem;

    (*- D‚claration de l'Unit‚ AFFICHE -----------*)
    unit affiche:procedure;
    var i:integer;
    begin
      if not vide then
        for i:=1 to upper(pol)
        do
          call pol(i).affiche;
        od;
      else
        writeln("Aucun Polynome en M‚moire");
      fi;
      writeln;
    end affiche;

    (*- D‚claration de l'Unit‚ NOMEXISTE ---------*)
    unit nomexiste:function(input nom:char):boolean;
    var i:integer;
    begin
      i:=0;
      result:=false;
      if not vide then
        while i < upper(pol) and not result
        do
          i:=i+1;
          if pol(i).nom=nom then
            result:=true;
          fi;
        od;
      fi;
    end nomexiste;

    (*- D‚claration de l'Unit‚ AJOUTE ------------*)
    unit ajoute:procedure(input r:polynome);
    var b:arrayof polynome,
        i:integer;
    begin
      if vide then
        array pol dim (1:1);
      else
        array b dim (1:upper(pol)+1);
        for i:=1 to upper(pol)
        do
          b(i):=pol(i);
        od;
        pol:=b;
      fi;
      pol(upper(pol)):=r;
    end ajoute;

    (*- D‚claration de l'Unit‚ SAISIEPOL ---------*)
    unit saisiepol:procedure;
    var trouve:boolean,
        r:polynome,
        i:integer;
    begin
      call affmem;
      r:=new polynome;
      trouve:=true;
      while trouve
      do
        write("Nom du Polynome ..... : ");
        readln(r.nom);
        trouve:=nomexiste(r.nom);
        if trouve then
          writeln("Le Nom ",r.nom," a d‚j… ‚t‚ utilis‚...");
        fi;
      od;
      call r.saisie;
      writeln;
      call r.affiche;
      call ajoute(r);
    end saisiepol;

    (*- D‚claration de l'Unit‚ REMPLACERPAR ------*)
    unit remplacerpar:procedure(input cible:polynome);
    var i:integer,
        trouve:boolean;
    begin
      i:=0;
      while (i < upper(pol)) and not trouve
      do
        i:=i+1;
        trouve:= pol(i).nom=cible.nom;
      od;
      if trouve then
        kill(pol(i));
        pol(i):=cible;
      fi;
    end remplacerpar;

    (*- D‚claration de l'Unit‚ QUESTION ----------*)
    unit question:procedure(inout r:polynome);
    var choix:char,
        trouve:boolean;
    begin
      if r.nbr > 0 then
        choix:=' ';
        while not (choix='o' or choix='O' or choix='n' or choix='N')
        do
          write("Desirez-vous sauvegarder ",r.nom," dans la Table (O ou N) : ");
          readln(choix);
        od;
        if choix='o' or choix='O' then
          trouve:=false;
          while not trouve
          do
            write("Sous quel Nom : ");
            readln(r.nom);
            if nomexiste(r.nom) then
              write(r.nom," D‚j… Utilis‚... Confirmation (O ou N) : ");
              readln(choix);
              if choix='o' or choix='O' then
                trouve:=true;
                call remplacerpar(r);
              fi;
            else
              call ajoute(r);
              trouve:=true;
            fi;
          od;
        fi;
      writeln;
      fi;
    end question;

    (*- D‚claration de l'Unit‚ SELECTION ---------*)
    unit selection:procedure(output p1:polynome);
    var i:integer,
        choix:char,
        trouve,choisi:boolean;
    begin
      choisi:=false;
      while not choisi
      do
        write("Votre choix : ");
        readln(choix);
        i:=0;
        trouve:=false;
        while i < upper(pol) and not trouve
        do
          i:=i+1;
          trouve:= choix=pol(i).nom;
        od;
        if trouve then
          p1:=pol(i);
          choisi:=true;
        fi;
      od;
    end selection;

    (*- D‚claration de l'Unit‚ SELECTION2 --------*)
    unit selection2:procedure(output p1,p2:polynome);
    begin
      writeln;
      writeln("Polynome Nø 1 : ");
      call selection(p1);
      writeln;
      writeln("Polynome Nø 2 : ");
      call selection(p2);
      call p1.affiche;
      call p2.affiche;
    end selection2;

    (*- D‚claration de l'Unit‚ TRAITEMENT --------*)
    unit traitement:procedure(function operation(p1,p2:polynome):polynome);
    var r,p1,p2:polynome;
    begin
      call affmem;
      if not vide then
        call selection2(p1,p2);
        r:=operation(p1,p2);
        call r.affiche;
        call question(r);
      fi;
    end traitement;

    (*- D‚claration de l'Unit‚ DIVISION ----------*)
    unit division:procedure;
    var p1,p2,q,r:polynome;
    begin
      call affmem;
      if not vide then
        call selection2(p1,p2);
        call divise(p1,p2,q,r);
        call question(q);
        call question(r);
      fi;
    end division;

  end table;

(**************************************************)
(** D‚claration des Op‚rations : + - * / **********)
(**************************************************)

  (*==============================================*)
  (*= D‚claration de l'Unit‚ PLUS ================*)
  (*==============================================*)
  unit plus:function(input a,b:polynome):polynome;
  var i:integer;
  begin
    result:=new polynome;
    result.nom:='R';
    result.nbr:=a.nbr+b.nbr;
    array result.exp dim (1:result.nbr);
    for i:=1 to a.nbr
    do
      result.exp(i):=new element;
      result.exp(i):=copy(a.exp(i));
    od;
    for i:=1 to b.nbr
    do
      result.exp(a.nbr+i):=new element;
      result.exp(a.nbr+i):=copy(b.exp(i));
    od;
    call result.factorise;
  end plus;

  (*================================================*)
  (*= D‚claration de l'Unit‚ MOINS =================*)
  (*================================================*)
  unit moins:function(input a,b:polynome):polynome;
  var i:integer;
  begin
    result:=new polynome;
    result.nom:='R';
    result.nbr:=a.nbr+b.nbr;
    array result.exp dim (1:result.nbr);
    for i:=1 to a.nbr
    do
      result.exp(i):=new element;
      result.exp(i):=copy(a.exp(i));
    od;
    for i:=1 to b.nbr
    do
      result.exp(a.nbr+i):=b.exp(i).mult(-1,0);
    od;
    call result.factorise;
  end moins;

  (*=================================================*)
  (*= D‚claration de l'Unit‚ MULTIPL ================*)
  (*=================================================*)
  unit multipl:function(input a,b:polynome):polynome;
  var i,j,ind:integer;
  begin
    result:=new polynome;
    result.nom:='R';
    result.nbr:=a.nbr*b.nbr;
    array result.exp dim (1:result.nbr);
    ind:=1;
    for i:=1 to a.nbr
    do
      for j:=1 to b.nbr
      do
        result.exp(ind):=a.exp(i).mult(b.exp(j).a,b.exp(j).k);
        ind:=ind+1;
      od;
    od;
    call result.factorise;
  end multipl;

  (*================================================*)
  (*= D‚claration de l'Unit‚ DIVISE ================*)
  (*================================================*)
  unit divise:procedure(input p1,p2:polynome;output quotient,r:polynome);
  var q:polynome,
      fin:boolean;
  begin
    quotient:=new polynome;
    quotient.nbr:=0;
    q:=new polynome;
    array q.exp dim (1:1);
    q.nbr:=1;
    r:=new polynome;
    r:=copy(p1);
    fin:=false;
    while not fin
    do
      if r.exp(1).k >= p2.exp(1).k then
        q.exp(1):=r.exp(1).mult(1/p2.exp(1).a,-1*p2.exp(1).k);
        r:=moins(r,multipl(p2,q));
        quotient:=plus(quotient,q);
        fin:= r.nbr=0;
      else
        fin:=true;
      fi;
    od;
    quotient.nom:='Q';
    writeln;
    writeln("  Q : Quotient de la Division, R : Reste de la Division.");
    call quotient.affiche;
    call r.affiche;
  end divise;

(****************************************************)
(** D‚claration de l'Unit‚ de Gestion de l'Ecran ****)
(****************************************************)

  (*================================================*)
  (*= D‚claration de l'Unit‚ GESTION ===============*)
  (*================================================*)
  unit gestion:class;

    (*- D‚claration de l'Unit‚ CLS -----------------*)
    unit cls:procedure;
    begin
      write(chr(27),"[2J");
    end cls;

    (*- D‚claration de l'Unit‚ ATTEND ---------------*)
    unit attend:procedure;
    var c:integer;
    begin
      writeln;
      write("   Appuyez sur < ENTER > pour Continuer  ");
      readln;
    end attend;

  end gestion;

(****************************************************)
(* D‚claration des Unit‚es correspondant ************)
(* aux diverses Options du Menu Principal. **********)
(****************************************************)

  (*= OPTION 1 =====================================*)
  (*= Saisie d'un Nouveau Polynome =================*)
  (*================================================*)
  unit option1:procedure(g:gestion;inout a:table);
  begin
    call g.cls;
    writeln("==========================================================");
    writeln("=  STRUCTURE DE POLYNOMES : Saisie de Polynomes  =========");
    writeln("==========================================================");
    writeln;
    call a.saisiepol;
    call g.attend;
  end option1;

  (*= OPTION 2 =====================================*)
  (*= Affichage de la Table des Polynomes ==========*)
  (*================================================*)
  unit option2:procedure(g:gestion;input a:table);
  begin
    call g.cls;
    writeln("==========================================================");
    writeln("=  STRUCTURE DE POLYNOMES : Affichage des Polynomes  =====");
    writeln("==========================================================");
    writeln;
    call a.affiche;
    call g.attend;
  end option2;

  (*= OPTION 3 =====================================*)
  (*= Evaluation d'un Polynome pour un x Donn‚ =====*)
  (*================================================*)
  unit option3:procedure(g:gestion;input a:table);
  var x:real,
      r:polynome;
  begin
    call g.cls;
    writeln("==========================================================");
    writeln("=  STRUCTURE DE POLYNOMES : Evaluation de Polynome  ======");
    writeln("==========================================================");
    writeln;
    call a.affmem;
    if not a.vide then
      call a.selection(r);
      writeln;
      call r.affiche;
      write("Entrez la valeur de x : ");
      readln(x);
      writeln;
      writeln("Resultat : ",r.evaluation(x):9:2);
    fi;
    call g.attend;
  end option3;

  (*= OPTION 4 =====================================*)
  (*= Addition de Deux Polynomes de la Table =======*)
  (*================================================*)
  unit option4:procedure(g:gestion;inout a:table);
  begin
    call g.cls;
    writeln("==========================================================");
    writeln("=  STRUCTURE DE POLYNOMES : Addition de Polynome  ========");
    writeln("==========================================================");
    writeln;
    call a.traitement(plus);
    call g.attend;
  end option4;

  (*= OPTION 5 =====================================*)
  (*= Soustraction de Deux Polynomes de la Table ===*)
  (*================================================*)
  unit option5:procedure(g:gestion;inout a:table);
  begin
    call g.cls;
    writeln("==========================================================");
    writeln("=  STRUCTURE DE POLYNOMES : Soustraction de Polynome  ====");
    writeln("==========================================================");
    writeln;
    call a.traitement(moins);
    call g.attend;
  end option5;

  (*= OPTION 6 =====================================*)
  (*= Multiplication de Deux Polynomes de la Table =*)
  (*================================================*)
  unit option6:procedure(g:gestion;inout a:table);
  begin
    call g.cls;
    writeln("==========================================================");
    writeln("=  STRUCTURE DE POLYNOMES : Multiplication de Polynomes  =");
    writeln("==========================================================");
    writeln;
    call a.traitement(multipl);
    call g.attend;
  end option6;

  (*= OPTION 7 ===================================*)
  (*= Division de Deux Polynomes de la Table =====*)
  (*==============================================*)
  unit option7:procedure(g:gestion;inout a:table);
  begin
    call g.cls;
    writeln("==========================================================");
    writeln("= STRUCTURE DE POLYNOMES : Division de Polynomes =========");
    writeln("==========================================================");
    writeln;
    call a.division;
    call g.attend;
  end option7;

  (*= OPTION 8 ===================================*)
  (*= D‚rivation d'un Polynome de la Table =======*)
  (*==============================================*)
  unit option8:procedure(g:gestion;inout a:table);
  var p1,r:polynome;
  begin
    call g.cls;
    writeln("==========================================================");
    writeln("=  STRUCTURE DE POLYNOMES : Derivation d'un Polynome  ====");
    writeln("==========================================================");
    writeln;
    call a.affmem;
    if not a.vide then
      call a.selection(p1);
      writeln;
      call p1.affiche;
      r:=p1.derive;
      call r.affiche;
      call a.question(r);
    fi;
    call g.attend;
  end option8;

(****************************************************)
(** Instructions du Programme Principal *************)
(****************************************************)

begin
  g:=new gestion;
  t:=new table;
  fini:=false;
  while not fini
  do
    call g.cls;
    writeln("==========================================================");
    writeln("=  STRUCTURE DE POLYNOMES : Menu Principal  ==============");
    writeln("==========================================================");
    writeln;
    writeln;
    writeln("   Options Disponibles : ");
    writeln("   -------------------   ");
    writeln;
    writeln("   Saisie d'un Polynome ...................... :  1 ");
    writeln("   Visualisation de la Table des Polynomes ... :  2 ");
    writeln("   Evaluation d'un Polynome pour un x donn‚ .. :  3 ");
    writeln("   Additionner des Polynomes ................. :  4 ");
    writeln("   Soustraire des Polynomes .................. :  5 ");
    writeln("   Multiplier des Polynomes .................. :  6 ");
    writeln("   Diviser des Polynomes ..................... :  7 ");
    writeln("   D‚river un Polynome ....................... :  8 ");
    writeln("   Retour au SystŠme d'Exploitation .......... :  9 ");
    writeln;
    write("   Votre Choix : ");
    readln(choix);
    case choix
      when 1 : call option1(g,t);
      when 2 : call option2(g,t);
      when 3 : call option3(g,t);
      when 4 : call option4(g,t);
      when 5 : call option5(g,t);
      when 6 : call option6(g,t);
      when 7 : call option7(g,t);
      when 8 : call option8(g,t);
      when 9 : fini:=true;
    esac
  od;
  call g.cls;
end projet;
(****************************************************)