# constants:=constants,HASH:

ss:= proc(p,q,x)
     local s;
     s:= sth(p,q,x);
     difvar(x,s);
end:


nroots:= proc(p)
    local s,X,x;
    X:=indets(p);
    if nops(X)>1 then ERROR(`incorrect number of variables`)
        elif nops(X)=0 then 
               if p=0 then RETURN(p, `is the zero polynomial`)
                      else RETURN(0)
               fi;
        else x:=op(1,X)
    fi;
    s:=sth(p,diff(p,x),x);
    difvar(x,s);
end:

difvar:=proc()
    local suc1,suc2,i,s,variable;
    suc1:=NULL;
    suc2:=NULL;
    if nargs>1 then variable:=args[1];
               for i from 2 to nargs do
                   if args[i]<>0 then
                       s:=sign(lcoeff(args[i],variable));
                       suc2:=suc2,s;
                       s:=s*(1-2*(irem(degree(args[i],variable),2)));
                       suc1:=suc1,s;
                   fi;
               od;
    fi;
    var(suc1)-var(suc2);
end:

var:= proc()
    local i,k,v;
    k:=0;
    v:=0;
    if nargs>1 then
    for i from 1 to nargs do
         if args[i]>0 then
              if k=0 then k:=1;
                   elif k<0 then v:= v+1; k:=1;
              fi;
         elif args[i]<0 then
              if k=0 then k:=-1;
                   elif k>0 then v:=v+1; k:=-1;
              fi;
         fi;
    od;
    fi;
    v;
end:


sth:= proc(a,b,x)
    local suc,p,q,n1,n2,lp,lq,r,R,S0,S1,d,NS,Sr,j,n;
    p:=expand(a);
    q:=expand(b);
    if q=0 then RETURN(x,p)
    fi;
    n1:=degree(p,x);
    n2:=degree(q,x);
    lp:=lcoeff(p,x);
    lq:=lcoeff(q,x);
    suc:=p,q;
    if n1>n2 then n:=n1-1;
              d:=n-n2;
              if d<>0 then S1:=((-1)**(d*(d+1)/2))*(lp*lq)**d*q;
                       S0:=((-1)**((d+2)*(d+3)/2))*lp**d*prem(p,q,x);
                        if S0<>0 then
                                   suc:=suc,S1,S0
                                 else suc:=suc,S1
                        fi;
                      else S1:=q;
                         S0:= -prem(p,q,x);
                         if S0<>0 then suc:= suc,S0
                         fi;
              fi;
              j:=n2-1;
            else n:=n2;
                 S1:=q;
                 S0:= - rem(lq**2*p,q,x);
                 j:=n-1;
                 if S0<>0 then suc:=suc,S0
              fi;
    fi;
    R:=lcoeff(S1,x);
    if S0=0 then r:=-1
            else r:=degree(S0,x);
    fi;
    while r>=0 do
    if r>0 then
         if r=j then NS:='NS';
                     divide(prem(S1,S0,x),((-R)**(j-r+2)),NS);
                     NS:=expand(NS)*((-1)**((j-r+2)*(j-r+3)/2));
                     if NS<>0 then suc:=suc,NS
                     fi;
                     S1:=S0;
                     S0:=NS;
                     R:=lcoeff(S1,x);
                     j:=r-1;
                  else Sr:='Sr';
                       divide(prem(S1,S0,x),(R**(j-r+2)),Sr);
                       S1:='S1';
                       divide(((lcoeff(S0,x)**(j-r))*S0),(R**(j-r)),S1);
                       S1:=S1*((-1)**((j-r)*(j-r+1)/2));
                       S0:=Sr*((-1)**((j-r+2)*(j-r+3)/2));
                       if S0<>0 then suc:=suc,S1,S0
                                else suc:=suc,S1
                       fi;
                       R:=lcoeff(S1,x);
                       j:= r-1;
         fi;
           else if j>0 then
                       S1:='S1';
                       divide(((lcoeff(S0,x)**j)*S0),(R**j),S1);
                       S1:=S1*((-1)**(j*(j+1)/2));
                       suc:=suc,S1;
                fi;
                S0:=0;
    fi;
    if S0<>0 then r:=degree(S0,x)
             else r:=-1
    fi;
    od;
    suc;
