1:- module(ccprism, [goal_graph/2, graph_params/3, graph_fold/4, top_value/2, unpack_viterbi/4]).

Top level tabled explanation graph creation */

    5:- use_module(library(callutils), [(*)/4]).    6:- use_module(library(rbutils),   [rb_fold/4, rb_add//2]).    7:- use_module(ccprism/handlers,   [goal_expls_tables/3, tables_graph/2]).    8:- use_module(ccprism/graph,      [prune_graph/4, graph_switches/2, graph_fold/4, top_value/2, top_goal/1]).    9:- use_module(ccprism/switches,   [sw_init/3]).
 goal_graph(+Goal:callable, -Graph:graph) is det
Finds all solutions to Goal in a delimited context supplying tabling and probabilistic choice. Explanations are extracted from the tables and returned as a hypergraph, including explanations of Goal itself (which need not be tabled) under the pseudo-goal '^top':top.
   16:- meta_predicate goal_graph(0,-).   17goal_graph(Goal, Graph) :-
   18   time(goal_expls_tables(Goal, Es, Tables)),
   19   tables_graph(Tables, Graph0),
   20   prune_graph(=, '^top':top, [('^top':top)-Es|Graph0], Graph).
 graph_params(+Spec:sw_init_spec, +G:graph, -P:sw_params) is det
Initialise parameters for all switches referenced in graph G. See sw_init/2 for more information.
   25graph_params(Spec,G,Params) :- call(maplist(sw_init(Spec))*graph_switches, G, Params).
   26
   27unpack_viterbi(Spec, VG, Score, TopG-Tree) :-
   28   top_goal(TopG), top_value(VG, TopVal),
   29   unpack_(Spec, TopVal, Score, Tree).
   30
   31unpack_(best,      LP-Tree, LP, Tree).
   32unpack_(kth_best(K), Trees, LP, Tree) :- nth1(K, Trees, Score-Tree), LP is -Score