
/* ------------------------------------------------------------------------
 > FILENAME:	supple_io
 > PURPOSE:	
 > AUTHORS:	Kevin Humphreys, Hamish Cunningham
 > NOTES:	
 ------------------------------------------------------------------------ */

cvsid_buchart_io("$Id: supple_io.pl 7085 2005-12-05 16:32:03Z ian_roberts $").


read_chart_file(File) :-
    retractall(chart(_,_,_,_,_)),
    vwrite('Reading chart file...'),nl,
    read_chart_file(File,Charts,_),
    vwrite('Asserting charts into database...'), nl,
    assertlist(Charts).

read_chart_file(File,Charts) :-
    see(File), seen, see(File),
    read_charts([],RCharts),
    reverse(RCharts,Charts),
    seen, !.

read_charts(In,Out) :-
    read(Chart),
    ((Chart = end_of_file, Out=In, !)
    ;(Chart = chart(sentence_n:S, edges:Edges, next_edge_number:E),
      read_charts([Chart|In],Out), !)
     ;(nl,vwrite('Malformed chart in file, involving '),vwrite(Chart),nl,Out=[],!)).

assertlist([]) :- !.
assertlist([Term|Terms]) :-
    assert(Term),
    assertlist(Terms), !.


% write out in same format as input
write_chart_file(InFile,OutFile) :-
    telling(Old),
    tell(OutFile), told, tell(OutFile),
    write('% chart file '),write(OutFile),
        write(' from '),write(InFile),
        write(' - AUTOGENERATED, DO NOT EDIT'),nl,nl,
    write_newcharts,
    told,
    tell(Old).

write_newcharts :-
    chart(Sentence,edges:Edges,Next),
%    once(sort_edges(Edges,SEdges)),
    write('chart('),nl,
    writeq(Sentence),write(', '),
    write('edges : ['),nl,
    write_edges(Edges),
    write('], '),
    writeq(Next), nl,
    write(').'),nl,nl,
    fail.
write_newcharts.

write_edges([]) :-
    nl, !.
write_edges([Edge]) :-
    write('  '),
    writeq(Edge), nl, !.
write_edges([Edge|Edges]) :-
    write('  '),
    writeq(Edge),
    write(','), nl,
    write_edges(Edges), !.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% tree display predicates
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

display_tree(Cat) :- display_tree(Cat,_).

display_tree(Cat,Level) :-
    edge(_,_,C,[],_,Children,Level,_,_,Edge),
    C =.. [Cat|Fs],
    reverse(Children,Cs),
    display_tree(Cat,Fs,Cs), nl,
    semantics(Cat,inactive,Edge,Sem),
    write(Sem), nl, nl,
    fail.
display_tree(Cat,Level) :- !.

display_tree(Cat,Features,[]) :-
    write(Cat), nl,
    member(s_form:S,Features),
    write(Cat), tab(2),
    write('"'), write(S), write('"'), nl, !.
display_tree(Cat,_,Cs) :-
    write(Cat), nl,
    display_tree2(Cs,1), !.

display_tree2([Child|Children],Indent) :-
    edge(_,_,C,[],_,[],_,_,_,Child),
    C =.. [Cat|Features],
    member(s_form:S,Features),
    tab(Indent), write(Cat),
    tab(2), write('"'), write(S), write('"'), nl,
    display_tree2(Children,Indent).
display_tree2([Child|Children],Indent) :-
    edge(_,_,C,[],_,Children2,_,_,_,Child),
    C =.. [Cat|_],
    reverse(Children2,C2s),
    tab(Indent), write(Cat), nl,
    Indent2 is Indent + 2,
    display_tree2(C2s,Indent2),
    display_tree2(Children,Indent).
display_tree2([],Indent).



display_bracketed_tree(Cat,Features,[]) :-
    write(Cat), nl,
    member(s_form:S,Features),
    write('('),write(Cat),
    write(' "'), write(S), write('")'), %nl,
    !.
display_bracketed_tree(Cat,_,Cs) :-
    write('('),write(Cat), %nl,
    display_bracketed_tree2(Cs,2),
    write(')'), !.

display_bracketed_tree2([Child|Children],Indent) :-
    edge(_,_,C,[],_,[],_,_,_,Child),
    C =.. [Cat|Features],
    member(s_form:S,Features),
    %tab(Indent),
    write(' ('), write(Cat),
    write(' "'), write(S), write('")'), %nl,
    display_bracketed_tree2(Children,Indent).