end:

`IF/smcd`:=proc(p,q,x)
    local a,b,n,m,s,M1,M2;
    a:=expand(p);
    b:=expand(q);
    n:=degree(a,x);
    m:=degree(b,x);
    if n>m then s:=sth(a,b,x)
           else s:=sth(b,a,x)
    fi;
    M1:=s[nops([s])];
    M2:=s[nops([s])-1];
    if degree(M1,x)=degree(M2,x) then M2
                                 else M1
    fi;
end:

`IF/kron`:=proc(A,B)
    local i,j,k,l,n,d,C;
    d:=linalg[rowdim](A);
    n:=linalg[rowdim](B);
    C:=array(1..n*d,1..n*d);
    for i from 1 to n do
        for j from 1 to n do
            for k from 1 to d do
 		for l from 1 to d do
		    C[d*(i-1)+k,d*(j-1)+l]:=A[k,l]*B[i,j];
		od;
            od;
        od;
    od;
    C;
end:


`IF/clean`:=proc(A,n,L)
    local C,E,l,i,j,F,k,s,r,rank;
    r:=linalg[coldim](A);
    if n>r then ERROR(`wrong size of arguments`)
    fi;
    C:=array(1..r,1..r);
    E:=array(1..r,1..r);
    l:=[];
    for i from 1 to n do
         for j from 1 to r do
              C[i,j]:=A[i,j];
         od;
    l:=[op(l),i];
    od;
    F:=linalg[gausselim](linalg[submatrix](C,1..n,1..r));
    for i from 1 to n do
         for j from 1 to r do
              E[i,j]:=F[i,j];
         od;
    od;
    k:=n;
    for i from n+1 while k<r do
         for j from 1 to r do
         E[k+1,j]:=A[i,j];
         od;
         rank:='rank';
         linalg[gausselim](linalg[submatrix](E,1..k+1,1..r),rank);
         if rank=k+1 then k:=k+1;
                        l:=[op(l),i];
                        for s from 1 to r do
                             C[k,s]:=A[i,s];
                        od;
         fi;
    od;
    L:=l;
    C;
end:



