https://github.com/RichardMoot/GrailLight
Tip revision: 67fbacd0e365d9008c021016377c0cfe1f1e309d authored by Richard Moot on 27 April 2021, 15:02:38 UTC
Update Supertag.tcl
Update Supertag.tcl
Tip revision: 67fbacd
lex_props.pl
:- op(400, xfy, \).
max_degree(Max) :-
findall(F, formula(F, _), List),
max_degree(List, 0, Max).
max_degree([], Max, Max).
max_degree([F|Fs], Max0, Max) :-
degree(F, Deg),
Max1 is max(Max0,Deg),
max_degree(Fs, Max1, Max).
degree(dr(A,B), D) :-
!,
degree(A, D0),
degree(B, D1),
D is D0 + D1.
degree(dl(A,B), D) :-
!,
degree(A, D0),
degree(B, D1),
D is D0 + D1.
degree(_, 1).
show_degree(Min) :-
findall(F-N, formula(F, N), List),
show_degree(List, Min, 0).
show_degree([], _, Total) :-
format('===~nTotal: ~D~n', [Total]).
show_degree([F-N|Fs], Min, Total0) :-
degree(F, D),
(D >= Min -> format('~p-~D [~D]~n', [F,N,D]),Total=Total0+N ; Total=Total0),
show_degree(Fs, Min, Total).
max_right_aas(Max) :-
findall(F, formula(F,_), List),
max_right_aas(List, 0, Max).
max_right_aas([], Max, Max).
max_right_aas([F|Fs], Max0, Max) :-
right_aas(F, RA),
Max1 is max(Max0, RA),
max_right_aas(Fs, Max1, Max).
right_aas(dr(A,B), Max) :-
!,
right_arguments(B, MaxB),
right_aas(A, Max0),
Max is max(Max0, MaxB).
right_aas(dl(B,A), Max) :-
!,
right_arguments(B, MaxB),
right_aas(A, Max0),
Max is max(Max0, MaxB).
right_aas(_, 0).
max_left_aas(Max) :-
findall(F, formula(F,_), List),
max_left_aas(List, 0, Max).
max_left_aas([], Max, Max).
max_left_aas([F|Fs], Max0, Max) :-
left_aas(F, RA),
Max1 is max(Max0, RA),
max_left_aas(Fs, Max1, Max).
left_aas(dr(A,B), Max) :-
!,
left_arguments(B, MaxB),
left_aas(A, Max0),
Max is max(Max0, MaxB).
left_aas(dl(B,A), Max) :-
!,
left_arguments(B, MaxB),
left_aas(A, Max0),
Max is max(Max0, MaxB).
left_aas(_, 0).
find_left_aas(LA) :-
formula(F, N),
left_aas(F, LA0),
LA0 >= LA,
format('~w-~@-~w [~w]~n', [F, print_ccgform(F), N, LA0]),
fail.
find_left_aas(_).
find_right_aas(RA) :-
formula(F, N),
right_aas(F, RA0),
RA0 >= RA,
format('~w-~w [~w]~n', [F, N, RA0]),
fail.
find_right_aas(_).
max_right_arguments(Max) :-
findall(F, formula(F,_), List),
max_right_arguments(List, 0, Max).
max_right_arguments([], Max, Max).
max_right_arguments([F|Fs], Max0, Max) :-
right_arguments(F, RA),
Max1 is max(Max0, RA),
max_right_arguments(Fs, Max1, Max).
right_arguments(dr(A,_), Max) :-
!,
right_arguments(A, Max0),
Max is Max0 + 1.
right_arguments(dl(_,A), Max) :-
!,
right_arguments(A, Max).
right_arguments(_, 0).
find_left_arguments(LA) :-
formula(F, N),
left_arguments(F, LA0),
LA0 >= LA,
format('~w-~@-~w [~w]~n', [F, print_ccgform(F), N, LA0]),
fail.
find_left_arguments(_).
find_right_arguments(RA) :-
formula(F, N),
right_arguments(F, RA0),
RA0 >= RA,
format('~w-~w [~w]~n', [F, N, RA0]),
fail.
find_right_arguments(_).
max_left_arguments(Max) :-
findall(F, formula(F,_), List),
max_left_arguments(List, 0, Max).
max_left_arguments([], Max, Max).
max_left_arguments([F|Fs], Max0, Max) :-
left_arguments(F, RA),
Max1 is max(Max0, RA),
max_left_arguments(Fs, Max1, Max).
left_arguments(dl(_,A), Max) :-
!,
left_arguments(A, Max0),
Max is Max0 + 1.
left_arguments(dr(A,_), Max) :-
!,
left_arguments(A, Max).
left_arguments(_, 0).
print_ccgform(dr(A,B)) :-
!,
format('(~@/~@)', [print_ccgform(A),print_ccgform(B)]).
print_ccgform(dl(B,A)) :-
!,
format('(~@\\~@)', [print_ccgform(A),print_ccgform(B)]).
print_ccgform(A) :-
print_ccgatom(A).
print_ccgatom(Term0) :-
functor(Term0, F0, A),
atom_to_upper(F0, F),
functor(Term, F, A),
copy_arg(A, Term0, Term),
format('~w', [Term]).
%atom_to_upper(A, A).
atom_to_upper(Atom0, Atom) :-
atom_chars(Atom0, Chars0),
list_to_upper(Chars0, Chars),
atom_chars(Atom, Chars).
list_to_upper([], []).
list_to_upper([A0|As0], [A|As]) :-
upcase_atom(A0, A),
list_to_upper(As0, As).
copy_arg(0, _, _).
copy_arg(1, Term0, Term) :-
arg(1, Term0, Arg),
arg(1, Term, Arg).
%
undergeneration :-
setof(F-N, A^(formula(F,N),argument(F,A),undergenerates(A)), Formulas),
portray_formulas(Formulas, 0).
portray_formulas([], Total) :-
format('===~nTotal: ~D~n', [Total]).
portray_formulas([F-N|Fs], T0) :-
format('~p [~w]~n', [F,N]),
T is T0 + N,
portray_formulas(Fs, T).
undergenerates(dl(dl(_,_),_)).
undergenerates(dr(_,dr(_,_))).
argument(dr(_, A), A).
argument(dl(A, _), A).
argument(dr(F, _), A) :-
argument(F, A).
argument(dl(_, F), A) :-
argument(F, A).
%
simplify_formulas :-
formula(F0, N),
simplify_formula(F0, F),
portray_clause(formula(F, N)),
fail.
simplify_formulas.
simplify_formula(dl(_,A0,B0), dl(A,B)) :-
!,
simplify_formula(A0, A),
simplify_formula(B0, B).
simplify_formula(dr(_,A0,B0), dr(A,B)) :-
!,
simplify_formula(A0, A),
simplify_formula(B0, B).
simplify_formula(p(_,A0,B0), p(A,B)) :-
!,
simplify_formula(A0, A),
simplify_formula(B0, B).
simplify_formula(dia(_, A0), A) :-
!,
simplify_formula(A0, A).
simplify_formula(box(_, A0), A) :-
!,
simplify_formula(A0, A).
simplify_formula(A, A).