display_bracketed_tree2([Child|Children],Indent) :-
    edge(_,_,C,[],_,Children2,_,_,_,Child),
    C =.. [Cat|_],
    reverse(Children2,C2s),
    %tab(Indent),
    write(' ('), write(Cat), %nl,
    Indent2 is Indent + 2,
    display_bracketed_tree2(C2s,Indent2), write(')'),
    display_bracketed_tree2(Children,Indent).
display_bracketed_tree2([],Indent).



% alternative display routine to output tipster-style span annotations
display_tdm_attributes(Sentence,Edges,InputEdges) :- nonvar(Edges),
	foreach(member(edge(_,_,C,[],_,Cs,_,Start,End,ID),Edges),
	(C =.. [Cat|_],
	 reverse(Cs,RCs),
	 display_tdm_attributes(Cat,RCs,Start,End,InputEdges), 
	 semantics(Cat,inactive,ID,Sem), Sem \= [], nl,
	 foreach(member(ne_tag(X,offsets(NEStart,NEEnd)),Sem),
	         (ne_tag(X,Sem,Tag),
		  write('name '),
		  write(NEStart), write(' '),
		  write(NEEnd), write(' '),
		  write(Tag), write(' '),
		  write(X), nl)), nl, !,
%	 write_list3([semantics,Start,End]), write(' '),
%	 write_sem_list(Sem), nl, nl
         write_semantics([Start,End,Sem]),nl
          )),!.

display_tdm_attributes(_,_,_).
display_tdm_attributes(Cat,[],Start,End,InputEdges) :- !.
display_tdm_attributes(Cat,Cs,Start,End,InputEdges) :-
	length(Cs,CL),
	write_list3([syntax,Start,End,Cat,constituents,CL]),nl,
	display_tdm_child_attributes(Cs,InputEdges), !.

display_tdm_child_attributes([],_) :- !.
display_tdm_child_attributes([Child|Children],InputEdges) :-
        % leaf node
	(edge(_,_,C,[],_,[],_,Start,End,Child)
        ;memberchk(edge(_,_,C,[],_,[],_,Start,End,Child),InputEdges)),
	C =.. [Cat|_],
	write_list3([syntax,Start,End,Cat,constituents,0]),nl,
	display_tdm_child_attributes(Children,InputEdges), !.
display_tdm_child_attributes([Child|Children],InputEdges) :-
        % node with children
	(edge(_,_,C,[],_,Children2,_,Start,End,Child)
	;memberchk(edge(_,_,C,[],_,Children2,_,Start,End,Child),InputEdges)),!,
	C =.. [Cat|_],
	length(Children2,CL),
	write_list3([syntax,Start,End,Cat,constituents,CL]),nl,
	reverse(Children2,C2s),
	display_tdm_child_attributes(C2s,InputEdges),
	display_tdm_child_attributes(Children,InputEdges), !.
display_tdm_child_attributes([_|Children],InputEdges) :-
	display_tdm_child_attributes(Children,InputEdges).


display_tdm_ne_attributes(_,Edges) :- nonvar(Edges),
	foreach(member(edge(_,_,C,[],_,_,_,_,_,ID),Edges),
	        (C =.. [Cat|Features],
		 semantics(Cat,inactive,ID,Sem),
		 foreach(member(ne_tag(X,offsets(Start,End)),Sem),
		         (ne_tag(X,Sem,Tag),
			  write('name '),
			  write(Start), write(' '),
			  write(End), write(' '),
			  write(Tag), write(' '),
			  write(X), nl)) )), !.
display_tdm_ne_attributes(_,Edges).
	
%%% muc categories
ne_tag(X,Sem,organization) :- memberchk(organization(X),Sem).
ne_tag(X,Sem,location) :- memberchk(location(X),Sem).
ne_tag(X,Sem,person) :- memberchk(person(X),Sem).
ne_tag(X,Sem,date) :- memberchk(date(X),Sem).
ne_tag(X,Sem,time) :- memberchk(time(X),Sem).
ne_tag(X,Sem,percent) :- memberchk(percent(X),Sem).
ne_tag(X,Sem,money) :- memberchk(money(X),Sem).

% muc7 artifacts identified by NE grammar but not output as NEs
ne_tag(X,Sem,aircraft) :- memberchk(aircraft(X),Sem).
ne_tag(X,Sem,boat) :- memberchk(boat(X),Sem).
ne_tag(X,Sem,flight) :- memberchk(flight(X),Sem).