`IF/SIadd`:=proc(T,Q,m)
    local P,P1,suc,M,d,V,E,s,r,ns,ns2,i,NE,NE1,NE2,NE3,NV,NR,
          Mat,A,NC,l,l1,Nr,EF,CF,B,L,VF,j,RF,x,X,mult,NA,R2;  
    P:=op(1,T);
    X:=indets(P);
    if nops(X)>1 then ERROR(`incorrect number of variables`)
        elif nops(X)=0 then RETURN([])
        else x:=op(1,X)
    fi;
    X:=indets(Q);
    if nops(X)>1 then ERROR(`incorrect number of variables`)
        elif (nops(X)=1 and op(1,X)<>x) then
                  ERROR(`wrong type of indeterminates in`,Q)
	elif nops(X)=0 then
	    E:=op(3,T);
	    r:=nops(E);
            if Q=0 then s:=0 else s:=sign(Q)
	    fi;
	    NE:=[];
	    for i from 1 to r do
		NE:=[op(NE),[op(op(i,E)),s]]
	    od;
	    RETURN([op(1,T),op(2,T),NE,op(4,T),op(5,T),op(6,T)])
    fi;
    if op(3,T)=[] then RETURN(T)
    fi;
    P1:=diff(P,x);
    suc:=sth(P,P1*Q,x);
    M:=op(nops([suc]),[suc]);
    d:=degree(M,x);
    V:=op(5,T);
    E:=op(3,T);
    s:=V[1];
    r:=linalg[vectdim](V);
    ns:=difvar(x,suc);
    if s=ns then NE:=[];
	 for i from 1 to r do
	      NE:=[op(NE),[op(op(i,E)),1]]
	 od;
	 RETURN([P,op(2,T),NE,op(4,T),op(5,T),op(6,T)]);
    elif s=-ns then NE:=[];
	 for i from 1 to r do
	      NE:=[op(NE),[op(op(i,E)),-1]]
 	 od;
	 RETURN([P,op(2,T),NE,op(4,T),op(5,T),op(6,T)]);
    fi;
    NR:=op(2,T);
    if d=0 then 
        NE1:=[];
        NE2:=[];
        NV:=array(1..2*r);
        for i from 1 to r do
            NE1:=[op(NE1),[op(op(i,E)),1]];
            NE2:=[op(NE2),[op(op(i,E)),-1]];
            NV[i]:=V[i];
       	    NR:=[op(NR),op(i,NR)*Q];
        od;
        NE:=[op(NE1),op(NE2)];
        NV[r+1]:=ns;
        for i from 2 to r do
	    NV[r+i]:=ss(P,P1*op(i+r,NR),x);
        od;
        Mat:=array(1..2,1..2);
        Mat[1,1]:=1;
        Mat[1,2]:=1;
        Mat[2,1]:=1;
        Mat[2,2]:=-1;
    else 
	if nargs=3 then mult:=args[3]
	    else mult:=nroots(`IF/smcd`(P,P1,x))
	fi;
      	if mult=0 then
	    ns2:=s - nroots(M)
	else
	    ns2:=ss(P,P1*Q^2,x)
        fi;
        if ns2=0 then NE:=[];
	    for i from 1 to r do
	       NE:=[op(NE),[op(op(i,E)),0]]
	    od;
	    RETURN([P,op(2,T),NE,op(4,T),op(5,T),op(6,T)]);
        elif ns=ns2 then 
            NE1:=[];
            NE2:=[];
            NV:=array(1..2*r);
            for i from 1 to r do
                NE1:=[op(NE1),[op(op(i,E)),0]];
                NE2:=[op(NE2),[op(op(i,E)),1]];
                NV[i]:=V[i];
                NR:=[op(NR),op(i,NR)*Q];
            od;
            NE:=[op(NE1),op(NE2)];
            NV[r+1]:=ns;
            for i from 2 to r do
	        NV[r+i]:=ss(P,P1*op(i+r,NR),x);
            od;
	    Mat:=array(1..2,1..2);
            Mat[1,1]:=1;
            Mat[1,2]:=1;
            Mat[2,1]:=0;
            Mat[2,2]:=1;
        elif ns=-ns2 then
            NE1:=[];
            NE2:=[];
            NV:=array(1..2*r);
            for i from 1 to r do
                NE1:=[op(NE1),[op(op(i,E)),0]];
                NE2:=[op(NE2),[op(op(i,E)),-1]];
                NV[i]:=V[i];
                NR:=[op(NR),op(i,NR)*Q];
            od;
            NE:=[op(NE1),op(NE2)];
            NV[r+1]:=ns;
            for i from 2 to r do
	        NV[r+i]:=ss(P,P1*op(i+r,NR),x);
            od;
	    Mat:=array(1..2,1..2);
            Mat[1,1]:=1;
            Mat[1,2]:=1;
            Mat[2,1]:=0;
            Mat[2,2]:=-1;
        else NE1:=[];
            NE2:=[];
	    NE3:=[];
            R2:=[];
            NV:=array(1..3*r);
            for i from 1 to r do
                NE1:=[op(NE1),[op(op(i,E)),0]];
                NE2:=[op(NE2),[op(op(i,E)),1]];
                NE3:=[op(NE3),[op(op(i,E)),-1]];
                NV[i]:=V[i];
	        R2:=[op(R2),op(i,NR)*Q^2];
                NR:=[op(NR),op(i,NR)*Q];
            od;
            NE:=[op(NE1),op(NE2),op(NE3)];
            NR:=[op(NR),op(R2)];
            NV[r+1]:=ns;
	    NV[2*r+1]:=ns2;
            for i from 2 to r do
	        NV[r+i]:=ss(P,P1*op(i+r,NR),x);
	        NV[2*r+i]:=ss(P,P1*op(i+2*r,NR),x);
            od;
            Mat:=array(1..3,1..3);
            Mat[1,1]:=1;
            Mat[1,2]:=1;
            Mat[1,3]:=1;
            Mat[2,1]:=0;
            Mat[2,2]:=1;
            Mat[2,3]:=-1;
            Mat[3,1]:=0;
            Mat[3,2]:=1;
            Mat[3,3]:=1;
        fi;
    fi;
    A:=`IF/kron`(op(6,T),Mat);
    NC:=linalg[linsolve](A,NV);
    l:=[];
    l1:=[];
    Nr:=0;
    EF:=[];
    CF:=[];
    for i from 1 to linalg[vectdim](NV) do
        l1:=[op(l1),i];
        if NC[i]<>0 then Nr:=Nr+1;
            EF:=[op(EF),op(i,(NE))];
            CF:=[op(CF),NC[i]];
            l:=[op(l),i];
        fi;
    od;
    if Nr<linalg[vectdim](NV) then
        B:=linalg[submatrix](A,l1,l);
        L:='L';
        NA:=`IF/clean`(B,r,L);
    else NA:=A;
        L:=l1;
    fi;
    VF:=array(1..Nr);
    RF:=[];
    for i from 1 to Nr do
        j:=op(i,L);
        VF[i]:=NV[j];
        RF:=[op(RF),op(j,NR)];
    od;
    [P,RF,EF,CF,VF,NA];
