From 4c15c9371e2ed868d173cc930b424c9be1799b21 Mon Sep 17 00:00:00 2001 From: vsc Date: Wed, 27 Apr 2005 20:09:26 +0000 Subject: [PATCH] indexing code could get confused with suspension points some further improvements on oveflow handling fix paths in Java makefile changs to support gibbs sampling in CLP(BN) git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1283 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- C/adtdefs.c | 6 +- C/grow.c | 3 + C/index.c | 6 +- C/stdpreds.c | 207 ++++++++++++++++++++++++++------------ CLPBN/Makefile.in | 2 + CLPBN/clpbn.yap | 11 +- CLPBN/clpbn/vel.yap | 128 +++-------------------- LGPL/JPL/java/Makefile.in | 4 +- 8 files changed, 178 insertions(+), 189 deletions(-) diff --git a/C/adtdefs.c b/C/adtdefs.c index e018f4301..845bd3d1c 100644 --- a/C/adtdefs.c +++ b/C/adtdefs.c @@ -173,11 +173,13 @@ LookupAtom(char *atom) } } #endif - NOfAtoms++; /* add new atom to start of chain */ ae = (AtomEntry *) Yap_AllocAtomSpace((sizeof *ae) + strlen(atom) + 1); - if (ae == NULL) + if (ae == NULL) { + WRITE_UNLOCK(HashChain[hash].AERWLock); return NIL; + } + NOfAtoms++; na = AbsAtom(ae); ae->PropsOfAE = NIL; if (ae->StrOfAE != atom) diff --git a/C/grow.c b/C/grow.c index 7e1da1a13..b89e078a6 100644 --- a/C/grow.c +++ b/C/grow.c @@ -808,6 +808,7 @@ do_growheap(int fix_code, UInt in_size, struct intermediates *cip) } #if YAPOR Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"cannot grow Heap: more than a worker/thread running"); + fprintf(stderr,"ERROR 1\n"); return FALSE; #endif if (SizeOfOverflow > sz) @@ -816,6 +817,7 @@ do_growheap(int fix_code, UInt in_size, struct intermediates *cip) size = size/2; sz = size << shift_factor; if (sz < in_size) { +fprintf(stderr,"ERROR 2\n"); return FALSE; } } @@ -846,6 +848,7 @@ do_growheap(int fix_code, UInt in_size, struct intermediates *cip) return TRUE; } /* failed */ +fprintf(stderr,"ERROR 3\n"); return FALSE; } diff --git a/C/index.c b/C/index.c index 375129fb7..8f32eeace 100644 --- a/C/index.c +++ b/C/index.c @@ -11,8 +11,11 @@ * File: index.c * * comments: Indexing a Prolog predicate * * * -* Last rev: $Date: 2005-04-21 13:53:05 $,$Author: vsc $ * +* Last rev: $Date: 2005-04-27 20:09:25 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.123 2005/04/21 13:53:05 vsc +* fix bug with (var(X) -> being interpreted as var(X) by indexing code +* * Revision 1.122 2005/04/10 04:01:12 vsc * bug fixes, I hope! * @@ -3389,6 +3392,7 @@ suspend_indexing(ClauseDef *min, ClauseDef *max, PredEntry *ap, struct intermedi UInt cls = (max-min)+1; if (cint->expand_block && + cint->expand_block != (yamop *)(&(ap->cs.p_code.ExpandCode)) && cint->expand_block->u.sp.s2 < 2*(max-min)) { cint->expand_block->u.sp.s3++; return (UInt)(cint->expand_block); diff --git a/C/stdpreds.c b/C/stdpreds.c index 007982a1d..c4ab46852 100644 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -11,8 +11,14 @@ * File: stdpreds.c * * comments: General-purpose C implemented system predicates * * * -* Last rev: $Date: 2005-04-07 17:48:55 $,$Author: ricroc $ * +* Last rev: $Date: 2005-04-27 20:09:25 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.87 2005/04/07 17:48:55 ricroc +* Adding tabling support for mixed strategy evaluation (batched and local scheduling) +* UPDATE: compilation flags -DTABLING_BATCHED_SCHEDULING and -DTABLING_LOCAL_SCHEDULING removed. To support tabling use -DTABLING in the Makefile or --enable-tabling in configure. +* NEW: yap_flag(tabling_mode,MODE) changes the tabling execution mode of all tabled predicates to MODE (batched, local or default). +* NEW: tabling_mode(PRED,MODE) changes the default tabling execution mode of predicate PRED to MODE (batched or local). +* * Revision 1.86 2005/03/13 06:26:11 vsc * fix excessive pruning in meta-calls * fix Term->int breakage in compiler @@ -979,14 +985,16 @@ static Int p_name(void) { /* name(?Atomic,?String) */ char *String, *s; /* alloc temp space on trail */ - Term t, NewT, AtomNameT = Deref(ARG1); + Term t = Deref(ARG2), NewT, AtomNameT = Deref(ARG1); - t = Deref(ARG2); + restart_aux: if (!IsVarTerm(AtomNameT)) { if (IsAtomTerm(AtomNameT)) { String = RepAtom(AtomOfTerm(AtomNameT))->StrOfAE; } else if (IsIntTerm(AtomNameT)) { String = Yap_PreAllocCodeSpace(); + if (String + 1024 > (char *)AuxSp) + goto expand_auxsp; #if SHORT_INTS sprintf(String, "%ld", IntOfTerm(AtomNameT)); #else @@ -994,10 +1002,14 @@ p_name(void) #endif } else if (IsFloatTerm(AtomNameT)) { String = Yap_PreAllocCodeSpace(); + if (String + 1024 > (char *)AuxSp) + goto expand_auxsp; sprintf(String, "%f", FloatOfTerm(AtomNameT)); } else if (IsLongIntTerm(AtomNameT)) { String = Yap_PreAllocCodeSpace(); + if (String + 1024 > (char *)AuxSp) + goto expand_auxsp; #if SHORT_INTS sprintf(String, "%ld", LongIntOfTerm(AtomNameT)); @@ -1007,6 +1019,8 @@ p_name(void) #if USE_GMP } else if (IsBigIntTerm(AtomNameT)) { String = Yap_PreAllocCodeSpace(); + if (String + 1024 > (char *)AuxSp) + goto expand_auxsp; mpz_get_str(String, 10, Yap_BigIntOfTerm(AtomNameT)); #endif } else { @@ -1022,15 +1036,16 @@ p_name(void) return Yap_unify(NewT, ARG2); } s = String = ((AtomEntry *)Yap_PreAllocCodeSpace())->StrOfAE; - if (s == NULL) { - return FALSE; - } + if (String == ((AtomEntry *)NULL)->StrOfAE || + String + 1024 > (char *)AuxSp) + goto expand_auxsp; if (!IsVarTerm(t) && t == MkAtomTerm(AtomNil)) { return Yap_unify_constant(ARG1, MkAtomTerm(Yap_LookupAtom(""))); } while (!IsVarTerm(t) && IsPairTerm(t)) { Term Head; Int i; + Head = HeadOfTerm(t); if (IsVarTerm(Head)) { Yap_Error(INSTANTIATION_ERROR,Head,"name/2"); @@ -1046,16 +1061,8 @@ p_name(void) Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,Head,"name/2"); return FALSE; } - if (s+1 >= (char *)AuxSp-1024) { - char *nString; - - *H++ = t; - nString = ((AtomEntry *)Yap_ExpandPreAllocCodeSpace(0, NULL))->StrOfAE; - if (!nString) - return FALSE; - t = *--H; - s = nString+(s-String); - String = nString; + if (s > (char *)AuxSp-1024) { + goto expand_auxsp; } *s++ = i; t = TailOfTerm(t); @@ -1070,24 +1077,43 @@ p_name(void) Atom at; while ((at = Yap_LookupAtom(String)) == NIL) { if (!Yap_growheap(FALSE, 0, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); + Yap_Error(OUT_OF_HEAP_ERROR, ARG2, "generating atom from string in name/2"); return FALSE; } + /* safest to restart, we don't know what happened to String */ + t = Deref(ARG2); + AtomNameT = Deref(ARG1); + goto restart_aux; } NewT = MkAtomTerm(at); } return Yap_unify_constant(ARG1, NewT); } else { - Yap_Error(TYPE_ERROR_LIST,t,"name/2"); + Yap_Error(TYPE_ERROR_LIST,ARG2,"name/2"); return FALSE; } + + /* error handling */ + expand_auxsp: + String = Yap_ExpandPreAllocCodeSpace(0,NULL); + if (String + 1024 > (char *)AuxSp) { + /* crash in flames */ + Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, "allocating temp space in name/2"); + return FALSE; + } + AtomNameT = Deref(ARG1); + t = Deref(ARG2); + goto restart_aux; + } static Int p_atom_chars(void) { Term t1 = Deref(ARG1); + char *String; + restart_aux: if (!IsVarTerm(t1)) { Term NewT; if (!IsAtomTerm(t1)) { @@ -1102,11 +1128,14 @@ p_atom_chars(void) return Yap_unify(NewT, ARG2); } else { /* ARG1 unbound */ - char *String = ((AtomEntry *)Yap_PreAllocCodeSpace())->StrOfAE; /* alloc temp space on trail */ - register Term t = Deref(ARG2); - register char *s = String; + Term t = Deref(ARG2); + char *s; Atom at; + String = ((AtomEntry *)Yap_PreAllocCodeSpace())->StrOfAE; + if (String + 1024 > (char *)AuxSp) + goto expand_auxsp; + s = String; if (IsVarTerm(t)) { Yap_Error(INSTANTIATION_ERROR, t1, "atom_chars/2"); return(FALSE); @@ -1135,14 +1164,8 @@ p_atom_chars(void) Yap_Error(REPRESENTATION_ERROR_CHARACTER_CODE,Head,"atom_chars/2"); return(FALSE); } - if (s+1 == (char *)AuxSp) { - char *nString; - - *H++ = t; - nString = ((AtomEntry *)Yap_ExpandPreAllocCodeSpace(0,NULL))->StrOfAE; - t = *--H; - s = nString+(s-String); - String = nString; + if (s+1024 > (char *)AuxSp) { + goto expand_auxsp; } *s++ = i; t = TailOfTerm(t); @@ -1173,14 +1196,8 @@ p_atom_chars(void) Yap_Error(TYPE_ERROR_CHARACTER,Head,"atom_chars/2"); return(FALSE); } - if (s+1 == (char *)AuxSp) { - char *nString; - - *H++ = t; - nString = ((AtomEntry *)Yap_ExpandPreAllocCodeSpace(0,NULL))->StrOfAE; - t = *--H; - s = nString+(s-String); - String = nString; + if (s+1024 == (char *)AuxSp) { + goto expand_auxsp; } *s++ = is[0]; t = TailOfTerm(t); @@ -1202,6 +1219,16 @@ p_atom_chars(void) } return Yap_unify_constant(ARG1, MkAtomTerm(at)); } + /* error handling */ + expand_auxsp: + String = Yap_ExpandPreAllocCodeSpace(0,NULL); + if (String + 1024 > (char *)AuxSp) { + /* crash in flames */ + Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, "allocating temp space in atom_chars/2"); + return FALSE; + } + t1 = Deref(ARG1); + goto restart_aux; } static Int @@ -1268,7 +1295,7 @@ p_atom_concat(void) } Yap_ReleasePreAllocCodeSpace((ADDR)cpt0); Yap_Error(TYPE_ERROR_LIST, ARG1, "atom_concat/2"); - return(FALSE); + return FALSE; } static Int @@ -1281,6 +1308,14 @@ p_atomic_concat(void) UInt sz; restart: + if (cptr+1024 > (char *)AuxSp) { + cptr = Yap_ExpandPreAllocCodeSpace(0,NULL); + if (cptr + 1024 > (char *)AuxSp) { + /* crash in flames */ + Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, "allocating temp space in atomic_concat/2"); + return FALSE; + } + } cpt0 = cptr; /* we need to have a list */ if (IsVarTerm(t1)) { @@ -1374,6 +1409,9 @@ static Int p_atom_codes(void) { Term t1 = Deref(ARG1); + char *String; + + restart_pred: if (!IsVarTerm(t1)) { Term NewT; if (!IsAtomTerm(t1)) { @@ -1384,10 +1422,14 @@ p_atom_codes(void) return (Yap_unify(NewT, ARG2)); } else { /* ARG1 unbound */ - char *String = ((AtomEntry *)Yap_PreAllocCodeSpace())->StrOfAE; - register Term t = Deref(ARG2); - register char *s = String; + Term t = Deref(ARG2); + char *s; + String = ((AtomEntry *)Yap_PreAllocCodeSpace())->StrOfAE; + if (String + 1024 > (char *)AuxSp) { + goto expand_auxsp; + } + s = String; if (IsVarTerm(t)) { Yap_Error(INSTANTIATION_ERROR, t1, "atom_codes/2"); return(FALSE); @@ -1415,14 +1457,8 @@ p_atom_codes(void) Yap_Error(REPRESENTATION_ERROR_CHARACTER_CODE,Head,"atom_codes/2"); return(FALSE); } - if (s+1 == (char *)AuxSp) { - char *nString; - - *H++ = t; - nString = ((AtomEntry *)Yap_ExpandPreAllocCodeSpace(0,NULL))->StrOfAE; - t = *--H; - s = nString+(s-String); - String = nString; + if (s+1024 > (char *)AuxSp) { + goto expand_auxsp; } *s++ = i; t = TailOfTerm(t); @@ -1437,6 +1473,19 @@ p_atom_codes(void) *s++ = '\0'; return (Yap_unify_constant(ARG1, MkAtomTerm(Yap_LookupAtom(String)))); } + /* error handling */ + expand_auxsp: + if (String + 1024 > (char *)AuxSp) { + String = Yap_ExpandPreAllocCodeSpace(0,NULL); + + if (String + 1024 > (char *)AuxSp) { + /* crash in flames */ + Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, "allocating temp space in atom_codes/2"); + return FALSE; + } + t1 = Deref(ARG1); + } + goto restart_pred; } static Int @@ -1537,7 +1586,16 @@ p_number_chars(void) Term NewT; register char *s; + restart_aux: String = Yap_PreAllocCodeSpace(); + if (String+1024 > (char *)AuxSp) { + String = Yap_ExpandPreAllocCodeSpace(0,NULL); + if (String + 1024 > (char *)AuxSp) { + /* crash in flames */ + Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, "allocating temp space in number_chars/2"); + return FALSE; + } + } if (IsNonVarTerm(t1)) { Term NewT; if (!IsNumTerm(t1)) { @@ -1595,14 +1653,15 @@ p_number_chars(void) Yap_Error(REPRESENTATION_ERROR_CHARACTER_CODE,Head,"number_chars/2"); return(FALSE); } - if (s+1 == (char *)AuxSp) { - char *nString; - - *H++ = t; - nString = Yap_ExpandPreAllocCodeSpace(0,NULL); - t = *--H; - s = nString+(s-String); - String = nString; + if (s+1024 > (char *)AuxSp) { + int offs = (s-String); + String = Yap_ExpandPreAllocCodeSpace(0,NULL); + if (String + (offs+1024) > (char *)AuxSp) { + /* crash in flames */ + Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, "allocating temp space in number_chars/2"); + return FALSE; + } + goto restart_aux; } *s++ = i; t = TailOfTerm(t); @@ -1667,9 +1726,17 @@ p_number_atom(void) char *String; /* alloc temp space on Trail */ register Term t = Deref(ARG2), t1 = Deref(ARG1); Term NewT; - register char *s; + char *s; s = String = ((AtomEntry *)Yap_PreAllocCodeSpace())->StrOfAE; + if (String+1024 > (char *)AuxSp) { + s = String = Yap_ExpandPreAllocCodeSpace(0,NULL); + if (String + 1024 > (char *)AuxSp) { + /* crash in flames */ + Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, "allocating temp space in number_atom/2"); + return FALSE; + } + } if (IsNonVarTerm(t1)) { Atom at; @@ -1731,6 +1798,14 @@ p_number_codes(void) register char *s; String = Yap_PreAllocCodeSpace(); + if (String+1024 > (char *)AuxSp) { + s = String = Yap_ExpandPreAllocCodeSpace(0,NULL); + if (String + 1024 > (char *)AuxSp) { + /* crash in flames */ + Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, "allocating temp space in number_codes/2"); + return FALSE; + } + } if (IsNonVarTerm(t1)) { if (IsIntTerm(t1)) { #if SHORT_INTS @@ -2973,17 +3048,17 @@ Yap_InitCPreds(void) Yap_InitCPred("$values", 3, p_values, SafePredFlag|SyncPredFlag|HiddenPredFlag); /* general purpose */ Yap_InitCPred("$opdec", 3, p_opdec, SafePredFlag|SyncPredFlag|HiddenPredFlag); - Yap_InitCPred("name", 2, p_name, SafePredFlag); + Yap_InitCPred("name", 2, p_name, 0); Yap_InitCPred("char_code", 2, p_char_code, SafePredFlag); - Yap_InitCPred("atom_chars", 2, p_atom_chars, SafePredFlag); - Yap_InitCPred("atom_codes", 2, p_atom_codes, SafePredFlag); + Yap_InitCPred("atom_chars", 2, p_atom_chars, 0); + Yap_InitCPred("atom_codes", 2, p_atom_codes, 0); Yap_InitCPred("atom_length", 2, p_atom_length, SafePredFlag); Yap_InitCPred("$atom_split", 4, p_atom_split, SafePredFlag|HiddenPredFlag); - Yap_InitCPred("number_chars", 2, p_number_chars, SafePredFlag); - Yap_InitCPred("number_atom", 2, p_number_atom, SafePredFlag); - Yap_InitCPred("number_codes", 2, p_number_codes, SafePredFlag); - Yap_InitCPred("atom_concat", 2, p_atom_concat, SafePredFlag); - Yap_InitCPred("atomic_concat", 2, p_atomic_concat, SafePredFlag); + Yap_InitCPred("number_chars", 2, p_number_chars, 0); + Yap_InitCPred("number_atom", 2, p_number_atom, 0); + Yap_InitCPred("number_codes", 2, p_number_codes, 0); + Yap_InitCPred("atom_concat", 2, p_atom_concat, 0); + Yap_InitCPred("atomic_concat", 2, p_atomic_concat, 0); Yap_InitCPred("=..", 2, p_univ, 0); Yap_InitCPred("$statistics_trail_max", 1, p_statistics_trail_max, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$statistics_heap_max", 1, p_statistics_heap_max, SafePredFlag|SyncPredFlag|HiddenPredFlag); diff --git a/CLPBN/Makefile.in b/CLPBN/Makefile.in index ee24d7a79..5e6465840 100644 --- a/CLPBN/Makefile.in +++ b/CLPBN/Makefile.in @@ -28,7 +28,9 @@ CLPBN_TOP= $(srcdir)/clpbn.yap CLPBN_PROGRAMS= \ $(srcdir)/clpbn/aggregates.yap \ $(srcdir)/clpbn/bnt.yap \ + $(srcdir)/clpbn/discrete_utils.yap \ $(srcdir)/clpbn/evidence.yap \ + $(srcdir)/clpbn/gibbs.yap \ $(srcdir)/clpbn/graphs.yap \ $(srcdir)/clpbn/graphviz.yap \ $(srcdir)/clpbn/utils.yap \ diff --git a/CLPBN/clpbn.yap b/CLPBN/clpbn.yap index 39801b238..457a98b51 100644 --- a/CLPBN/clpbn.yap +++ b/CLPBN/clpbn.yap @@ -20,9 +20,6 @@ :- dynamic user:term_expansion/2. -:- multifile - user:term_expansion/2. - :- attribute key/1, dist/3, evidence/1, starter/0. @@ -34,6 +31,10 @@ check_if_vel_done/1 ]). +:- use_module('clpbn/gibbs', [gibbs/3, + check_if_gibbs_done/1 + ]). + :- use_module('clpbn/graphs', [ clpbn2graph/1 ]). @@ -148,6 +149,8 @@ add_to_keys(K1, Ks, [K1|Ks]). write_out(vel, GVars, AVars, DiffVars) :- vel(GVars, AVars, DiffVars). +write_out(gibbs, GVars, AVars, DiffVars) :- + gibbs(GVars, AVars, DiffVars). write_out(bnt, GVars, AVars, _) :- dump_as_bnt(GVars, AVars). write_out(graphs, _, AVars, _) :- @@ -245,7 +248,7 @@ bind_clpbns(Key, Domain, Table, Parents, Key1, Domain1, Table1, Parents1) :- Key == Key1, !, ( Domain == Domain1, Table == Table1, Parents == Parents1 -> true ; throw(error(domain_error(bayesian_domain),bind_clpbns(var(Key, Domain, Table, Parents),var(Key1, Domain1, Table1, Parents1))))). bind_clpbns(_, _, _, _, _, _, _, _) :- - format(user_error, "unification of two bayesian vars not supported~n"). + format(user_error, 'unification of two bayesian vars not supported~n', []). bind_evidence_from_extra_var(Ev1,Var) :- get_atts(Var, [evidence(Ev0)]),!,Ev0 = Ev1. diff --git a/CLPBN/clpbn/vel.yap b/CLPBN/clpbn/vel.yap index c0c82d5d6..68c92aab2 100644 --- a/CLPBN/clpbn/vel.yap +++ b/CLPBN/clpbn/vel.yap @@ -29,6 +29,11 @@ clpbn_not_var_member/2, check_for_hidden_vars/3]). +:- use_module(library('clpbn/discrete_utils'), [ + project_from_CPT/3, + reorder_CPT/5, + get_dist_size/2]). + :- use_module(library(lists), [ append/3, @@ -74,7 +79,7 @@ find_all_clpbn_vars([V|Vs], [Var|LV], ProcessedVars, [table(I,Table,Parents,Size % variables with evidence should not be processed. (var(Ev) -> Var = var(V,I,Sz,Vals,Parents,Ev,_,_), - get_dist_size(V,Sz), + vel_get_dist_size(V,Sz), ProcessedVars = [Var|ProcessedVars0] ; ProcessedVars = ProcessedVars0 @@ -84,54 +89,9 @@ find_all_clpbn_vars([V|Vs], [Var|LV], ProcessedVars, [table(I,Table,Parents,Size var_with_deps(V, Table, Deps, Sizes, Ev, Vals) :- clpbn:get_atts(V, [dist(Vals,OTable,Parents)]), ( clpbn:get_atts(V, [evidence(Ev)]) -> true ; true), - reorder_table([V|Parents],Sizes0,OTable,Deps0,Table0), + reorder_CPT([V|Parents],OTable,Deps0,Table0,Sizes0), simplify_evidence(Deps0, Table0, Deps0, Sizes0, Table, Deps, Sizes). -get_sizes([], []). -get_sizes([V|Deps], [Sz|Sizes]) :- - get_dist_size(V,Sz), - get_sizes(Deps, Sizes). - -reorder_table(Vs0, Sizes, T0, Vs, TF) :- - get_sizes(Vs0, Szs), - numb_vars(Vs0, Szs, _, VPs0, VLs0), - keysort(VLs0, VLs), - compute_new_factors(VLs, _, Vs, Sizes), - get_factors(VLs0,Fs), - length(T0,L), - functor(TF,t,L), - copy_to_new_array(T0, 0, VPs0, Fs, TF). - -numb_vars([], [], 1, [], []). -numb_vars([V|Vs], [L|Ls], A0, [Ai|VPs], [V-(L,_)|VLs]) :- - numb_vars(Vs, Ls, Ai, VPs, VLs), - A0 is Ai*L. - -compute_new_factors([], 1, [], []). -compute_new_factors([V-(L,F)|VLs], NF, [V|Vs], [L|Szs]) :- - compute_new_factors(VLs, F, Vs, Szs), - NF is F*L. - -get_factors([],[]). -get_factors([_-(_,F)|VLs0],[F|Fs]) :- - get_factors(VLs0,Fs). - -copy_to_new_array([], _, _, _, _). -copy_to_new_array([P|Ps], I, F0s, Fs, S) :- - convert_factor(F0s, Fs, I, N), - I1 is I+1, - N1 is N+1, - arg(N1,S,P), - copy_to_new_array(Ps, I1, F0s, Fs, S). - -convert_factor([], [], _, 0). -convert_factor([F0|F0s], [F|Fs], I, OUT) :- - X is I//F0, - NI is I mod F0, - NEXT is F*X, - convert_factor(F0s, Fs, NI, OUT1), - OUT is OUT1+NEXT. - find_all_table_deps(Tables0, LV) :- find_dep_graph(Tables0, DepGraph0), sort(DepGraph0, DepGraph), @@ -168,7 +128,7 @@ compute_size([tab(_,Vs,_)|Tabs],Vs0,K) :- multiply_sizes([],K,K). multiply_sizes([V|Vs],K0,K) :- - get_dist_size(V, Sz), + vel_get_dist_size(V, Sz), KI is K0*Sz, multiply_sizes(Vs,KI,K). @@ -176,8 +136,7 @@ process(LV0, InputVs, Out) :- find_best(LV0, V0, -1, V, WorkTables, LVI, InputVs), V \== V0, !, multiply_tables(WorkTables, Table), - propagate_evidence(V, Evs), - project(V,Table,NewTable,Evs), + project_from_CPT(V,Table,NewTable), include(LVI,NewTable,V,LV2), process(LV2, InputVs, Out). process(LV0, _, Out) :- @@ -209,26 +168,12 @@ multiply_tables([tab(Tab1,Deps1,Szs1), tab(Tab2,Deps2,Sz2)| Tables], Out) :- simplify_evidence([], Table, Deps, Sizes, Table, Deps, Sizes). simplify_evidence([V|VDeps], Table0, Deps0, Sizes0, Table, Deps, Sizes) :- - clpbn:get_atts(V, [evidence(Ev)]), - clpbn:get_atts(V, [dist(Out,_,_)]), - generate_szs_with_evidence(Out,Ev,Evs), - project(V,tab(Table0,Deps0,Sizes0),tab(NewTable,Deps1,Sizes1),Evs), + clpbn:get_atts(V, [evidence(_)]), !, + project_from_CPT(V,tab(Table0,Deps0,Sizes0),tab(NewTable,Deps1,Sizes1)), simplify_evidence(VDeps, NewTable, Deps1, Sizes1, Table, Deps, Sizes). simplify_evidence([_|VDeps], Table0, Deps0, Sizes0, Table, Deps, Sizes) :- simplify_evidence(VDeps, Table0, Deps0, Sizes0, Table, Deps, Sizes). -propagate_evidence(V, Evs) :- - clpbn:get_atts(V, [evidence(Ev),dist(Out,_,_)]), !, - generate_szs_with_evidence(Out,Ev,Evs). -propagate_evidence(_, _). - -generate_szs_with_evidence([],_,[]). -generate_szs_with_evidence([Ev|Out],Ev,[ok|Evs]) :- !, - generate_szs_with_evidence(Out,Ev,Evs). -generate_szs_with_evidence([_|Out],Ev,[not_ok|Evs]) :- - generate_szs_with_evidence(Out,Ev,Evs). - - fetch_tables([], []). fetch_tables([var(_,_,_,_,_,_,Deps,_)|LV0], Tables) :- append(Deps,Tables0,Tables), @@ -284,50 +229,6 @@ element([F|Fs], I, P1, [F1|Fs1], P2, [F2|Fs2], Tab1, Tab2, El) :- element(Fs, NI, NP1, Fs1, NP2, Fs2, Tab1, Tab2, El). % -project(V,tab(Table,Deps,Szs),tab(NewTable,NDeps,NSzs),Evs) :- - functor(Table,_,Max), - find_projection_factor(Deps, V, NDeps, Szs, NSzs, F, Sz), - OLoop is Max//(Sz*F), - project_outer_loop(0,OLoop,F,Sz,Table,Evs,NTabl), - NewTable =.. [t|NTabl]. - -find_projection_factor([V|Deps], V1, Deps, [Sz|Szs], Szs, F, Sz) :- - V == V1, !, - mult(Szs, 1, F). -find_projection_factor([V|Deps], V1, [V|NDeps], [Sz|Szs], [Sz|NSzs], F, NSz) :- - find_projection_factor(Deps, V1, NDeps, Szs, NSzs, F, NSz). - -mult([], F, F). -mult([Sz|Szs], Sz0, F) :- - SzI is Sz0*Sz, - mult(Szs, SzI, F). - -project_outer_loop(OLoop,OLoop,_,_,_,_,[]) :- !. -project_outer_loop(I,OLoop,F,Sz,Table,Evs,NTabl) :- - Base is I*Sz*F, - project_mid_loop(0,F,Base,Sz,Table,Evs,NTabl,NTabl0), - I1 is I+1, - project_outer_loop(I1,OLoop,F,Sz,Table,Evs,NTabl0). - -project_mid_loop(F,F,_,_,_,_,NTabl,NTabl) :- !. -project_mid_loop(I,F,Base,Sz,Table,Evs,[Ent|NTablF],NTabl0) :- - I1 is I+1, - NBase is I+Base, - project_inner_loop(0,Sz,Evs,NBase,F,Table,0.0,Ent), - project_mid_loop(I1,F,Base,Sz,Table,Evs,NTablF,NTabl0). - -project_inner_loop(Sz,Sz,[],_,_,_,Ent,Ent) :- !. -project_inner_loop(I,Sz,[ok|Evs],NBase,F,Table,Ent0,Ent) :- !, - I1 is I+1, - Pos is NBase+I*F+1, - arg(Pos,Table,E1), - Ent1 is E1+Ent0, - project_inner_loop(I1,Sz,Evs,NBase,F,Table,Ent1,Ent). -project_inner_loop(I,Sz,[_|Evs],NBase,F,Table,Ent0,Ent) :- !, - I1 is I+1, - project_inner_loop(I1,Sz,Evs,NBase,F,Table,Ent0,Ent). - - include([],_,_,[]). include([var(V,P,VSz,D,Parents,Ev,Tabs,Est)|LV],tab(T,Vs,Sz),V1,[var(V,P,VSz,D,Parents,Ev,Tabs,Est)|NLV]) :- clpbn_not_var_member(Vs,V), !, @@ -411,10 +312,9 @@ add_alldiffs([],Eqs,Eqs). add_alldiffs(AllDiffs,Eqs,(Eqs/alldiff(AllDiffs))). -get_dist_size(V,Sz) :- +vel_get_dist_size(V,Sz) :- get_atts(V, [size(Sz)]), !. -get_dist_size(V,Sz) :- - clpbn:get_atts(V, [dist(Vals,_,_)]), !, - length(Vals,Sz), +vel_get_dist_size(V,Sz) :- + get_dist_size(V,Sz), !, put_atts(V, [size(Sz)]). diff --git a/LGPL/JPL/java/Makefile.in b/LGPL/JPL/java/Makefile.in index ce359d463..bd5844ab5 100644 --- a/LGPL/JPL/java/Makefile.in +++ b/LGPL/JPL/java/Makefile.in @@ -79,8 +79,8 @@ CLASSES=$(JAVA:.java=.class) all: $(JPL) $(JAVA): - -@ ( cd jpl ; @LN_S@ ../$(srcdir)/jpl/*.java .) - -@ ( cd jpl/fli ; @LN_S@ ../../$(srcdir)/jpl/fli/*.java .) + -@ ( cd jpl ; @LN_S@ $(srcdir)/jpl/*.java .) + -@ ( cd jpl/fli ; @LN_S@ $(srcdir)/jpl/fli/*.java .) $(JPL): $(JAVA) $(JAVAC) $(JAVA)