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
This commit is contained in:
vsc
parent
c2e03a81b9
commit
4c15c9371e
@ -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)
|
||||
|
||||
3
C/grow.c
3
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;
|
||||
}
|
||||
|
||||
|
||||
@ -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);
|
||||
|
||||
207
C/stdpreds.c
207
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);
|
||||
|
||||
@ -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 \
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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)]).
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
Reference in New Issue
Block a user