end:

SI:=proc()
    local k,P,X,x,suc,r,M,U1,U2,A,V,C,NT,i;
    k:=nargs;
    P:=args[1];
    X:=indets(P);
    if nops(X)>1 then ERROR(`incorrect number of variables`)
        elif nops(X)=0 then RETURN([])
        else x:=op(1,X)
    fi;
    suc:=sth(P,diff(P,x),x);
    r:=difvar(x,suc);
    if r=0 then RETURN([])
    fi;
    M:=op(nops([suc]),[suc]);
    if degree (M,x)>0 then U1:='U1';
        content(M,x,U1);
        M:=U1;
        U1:='U1';
        U2:='U2';
        prem(P,M,x,U1,U2);
        P:=U2;
    fi;
    A:=array(1..1,1..1);
    A[1,1]:=1;
    V:=array(1..1);
    V[1]:=r;
    C:=array(1..1);
    C[1]:=r;
    NT:=[P,[1],[[]],C,V,A];
    if k=1 then RETURN(NT)
        else for i from 2 to k do
                 NT:=`IF/SIadd`(NT,args[i],0)
             od;
    fi;
    NT;
end:


sqfree:=proc(R,x)
    local suc,M,U1,U2,P;
    P:=R;
    suc:=sth(P,diff(P,x),x);
    M:=op(nops([suc]),[suc]);
    if degree (M,x)>0 then U1:='U1';
        content(M,x,U1);
        M:=U1;
        U1:='U1';
        U2:='U2';
        prem(P,M,x,U1,U2);
        P:=U2;
    fi;
    U1:='U1';
    content(P,x,U1);
    P:=U1;
end:    

