/* CALCUL DES RESOLVANTES PRODUITS DE 1 AU DEGRE DU POLYNOMES */

/* AVEC LES RESULTANTS */
resolvante_produit_res(p,x):=
   block([n,rmax,puissances,elementaires,rh,k,rf],
          n:hipow(p,x),
          rmax : binomial(n,quotient(n,2)),
          rh: makelist(resultant(p,y-x^i,x),i,0,rmax),
          puissances: makelist(maplist(lambda([pol],
                                              (-1)^k*coeff(pol,y,n-k)),
                                       expand(rh)),
                               k,0,n),
          elementaires :maplist(lambda([puissances] ,
                                    pui2ele(first(puissances),puissances)),
                                puissances),
          k : 0,
          maplist(lambda([elem],
                         (deg:first(elem),
                          rf[k] : y^deg,
                          for i:1 thru deg do
                              (elem:rest(elem),
                               rf[k]:rf[k] +
                                       (-1)^(i)*first(elem)*y^(deg-i)),
                          k:k+1,
                          rf[k-1])),
                  elementaires));

/* AVEC LES FONCTIONS SYMETRIQUES */
/* Les A[k] sont les fonctions puissances des racines de la re'solvante */

resolvante_produit_sym (p,x):=
    block([n,rmax,krmax,a,aa,resol,pui_depart],
       (n:hipow(p,x),
        krmax : if oddp(n) then 1+quotient(n,2) else quotient(n,2),
        a[0]:makelist(binomial(n,r),r,0,n),
        a[1] :cons(n,makelist(coeff(p,x,n-i)*(-1)^i/coeff(p,x,n),i,1,n)),
        pui_depart:ele2pui(binomial(n,krmax)*krmax,a[1]),
        for i:1 thru quotient(n,2)
           do for k:binomial(n,i-1)+1 thru binomial(n,i)
              do a[k] : pui2ele(n-i,makelist(part(pui_depart,r*k+1),
                                          r,0,n-i)),
        makelist((bin : binomial(n,r),
                  aa : pui2ele(bin,makelist(part(a[k],r+1),k,0,bin)),
                  resol : y^bin,
                  for j:bin-1 step -1 thru 0 do
                      (aa:rest(aa),
                       resol : resol + (-1)^(bin-j)*first(aa)*y^j),
                 resol), r,1,n)));

resolvante_unitaire(p,q,x):=
    block([aa,ele,pp,ppui,n,m,alt,resol],
    (p:expand(p),q:expand(q),
     n:hipow(p,x),
     ele:cons(n,makelist(coeff(p,x,n-j)*(-1)^j/coeff(p,x,n),j,1,n)),
     m:hipow(q,x),
     pp:ele2pui(n*m,ele), print(pp),
     ppui : expand(makelist(q^j,j,1,n)), print(ppui),
     ppui : makelist((aa:part(ppui,j),
                      aa:aa + (part(pp,1)-1)*coeff(aa,x,0),
                for k:m*j step -1 thru 0 do 
                    aa:ratsubst(part(pp,k+1),x^k,aa),aa),
                j,1,n), print(ppui),
     pp:pui2ele(n,cons(n,ppui)),
     resol:y^n,alt:1,
     for i:n-1 step -1 thru 0 do
        ( pp:rest(pp),
          alt:-1*alt,
          resol:alt*first(pp)*y^i + resol), 
     resol));

/*   Pour calculer prod_{1<= i<j<= 7} (x_i-x_j)   */

resolvante_alternee1(f,x) := 
    block([r,c,delta,n],
      n:hipow(f,x),
      r:resultant(f,y-diff(f,x)^2,x),
      c : ev(r,y=0),
      r:expand(subst(y=1/z,r/y^8)),
      delta: poly_discriminant(f,x),
      r:expand(delta^8*subst(z=y/delta,r)/c),
      ev(r,y=z^2));


/* Calcul de $x_1x_2+x_3$ */


