% --------------------------------------------------------------------------
%   FILE:       GENCRIT.PL
%   AUTHOR:     Tim Duncan
%   UPDATED:    Tue Aug 11 18:42:41 BST 1987
%   PURPOSE:    Organise critique of augmented tree.
% --------------------------------------------------------------------------


:- op(100,fx,*).
:- op(100,xfy,:).


/* Entry point for critique generation, gencrit/1 organises the critique by
splitting the tree putting subtrees in the environment and calling the
appropriate network in PROSENET.
*/

gencrit([Anes,Premed]) :-
    init_crit,
    setminors(Premed),
    discuss_principles,
    discuss_major(Anes,Text/[]),
    ( null(Text),
      text(ok,Comment),
      runoff(Comment),
      savetxt(Comment)
    ; recorda(major,discussed,_),
      savetxt(Text),
      flatten(Text,Out),
      runoff(Out) ), !,
    discuss_minors,
    runoff([*nl,*nl]).


init_crit :-
    member(Key,[text,dl_text,minors,good_techs,global]),
    recorded(Key,_,Rf),
    erase(Rf), fail.
init_crit :- initenv.


/* ------------------------- PRINCIPLES --------------------- */


discuss_principles :-
    initenv,
    fast_setof(Principle,collect(Principle),Principles),
    setenv(principle,Principles),
    text(p1,Text),      % generate text from node $p1
    runoff(Text),
    savetxt(Text), !.
discuss_principles.


collect(Description) :-
    recorded(patient,Disease,_),
    pmframe(Disease,Principles,Risks),
    principle_description(Disease,Principles,Description).


/* Turn a PMF principle into prose description */

principle_description(Disease,Principles,Probl:Compl) :-
    description(problem,Disease,Probl),
    collect_dangers(Principles,[],Dangers),
    not(null(Dangers)),
    describe(danger,Dangers,Compl), !.




/* Only the dangers are used in discussing principles */

collect_dangers([],Acc,Acc).
collect_dangers([principle(P)|More],Acc,Return) :- !,
    collect_dangers(P,Acc,Dang),
    collect_dangers(More,Dang,Return).
collect_dangers([danger(D)|More],Acc,Return) :-
    not(member(D,Acc)), !,
    collect_dangers(More,[D|Acc],Return).
collect_dangers([_|More],Acc,Return) :-
    collect_dangers(More,Acc,Return).




/* --------------------- MAJOR ----------------------
Note: if alternatives, then ignore and just deal with
chosen method, since NOTREG and NOTGA will talk about
the alternative anyway.
*/


discuss_major([treg:R:P,REG],Text) :-       % treg = regional
    initenv,
    ( risky(R),
      textgen(imx,X/X,Major),
      textgen(notreg,Major,Text)    % and suggest general anesthetic ?
    ; setminors([treg:R:P,REG]),
      null_dl(Text) ), !.

discuss_major([tga:R:P,Intub,Maint,Induct],Text) :-  % tga = general anaesth
    discuss_intubation(Intub,Int_txt), !,
    savetxt(Int_txt),
    discuss_induction(Induct,Ind_txt), !,
    savetxt(Ind_txt),
    discuss_maintenance(Maint,Maintxt),
    savetxt(Maintxt),
    append_dl(Int_txt,Ind_txt,Tmp),
    append_dl(Tmp,Maintxt,Text).

discuss_major(['ALTERNATIVES',[Chosen|Other]],Text) :- !,
    discuss_major(Chosen,Major),
    ( head(tga:R:P,Chosen),       % if general was problematic,
      textgen(notga,Major,Text)   % suggest regional as alternative
    ; true ), !.



/* ------------------------ INTUBATION ------------------------ */


discuss_intubation(Intub,Text) :-
    not(worth_discussing(Intub)), !,
    setminors(Intub),
    null_dl(Text).
discuss_intubation([tintub:R:P,Tree],Text) :-
    initenv,
    setenv(subplan,[intubation]),
    setenv(intub_risk,P),  % intubation risk - INTRISKDESC ??
    chosen_technique(Tech,Tree),
    ( Tech = tnointub,     % no intubation
      textgen(n,X/X,Text)
    ; textgen(int,X/X,Text) ).



/* ----------------------- INDUCTION -------------------------- */