ne_tag(X,Sem,unknown).


write_list3([]). 
write_list3([A]):- !, write(A). 
write_list3([A|As]):-  
    write(A),
    write(' '), 
    write_list3(As). 

write_sem_list(L):- write('['), write_sem_list3(L), write(']'). 
write_sem_list3([]). 
write_sem_list3([A]):- !,     
	write_term(A,[quoted(true),ignore_ops(true),numbervars(true)]).
write_sem_list3([A|As]):-  
    write_term(A,[quoted(true),ignore_ops(true),numbervars(true)]),
    write(', '), 
    write_sem_list3(As). 


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% best parse display routines
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

display_best_parse(Sentence,Edges) :-
    best_parse_file(File),
    telling(Old), tell(File),
    foreach(member(edge(_,_,C,[],_,Cs,_,_,_,ID),Edges),
	(C =.. [Cat|Fs],
         reverse(Cs,RCs),
	 ((bracketed_parses, display_bracketed_tree(Cat,Fs,RCs))
         ;display_tree(Cat,Fs,RCs))
	 %nl, nl,
         %semantics(Cat,inactive,ID,Sem), 
	 %write_list(Sem), nl, nl
	 )), nl,
    tell(Old), !.
display_best_parse(_,_).


write_list(L):- write('['), write_list2(L), write(']'). 
write_list2([]). 
write_list2([A]):- !, write(A). 
write_list2([A|As]):-  
    write(A), 
    write(', '), 
    write_list2(As). 





%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% parse stats display routines
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% display_parser_stats/0 - how many edges, parses etc.
%display_parser_stats :-
%  count_edges(E),
%  vwrite_nl(['number of edges = ', E]).

count_edges(E) :-
  foreach(
    edge(_, _, _, _, _, _, _, _, _, _),
    (
      ( retract(count_edges_number(N)) ; N is 0 ),
      N2 is N + 1,
      assert(count_edges_number(N2))
    )
  ),
  retract(count_edges_number(E)).


% display_rule_info/2 - prints out rule being fired
% (send this to a file then "sort FILE | uniq -c | sort -r")
display_rule_info(Rule,Grammar) :-
    vwrite(Grammar),vwrite(' '),vwrite(Rule),
    rule(Cat,SubCats,Rule,Grammar),
    vwrite(': '),
    name(Rule,[_,_,_,_|NumS]),name(Num,NumS),
    ((Num < 10, vwrite(' ')) ; true),
    ((Num < 100, vwrite(' ')) ; true),
    Cat =.. [C|_],
    vwrite(C),vwrite(' ->'),
    !,
    ((member(SubCat,SubCats),
      SubCat =.. [SC|_],
      vwrite(' '),vwrite(SC),
      fail)
        ; nl).


display_best_parse_stats(Sentence,Edges,Max) :-
    (best_parse_file(File);verbose),
    telling(Old),
    ((best_parse_file(File),tell(File))
    ;(verbose_output(VOut),tell(VOut))),
    vwrite('Sentence No.: '),vwrite(Sentence),nl,

    % calculate coverage of best parse
    calculate_skip(Edges,1,Max,Skip),
    Coverage is Max - Skip,
    ((Max > 0, CoveragePC is (Coverage/Max)*100)
        ;CoveragePC = 100),
    vwrite('Coverage is '),vwrite(Coverage),
    vwrite(' tokens out of '),vwrite(Max),
    vwrite(' ('),vwrite(CoveragePC),vwrite('%)'),nl,

    findall(ID,edge(_,_,_,_,_,_,3,_,_,ID),Level3Edges),
    length(Level3Edges,Number),
    vwrite(Number),vwrite(' inactive edges in final chart, '),
    length(Edges,BNumber),
    vwrite(BNumber),vwrite(' edges in best parse'),nl,

    tell(Old),!.
display_best_parse_stats(_,_,_).

calculate_skip([],LastEnd,Max,Skip) :-
	Skip is Max - LastEnd, !.
calculate_skip([edge(Start,End,_,_,_,_,_,_,_,_)|Edges],LastEnd,Max,Skip) :-
	calculate_skip(Edges,End,Max,RestSkip),
	Skip is Start - LastEnd + RestSkip.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% chatty modes
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

:- dynamic verbose/0.
verbose(1) :- retractall(verbose), assert(verbose).
verbose(0) :- retractall(verbose).