sqfran:=proc(R,nder)
    local X,x,suc,r,A,V,C,M,U1,U2,NT,d,E,NE,P,i;
    P:=R;
    X:=indets(P);
    A:=array(1..1,1..1);
    A[1,1]:=1;
    V:=array(1..1);
    V[1]:=0;
    C:=array(1..1);
    C[1]:=0;
    if nops(X)>1 then ERROR(`incorrect number of variables`)
        elif nops(X)=0 then RETURN([P,[1],[],C,V,A])
        else x:=op(1,X)
    fi;
    suc:=sth(P,diff(P,x),x);
    r:=difvar(x,suc);
    V[1]:=r;
    C[1]:=r;
    if r=0 then RETURN([P,[1],[],C,V,A])
        elif r=1 then 
            if nargs>1 then nder:=0;
            fi;
            RETURN([P,[1],[[]],C,V,A])
    fi;
    M:=op(nops([suc]),[suc]);
    if degree (M,x)>0 then 
        content(M,x,'U1');
        M:=U1;
        prem(P,M,x,'U1','U2');
        P:=U2;
    fi;
    content(P,x,'U1');
    P:=U1;
    NT:=[P,[1],[[]],C,V,A];
    d:=degree(P,x)-1;
    while r>1 do 
        if (r=2 and d>1) then E:=op(3,NT);
            NE:=[];
            for i from 1 to nops(E) do
                NE:=[op(NE),[op(op(i,E)),HASH]]
            od;
            NT:=[op(1,NT),op(2,NT),NE,op(4,NT),op(5,NT),op(6,NT)];
            NT:=`IF/SIadd`(NT,diff(P,x),0);
        else content(diff(P,x$d)/d!,x,'U2');
            NT:=`IF/SIadd`(NT,U2,0)
        fi;
        d:=d-1;
        r:=`IF/maximo`(op(4,NT));
    od;
    if nargs>1 then nder:=degree(P,x)-d-1
    fi;
    NT;
end:

ran:=proc(R,nder)
    local X,x,suc,r,A,V,C,M,U2,NT,d,P,m;
    P:=R;
    X:=indets(P);
    A:=array(1..1,1..1);
    A[1,1]:=1;
    V:=array(1..1);
    V[1]:=0;
    C:=array(1..1);
    C[1]:=0;
    if nops(X)>1 then ERROR(`incorrect number of variables`)
        elif nops(X)=0 then RETURN([P,[1],[],C,V,A])
        else x:=op(1,X)
    fi;
    suc:=sth(P,diff(P,x),x);
    M:=op(nops([suc]),[suc]);
    m:=nroots(M);
    r:=difvar(x,suc);
    V[1]:=r;
    C[1]:=r;
    if r=0 then RETURN([P,[1],[],C,V,A])
        elif r=1 then 
            if nargs>1 then nder:=0;
            fi;
            RETURN([P,[1],[[]],C,V,A])
    fi;
    NT:=[P,[1],[[]],C,V,A];
    d:=degree(P,x)-1;
    while r>1 do
        U2:='U2';
        content(diff(P,x$d)/d!,x,U2);
        NT:=`IF/SIadd`(NT,U2,m);
        d:=d-1;
        r:=`IF/maximo`(op(4,NT));
    od;
    if nargs>1  then nder:=degree(P,x)-d-1
    fi;
    NT;
end:


`IF/maximo`:=proc(v)
    local m,i,n;
    n:=linalg[vectdim](v);
    m:=v[1];
    if n>1 then
         for i from 2 to n do
              if v[i]>m then m:=v[i]
              fi;
         od;
    fi;
    m;
end:


ransi:=proc()
    local n,T,i;
    n:=nargs;
    if n<1 then ERROR(`no arguments`)
    elif (n=1 or op(3,args[1])=[]) then RETURN(args[1])
    fi;
    T:=mark(args[1]);
    for i from 2 to n do
        T:=`IF/SIadd`(T,args[i])
    od;
    T:=unmark(T);
end:

mark:=proc(T)
    local E,NE,i;
    E:=op(3,T);
    NE:=[];
    for i from 1 to nops(E) do
    	NE:=[op(NE),[i,op(op(i,E))]]
    od;
    [op(1,T),op(2,T),NE,op(4,T),op(5,T),op(6,T)];
end:

unmark:=proc(T)
    local E,A,i,l,NE,j,k,found,rt,NA,NC,C,h,s;
    E:=op(3,T);
    s:=nops(E);
    NE:=[];
    A:=op(6,T);
    C:=op(4,T);
    NC:=[];
    NA:=array(1..s,1..s);
    for l from 1 to s do
        i:=s-l+1;
    	found:=false;
	j:=s+1;
	while not found do 
	    j:=j-1;
	    if op(1,op(j,E))=i then 
   		found:=true;
		rt:=[];
		for k from 2 to nops(op(j,E)) do
		    rt:=[op(rt),op(k,op(j,E))]
		od;
		NE:=[rt,op(NE)];
		for h from 1 to s do
		    NA[h,i]:=A[h,j]
		od;
		NC:=[op(NC),op(j,C)];
	    fi;
	od;
    od;
    [op(1,T),op(2,T),NE,NC,op(5,T),NA];