discuss_induction(Induct,Text) :-
    not(worth_discussing(Induct)), !,
    setminors(Induct),
    null_dl(Text).
discuss_induction([tinduct:R:P,Tree],Text) :-
    initenv,
    setenv(subplan,[induction]),
    chosen_technique(_,Tree),
    textgen(imx,X/X,Text).



/* ----------------------- MAINTENANCE -------------------------- */


discuss_maintenance([tmaint:R:P,N2O,Relax,Inhal],Text) :-
    not(worth_discussing(Inhal)), !,
    setminors([tmaint:R:P,N2O,Relax,Inhal]),
    null_dl(Text).
discuss_maintenance([tmaint:R:P,N2O,Relax,Inhal],Text) :-
    initenv,
    setenv(subplan,[maintenance]),
    setminors(N2O),
    setminors(Relax),
    chosen_technique(_,Inhal),
    textgen(imx,X/X,Text).





/* ----------------------- UTILITIES ----------------------- */


/*
setminors(Tree)
*/

setminors([]).
setminors(['ALTERNATIVES',[Tech|Others]]) :- !,
    setminors(Tech), !,
    setminors(Others).
setminors([Tech|Others]) :- !,
    setminors(Tech), !,
    setminors(Others).
setminors(Tech:R:Desc) :- !,
    unsorted_btlist(Risks,_,Wellchos,_,Desc),
    ( null(Risks)
    ; update(minors,Tech:R:Risks) ), !,
    ( null(Wellchos)
    ; update(good_techs,Tech:Wellchos) ), !.
setminors([Tech,Subtech]) :- !,
    setminors([Tech]), !,
    setminors(Subtech).


/* set up the environment to discuss the chosen technique */

chosen_technique(Tech,['ALTERNATIVES',Tree]) :- !,
    delete([Tech:Risk:Prose|Subtree],Tree,Alternatives),
    process_tech([Tech:Risk:Prose|Subtree]),
    setenv(alts,Alternatives),
    setenv(altcount,[0]),
    ( exists_better_alternative(Risk,Alternatives),
      setenv(chostechval,[soso])
    ; setenv(chostechval,[ok]) ), !.    % only alternatives of equal worth
chosen_technique(Tech,[Tech:Risk:Prose|Subtree]) :-
    delenv(alts,_),
    delenv(altcount,_),
    setenv(chostechval,[good]),
    process_tech([Tech:Risk:Prose|Subtree]).


process_tech([Tech:Risk:Prose|Subtree]) :-
    setenv(chostechrisk,[Risk]),
    setenv(chostech,[Tech|Subtree]),
    btlist(Risks,Benefits,CP,Prose),
    setenv(tlist,Risks),
    setenv(blist,Benefits),
    setenv(cprule,CP).


exists_better_alternative(Risk,[[Tech:R:['CP'(_)|P]|Subtree]|More]) :- !.
exists_better_alternative(Risk,[[Tech:R:P|Subtree]|More]) :-
    not(less_or_equal_risk(Risk,R)).  % found better alternative
exists_better_alternative(Risk,[[Tech:R:P|Subtree]|More]) :- !,
    exists_better_alternative(Risk,More).


/* btlist/4
Mode: btlist(-,-,-,+)
Args: btlist(R,B,C,D)
    R = Risk:Description pairs, sorted High to Low.
    B = Benefit::Description pairs, sorted High to Low.
    C = CP rules
    D = Description
The descrition obtained from the augmented tree is split up into risks,
benefits and CP rule, where these exist. Note: if risk/benefit includes
the word "noprint" (eg: full_stom => aspiration) then drop it.
*/


btlist(R,B,C,D) :-
    unsorted_btlist(Ru,Bu,_,C,D),
    sortrisk(Ru,R),     % sort risks High to Low
    sortrisk(Bu,Br),    % sort benefits low to high, and reverse
    reverse(Br,B).




/* unsorted_btlist/5
In addition to risks, benefits, and CP rules, unsorted_btlist/5
also finds "wellchosen" techniques, ie. those with benefits or
explicitly marked as "wellchos"
*/

unsorted_btlist([],[],[],[],[]).
unsorted_btlist(R,B,W,[CP|C],['CP'(CP)|Rest]) :- !,
    unsorted_btlist(R,B,W,C,Rest).
