1:- module(bdfm, []). 3:-use_module(pac(basic)). 4term_expansion --> pac:expand_pac.
5:- use_module(pac(op)). 6
8gb_BDFM([P|F], G, Opt):-
9 subset([order(Ord), trace(Trace), assoc(Assoc),
10 fraction_free(FF), prime(Prime)],
11 Opt),
12 Debug = debug(Trace, Assoc),
13 init_base(G0),
14 add_to_base(P, G0, G1),
15 poly_pairs(F, [], D, G1, G2, Ord),
16 gb_spoly(D, G2, G, Debug, Ord, FF, Prime).
17
18init_base([]).
19add_to_base(P, R, [P|R]).
20
22poly_pairs([], D, D, G, G, _).
23poly_pairs([P|F], D0, D, G0, G, Ord):-
24 update_spoly_agenda(D0, P, D1, G0, Ord),
25 poly_pairs(F, D1, D, [P|G0], G, Ord).
26
29
30galois_zip(Prime, L, G, Zip):-
31 maplist(pred(Prime, [P, Q, P-Q]:-
32 poly:galois_poly(Prime, P, Q)),
33 L, G, Zip).
34
36poly_trace([P|Ps], X, Y, Ord):- reduce_by_poly(X, P, X0, Ord),
37 poly_trace(Ps, X0, Y, Ord).
38
41
42spoly_trace(X, Y, Ps, Z, Ord):- poly:s_poly(X, Y, Z0, Ord),
43 poly_trace(Ps, Z0, Z, Ord).
44
46generic_spoly(true, I, J, Spoly, _G, Ord):- !,
47 once(poly:s_poly_z(I, J, Spoly, Ord)).
48generic_spoly(_, I, J, Spoly, _G, Ord):-
49 once(poly:s_poly(I, J, Spoly, Ord)).
50
52gb_spoly([], G, G, _, _, _, _).
53gb_spoly([I-J|D], G0, G, Debug, Ord, FF, BL):-
54 once(generic_spoly(FF, I, J, Spoly, G0, Ord)),
55 once(gb:reduce_head_by_polyset(Spoly, G0, S0, Ord, FF, _Trace, [])),
56 once(gb:generic_normal_poly(FF, BL, S0, R)),
57 ( R ==[]
58 -> gb_spoly(D, G0, G, Debug, Ord, FF, BL)
59 ; update_spoly_agenda(D, R, D0, G0, Ord),
60 gb_spoly(D0, [R|G0], G, Debug, Ord, FF, BL)
61 ).
62
63
64debug(debug(Agenda_Trace, Assoc), D, G0, R):-
65 ( Agenda_Trace == true
66 -> poly:postprocess(R, Residue, Assoc),
67 length([_|D], L),
68 length(G0, L0),
69 ( Residue == []
70 -> W = []
71 ; Residue = [_*W|_]
72 ),
73 format("(#agenda, #gb) = (~d, ~d) ~w\n", [L, L0, W])
74 ; true
75 ).
76
78update_spoly_agenda(D, M, D0, G, Ord):-
79 update_spoly_agenda_B(D, U, [], M, Ord),
80 update_spoly_agenda_DFM(M, V, G, Ord),
81 sort_spoly(V, V0),
82 merge_spoly_agenda(U, V0, D0).
83
85update_spoly_agenda_B([], D, D, _, _).
86update_spoly_agenda_B([I-J|R], P, Q, M, Ord):- b_cond(M, I, J), !,
87 update_spoly_agenda_B(R, P, Q, M, Ord).
88update_spoly_agenda_B([A|R], [A|P], Q, M, Ord):-
89 update_spoly_agenda_B(R, P, Q, M, Ord).
90
92update_spoly_agenda_DFM(M, V, G, Ord):-
93 update_spoly_agenda_DFM(G, G, M, V, [], Ord).
94
96update_spoly_agenda_DFM([I|Gi], G, J, P, Q, Ord):-
97 ( f_cond(I, J, Gi); m_cond(I, J, G); d_cond(I, J) ),
98 !,
99 update_spoly_agenda_DFM(Gi, G, J, P, Q, Ord).
100update_spoly_agenda_DFM([I|Gi], G, J, [I-J|P], Q, Ord):- !,
101 update_spoly_agenda_DFM(Gi, G, J, P, Q, Ord).
102update_spoly_agenda_DFM(_, _, _, P, P, _).
103
105b_cond([_*Tk|_], [_*Ti|_], [_*Tj|_]):-
106 poly:mono_lcm(Ti, Tj, Tij),
107 poly:div_mono_mono_term(Tij, Tk),
108 poly:mono_lcm(Ti, Tk, Tik),
109 Tik \== Tij,
110 poly:mono_lcm(Tj, Tk, Tjk),
111 Tjk \== Tij.
113d_cond([_*Ti|_], [_*Tj|_]) :- poly: merge_mono_mono(Ti, Tj, T),
114 poly:mono_lcm(Ti, Tj, T).
115
117f_cond([_*Ti|_], [_*Tj|_], G) :-
118 poly:mono_lcm(Ti, Tj, T),
119 poly:rev_member([_*Tk|_], G),
121 poly:mono_lcm(Tk, Tj, T).
122
124m_cond(Pi, Pj, G) :- Pi = [_*Ti|_],
125 Pj = [_*Tj|_],
126 poly:mono_lcm(Ti, Tj, Tij),
127 poly:rev_member(Pk, G),
129 Pk \== Pi,
130 Pk = [_*Tk|_],
131 poly:div_mono_mono_term(Tij, Tk),
132 poly:mono_lcm(Tj, Tk, Tjk),
133 Tjk \== Tij.
134
135
138merge_spoly_agenda([], X, X).
139merge_spoly_agenda(X, [], X).
140merge_spoly_agenda([P|R], [Q|S], [P|T]):-
141 compare_spoly(C, P, Q),
142 C = (<),
143 !,
144 merge_spoly_agenda(R, [Q|S], T).
145merge_spoly_agenda(R, [Q|S], [Q|T]):- merge_spoly_agenda(R, S, T).
146
147
150compare_spoly(C, [_*M|_]-[_*N|_], [_*M0|_]-[_*N0|_]):-
151 poly:mono_lcm(M, N, A),
152 poly:mono_lcm(M0, N0, A0),
153 poly:compare_total_order(C0, A, A0),
154 (C0 == (=) -> C = (<); C = C0 ).
155
158sort_spoly(X, Y):- predsort(compare_spoly, X, Y)