end: 


`IF/minor`:=proc(L1,L2,c,h)
    local i,j,M;
    j:=0;
    if nargs =4 then h:=false
    fi;
    for i from 1 while j=0 do
        if (op(i,L1)=HASH or (i=nops(L1) and op(i,L1)=op(i,L2))) 
            then j:=1;
            if nargs =4 then h:=true
            fi;
            M:=true
        elif op(i,L1)<op(i,L2) then j:=1;
            if i>1 then 
                if op(i-1,L1)>0 then M:=true
                      else M:=false
                fi;
            else 
                if c>0 then M:=true
                     else M:=false
                fi;
            fi;
        elif op(i,L1)>op(i,L2) then j:=1;
            if i>1 then 
                if op(i-1,L1)<0 then M:=true
                      else M:=false
                fi;
            else 
                if c<0 then M:=true
                     else M:=false
                fi;
            fi;
        fi;
    od;
    M;
end:
        
ransort:=proc(T)
    local v,i,j,U,s1,n,k,E,P,c,X,x,s;
    E:=op(3,T);
    P:=op(1,T);
    X:=indets(P);
    if nops(X)>1 then ERROR(`incorrect number of variables`)
        elif nops(X)=0 then RETURN(E)
        else x:=op(1,X)
    fi;
    c:=lcoeff(P,x);
    n:=nops(E);
    if n<2 then RETURN(E)
    fi;
    v:=array(1..n);
    for i from 1 to n do
         v[i]:=op(i,E);
    od;
    for i from 1 to n-1 do
        for j from i+1 to n do
            if `IF/minor`(v[j],v[i],c) then U:=v[j];
                                     v[j]:=v[i];
                                     v[i]:=U;
            fi;
        od;
    od;
    i:=0;
    while i<n-1 do
         k:=0;
         for j from 1 to min(nops(v[n-i]),nops(v[n-i-1])) while k=0 do
              if op(j,v[n-i])<>op(j,v[n-i-1]) then
                   k:=1;
                   i:=i+1;
                                              else
                   if op(j,v[n-i])=HASH then
                        k:=1;
                        s1:=(irem(i,2)*2-1)*op(j+1,v[n-i]);
                        if s1*c>0 then U:=v[n-i];
                                 v[n-i]:=v[n-i-1];
                                 v[n-i-1]:=U;
                                 i:=i+2
                                else i:=i+1
                        fi;
                   fi;
              fi;
         od;
    od;
    s:=NULL;
    for i from 1 to n do
         s:=s,v[i];
    od;
    s:=[s];
end:

position:=proc(rt,T)
    local E,l,r,i,reached,rt1,l1,coincide,k;
    E:=op(3,T);
    l:=nops(rt);
    r:=nops(E);
    i:=1;
    reached:=false;
    while (not reached and i<=r) do
	rt1:=op(i,E);
	l1:=nops(rt1);
	if l=l1 then
	    k:=1;
	    coincide:=true;
	    while (coincide and k<=l) do 
		if op(k,rt)<>op(k,rt1) then 
		    coincide:=false
		fi;
		k:=k+1;
	    od;
	    if coincide then reached:=true
	    fi;
	fi;
	i:=i+1;
    od;
    if (not reached) then i:=1;
    fi;
    i-1;
end: 