resolvante_klein(polynome,x) := 
       block([degre,p,pui,elem,e,n],
       e:polynome2ele(polynome,x),
       n:hipow(polynome,x),
       degre : 3*binomial(n,3),
       p : rest(ele2pui(2*degre,e)), 
       print(fait),
       pui: cons(degre,
               cons((n-2)*e[3]+(n-2)*(n-1)/2*e[2],
                    makelist(monterme(p,r)
                             + (n-2)*(p[r]^2/2-p[2*r]/2) 
                             + (n-2)*(n-1)/2*p[r]
                             +3*h(p,r), r,2,degre))), 
       print(fait),
       elem : rest(pui2ele(degre,pui)), 
       print(fait),
       x^degre + sum((-1)^i*elem[i]*x^(degre-i),i,1,degre))$

monterme(p,r) := block([somme],
               somme:0, 
               for i:quotient(r,2)+1 thru r-1 do 
                 (somme : somme + 
                      binomial(r,i)*(p[r+i]-p[i]*p[r]-p[2*i]*p[r-i]/2+
                          p[i]^2*p[r-i]/2 + p[2*r-i]-p[r-i]*p[r]-
                          p[2*r-2*i]*p[i]/2+ p[r-i]^2*p[i]/2)),
               somme)$

h(p,r) := if oddp(r) then 0 
             else binomial(r,r/2)*(p[3*r/2]/3-p[r/2]*p[r]/2+p[r/2]^3/6)$

/* Calcul de $x_1x_2x_3+x_4$ */

resolvante_klein3(polynome,x) := 
       block([degre,p,lim,e,n],
       e:polynome2ele(polynome,x),
       n:hipow(polynome,x),
       degre : 4*binomial(n,4),
       p : rest(ele2pui(3*degre,e)), print(fait),
       p: cons(degre,cons((n-3)*e[4]+(n-3)*(n-2)*(n-1)/3*e[2],
             makelist(monterme3(p,r)+
                       + (n-3)*(p[3*r]/3-p[r]*p[2*r]/2 + p[r]^3/6) + 
                       (n-3)*(n-2)*(n-1)/3*p[r]
                       +3*h3(p,r),r,2,degre))), print(fait),
       p : rest(pui2ele(degre,p)), print(fait),
       x^degre + sum((-1)^i*p[i]*x^(degre-i),i,1,degre))$

monterme3(p,r) :=
       block([somme],
               somme:0, 
               for i:quotient(r,2)+1 thru r-1 do 
                 (somme : somme + 
                             binomial(r,i)*
                 (-p[2*i+r]+p[i]*p[i+r] + p[2*i]*p[r]/2 - p[i]^2*p[r]
         +p[3*i]*p[r-i]/3 -p[i]*p[2*i]*p[r-i]/2 + p[i]^3*p[r-i]/6
         -p[3*r-2*i]+p[r-i]*p[2*r-i] + p[2*r-2*i]*p[r]/2 - p[r-i]^2*p[r]
         +p[3*r-3*i]*p[i]/3 -p[r-i]*p[2*r-2*i]*p[i]/2 + p[r-i]^3*p[i]/6)),
                 somme)$


h3(p,r) := if oddp(r) then 0 
             else binomial(r,r/2)*
          (-p[2*r]/4+p[3*r/2]*p[r/2]/3+p[r]^2/8 +p[r]*p[r/2]^2/4+p[r/2]^4/24)$

/*  CALCUL DE LA RESOLVANTE x1x2-x3x4 */
/* e EST LISTE DES FONCTIONS SYMETRIQUES ELEMENTAIRES [n,e1,...,en] 
   DU POLYNOME QUE L'ON TRANSFORME DEGRE 420 pour degre 8 */
  /* (NON TESTEE) */

resolvante_vierer (polynome,x) :=
      block( [degre,p,e,n],
        e:polynome2ele(polynome,x),
        n:hipow(polynome,x),
        degre : 6*binomial(n,4),
        p : rest(ele2pui(2*degre,e)),
        p: cons(degre,
                makelist(if oddp(r) then 0  
                            else 2*termevierer(p,r) 
                                 + (-1)^r*(n-3)*(n-2)*(p[r]^2-p[2*r])/2
                                 + 6*(-1)^(r/2)*binomial(r,r/2)*
               (-p[2*r]/4+p[3*r/2]*p[r/2]/3+p[r]^2/8 - p[r]*p[r/2]^2/4
                   +p[r/2]^4/24),r,1,degre)),
       p:rest(pui2ele(degre,p)),
       x^degre + sum((-1)^i*p[i]*x^(degre-i),i,1,degre))$

