1:- module(bdfm, []).    2% Basic Grobner Base Method without using vectors.
    3:-use_module(pac(basic)).    4term_expansion --> pac:expand_pac.
    5:- use_module(pac(op)).    6
    7%
    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
   21%
   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
   27% For Tracing method
   28% ?- galois_zip(3, [[1*[x^1], 5*[]]], X, Y).
   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
   35% ?- poly_trace([[1*[x^1], -1*[]]], [1*[x^1], 1*[a^1]], R, lexical).
   36poly_trace([P|Ps], X, Y, Ord):- reduce_by_poly(X, P, X0, Ord),
   37	poly_trace(Ps, X0, Y, Ord).
   38
   39% ?- spoly_trace([1*[x^1], 1*[]], [1*[y^1], 1*[]], [], Z, total).
   40%@ Z = [1*[y^1], -1*[x^1]] .
   41
   42spoly_trace(X, Y, Ps, Z, Ord):- poly:s_poly(X, Y, Z0, Ord),
   43	poly_trace(Ps, Z0, Z, Ord).
   44
   45%
   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
   51%
   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
   77%
   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
   84%
   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
   91%
   92update_spoly_agenda_DFM(M, V, G, Ord):-
   93	update_spoly_agenda_DFM(G, G, M, V, [], Ord).
   94
   95%
   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
  104%
  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.
  112%
  113d_cond([_*Ti|_], [_*Tj|_]) :- poly: merge_mono_mono(Ti, Tj, T),
  114       poly:mono_lcm(Ti, Tj, T).
  115
  116%
  117f_cond([_*Ti|_], [_*Tj|_], G) :-
  118	poly:mono_lcm(Ti, Tj, T),
  119	poly:rev_member([_*Tk|_], G),
  120%	member([_*Tk|_], G),
  121	poly:mono_lcm(Tk, Tj, T).
  122
  123%
  124m_cond(Pi, Pj, G) :-   Pi = [_*Ti|_],
  125	Pj = [_*Tj|_],
  126	poly:mono_lcm(Ti, Tj, Tij),
  127	poly:rev_member(Pk, G),
  128%	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
  136% ?- merge_spoly_agenda([[1*[b^1]]-[1*[a^1]]], [[1*[a^1]]-[1*[b^1]]], R).
  137%@ R = [[1*[b^1]]-[1*[a^1]], [1*[a^1]]-[1*[b^1]]] .
  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
  148% ?- compare_spoly(C, [1*[a^2]]-[1*[b^2]], [1*[b^1]]-[1*[a^2]]).
  149%@ C = (>).
  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
  156% ?- sort_spoly([[1*[a^2]]-[1*[b^2]], [1*[b^1]]-[1*[a^2]]], R).
  157%@ R = [[1*[b^1]]-[1*[a^2]], [1*[a^2]]-[1*[b^2]]].
  158sort_spoly(X, Y):- predsort(compare_spoly, X, Y)