`IF/sth1`:=proc(T,S)
    local P,X,x,F,y,r,n,L,NT,i,j,NL,LF,s,d,d1;
    if nops(op(3,T))=0 then RETURN([])
    fi;
    P:=op(1,T);
    X:=indets(P);
    if nops(X)>1 then ERROR(`incorrect number of variables`)
        elif nops(X)=0 then RETURN(E)
        else x:=op(1,X)
    fi;
    F:=op(1,S);
    X:=indets(F);
    if nops(X)<>2 then ERROR(`incorrect number of variables`)
        elif x=op(1,X) then y:=op(2,X)
        elif x=op(2,X) then y:=op(1,X)
        else ERROR(`variables do not match`)
    fi;
    r:=linalg[vectdim](op(4,T));
    L:=[];
    s:=nops(S);
    d:=degree(op(1,S),y);
    for i from 1 to s do
        d1:=degree(op(i,S),y);
        if d1=d then
            L:=[op(L), lcoeff(op(i,S),y)];
            d:=d-1
        else
            for j from d1 to d-1 do
		L:=[op(L),0]
	    od;
	    d:=d1
        fi;
    od;
    s:=nops(L);
    NT:=ransi(T,op(L));
    LF:=[];
    for i from 1 to r do
        n:=nops(op(i,op(3,NT)));
        NL:=[];
        for j from n-s+1 to n do
	    NL:=[op(NL),op(j,op(i,op(3,NT)))] 
        od;
        LF:=[op(LF),`IF/var1`(op(NL))];
    od;
end:


`IF/var1`:=proc()
    local n,a,b,C,j,P,D,k;
    n:=nargs;
    if n<2 then ERROR(`incorrect number of indeterminates`)
    fi;
    a:=args[1];
    if a=0 then ERROR(`null first sign`)
    fi;
    C:=0;
    b:=args[2];
    j:=2;
    while j<=n do
        P:=0;
        D:=0;
	while (b<>0 and j<=n) do 
	    if a=b then P:=P+1
	    	else D:=D+1
	    fi;
	    a:=b;
	    j:=j+1;
	    if j<=n then b:=args[j]
	    fi;
	od;
	C:=C+P-D;
	if j<n then 
	    k:=0;
	    while (b=0 and j<=n) do
	    	k:=k+1;
		j:=j+1;
		if j<=n then b:=args[j]
		fi;
	    od;
	    if b<>0 then C:=C+`IF/epsilon`(k,a,b);
		a:=b;
		j:=j+1;
		if j<=n then b:=args[j]
		fi;
	    fi;
	elif b=0 then j:=j+1
	fi;
    od;
    C;
end:


`IF/epsilon`:=proc(k,a,b);
    if irem(k,2)=1 then 0
        else (-1)^(k/2)*a*b
    fi;
end:

