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; }
static int compare_sw_ins(const void *a, const void *b) { SW_INS_PTR sw_ins_a, sw_ins_b; TERM msw_a, msw_b; sw_ins_a = *(const SW_INS_PTR *)(a); sw_ins_b = *(const SW_INS_PTR *)(b); msw_a = prism_sw_ins_term(sw_ins_a->id); msw_b = prism_sw_ins_term(sw_ins_b->id); return bpx_compare(bpx_get_arg(1,msw_a), bpx_get_arg(1,msw_b)); }
/* * 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_mp_recv_swlayout_0(void) { occ_position = MALLOC(sizeof(int) * occ_switch_tab_size); MPI_Recv(occ_position, occ_switch_tab_size, MPI_INT, 0, TAG_SWITCH_RES, MPI_COMM_WORLD, NULL); /* debug */ { int i; TERM msw; for (i = 0; i < occ_switch_tab_size; i++) { msw = bpx_get_arg(1, prism_sw_ins_term(occ_switches[i]->id)); mp_debug("%s -> %d", bpx_term_2_string(msw), occ_position[i]); } } return BP_TRUE; }
int pc_mp_send_switches_0(void) { char *msg, *str; TERM msw; int msglen, msgsiz; int vals[2]; int i, n; msglen = 0; msgsiz = 65536; msg = MALLOC(msgsiz); for (i = 0; i < occ_switch_tab_size; i++) { msw = bpx_get_arg(1, prism_sw_ins_term(occ_switches[i]->id)); str = (char *)bpx_term_2_string(msw); n = strlen(str) + 1; if (msgsiz <= msglen + n) { msgsiz = (msglen + n + 65536) & ~65535; msg = REALLOC(msg, msgsiz); } strcpy(msg + msglen, str); msglen += n; } msg[msglen++] = '\0'; /* this is safe */ vals[0] = msglen; vals[1] = occ_switch_tab_size; MPI_Gather(vals, 2, MPI_INT, NULL, 0, MPI_INT, 0, MPI_COMM_WORLD); MPI_Send(msg, msglen, MPI_CHAR, 0, TAG_SWITCH_REQ, MPI_COMM_WORLD); free(msg); 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)); }
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; }