/*
* Export probabilities of switches from Prolog to C. Switches is
* a list of switches, each of which takes the form:
*
* sw(Id,InstanceIds,Probs,SmoothCs,Fixed,FixedH),
*
* where
* Id: identifier of the switch
* InstanceIds: list of ids of the instances of the switch
* Probs: current probabilities assigned to the instance switches
* SmoothCs: current pseudo counts assigned to the instance switches
* Fixed: probabilities fixed?
* FixedH: pseudo counts fixed?
*
* The structures for switch instances have been allocated. This
* function only fills out the initial probabilities.
*/
int pc_export_sw_info_1(void)
{
int sw_id,instance_id,fixed,fixed_h;
double prob,smooth;
TERM p_switches, p_switch;
TERM p_instance_list,p_prob_list,p_smooth_list;
TERM p_prob,p_smooth;
p_switches = bpx_get_call_arg(1,1);
while (bpx_is_list(p_switches)) {
/* p_switch: sw(Id,InstList,ProbList,SmoothCList,FixedP,FixedH) */
p_switch = bpx_get_car(p_switches);
sw_id = bpx_get_integer(bpx_get_arg(1,p_switch));
p_instance_list = bpx_get_arg(2,p_switch);
p_prob_list = bpx_get_arg(3,p_switch);
p_smooth_list = bpx_get_arg(4,p_switch);
fixed = bpx_get_integer(bpx_get_arg(5,p_switch));
fixed_h = bpx_get_integer(bpx_get_arg(6,p_switch));
while (bpx_is_list(p_instance_list)) {
instance_id = bpx_get_integer(bpx_get_car(p_instance_list));
p_prob = bpx_get_car(p_prob_list);
p_smooth = bpx_get_car(p_smooth_list);
if (bpx_is_integer(p_prob)) {
prob = (double)bpx_get_integer(p_prob);
}
else if (bpx_is_float(p_prob)) {
prob = bpx_get_float(p_prob);
}
else {
RET_ERR(illegal_arguments);
}
if (bpx_is_integer(p_smooth)) {
smooth = (double)bpx_get_integer(p_smooth);
}
else if (bpx_is_float(p_smooth)) {
smooth = bpx_get_float(p_smooth);
}
else {
RET_ERR(illegal_arguments);
}
switch_instances[instance_id]->inside = prob;
switch_instances[instance_id]->fixed = fixed;
switch_instances[instance_id]->fixed_h = fixed_h;
switch_instances[instance_id]->smooth_prolog = smooth;
p_instance_list = bpx_get_cdr(p_instance_list);
p_prob_list = bpx_get_cdr(p_prob_list);
p_smooth_list = bpx_get_cdr(p_smooth_list);
}
p_switches = bpx_get_cdr(p_switches);
}
return BP_TRUE;
}
int pc_export_switch_2(void)
{
BPLONG sw,sw_ins_ids,sw_ins_id;
SW_INS_PTR *curr_ins_ptr;
sw = bpx_get_integer(bpx_get_call_arg(1,2));
sw_ins_ids = bpx_get_call_arg(2,2);
if (sw >= max_sw_tab_size) expand_switch_table(sw + 1);
if (sw >= sw_tab_size) sw_tab_size = sw + 1;
curr_ins_ptr = &switches[sw];
while (bpx_is_list(sw_ins_ids)) {
sw_ins_id = bpx_get_integer(bpx_get_car(sw_ins_ids));
sw_ins_ids = bpx_get_cdr(sw_ins_ids);
if (sw_ins_id >= max_sw_ins_tab_size)
expand_switch_instance_table(sw_ins_id + 1);
if (sw_ins_id >= sw_ins_tab_size) sw_ins_tab_size = sw_ins_id + 1;
switch_instances[sw_ins_id] = alloc_switch_instance();
switch_instances[sw_ins_id]->id = sw_ins_id;
*curr_ins_ptr = switch_instances[sw_ins_id];
curr_ins_ptr = &switch_instances[sw_ins_id]->next;
}
*curr_ins_ptr = NULL;
return BP_TRUE;
}
int sort_egraphs(TERM p_fact_list) /* assumed to be dereferenced in advance */
{
TERM pair;
int root_index = 0, goal_id, count;
sorted_egraph_size = 0;
suppress_init_flags = 1;
while (bpx_is_list(p_fact_list)) {
pair = bpx_get_car(p_fact_list);
p_fact_list = bpx_get_cdr(p_fact_list);
goal_id = bpx_get_integer(bpx_get_arg(1,pair));
count = bpx_get_integer(bpx_get_arg(2,pair));
if (sort_one_egraph(goal_id,root_index,count) == BP_ERROR) {
INIT_VISITED_FLAGS;
return BP_ERROR;
}
root_index++;
}
suppress_init_flags = 0;
INIT_VISITED_FLAGS;
return BP_TRUE;
}
int pc_import_occ_switches_3(void)
{
CACHE_REGS
TERM p_sw_list,p_sw_list0,p_sw_list1;
TERM p_sw_ins_list0,p_sw_ins_list1,sw,sw_ins;
TERM p_num_sw, p_num_sw_ins;
int i;
int num_sw_ins;
void release_occ_switches();
#ifdef __YAP_PROLOG__
TERM *hstart;
restart:
hstart = heap_top;
#endif
p_sw_list = bpx_get_call_arg(1,3);
p_num_sw = bpx_get_call_arg(2,3);
p_num_sw_ins = bpx_get_call_arg(3,3);
p_sw_list0 = bpx_build_nil();
num_sw_ins = 0;
for (i = 0; i < occ_switch_tab_size; i++) {
SW_INS_PTR ptr;
#ifdef __YAP_PROLOG__
if ( heap_top + 64*1024 >= local_top ) {
H = hstart;
/* running out of stack */
extern int Yap_gcl(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop);
Yap_gcl(4*64*1024, 3, ENV, CP);
goto restart;
}
#endif
sw = bpx_build_structure("sw",2);
bpx_unify(bpx_get_arg(1,sw), bpx_build_integer(i));
p_sw_ins_list0 = bpx_build_nil();
ptr = occ_switches[i];
while (ptr != NULL) {
num_sw_ins++;
if (ptr->inside <= 0.0) ptr->inside = 0.0; /* FIXME: quick hack */
sw_ins = bpx_build_structure("sw_ins",4);
bpx_unify(bpx_get_arg(1,sw_ins),bpx_build_integer(ptr->id));
bpx_unify(bpx_get_arg(2,sw_ins),bpx_build_float(ptr->inside));
bpx_unify(bpx_get_arg(3,sw_ins),bpx_build_float(ptr->smooth));
bpx_unify(bpx_get_arg(4,sw_ins),bpx_build_float(ptr->total_expect));
p_sw_ins_list1 = bpx_build_list();
bpx_unify(bpx_get_car(p_sw_ins_list1),sw_ins);
bpx_unify(bpx_get_cdr(p_sw_ins_list1),p_sw_ins_list0);
p_sw_ins_list0 = p_sw_ins_list1;
ptr = ptr->next;
}
bpx_unify(bpx_get_arg(2,sw),p_sw_ins_list0);
p_sw_list1 = bpx_build_list();
bpx_unify(bpx_get_car(p_sw_list1),sw);
bpx_unify(bpx_get_cdr(p_sw_list1),p_sw_list0);
p_sw_list0 = p_sw_list1;
}
release_occ_switches();
return
bpx_unify(p_sw_list, p_sw_list0) &&
bpx_unify(p_num_sw, bpx_build_integer(occ_switch_tab_size)) &&
bpx_unify(p_num_sw_ins, bpx_build_integer(num_sw_ins));
}
int pc_import_sorted_graph_paths_2(void)
{
TERM paths0,paths1,glist,slist,t0,t1,p_tmp;
EG_PATH_PTR path_ptr;
EG_NODE_PTR *children;
SW_INS_PTR *sws;
int node_id,k,len;
node_id = bpx_get_integer(bpx_get_call_arg(1,2));
path_ptr = sorted_expl_graph[node_id]->path_ptr;
if (path_ptr == NULL) {
if (explicit_empty_expls) {
t0 = bpx_build_list();
t1 = bpx_build_list();
bpx_unify(bpx_get_car(t0),bpx_build_nil());
bpx_unify(bpx_get_cdr(t0),t1);
bpx_unify(bpx_get_car(t1),bpx_build_nil());
bpx_unify(bpx_get_cdr(t1),bpx_build_nil());
paths0 = bpx_build_list();
bpx_unify(bpx_get_car(paths0),t0);
bpx_unify(bpx_get_cdr(paths0),bpx_build_nil());
}
else paths0 = bpx_build_nil();
}
else {
paths0 = bpx_build_nil();
while (path_ptr != NULL) {
len = path_ptr->children_len;
children = path_ptr->children;
if (len > 0) {
glist = bpx_build_list();
p_tmp = glist;
for (k = 0; k < len; k++) {
bpx_unify(bpx_get_car(p_tmp),
bpx_build_integer(children[k]->id));
if (k == len - 1) {
bpx_unify(bpx_get_cdr(p_tmp),bpx_build_nil());
}
else {
bpx_unify(bpx_get_cdr(p_tmp),bpx_build_list());
p_tmp = bpx_get_cdr(p_tmp);
}
}
}
else glist = bpx_build_nil();
len = path_ptr->sws_len;
sws = path_ptr->sws;
if (len > 0) {
slist = bpx_build_list();
p_tmp = slist;
for (k = 0; k < len; k++) {
bpx_unify(bpx_get_car(p_tmp),bpx_build_integer(sws[k]->id));
if (k == len - 1) {
bpx_unify(bpx_get_cdr(p_tmp),bpx_build_nil());
}
else {
bpx_unify(bpx_get_cdr(p_tmp),bpx_build_list());
p_tmp = bpx_get_cdr(p_tmp);
}
}
}
else slist = bpx_build_nil();
if (explicit_empty_expls ||
!bpx_is_nil(glist) || !bpx_is_nil(slist)) {
t0 = bpx_build_list();
t1 = bpx_build_list();
bpx_unify(bpx_get_car(t0),glist);
bpx_unify(bpx_get_cdr(t0),t1);
bpx_unify(bpx_get_car(t1),slist);
bpx_unify(bpx_get_cdr(t1),bpx_build_nil());
paths1 = bpx_build_list();
bpx_unify(bpx_get_car(paths1),t0);
bpx_unify(bpx_get_cdr(paths1),paths0);
paths0 = paths1;
}
path_ptr = path_ptr->next;
}
}
return bpx_unify(bpx_get_call_arg(2,2),paths0);
}
static int add_egraph_path(int node_id, TERM children_prolog, TERM sws_prolog)
{
EG_PATH_PTR path_ptr;
EG_NODE_PTR *children;
SW_INS_PTR *sws;
int len,k;
int child,sw;
TERM p_child,p_sw;
int list_length(BPLONG, BPLONG);
if (node_id >= max_egraph_size) expand_egraph(node_id + 1);
if (node_id >= egraph_size) egraph_size = node_id + 1;
path_ptr = (EG_PATH_PTR)MALLOC(sizeof(struct ExplGraphPath));
len = list_length(children_prolog, children_prolog);
if (len > 0) {
path_ptr->children_len = len;
children = (EG_NODE_PTR *)MALLOC(sizeof(EG_NODE_PTR) * len);
k = 0;
while (bpx_is_list(children_prolog)) {
p_child = bpx_get_car(children_prolog);
if (!bpx_is_integer(p_child))
RET_ERR(err_invalid_goal_id);
child = bpx_get_integer(p_child);
children[k] = expl_graph[child];
k++;
children_prolog = bpx_get_cdr(children_prolog);
}
path_ptr->children = children;
}
else {
path_ptr->children_len = 0;
path_ptr->children = NULL;
}
len = list_length(sws_prolog, sws_prolog);
if (len > 0) {
path_ptr->sws_len = len;
sws = (SW_INS_PTR *)MALLOC(sizeof(SW_INS_PTR) * len);
k = 0;
while (bpx_is_list(sws_prolog)) {
p_sw = bpx_get_car(sws_prolog);
if (!bpx_is_integer(p_sw))
RET_ERR(err_invalid_switch_instance_id);
sw = bpx_get_integer(p_sw);
sws[k] = switch_instances[sw];
k++;
sws_prolog = bpx_get_cdr(sws_prolog);
}
path_ptr->sws = sws;
}
else {
path_ptr->sws_len = 0;
path_ptr->sws = NULL;
}
path_ptr->next = expl_graph[node_id]->path_ptr;
expl_graph[node_id]->path_ptr = path_ptr;
return BP_TRUE;
}
static void get_n_most_likely_path_rerank(int n, int l, int goal_id,
TERM *p_n_viterbi_list_ptr)
{
TERM p_goal_path;
TERM p_subpath_goal, p_subpath_sw;
TERM p_tmp, p_tmp_g, p_tmp_g0, p_tmp_g1, p_tmp_sw, p_tmp_sw0, p_tmp_sw1;
TERM p_n_viterbi, p_n_viterbi_list, p_tmp_list;
TERM p_viterbi_prob;
int j,m,k;
EG_PATH_PTR path_ptr = NULL;
int c_len, sw_len;
V_ENT_PTR v_ent;
int l_used;
double n_viterbi_egraph_score;
p_n_viterbi_list = bpx_build_list();
p_tmp_list = p_n_viterbi_list;
l_used = 0;
for (j = 0; j < l; j++) {
if (expl_graph[goal_id]->top_n[j] != NULL) l_used++;
}
viterbi_rank =
(V_RANK_PTR)MALLOC(sizeof(struct ViterbiRankEntry) * l_used);
for (j = 0; j < l_used; j++) {
alloc_n_viterbi_egraphs();
n_viterbi_egraph_size =
visit_n_most_likely_path(expl_graph[goal_id]->top_n[j],0);
viterbi_rank[j].size = n_viterbi_egraph_size;
viterbi_rank[j].expl = n_viterbi_egraphs;
viterbi_rank[j].score = compute_rerank_score();
}
qsort(viterbi_rank, l_used, sizeof(struct ViterbiRankEntry),
compare_viterbi_rank);
for (j = 0; j < l_used && j < n; j++) {
n_viterbi_egraph_size = viterbi_rank[j].size;
n_viterbi_egraphs = viterbi_rank[j].expl;
n_viterbi_egraph_score = viterbi_rank[j].score;
/* Build the Viterbi path as a Prolog list: */
p_goal_path = bpx_build_list();
p_tmp = p_goal_path;
for (m = 0; m < n_viterbi_egraph_size; m++) {
bpx_unify(bpx_get_car(p_tmp),
bpx_build_integer(n_viterbi_egraphs[m]->goal_id));
if (m == n_viterbi_egraph_size - 1) {
bpx_unify(bpx_get_cdr(p_tmp),bpx_build_nil());
}
else {
bpx_unify(bpx_get_cdr(p_tmp),bpx_build_list());
p_tmp = bpx_get_cdr(p_tmp);
}
}
p_subpath_goal = bpx_build_list();
p_subpath_sw = bpx_build_list();
p_tmp_g = p_subpath_goal;
p_tmp_sw = p_subpath_sw;
for (m = 0; m < n_viterbi_egraph_size; m++) {
v_ent = n_viterbi_egraphs[m];
if (v_ent->path_ptr == NULL) {
p_tmp_g0 = bpx_build_nil();
p_tmp_sw0 = bpx_build_nil();
}
else {
path_ptr = v_ent->path_ptr;
c_len = path_ptr->children_len;
sw_len = path_ptr->sws_len;
if (c_len == 0) {
p_tmp_g0 = bpx_build_nil();
}
else {
p_tmp_g0 = bpx_build_list();
p_tmp_g1 = p_tmp_g0;
for (k = 0; k < c_len; k++) {
bpx_unify(bpx_get_car(p_tmp_g1),
bpx_build_integer(path_ptr->children[k]->id));
if (k == c_len - 1) {
bpx_unify(bpx_get_cdr(p_tmp_g1),bpx_build_nil());
}
else {
bpx_unify(bpx_get_cdr(p_tmp_g1),bpx_build_list());
p_tmp_g1 = bpx_get_cdr(p_tmp_g1);
}
}
}
if (sw_len == 0) {
p_tmp_sw0 = bpx_build_nil();
}
else {
p_tmp_sw0 = bpx_build_list();
p_tmp_sw1 = p_tmp_sw0;
for (k = 0; k < sw_len; k++) {
bpx_unify(bpx_get_car(p_tmp_sw1),bpx_build_integer(path_ptr->sws[k]->id));
if (k == sw_len - 1) {
bpx_unify(bpx_get_cdr(p_tmp_sw1),bpx_build_nil());
}
else {
bpx_unify(bpx_get_cdr(p_tmp_sw1),bpx_build_list());
p_tmp_sw1 = bpx_get_cdr(p_tmp_sw1);
}
}
}
}
bpx_unify(bpx_get_car(p_tmp_g),p_tmp_g0);
bpx_unify(bpx_get_car(p_tmp_sw),p_tmp_sw0);
if (m == n_viterbi_egraph_size - 1) {
bpx_unify(bpx_get_cdr(p_tmp_g),bpx_build_nil());
bpx_unify(bpx_get_cdr(p_tmp_sw),bpx_build_nil());
}
else {
bpx_unify(bpx_get_cdr(p_tmp_g),bpx_build_list());
bpx_unify(bpx_get_cdr(p_tmp_sw),bpx_build_list());
p_tmp_g = bpx_get_cdr(p_tmp_g);
p_tmp_sw = bpx_get_cdr(p_tmp_sw);
}
}
p_viterbi_prob = bpx_build_float(n_viterbi_egraph_score);
p_n_viterbi = bpx_build_structure("v_expl",5);
bpx_unify(bpx_get_arg(1,p_n_viterbi),bpx_build_integer(j));
bpx_unify(bpx_get_arg(2,p_n_viterbi),p_goal_path);
bpx_unify(bpx_get_arg(3,p_n_viterbi),p_subpath_goal);
bpx_unify(bpx_get_arg(4,p_n_viterbi),p_subpath_sw);
bpx_unify(bpx_get_arg(5,p_n_viterbi),p_viterbi_prob);
bpx_unify(bpx_get_car(p_tmp_list),p_n_viterbi);
if (j == (l_used - 1) || j == (n - 1)) {
bpx_unify(bpx_get_cdr(p_tmp_list),bpx_build_nil());
}
else {
bpx_unify(bpx_get_cdr(p_tmp_list),bpx_build_list());
p_tmp_list = bpx_get_cdr(p_tmp_list);
}
}
for (j = 0; j < l_used; j++) {
free(viterbi_rank[j].expl);
}
free(viterbi_rank);
viterbi_rank = NULL;
*p_n_viterbi_list_ptr = p_n_viterbi_list;
}
static void get_n_most_likely_path(int n, int goal_id,
TERM *p_n_viterbi_list_ptr)
{
TERM p_goal_path;
TERM p_subpath_goal, p_subpath_sw;
TERM p_tmp, p_tmp_g, p_tmp_g0, p_tmp_g1, p_tmp_sw, p_tmp_sw0, p_tmp_sw1;
TERM p_n_viterbi, p_n_viterbi_list, p_tmp_list;
TERM p_viterbi_prob;
int j,m,k;
EG_PATH_PTR path_ptr = NULL;
int c_len, sw_len;
V_ENT_PTR v_ent;
p_n_viterbi_list = bpx_build_list();
p_tmp_list = p_n_viterbi_list;
for (j = 0; j < n; j++) {
if (expl_graph[goal_id]->top_n[j] == NULL) continue;
alloc_n_viterbi_egraphs();
n_viterbi_egraph_size =
visit_n_most_likely_path(expl_graph[goal_id]->top_n[j],0);
/* Build the Viterbi path as a Prolog list: */
p_goal_path = bpx_build_list();
p_tmp = p_goal_path;
for (m = 0; m < n_viterbi_egraph_size; m++) {
bpx_unify(bpx_get_car(p_tmp),bpx_build_integer(n_viterbi_egraphs[m]->goal_id));
if (m == n_viterbi_egraph_size - 1) {
bpx_unify(bpx_get_cdr(p_tmp),bpx_build_nil());
}
else {
bpx_unify(bpx_get_cdr(p_tmp),bpx_build_list());
p_tmp = bpx_get_cdr(p_tmp);
}
}
p_subpath_goal = bpx_build_list();
p_subpath_sw = bpx_build_list();
p_tmp_g = p_subpath_goal;
p_tmp_sw = p_subpath_sw;
for (m = 0; m < n_viterbi_egraph_size; m++) {
v_ent = n_viterbi_egraphs[m];
if (v_ent->path_ptr == NULL) {
p_tmp_g0 = bpx_build_nil();
p_tmp_sw0 = bpx_build_nil();
}
else {
path_ptr = v_ent->path_ptr;
c_len = path_ptr->children_len;
sw_len = path_ptr->sws_len;
if (c_len == 0) {
p_tmp_g0 = bpx_build_nil();
}
else {
p_tmp_g0 = bpx_build_list();
p_tmp_g1 = p_tmp_g0;
for (k = 0; k < c_len; k++) {
bpx_unify(bpx_get_car(p_tmp_g1),bpx_build_integer(path_ptr->children[k]->id));
if (k == c_len - 1) {
bpx_unify(bpx_get_cdr(p_tmp_g1),bpx_build_nil());
}
else {
bpx_unify(bpx_get_cdr(p_tmp_g1),bpx_build_list());
p_tmp_g1 = bpx_get_cdr(p_tmp_g1);
}
}
}
if (sw_len == 0) {
p_tmp_sw0 = bpx_build_nil();
}
else {
p_tmp_sw0 = bpx_build_list();
p_tmp_sw1 = p_tmp_sw0;
for (k = 0; k < sw_len; k++) {
bpx_unify(bpx_get_car(p_tmp_sw1),bpx_build_integer(path_ptr->sws[k]->id));
if (k == sw_len - 1) {
bpx_unify(bpx_get_cdr(p_tmp_sw1),bpx_build_nil());
}
else {
bpx_unify(bpx_get_cdr(p_tmp_sw1),bpx_build_list());
p_tmp_sw1 = bpx_get_cdr(p_tmp_sw1);
}
}
}
}
bpx_unify(bpx_get_car(p_tmp_g),p_tmp_g0);
bpx_unify(bpx_get_car(p_tmp_sw),p_tmp_sw0);
if (m == n_viterbi_egraph_size - 1) {
bpx_unify(bpx_get_cdr(p_tmp_g),bpx_build_nil());
bpx_unify(bpx_get_cdr(p_tmp_sw),bpx_build_nil());
}
else {
bpx_unify(bpx_get_cdr(p_tmp_g),bpx_build_list());
bpx_unify(bpx_get_cdr(p_tmp_sw),bpx_build_list());
p_tmp_g = bpx_get_cdr(p_tmp_g);
p_tmp_sw = bpx_get_cdr(p_tmp_sw);
}
}
p_viterbi_prob = bpx_build_float(expl_graph[goal_id]->top_n[j]->max);
p_n_viterbi = bpx_build_structure("v_expl",5);
bpx_unify(bpx_get_arg(1,p_n_viterbi),bpx_build_integer(j));
bpx_unify(bpx_get_arg(2,p_n_viterbi),p_goal_path);
bpx_unify(bpx_get_arg(3,p_n_viterbi),p_subpath_goal);
bpx_unify(bpx_get_arg(4,p_n_viterbi),p_subpath_sw);
bpx_unify(bpx_get_arg(5,p_n_viterbi),p_viterbi_prob);
bpx_unify(bpx_get_car(p_tmp_list),p_n_viterbi);
if (j == n - 1 ||
(j < n - 1 && expl_graph[goal_id]->top_n[j + 1] == NULL)) {
bpx_unify(bpx_get_cdr(p_tmp_list),bpx_build_nil());
}
else {
bpx_unify(bpx_get_cdr(p_tmp_list),bpx_build_list());
p_tmp_list = bpx_get_cdr(p_tmp_list);
}
for (m = 0; m < n_viterbi_egraph_size; m++) {
/* Release the entries newly added in visit_n_most_likely_path() */
if (n_viterbi_egraphs[m]->path_ptr == NULL) {
free(n_viterbi_egraphs[m]);
}
}
free(n_viterbi_egraphs);
n_viterbi_egraphs = NULL;
}
*p_n_viterbi_list_ptr = p_n_viterbi_list;
}
static void get_most_likely_path(int goal_id,
TERM *p_goal_path_ptr,
TERM *p_subpath_goal_ptr,
TERM *p_subpath_sw_ptr,
double *viterbi_prob_ptr)
{
TERM p_goal_path;
TERM p_subpath_goal, p_subpath_sw;
TERM p_tmp, p_tmp_g, p_tmp_g0, p_tmp_g1, p_tmp_sw, p_tmp_sw0, p_tmp_sw1;
int m,k;
EG_NODE_PTR eg_ptr = NULL;
EG_PATH_PTR path_ptr = NULL;
int viterbi_egraph_size;
int c_len, sw_len;
alloc_viterbi_egraphs();
viterbi_egraph_size = visit_most_likely_path(expl_graph[goal_id],0);
/* Build the Viterbi path as a Prolog list: */
p_goal_path = bpx_build_list();
p_tmp = p_goal_path;
for (m = 0; m < viterbi_egraph_size; m++) {
bpx_unify(bpx_get_car(p_tmp),bpx_build_integer(viterbi_egraphs[m]->id));
if (m == viterbi_egraph_size - 1) {
bpx_unify(bpx_get_cdr(p_tmp),bpx_build_nil());
}
else {
bpx_unify(bpx_get_cdr(p_tmp),bpx_build_list());
p_tmp = bpx_get_cdr(p_tmp);
}
}
p_subpath_goal = bpx_build_list();
p_subpath_sw = bpx_build_list();
p_tmp_g = p_subpath_goal;
p_tmp_sw = p_subpath_sw;
for (m = 0; m < viterbi_egraph_size; m++) {
eg_ptr = viterbi_egraphs[m];
if (eg_ptr->max_path == NULL) {
p_tmp_g0 = bpx_build_nil();
p_tmp_sw0 = bpx_build_nil();
}
else {
path_ptr = eg_ptr->max_path;
c_len = path_ptr->children_len;
sw_len = path_ptr->sws_len;
if (c_len == 0) {
p_tmp_g0 = bpx_build_nil();
}
else {
p_tmp_g0 = bpx_build_list();
p_tmp_g1 = p_tmp_g0;
for (k = 0; k < c_len; k++) {
bpx_unify(bpx_get_car(p_tmp_g1),
bpx_build_integer(path_ptr->children[k]->id));
if (k == c_len - 1) {
bpx_unify(bpx_get_cdr(p_tmp_g1),bpx_build_nil());
}
else {
bpx_unify(bpx_get_cdr(p_tmp_g1),bpx_build_list());
p_tmp_g1 = bpx_get_cdr(p_tmp_g1);
}
}
}
if (sw_len == 0) {
p_tmp_sw0 = bpx_build_nil();
}
else {
p_tmp_sw0 = bpx_build_list();
p_tmp_sw1 = p_tmp_sw0;
for (k = 0; k < sw_len; k++) {
bpx_unify(bpx_get_car(p_tmp_sw1),bpx_build_integer(path_ptr->sws[k]->id));
if (k == sw_len - 1) {
bpx_unify(bpx_get_cdr(p_tmp_sw1),bpx_build_nil());
}
else {
bpx_unify(bpx_get_cdr(p_tmp_sw1),bpx_build_list());
p_tmp_sw1 = bpx_get_cdr(p_tmp_sw1);
}
}
}
}
bpx_unify(bpx_get_car(p_tmp_g),p_tmp_g0);
bpx_unify(bpx_get_car(p_tmp_sw),p_tmp_sw0);
if (m == viterbi_egraph_size - 1) {
bpx_unify(bpx_get_cdr(p_tmp_g),bpx_build_nil());
bpx_unify(bpx_get_cdr(p_tmp_sw),bpx_build_nil());
}
else {
bpx_unify(bpx_get_cdr(p_tmp_g),bpx_build_list());
bpx_unify(bpx_get_cdr(p_tmp_sw),bpx_build_list());
p_tmp_g = bpx_get_cdr(p_tmp_g);
p_tmp_sw = bpx_get_cdr(p_tmp_sw);
}
}
free(viterbi_egraphs);
viterbi_egraphs = NULL;
*p_goal_path_ptr = p_goal_path;
*p_subpath_goal_ptr = p_subpath_goal;
*p_subpath_sw_ptr = p_subpath_sw;
*viterbi_prob_ptr = expl_graph[goal_id]->max; /* top goal's max prob */
}
int pc_compute_hindsight_4(void)
{
TERM p_subgoal,p_hindsight_pairs,t,t1,p_pair;
int goal_id,is_cond,j;
goal_id = bpx_get_integer(bpx_get_call_arg(1,4));
p_subgoal = bpx_get_call_arg(2,4);
is_cond = bpx_get_integer(bpx_get_call_arg(3,4));
initialize_egraph_index();
alloc_sorted_egraph(1);
RET_ON_ERR(sort_one_egraph(goal_id,0,1));
if (verb_graph) print_egraph(0,PRINT_NEUTRAL);
alloc_hindsight_goals();
if (log_scale) {
RET_ON_ERR(compute_inside_scaling_log_exp());
RET_ON_ERR(compute_outside_scaling_log_exp());
RET_ON_ERR(get_hindsight_goals_scaling_log_exp(p_subgoal,is_cond));
}
else {
RET_ON_ERR(compute_inside_scaling_none());
RET_ON_ERR(compute_outside_scaling_none());
RET_ON_ERR(get_hindsight_goals_scaling_none(p_subgoal,is_cond));
}
if (hindsight_goal_size > 0) {
/* Build the list of pairs of a subgoal and its hindsight probability */
p_hindsight_pairs = bpx_build_list();
t = p_hindsight_pairs;
for (j = 0; j < hindsight_goal_size; j++) {
p_pair = bpx_build_list();
t1 = p_pair;
bpx_unify(bpx_get_car(t1),
bpx_build_integer(hindsight_goals[j]));
bpx_unify(bpx_get_cdr(t1),bpx_build_list());
t1 = bpx_get_cdr(t1);
bpx_unify(bpx_get_car(t1),bpx_build_float(hindsight_probs[j]));
bpx_unify(bpx_get_cdr(t1),bpx_build_nil());
bpx_unify(bpx_get_car(t),p_pair);
if (j == hindsight_goal_size - 1) {
bpx_unify(bpx_get_cdr(t),bpx_build_nil());
}
else {
bpx_unify(bpx_get_cdr(t),bpx_build_list());
t = bpx_get_cdr(t);
}
}
}
else {
p_hindsight_pairs = bpx_build_nil();
}
FREE(hindsight_goals);
FREE(hindsight_probs);
return bpx_unify(bpx_get_call_arg(4,4),p_hindsight_pairs);
}
