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