1module bas; 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 #### IDEAL BASES #### 32 #### #### 33 ####################### 34 35 36Ideal bases are lists of vector polynomials (with additional 37information), constituting the rows of a dpmat (see below). In a 38rep. part there can be stored vectors representing each base element 39according to a fixed basis. Usually rep=nil. 40 41Informal syntax : 42 43 <bas> ::= list of base elements 44 <base element> ::= list(nr dpoly length ecart rep) 45 46END COMMENT; 47 48 49% -------- Reference operators for the base element b --------- 50 51symbolic procedure bas_dpoly b; cadr b; 52symbolic procedure bas_dplen b; caddr b; 53symbolic procedure bas_nr b; car b; 54symbolic procedure bas_dpecart b; cadddr b; 55symbolic procedure bas_rep b; nth(b,5); 56 57% ----- Elementary constructors for the base element be -------- 58 59symbolic procedure bas_newnumber(nr,be); 60% Returns be with new number part. 61 nr . cdr be; 62 63symbolic procedure bas_make(nr,pol); 64% Make base element with rep=nil. 65 list(nr,pol, length pol,dp_ecart pol,nil); 66 67symbolic procedure bas_make1(nr,pol,rep); 68% Make base element with prescribed rep. 69 list(nr,pol, length pol,dp_ecart pol,rep); 70 71symbolic procedure bas_getelement(i,bas); 72% Returns the base element with number i from bas (or nil). 73 if null bas then list(i,nil,0,0,nil) 74 else if eqn(i,bas_nr car bas) then car bas 75 else bas_getelement(i,cdr bas); 76 77% ---------- Operations on base lists --------------- 78 79symbolic procedure bas_sort b; 80% Sort the base list b. 81 sort(b,function red_better); 82 83symbolic procedure bas_print u; 84% Prints a list of distributive polynomials using dp_print. 85 begin terpri(); 86 if null u then print 'empty 87 else for each v in u do 88 << write bas_nr v, " --> "; dp_print2 bas_dpoly v >> 89 end; 90 91symbolic procedure bas_renumber u; 92% Renumber base list u. 93 if null u then nil 94 else begin scalar i; i:=0; 95 return for each x in u collect <<i:=i+1; bas_newnumber(i,x) >> 96 end; 97 98symbolic procedure bas_setrelations u; 99% Set in the base list u the relation part rep of base element nr. i 100% to e_i (provided i>0). 101 for each x in u do 102 if bas_nr x > 0 then rplaca(cddddr x, dp_from_ei bas_nr x); 103 104symbolic procedure bas_removerelations u; 105% Remove relation parts. 106 for each x in u do rplaca(cddddr x, nil); 107 108symbolic procedure bas_getrelations u; 109% Returns the relations of the base list u as a separate base list. 110 begin scalar w; 111 for each x in u do w:=bas_make(bas_nr x,bas_rep x) . w; 112 return reversip w; 113 end; 114 115symbolic procedure bas_from_a u; 116% Converts the algebraic (prefix) form u to a base list clearing 117% denominators. Only for lists. 118 bas_renumber for each v in cdr u collect 119 bas_make(0,dp_from_a prepf numr simp v); 120 121symbolic procedure bas_2a u; 122% Converts the base list u to its algebraic prefix form. 123 append('(list),for each x in u collect dp_2a bas_dpoly x); 124 125symbolic procedure bas_neworder u; 126% Returns reordered base list u (e.g. after change of term order). 127 for each x in u collect 128 bas_make1(bas_nr x,dp_neworder bas_dpoly x, 129 dp_neworder bas_rep x); 130 131symbolic procedure bas_zerodelete u; 132% Returns base list u with zero elements deleted but not renumbered. 133 if null u then nil 134 else if null bas_dpoly car u then bas_zerodelete cdr u 135 else car u.bas_zerodelete cdr u; 136 137symbolic procedure bas_simpelement b; 138% Returns (b_new . z) with 139% bas_dpoly b_new having leading coefficient 1 or 140% gcd(dp_content bas_poly,dp_content bas_rep) canceled out 141% and dpoly_old = z * dpoly_new , rep_old= z * rep_new. 142 143 if null bas_dpoly b then b . cali_bc_fi 1 144 else begin scalar z,z1,pol,rep; 145 if (z:=cali_bc_inv (z1:=dp_lc bas_dpoly b)) then 146 return bas_make1(bas_nr b, 147 dp_times_bc(z,bas_dpoly b), 148 dp_times_bc(z,bas_rep b)) 149 . z1; 150 151 % -- now we assume that base coefficients are a gcd domain ---- 152 153 z:=cali_bc_gcd(dp_content bas_dpoly b,dp_content bas_rep b); 154 if cali_bc_minus!? z1 then z:=cali_bc_neg z; 155 pol:=for each x in bas_dpoly b collect 156 car x . car cali_bc_divmod(cdr x,z); 157 rep:=for each x in bas_rep b collect 158 car x . car cali_bc_divmod(cdr x,z); 159 return bas_make1(bas_nr b,pol,rep) . z; 160 end; 161 162symbolic procedure bas_simp u; 163% Applies bas_simpelement to each dpoly in the base list u. 164 for each x in u collect car bas_simpelement x; 165 166symbolic procedure bas_zero!? b; 167% Test whether all base elements are zero. 168 null b or (null bas_dpoly car b and bas_zero!? cdr b); 169 170symbolic procedure bas_sieve(bas,vars); 171% Sieve out all base elements from the base list bas with leading 172% term containing a variable from the list of var. names vars and 173% renumber the result. 174 begin scalar m; m:=mo_zero(); 175 for each x in vars do 176 if member(x,ring_names cali!=basering) then 177 m:=mo_sum(m,mo_from_a x) 178 else typerr(x,"variable name"); 179 return bas_renumber for each x in bas_zerodelete bas join 180 if mo_zero!? mo_gcd(m,dp_lmon bas_dpoly x) then {x}; 181 end; 182 183symbolic procedure bas_homogenize(b,var); 184% Homogenize the base list b using the var. name var. 185% Note that the rep. part is correct only upto a power of var ! 186 for each x in b collect 187 bas_make1(bas_nr x,dp_homogenize(bas_dpoly x,var), 188 dp_homogenize(bas_rep x,var)); 189 190symbolic procedure bas_dehomogenize(b,var); 191% Set the var. name var in the base list b equal to one. 192 begin scalar u,v; 193 if not member(var,v:=ring_all_names cali!=basering) then 194 typerr(var,"dpoly variable"); 195 u:=setdiff(v,list var); 196 return for each x in b collect 197 bas_make1(bas_nr x,dp_seed(bas_dpoly x,u), 198 dp_seed(bas_rep x,u)); 199 end; 200 201% ---------------- Special tools for local algebra ----------- 202 203symbolic procedure bas!=factorunits p; 204 if null p then nil 205 else bas!=delprod 206 for each y in cdr (fctrf numr simp dp_2a p where !*factor=t) 207 collect (dp_from_a prepf car y . cdr y); 208 209symbolic procedure bas!=delprod u; 210 begin scalar p; p:=dp_fi 1; 211 for each x in u do 212 if not dp_unit!? car x then p:=dp_prod(p,dp_power(car x,cdr x)); 213 return p 214 end; 215 216symbolic procedure bas!=detectunits p; 217 if null p then nil 218 else if listtest(cdr p,dp_lmon p, 219 function(lambda(x,y);not mo_vdivides!?(y,car x))) then p 220 else list dp_term(cali_bc_fi 1,dp_lmon p); 221 222symbolic procedure bas_factorunits b; 223 bas_make(bas_nr b,bas!=factorunits bas_dpoly b); 224 225symbolic procedure bas_detectunits b; 226 bas_make(bas_nr b,bas!=detectunits bas_dpoly b); 227 228 229endmodule; % bas 230 231end; 232