vwrite(X) :-
    verbose,
    telling(Current),
    verbose_output(Out),
    tell(Out),
    write(X),
    tell(Current), !.
vwrite(_).

vwrite_list(X) :-
    verbose,
    telling(Current),
    verbose_output(Out),
    tell(Out),
    write_list(X),
    tell(Current), !.
vwrite_list(_).

vcall(X) :-
    verbose,
    telling(Current),
    verbose_output(Out),
    tell(Out),
    call(X),
    tell(Current), !.
vcall(_).

vnl :-
    verbose,
    telling(Current),
    verbose_output(Out),
    tell(Out),
    nl,
    tell(Current), !.
vnl.

% debug mode

:- dynamic debug_on/0.
buchart_debug(1) :- retractall(debug_on), retractall(verbose),
        assert(verbose), assert(debug_on).
buchart_debug(0) :- retractall(debug_on).

dwrite(X) :-
    debug_on,
    telling(Current),
    verbose_output(Out),
    tell(Out),
    write(X),
    tell(Current), !.
dwrite(_).

dwrite_list(X) :-
    debug_on,
    telling(Current),
    verbose_output(Out),
    tell(Out),
    write_list(X),
    tell(Current), !.
dwrite_list(_).

dcall(X) :-
    debug_on,
    telling(Current),
    verbose_output(Out),
    tell(Out),
    call(X),
    tell(Current), !.
dcall(_).

dnl :-
    debug_on,
    telling(Current),
    verbose_output(Out),
    tell(Out),
    nl,
    tell(Current), !.
dnl.


%%% HORACIO: writing semantics when external call

write_semantics(_,[]):-!.
write_semantics(H,[START,END,SEMANTICS|R]):-
     write(H,'semantics'),write(H,' '),
     write(H,START),write(H,' '),
     write(H,END),nl(H),
     write_qlf(H,SEMANTICS),
     write_semantics(H,R).

write_qlf(_,[]):-!.
write_qlf(H,[TERM|TERMS]):-
     write_canonical(H,TERM),nl(H),
     write_qlf(H,TERMS).


%%% more on writing logical forms one line per term



write_semantics([START,END,SEMANTICS]):-
     write('semantics'),write(' '),
     write(START),write(' '),
     write(END),nl,
     write_qlf(SEMANTICS).

write_qlf([]):-!.
write_qlf([TERM|TERMS]):-
     write_canonical(TERM),nl,
     write_qlf(TERMS).



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Revision 1.4  2002/03/15 13:26:00  saggion
% *** empty log message ***
%
% Revision 1.3  2001/12/06 13:47:40  saggion
% types of players
%
% Revision 1.2  2001/12/04 17:46:01  saggion
% Dealing with the external call (-sem argument, parse_file.pl and buchart_io.pl)
%
% Revision 1.1  2001/12/04 13:08:23  saggion
% files and directories for buchart now in mumis (from Lasie3)
%
% Revision 1.1  2001/06/26 17:28:34  saggion
% New directory for buchart and disint resources
%
% Revision 1.3  2001/05/14 17:42:56  saggion
% Modifications to buchart
%
% Revision 1.23  1998/03/28 19:07:34  robertg
% Stopped semantics writeout when writing bracketed parses.
%
% Revision 1.22  1998/03/16 19:55:08  kwh
% pass through named artifacts as NEs
%
% Revision 1.21  1998/02/07 19:46:38  kwh
% moved aircraft grammar to first
%
% Revision 1.20  1998/01/24 16:59:15  kwh
% don't output flights as NEs
%
% Revision 1.19  1998/01/22 13:08:16  kwh
% don't output aircraft as unknown NEs
%
% Revision 1.18  1998/01/21 14:54:26  kwh
% don't output aircraft as NEs
%
% Revision 1.17  1998/01/09 16:43:32  kwh
% tree output (-p and -b options) working again
%
% Revision 1.16  1997/12/01 15:55:46  kwh
% rationalised top level control, merge subgrammars during compilation, pass child edges through for syntax output, and revised docs
%
% Revision 1.15  1997/11/18 18:47:58  kwh
% keep all leaf/intermediate edges in chart for complete syntax output
%
% Revision 1.14  1997/10/15 13:40:58  kwh
% don't include non-existant edges in constituent count
%
% Revision 1.13  1997/09/30 17:24:36  kwh
% merge buchart_cascade changes back in
%
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