unsorted_btlist(R,B,W,C,[Risk:Desc|Rest]) :-
    member(noprint,Desc), !,
    unsorted_btlist(R,B,W,C,Rest).
unsorted_btlist([Risk:Desc|R],B,W,C,[Risk:Desc|Rest]) :-
    risky(Risk),
    not(member(wellchos,Desc)), !,
    unsorted_btlist(R,B,W,C,Rest).
unsorted_btlist(R,[Bene:Desc|B],[Bene:Desc|W],C,[Bene:Desc|Rest]) :-
    benefit(Bene), !,
    unsorted_btlist(R,B,W,C,Rest).
unsorted_btlist(R,B,[Wellchos:Desc|W],C,[Wellchos:Desc|Rest]) :-
    member(wellchos,Desc), !,
    unsorted_btlist(R,B,W,C,Rest).
unsorted_btlist(R,B,C,[Risk:Desc|Rest]) :- !,
    unsorted_btlist(R,B,C,Rest).



/* worth_discussing/1
Plan is worth discussing as a major point provided that there
are some alternatives in the plan. Otherwise it will be relegated
to "minors".
*/

worth_discussing([]) :- !, fail.
worth_discussing(['ALTERNATIVES'|_]) :- true, !.
worth_discussing([Tech|Others]) :-
    ( worth_discussing(Tech)
    ; worth_discussing(Others) ).




/* ---------------------- MINOR -------------------- */

discuss_minors :-
    initenv,
    organise_minors(M),
    organise_good_techs(G),
    ( null(M), null(G)
    ; setenv(good_techs,G),
      setenv(minors,M),
      setenv(linenum,[0]), !,
      text(fin,Text),
      runoff(Text) ), !.

organise_minors(M) :-
    recorded(minors,M1,_),
    weedredund(M1,M2),
    sortrisk(M2,M3),
    pruneextra(M3,[],M), !.
organise_minors([]).



/* weed out the redundant ones from global list
   of techniques already discussed */

weedredund(A,B) :-
    recorded(redundant,(global,L),_), !,
    weedredund(A,B,L).
weedredund(X,X).

weedredund([],[],_).
weedredund([Tech:Desc|Rest],Return,Done) :-
    member(Tech,Done), !,
    weedredund(Rest,Return).
weedredund([Tech:Desc|Rest],[Tech:Desc|Return],Done) :-
    !, weedredund(Rest,Return).



/* pruneextra/3
Check that there aren't two risks of the same 'type'.
Second arg is a descending accumulator to remember types.
*/

pruneextra([],_,[]).
pruneextra([Tech:R:Desc|More],Acc,[Tech:R:Desc|Rest]) :-
    not(member(type(_),Desc)), !,   % doesn't involve type
    pruneextra(More,Acc,Rest).
pruneextra([Tech:R:Desc|More],Acc,[Tech:R:Desc|Rest]) :-
    member(type(T),Desc),
    not(member(T,Acc)), !,          % add to accumulator
    pruneextra(More,[T|Acc],Rest).
pruneextra([Tech:R:Desc|More],Acc,Rest) :- !,
    pruneextra(More,Acc,Rest).



organise_good_techs(G) :-
    recorded(good_techs,G1,_),
    weedredund(G1,G2),
    mkgtech(G2,[],G), !.
organise_good_techs([]).



/* mkgtech/3
Gathers all the techniques that are 'wellchosen' for a
context together under that context. The second arg is
a descending accumulator for contexts found.
*/

mkgtech([],X,X).    % return accumulator
mkgtech([T:[R:D|_]|More],Acc,Return) :-
    member(context(C),D),
    describe(problem,C,P), !,
    update_gtech(P,T:D,Acc,NewAcc), !,
    mkgtech(More,NewAcc,Return).



update_gtech(P,T,Acc,[prob(P):[T]|Acc]) :-
    not(member(prob(P):L,Acc)), !.          % new problem found
update_gtech(P,T,Acc,[prob(P):[T|L]|Mod]) :-
    delete(prob(P):L,Acc,Mod),
    not(member(T,L)), !.                % new benefit for old problem
update_gtech(P,T,Acc,Acc).              % nothing new.
