1module odim;
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
27COMMENT
28
29                ##########################################
30                ##                                      ##
31                ##   Applications to zerodimensional ##
32                ##      ideals and modules.               ##
33                ##                                      ##
34                ##########################################
35
36getkbase returns a k-vector space basis of S^c/M,
37odim_borderbasis computes a borderbasis of M,
38odim_up finds univariate polynomials in zerodimensional ideals.
39
40END COMMENT;
41
42% -------------- Test for zero dimension -----------------
43% For a true answer m must be a gbasis.
44
45put('dimzerop,'psopfn,'odim!=zerop);
46symbolic procedure odim!=zerop m;
47  begin scalar c;
48  intf_test m; intf_get(m:=car m);
49  if not (c:=get(m,'gbasis)) then
50        put(m,'gbasis,c:=gbasis!* get(m,'basis));
51  if dimzerop!* c then return 'yes else return 'no;
52  end;
53
54symbolic procedure dimzerop!* m; null odim_parameter m;
55
56symbolic procedure odim_parameter m;
57% Return a parameter of the dpmat m or nil, if it is zerodimensional
58% or (1).
59  odim!=parameter moid_from_dpmat m;
60
61symbolic procedure odim!=parameter m;
62  if null m then nil
63  else odim!=parameter1 cdar m or odim!=parameter cdr m;
64
65symbolic procedure odim!=parameter1 m;
66  if null m then
67        ((if u then car u else u)
68        where u:= reverse ring_names cali!=basering)
69  else if mo_zero!? car m then nil
70  else begin scalar b,u;
71  u:=for each x in m join if length(b:=mo_support x)=1 then b;
72  b:=reverse ring_names cali!=basering;
73  while b and member(car b,u) do b:=cdr b;
74  return if b then car b else nil;
75  end;
76
77% --- Get a k-base of F/M as a list of monomials ----
78% m must be a gbasis for the correct result.
79
80put('getkbase,'psopfn,'odim!=evkbase);
81symbolic procedure odim!=evkbase m;
82  begin scalar c;
83  intf_test m; intf_get(m:=car m);
84  if not (c:=get(m,'gbasis)) then
85        put(m,'gbasis,c:=gbasis!* get(m,'basis));
86  return moid_2a getkbase!* c;
87  end;
88
89symbolic procedure getkbase!* m;
90  if not dimzerop!* m then rederr"dpmat not zerodimensional"
91  else for each u in moid_from_dpmat m join
92        odim!=kbase(mo_from_ei car u,ring_names cali!=basering,cdr u);
93
94symbolic procedure odim!=kbase(mo,n,m);
95  if moid_member(mo,m) then nil
96  else mo . for each x on n join
97                odim!=kbase(mo_inc(mo,car x,1),append(x,nil),m);
98
99% --- Produce an univariate polynomial inside the ideal m ---
100
101symbolic procedure odim_up(a,m);
102% Returns a univariate polynomial (of smallest possible degree if m
103% is a gbasis) in the variable a inside the zerodimensional ideal m.
104% Uses Buchberger's approach.
105  if dpmat_cols m>0 or not dimzerop!* m then
106      rederr"univariate polynomials only for zerodimensional ideals"
107  else if not member(a,ring_names cali!=basering) then
108    typerr(a,"variable name")
109  else if dpmat_unitideal!? m then dp_fi 1
110  else begin scalar b,v,p,l,q,r;
111    % l is a list of ( p(a) . NF p(a) ), sorted by lt NF p(a)
112    p:=(dp_fi 1 . dp_fi 1); b:=dpmat_list m;  v:=mo_from_a a;
113    while cdr p do
114      << l:=merge(list p,l,function odim!=greater);
115         q:=dp_times_mo(v,car p);
116         r:=red_redpol(b,bas_make(0,dp_times_mo(v,cdr p)));
117         p:=odim!=reduce(dp_prod(cdr r,q) . bas_dpoly car r,l);
118      >>;
119    return
120    if !*bcsimp then car dp_simp car p
121    else car p;
122    end;
123
124symbolic procedure odim!=greater(a,b);
125    mo_compare(dp_lmon cdr a,dp_lmon cdr b)=1;
126
127symbolic procedure odim!=reduce(a,l);
128  if null cdr a or null l or odim!=greater(a, car l) then a
129  else if mo_equal!?(dp_lmon cdr a,dp_lmon cdar l) then
130    begin scalar z,z1,z2,b;
131    b:=car l; z1:=cali_bc_neg dp_lc cdr a; z2:=dp_lc cdr b;
132    if !*bcsimp then
133      << if (z:=cali_bc_inv z1) then <<z1:=cali_bc_fi 1; z2:=cali_bc_prod(z2,z)>>
134         else
135           << z:=cali_bc_gcd(z1,z2);
136              z1:=car cali_bc_divmod(z1,z);
137              z2:=car cali_bc_divmod(z2,z);
138           >>;
139      >>;
140    a:=dp_sum(dp_times_bc(z2,car a),dp_times_bc(z1,car b)) .
141           dp_sum(dp_times_bc(z2,cdr a),dp_times_bc(z1,cdr b));
142    return odim!=reduce(a,cdr l)
143    end
144  else odim!=reduce(a,cdr l);
145
146% ------------------------- Borderbasis -----------------------
147
148symbolic procedure odim_borderbasis m;
149% Returns a border basis of the zerodimensional dpmat m as list of
150% base elements.
151  if not !*noetherian then
152        rederr"BORDERBASIS only for non noetherian term orders"
153  else if not dimzerop!* m then
154        rederr"BORDERBASIS only for zerodimensional ideals or modules"
155  else begin scalar b,v,u,mo,bas;
156  bas:=bas_zerodelete dpmat_list m;
157  mo:=for each x in bas collect dp_lmon bas_dpoly x;
158  v:=for each x in ring_names cali!=basering collect mo_from_a x;
159  u:=for each x in bas collect
160        {dp_lmon bas_dpoly x,red_tailred(bas,x)};
161  while u do
162  << b:=append(b,u);
163     u:=listminimize(
164        for each x in u join
165            for each y in v join
166                (begin scalar w; w:=mo_sum(first x,y);
167                if not listtest(b,w,function(lambda(x,y);car x=y))
168                        and not odim!=interior(w,mo) then
169                        return {{w,y,bas_dpoly second x}}
170                end),
171        function(lambda(x,y);car x=car y));
172     u:=for each x in u collect
173        {first x,
174        red_tailred(bas,bas_make(0,dp_times_mo(second x,third x)))};
175  >>;
176  return bas_renumber for each x in b collect second x;
177  end;
178
179symbolic procedure odim!=interior(m,mo);
180% true <=> monomial m is in the interior of the moideal mo.
181  begin scalar b; b:=t;
182  for each x in mo_support m do
183        b:=b and moid_member(mo_diff(m,mo_from_a x),mo);
184  return b;
185  end;
186
187endmodule; % odim
188
189end;
190