1module groebres;
2
3% Redistribution and use in source and binary forms, with or without
4% modification, are permitted provided that the following conditions are met:
5%
6%    * Redistributions of source code must retain the relevant copyright
7%      notice, this list of conditions and the following disclaimer.
8%    * Redistributions in binary form must reproduce the above copyright
9%      notice, this list of conditions and the following disclaimer in the
10%      documentation and/or other materials provided with the distribution.
11%
12% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
13% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
14% THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
15% PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNERS OR
16% CONTRIBUTORS
17% BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
18% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
19% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
20% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
21% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
22% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
23% POSSIBILITY OF SUCH DAMAGE.
24%
25
26
27%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
28%
29%  Optimization of h-Polynomials by resultant calculation and
30%  factorization .
31%
32%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
33
34% The resultant is calculated from a h-polynomial and its predecessor
35% if both are bivariate in the same variables and if these variables
36% are the last ones in vdpvars* .
37
38symbolic procedure groebtestresultant(h1,h2,lv);
39     begin scalar v1,hlist;
40         v1 := indexcpl(vevsum0(lv,h1),1);
41         if groebrescheck!?(2,v1,lv)
42            and indexcpl(vevsum0(lv,h2),1)=v1
43            then hlist :=
44                   reverse vdplsort
45                    groebhlistfromresultant
46                        (h1,h2,cadr reverse vdpvars!*)
47          else
48         if groebrescheck1!?(2,v1,lv)
49            and indexcpl(vevsum0(lv,h2),1)=v1
50            then hlist :=
51                   reverse vdplsort
52                    groebhlistfromresultant
53                        (h1,h2,caddr reverse vdpvars!*);
54         if null hlist then return nil;
55         return ' resultant .
56              for each x in hlist collect {h2,vdpenumerate x} end;
57
58symbolic procedure groebhlistfromresultant(h1,h0,x);
59% new h-polynomial calculation: calculate
60% the resultant of the two distributive polynomials h1 and h0
61% with respect to x.
62begin scalar ct00,hh,hh1,hs2;
63   ct00:= time();
64   hh:= vdpsimpcont groebresultant(h1,h0,x);
65   if !*trgroeb  then <<terpri();
66                     printb 57;
67                     prin2t " *** the resultant from ";
68                     vdpprint h1;
69                     prin2t "         *** and";
70                     vdpprint h0;
71                     prin2t "                     *** is";
72                     vdpprint hh;
73                     printb 57;
74                     terprit 4>>;
75   hs2:= nil;
76   if not vdpzero!? hh then
77       << hh1:= vdp2a vdprectoint(hh,vdplcm hh);
78          hh1:= fctrf !*q2f simp hh1;
79          if cdr hh1 and cddr hh1 then
80               hs2:= for each p in cdr hh1 collect a2vdp prepf car p;
81          if !*trgroeb and hs2 then
82                    <<prin2 " factorization of resultant successful:";
83                      terprit 2;
84                      for each x in hs2 do vdpprint x;
85                      terprit 2;
86                      ct00:= time() - ct00;
87                      prin2 " time for factorization:"; prin2 ct00;
88                      terpri()>>;
89           >>;
90  return hs2 end;
91
92
93symbolic procedure groebresultant(p1,p2,x);
94begin scalar q1,q2,q;
95q1:=vdp2a vdprectoint(p1,vdplcm p1);
96q2:=vdp2a vdprectoint(p2,vdplcm p2);
97q:=a2vdp prepsq simpresultant {q1,q2,x};
98return q end;
99
100symbolic procedure groebrescheck!?(a,h1,vl);
101  length h1 = a and car h1 = vl - 1;
102
103
104symbolic procedure groebrescheck1!?(a,h1,vl);
105  length h1 = a and car h1 = vl - 2 and cadr h1 = vl - 1;
106
107endmodule;;end;
108