termevierer(p,r) := block([somme],
            somme:0,
           for i:r/2+1 thru r-1 do
               somme : somme +
                      (-1)^i*binomial(r,i)*(-3*p[2*r]/2+p[r-i]*p[r+i]
                        +p[2*i]*p[2*(r-i)]/4 -p[r-i]^2*p[2*i]/4
                        -p[i]^2*p[2*(r-i)]/4
                         +p[i]*p[2*r-i]+p[r]^2/2
                     -p[i]*p[r-i]*p[r] +p[i]^2*p[r-i]^2/4),
           somme)$

/*  CALCUL DE LA RESOLVANTE x1x2 + x3x4  de D_8 */
/* e EST LISTE DES FONCTIONS SYMETRIQUES ELEMENTAIRES [n,e1,...,en] 
   DU POLYNOME QUE L'ON TRANSFORME DEGRE 210 pour degre le degre 8 */

resolvante_diedrale (polynome,x) :=
      block( [degre,p,e,n],
        e:polynome2ele(polynome,x),
        n:hipow(polynome,x),
        degre : 3*binomial(n,4),
        p : rest(ele2pui(2*degre,e)),
        p: cons(degre,
                makelist(termediedral(p,r) 
                         + (n-3)*(n-2)*(p[r]^2-p[2*r])/4
                                 + if oddp(r) then 0
                                      else 3*binomial(r,r/2)*
               (-p[2*r]/4+p[3*r/2]*p[r/2]/3+p[r]^2/8 - p[r]*p[r/2]^2/4
                   +p[r/2]^4/24),r,1,degre)),
       p:rest(pui2ele(degre,p)),
       x^degre + sum((-1)^i*p[i]*x^(degre-i),i,1,degre))$

termediedral(p,r) := block([somme],
            somme:0,
           for i:quotient(r,2)+1 thru r-1 do
               somme : somme +
                      binomial(r,i)*(-3*p[2*r]/2+p[r-i]*p[r+i]
                        +p[2*i]*p[2*(r-i)]/4 -p[r-i]^2*p[2*i]/4
                        -p[i]^2*p[2*(r-i)]/4
                         +p[i]*p[2*r-i]+p[r]^2/2
                     -p[i]*p[r-i]*p[r] +p[i]^2*p[r-i]^2/4),
           somme)$


/* RESOLVANTE BIPARTITE : x1x2x3..x(n/2) + x(n/2+1)....xn
   NE FONCTIONNE QUE SI n EST PAIR 
   SE CALCULE EN 3 OU 5 SECONDES POUR LE DEGRE 6 
   SE CALCULE EN 4 mn POUR LE DEGRE 8 */

resolvante_bipartite(polynome,x) := 
      block( [degre,pui_pol,elem_pol,n,pui_resol,elem_resol],
        elem_pol:polynome2ele(polynome,x),
        n:hipow(polynome,x),
        degre : binomial(n-1,n/2-1),
        pui_pol : ele2pui(4*degre,elem_pol),
        pui_resol : [],
        for r:degre step -1 thru 1 do
             (print(r),
             pui_resol : cons(pui(pui_pol,
                                   polynome_bipartite(r),
                                   makelist(concat(a,j),j,1,n)),
                               pui_resol)),
        elem_resol : pui2ele(degre,cons(degre,pui_resol)),
        ele2polynome(elem_resol,y))$

polynome_bipartite(r) :=
           block([s,borne],
           s : 0,
           borne:quotient(r,2)+remainder(r,2),
           for i:borne thru r do
                s : s + 
                    binomial(r,i)*prod(concat(a,j)^i,j,1,n/2)
                                 *prod(concat(a,j)^(r-i),j,n/2+1,n),
           if oddp(r) then  s 
              else s +(degre-1)*binomial(r,r/2)*prod(concat(a,j)^(r/2),j,1,n))$

/* resolvante_bipartite(x^6+2*x^2+2,x);

   resolvante_bipartite(x^6+2*x^3-2,x);  */


