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