cad:=proc(G)
    local F,F1,S,D,PP,P,U,D1,T,T1,L,L1,c,nd,X,x,y,aux,
	  nd1,OT,OT1,s,r,r1,rt,rt1,v,h,ML,k,FL,i,j,i1,sg;
    F:=G;
    X:=indets(F);
    if nops(X)>2 then ERROR(`incorrect number of variables`)
    elif (nops(X)=0 and F<>0) then RETURN([])
    elif F=0 then ERROR(`zero polynomial input`)
    elif nops(X)=1 then print(`the projection direction is`,op(1,X));
	RETURN([{nroots(F)}])
    fi;
    x:=op(1,X);
    y:=op(2,X);
    if degree(lcoeff(F,y),x)>0 then 
	if degree(lcoeff(F,x),y)>0 then ERROR(`no good projection direction`)
	else X:=[y,x];
	    aux:=x;
	    x:=y;
	    y:=aux
    	fi;
    fi;    
    F1:=diff(F,y);
    S:=sth(F,F1,y);
    D:=op(nops([S]),[S]);
    if degree(D,y)>0 then PP:='PP';
                        content(D,y,PP);
                        P:='P';
                        U:='U';
                        prem(F,PP,x,U,P);
                        PP:='PP';
                        content(P,y,PP);
                        F:=PP;
                        F1:=diff(F,y);
                        S:=sth(F,F1,y);
                        D:=op(nops([S]),[S]);
    fi;
    PP:='PP';
    content(D,x,PP);
    D:=PP;
    D:=sqfree(D,x);
    c:=sign(lcoeff(D,x));
    s:=-c*sign(irem(degree(D,x),2)*2-1);
    D1:=diff(D,x);
    nd:='nd';
    nd1:='nd1';
    T:=sqfran(D,nd);
    T1:=ran(D1,nd1);
    r:=nops(op(3,T));
    if r=0 then F:=subs(x=0,F);
	   print(`the projection direction is`, y);
           RETURN([{nroots(F)}])
    fi;
    r1:=nops(op(3,T1));
    ML:=[];
    if r=r1+1 then
        OT:=ransort(T);
	OT1:=ransort(T1);
	ML:=[{}];
	for i from 1 to r1 do 
	    ML:=[op(ML),i,{i}];
	od;
	ML:=[op(ML),r,{}]
    else 
        if nd1<nd then 
       	    for i from degree(D1,x)-nd1-1 to degree(D1,x)-nd do
	       T1:=`IF/SIadd`(T1,diff(D1,x$i))
            od;
        fi;
        OT:=ransort(T);
        T1:=`IF/SIadd`(T1,D);
        OT1:=ransort(T1);
        i:=1;
        j:=1;
        while i<=r do 
            k:=i;
    	    rt:=op(i,OT);
            while (k=i and j<=r1) do
	        rt1:=op(j,OT1);
	        h:='h';
	        v:=`IF/minor`(rt,rt1,c,h);
     	        if h then sg:=(irem(i,2)*2-1)*s;
		    if sg=op(nops(rt1),rt1) then v:=false
			else v:=true
		    fi;
	        fi;
   	        if v then 
		    if (i=1 and nops(ML)=0) then ML:=[{}]
		    fi;
                    ML:=[op(ML),i,{j}];
		    i:=i+1
                elif (i=1 and nops(ML)=0) then
		    ML:=[{j}]
	        elif (i=r and j=r1) then 
		    ML:=[op(ML),i,{}];
		    i:=i+1
	        fi;
   	        j:=j+1;
            od;
	    if (i=r and j>r1) then
		ML:=[op(ML),i,{}];
		i:=i+1
            fi;
        od;
    fi;  
    L:=`IF/sth1`(T,[S]);
    L1:=`IF/sth1`(T1,[S]);
    if nops(op(1,ML))=0 then 
    	FL:=[{`IF/minusinfty`(S)}]
    else i:=position(op(op(1,op(1,ML)),OT1),T1);
        FL:=[{op(i,L1)}]
    fi;
    for j from 1 to r-1 do
        i:=position(op(op(2*j,ML),OT),T);
	i1:=position(op(op(1,op(2*j+1,ML)),OT1),T1);
	FL:=[op(FL),op(i,L),{op(i1,L1)}]
    od;
    i:=position(op(op(2*r,ML),OT),T);
    FL:=[op(FL),op(i,L)];
    if nops(op(2*r+1,ML))=0 then
	FL:=[op(FL),{`IF/plusinfty`(S)}]
    else i:=position(op(op(1,op(2*r+1,ML)),OT1),T1);
        FL:=[{op(i,L1)}]
    fi;
    print(`the projection direction is`, y);
    FL;    
end:

`IF/minusinfty`:=proc(S)
     local suc1,suc2,i,dy,cx,d,s,x,y;
     suc1:=NULL;
     suc2:=NULL;
     for i from 1 to nargs do
         dy:=degree(args[i],y);
         cx:=lcoeff(args[i],y);
         d:=-(irem(degree(cx,x),2)*2-1);
	 s:=sign(lcoeff(cx,x))*d;
	 suc1:=suc1,s*(-(irem(dy,2)*2-1));
  	 suc2:=suc2,s;
     od;
     var(suc1)-var(suc2);
end:
	
`IF/plusinfty`:=proc(S)
     local suc1,suc2,i,dy,cx,s,x,y;
     suc1:=NULL;
     suc2:=NULL;
     for i from 1 to nargs do
         dy:=degree(args[i],y);
         cx:=lcoeff(args[i],y);
	 s:=sign(lcoeff(cx,x));
	 suc1:=suc1,s*(-(irem(dy,2)*2-1));
  	 suc2:=suc2,s;
     od;
     var(suc1)-var(suc2);
end:

IF := `No on-line help available: please read the file IF.tex`:
#save `IF.m`;
#quit
