160a61,63 2> load ("charsets_length.lisp"); 3> 4> /* load(grobner); */ 570c73 6< /* 7--- 8> 979c82 10< */ 11--- 12> 1391a95,97 14> /* This is no more necessary, charsets_set.lisp has been fixed */ 15> /* charsets_union([x]):=listify(apply(union, maplist(lambda([y],setify(expand(y))),x)))$ */ 16> 17290c296 18< /* the extend:ed char series of poly set ps */ 19--- 20> /* the extended char series of poly set ps */ 21321c327 22< /* the extend:ed char series of poly set ps -- allowing to remove factors */ 23--- 24> /* the extended char series of poly set ps -- allowing to remove factors */ 25372c378 26< /* the extend:ed irreducible char series of poly set ps: user function */ 27--- 28> /* the extended irreducible char series of poly set ps: user function */ 29458a465,469 30> /* In fact the argument handling is incorrect. Either it is triser(ps,ord) */ 31> /* where ord is a list, or triser(ps,lst,ord) where lst is the unordered set */ 32> /* of variables and ord the order computed by charsets_reorder (lst, charsets_degord, qs) */ 33> /* and automatically filled */ 34> 35478a490 36> 37494,495c506,507 38< /* sort to try to get things in maple order 39< qs : sort (qs, charsets_lenord1), */ 40--- 41> /* sort to try to get things in maple order */ 42> qs : sort (qs, charsets_lenord), 43597c609 44< num(xthru(multthru( last / lcoeff ( last,/* reverse */(ord)))))) 45--- 46> num(xthru(multthru( last / lcoeff ( last,ord))))) 47625,626c637,638 48< cf : length ( expand ( charsets_initial ( f, ord) ) ), 49< cg : length ( expand ( charsets_initial ( g, ord) ) ), 50--- 51> cf : charsets_polylength ( expand ( charsets_initial ( f, ord) ) ), 52> cg : charsets_polylength ( expand ( charsets_initial ( g, ord) ) ), 53630c642 54< if length ( expand ( f) ) < length ( expand ( g) ) 55--- 56> if charsets_polylength ( expand ( f) ) < charsets_polylength ( expand ( g) ) 57775c787 58< ?mlocal(v),array(v,n), 59--- 60> local(v),array(v,n), 61794d805 62< ?munlocal(v), 63868c879 64< apply(min, maplist(lambda([u],length( expand (u))),qs))] 65--- 66> apply(min, maplist(lambda([u],charsets_polylength( expand (u))),qs))] 67899,900c910,912 68< if mapatom(x) then degree(c,x) 69< else max(map(lambda([u],degree(c,u)),x)) 70--- 71> if mapatom(x) then charsets_degree(c,[x]), 72> if listp(f) then lmax(maplist(lambda([u],degree(u,x)),c)) 73> else charsets_degree([f],x) 74981,984c993 75< else ( 76< if medset = charsets_autored then 77< charsets_charseta(charsets_union(rs,cs,ps),ord,charsets_charsetn) 78< else charsets_charseta( charsets_union( rs, cs, ps), ord, medset))) 79--- 80> else charsets_charseta( charsets_union( rs, cs, ps), ord, medset)) 811021c1030 82< [charsetn, wcharsetn, qcharsetn, triset, trisetc, autored]),any_check, 83--- 84> [charsetn, wcharsetn, qcharsetn, triset, trisetc]),any_check, 851056,1057c1065,1066 86< cs : medset ( ps, ord), 87< fset2 : [ fset1[1], charsets_union( fset1[2], charsets_initialset1( cs, ord))], 88--- 89> if medset = [] then cs: ps else cs : medset ( ps, ord), 90> fset2 : [ fset1[1], charsets_union( fset1[2], charsets_initialset1(cs, ord))], 911069,1072d1077 92< else ( 93< if medset = charsets_autored then 94< charsets_fcharsetsub ( charsets_union ( rs, cs, ps), ord, 95< charsets_charsetn, fset3) 961075c1080 97< medset, fset3)))) 98--- 99> medset, fset3))) 1001248c1253 101< for j in ss do 102--- 103> for j in ss do ( 1041253c1258 105< charsets_qs[charsets_class( p, ord)])), 106--- 107> charsets_qs[charsets_class( p, ord)]))), 1081260,1261c1265,1267 109< if not charsets_operatorp(f,charsets_ListOrSet) and not ratnump(g) and not freeof (last(ord), g) 110< and (fg:first(last_result:divide ( f, g)),second(last_result)) = 0 then ( 111--- 112> if not charsets_operatorp(f,charsets_ListOrSet) and not ratnump(g) 113> and ((fg:first(last_result:divide(f,g, 114> charsets_lvar(g,ord))),second(last_result)) = 0) then ( 1151269c1275 116< /* fset1 is assigned to fset at th end: of the procedure */ 117--- 118> /* fset1 is assigned to fset at the end of the procedure */ 1191559c1565 120< qhi : sort (qhi, charsets_lenord1), 121--- 122> qhi : sort (qhi, charsets_lenord), 1231582c1588 124< else ( sort ( charsets_contract ( qsi, ord, 0), charsets_lenord2)) 125--- 126> else ( sort ( charsets_contract ( qsi, ord, 0), charsets_lenord)) 1271595c1601 128< qhi : sort (qhi, charsets_lenord2), 129--- 130> qhi : sort (qhi, charsets_lenord), 1311627c1633 132< /* the extend:ed char series of poly set ps */ 133--- 134> /* the extended char series of poly set ps */ 1351719c1725 136< /* the extend:ed char series of poly set ps -- allowing to remove factors */ 137--- 138> /* the extended char series of poly set ps -- allowing to remove factors */ 1391758c1764 140< else (sort ( qsi, charsets_lenord2)) 141--- 142> else (sort ( qsi, charsets_lenord)) 1432039c2045 144< /* the extend:ed irreducible char series of poly set ps */ 145--- 146> /* the extended irreducible char series of poly set ps */ 1472145c2151,2156 148< charsets_select ( ppi,n):=block([ i,pp,qq], 149--- 150> /* In maple the condition is n <= nops(i) and nops gives the same thing as maxima's */ 151> /* length for sums and products, excepts that for a single variable nops(x) = 1 while */ 152> /* length (x) produces an error. */ 153> 154> charsets_select ( ppi,n):=block([ i,pp,qq,lli], 155> lli : if (i=listofvars(i)[1]) then 1 else length(i), 1562149c2160 157< if n <= length ( i) then ( qq : charsets_adjoin2( i, qq)) 158--- 159> if n <= lli then ( qq : charsets_adjoin2( i, qq)) 1602177c2188 161< itt : charsets_adjoin2(i, qs), 162--- 163> itt : charsets_adjoin2(i, setify1(qs)), 1642181,2182c2192,2193 165< if charsets_subset ( j, itt) then ( _ind : 1))), 166< if _ind = 0 then ( iss : charsets_adjoin2(cons( i, qs),iss)))), 167--- 168> if charsets_subset (setify1([j]), itt) then ( _ind : 1))), 169> if _ind = 0 then (iss: charsets_adjoin2(cons(i,qs),iss)))), 1702184a2196,2197 171> 172> /* if _ind = 0 then ( iss: charsets_adjoin2(charsets_adjoin2(i,qs),iss)))), */ 1732187c2200,2202 174< charsets_nopsord(a,b):=if length( b) < length( a) then ( true) else ( false)$ 175--- 176> charsets_nopsord(a,b):= if symbolp (a) then (false) 177> else if symbolp (b) then (true) else 178> if length( b) < length( a) then ( true) else ( false)$ 1792435c2450 180< /* test for a trivial case --- can it be extend:ed? */ 181--- 182> /* test for a trivial case --- can it be extended? */ 1832684,2686d2698 184< /* compute the GCD of f and g over the algebraic field having */ 185< /* adjoining asc set as -- using Maple's built-in function */ 186< /* Malgcd is sometimes faster than algcd and is not used */ 1872688,2698d2699 188< charsets_Malgcd ( f,g,as,mord):=block( 189< [ nas,i,last], 190< nas : length ( as), 191< last:[ f, g ], 192< for i : nas thru 1 step - 1 do 193< subst(last, ( mord[i] = RootOf ( as[i], mord[i]) )), 194< last:evala ( Gcd ( (last)) ), 195< for i : 1 thru nas do 196< last: subst(last, ( RootOf ( as[i], mord[i]) = mord[i])), 197< last 198< )$ 1993299c3300 200< [ qs,cs,iss,n,i,qhi,qsi,factorset,csno,ppi,qqi,_ind,mem], 201--- 202> [ qs,cs,iss,n,i,qhi,qsi,factorset,csno,ppi,qqi,_ind,mem,fset4], 2033318c3319 204< qqi : charsets_union(qqi,setify1(ppi[2])), 205--- 206> qqi : charsets_union(qqi,ppi[2]), 2073321c3322 208< ppi : charsets_union( qs, setify1(ppi[1])), 209--- 210> ppi : charsets_union( setify1(qs), setify1(ppi[1])), 2113328,3329c3329,3332 212< else ( 213< if (qs # mem) and (4 < charsets_degree ( qs[1], ord)) then ( 214--- 215> else ( fset4: qs, 216> fset4: if (listp(qs) and (qs # []) and (listp(first(qs)))) 217> then first(qs) else qs, 218> if (qs # mem) and (4 < charsets_degree (fset4[1], ord)) then ( 2193333,3334c3336 220< ml2(cs,factorset, 221< charsets_fcharseta(qs,ord,charsets_wcharsetn))) 222--- 223> ml2(cs,factorset, charsets_fcharseta(qs,ord,charsets_wcharsetn))) 2243344,3345c3346,3347 225< if 0 < charsets_class ( cs[1], ord) then ( 226< iss : charsets_initialset ( cs, ord), 227--- 228> if 0 < charsets_class ( cs, ord) then ( 229> iss : charsets_initialset ( cs[1], ord), 2303347c3349 231< qsi : charsets_union([setify1(cs)],qsi)), 232--- 233> qsi : charsets_union([cs],qsi)), 2343349,3350c3351 235< else ( 236< iss : charsets_factorps ( factorset)), 237--- 238> else ( iss : charsets_factorps ( factorset)), 2393352c3353 240< if 1 < length ( qhi) then ( qhi : charsets_union(iss, rest(qhi))) 241--- 242> if 1 < length ( qhi) then ( qhi : charsets_union(setify1([iss]), rest(qhi))) 2433357a3359,3361 244> 245> 246> 2473528c3532 248< gb : grobner::gbasis ( qs, [ (zz), reverse(ord) ], plex), 249--- 250> gb : poly_reduced_grobner ( qs, [ (zz), reverse(ord) ]), 2513544c3548 252< ps : grobner::gbasis ( ps, charsets_reverse ( ord), plex), 253--- 254> ps : poly_reduced_grobner ( ps, charsets_reverse ( ord), lex), 2553558c3562 256< fs : grobner::gbasis ( fs, charsets_reverse ( ord), plex), 257--- 258> fs : poly_reduced_grobner ( fs, charsets_reverse ( ord), lex), 2593579c3583 260< gb : grobner::gbasis ( fs, charsets_reverse ( ord), plex)), 261--- 262> gb : poly_reduced_grobner ( fs, charsets_reverse ( ord), lex)), 2633584c3588 264< gb1 : grobner::gbasis ( gb, [ vrd, (urd) ], plex), 265--- 266> gb1 : poly_reduced_grobner ( gb, [ vrd, (urd) ], lex), 2673757c3761 268< grobner::gbasis ( setify1([ map(simplify ( qs[j] / f) /* $ ( ( j = 1 .. length ( qs) ))*/) ]), charsets_reverse ( ord), plex)) 269--- 270> poly_reduced_grobner ( setify1([ map(simplify ( qs[j] / f) /* $ ( ( j = 1 .. length ( qs) ))*/) ]), charsets_reverse ( ord), lex)) 2713773c3777 272< gb : grobner::gbasis ( qs, [ zz, map(ord[length ( ord) - j + 1]/* $ ( ( j = 1 .. length ( ord) ))*/) ], plex), 273--- 274> gb : poly_reduced_grobner ( qs, [ zz, map(ord[length ( ord) - j + 1]/* $ ( ( j = 1 .. length ( ord) ))*/) ], lex), 2753798c3802 276< gb : grobner::gbasis ( qs, [ zz, map(ord[length ( ord) - j + 1]/* $ ( ( j = 1 .. length ( ord) ))*/) ], plex), 277--- 278> gb : poly_reduced_grobner ( qs, [ zz, map(ord[length ( ord) - j + 1]/* $ ( ( j = 1 .. length ( ord) ))*/) ], lex), 2793816,3817c3820,3821 280< gb : grobner::gbasis ( qs, [ (zz), map(ord[length ( ord) 281< - j + 1]/* $ ( ( j = 1 .. length ( ord) ))*/) ], plex), 282--- 283> gb : poly_reduced_grobner ( qs, [ (zz), map(ord[length ( ord) 284> - j + 1]/* $ ( ( j = 1 .. length ( ord) ))*/) ], lex), 2853828c3832 286< /* the extend:ed irreducible char series of polyset ps */ 287--- 288> /* the extended irreducible char series of polyset ps */ 2893937,3938c3941,3942 290< [len_a : if mapatom(a) then 1 else length(a), 291< len_b : if mapatom(b) then 1 else length(b)], 292--- 293> [len_a : charsets_length(a), 294> len_b : charsets_length(b)], 2953941,3957d3944 296< charsets_lenord1( a,b):=block([ii,flag, 297< len_a : if mapatom(a) then 1 else length(a), 298< len_b : if mapatom(b) then 1 else length(b)], 299< if len_b < len_a then true 300< else ( 301< if len_b > len_a then false 302< else ( 303< flag:true, 304< for i:1 thru length(a) do block( 305< [len_ai : if mapatom(a[i]) then 1 else length(a[i]), 306< len_bi : if mapatom(b[i]) then 1 else length(b[i])], 307< if len_bi < len_ai then return(flag:false) 308< ), 309< flag 310< ) 311< ) 312< )$ 3133959,3970d3945 314< charsets_lenord2( a,b):=block( 315< [len_a : if mapatom(a) then 1 else length(a), 316< len_b : if mapatom(b) then 1 else length(b)], 317< if len_b > len_a then true 318< else ( 319< if len_b < len_a then false 320< else ( 321< if sum( if mapatom(b[i]) then 1 else length(b[i]),i,1,length(b)) < sum(if mapatom(a[i]) then 1 else length(a[i]),i,1,length(a)) 322< then true else false 323< ) 324< ) 325< )$ 3264238,4239d4212 327< charsets_lenord1, 328< charsets_lenord2, 329