diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'master' of ssh://yap.git.sourceforge.net/gitroot/yap/yap-6.3

Browse Source
This commit is contained in:
Tiago Gomes 2013-04-11 22:28:41 +01:00
commit de6d7981fb
19 changed files with 151 additions and 196 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
C/save.c
View File

@ -261,7 +261,7 @@ open_file(char *my_file, int flag)
#endif /* O_BINARY */ #endif /* O_BINARY */
#endif /* M_WILLIAMS */ #endif /* M_WILLIAMS */
{ {
splfild = 0; /* We do not have an open file */ splfild = -1; /* We do not have an open file */
return -1; return -1;
} }
#ifdef undf0 #ifdef undf0
@ -1466,7 +1466,7 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac
} else { } else {
strncat(LOCAL_FileNameBuf, inpf, YAP_FILENAME_MAX-1); strncat(LOCAL_FileNameBuf, inpf, YAP_FILENAME_MAX-1);
} }
if (inpf != NULL && (splfild = open_file(inpf, O_RDONLY)) > 0) { if (inpf != NULL && !((splfild = open_file(inpf, O_RDONLY)) < 0)) {
if ((mode = try_open(inpf,Astate,ATrail,AStack,AHeap,save_buffer,streamp)) != FAIL_RESTORE) { if ((mode = try_open(inpf,Astate,ATrail,AStack,AHeap,save_buffer,streamp)) != FAIL_RESTORE) {
return mode; return mode;
} }
@ -1499,7 +1499,7 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac
#endif #endif
if (YAP_LIBDIR != NULL) { if (YAP_LIBDIR != NULL) {
cat_file_name(LOCAL_FileNameBuf, YAP_LIBDIR, inpf, YAP_FILENAME_MAX); cat_file_name(LOCAL_FileNameBuf, YAP_LIBDIR, inpf, YAP_FILENAME_MAX);
if ((splfild = open_file(LOCAL_FileNameBuf, O_RDONLY)) > 0) { if (!((splfild = open_file(LOCAL_FileNameBuf, O_RDONLY)) < 0)) {
if ((mode = try_open(LOCAL_FileNameBuf,Astate,ATrail,AStack,AHeap,save_buffer,streamp)) != FAIL_RESTORE) { if ((mode = try_open(LOCAL_FileNameBuf,Astate,ATrail,AStack,AHeap,save_buffer,streamp)) != FAIL_RESTORE) {
return mode; return mode;
} }
@ -1508,7 +1508,7 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac
} }
#if _MSC_VER || defined(__MINGW32__) #if _MSC_VER || defined(__MINGW32__)
if ((inpf = Yap_RegistryGetString("startup"))) { if ((inpf = Yap_RegistryGetString("startup"))) {
if ((splfild = open_file(inpf, O_RDONLY)) > 0) { if (!((splfild = open_file(inpf, O_RDONLY)) < 0)) {
if ((mode = try_open(inpf,Astate,ATrail,AStack,AHeap,save_buffer,streamp)) != FAIL_RESTORE) { if ((mode = try_open(inpf,Astate,ATrail,AStack,AHeap,save_buffer,streamp)) != FAIL_RESTORE) {
return mode; return mode;
} }

34
MYDDAS/myddas_wkb2prolog.c
View File

@ -13,7 +13,7 @@ static void readswap8(double *buf);
static byte get_hostbyteorder(void); static byte get_hostbyteorder(void);
static byte get_inbyteorder(void); static byte get_inbyteorder(void);
static uint32 get_wkbType(void); static uint32 get_wkbType(void);
static Term get_point(char *functor); static Term get_point(char *functor USES_REGS);
static Term get_linestring(char *functor); static Term get_linestring(char *functor);
static Term get_polygon(char *functor); static Term get_polygon(char *functor);
static Term get_geometry(uint32 type); static Term get_geometry(uint32 type);
@ -150,7 +150,7 @@ static void readswap8(double *buf) {
cursor += 8; cursor += 8;
} }
static Term get_point(char *func){ static Term get_point(char *func USES_REGS){
Term args[2]; Term args[2];
Functor functor; Functor functor;
double d; double d;
@ -188,7 +188,7 @@ static Term get_linestring(char *func){
c_list = (Term *) calloc(sizeof(Term),n); c_list = (Term *) calloc(sizeof(Term),n);
for ( i = 0; i < n; i++) { for ( i = 0; i < n; i++) {
c_list[i] = get_point(NULL); c_list[i] = get_point(NULL PASS_REGS);
} }
list = MkAtomTerm(Yap_LookupAtom("[]")); list = MkAtomTerm(Yap_LookupAtom("[]"));
@ -241,15 +241,14 @@ static Term get_geometry(uint32 type){
switch(type) { switch(type) {
case WKBPOINT: case WKBPOINT:
return get_point("point"); return get_point("point" PASS_REGS);
case WKBLINESTRING: case WKBLINESTRING:
return get_linestring("linestring"); return get_linestring("linestring");
case WKBPOLYGON: case WKBPOLYGON:
return get_polygon("polygon"); return get_polygon("polygon");
case WKBMULTIPOINT: case WKBMULTIPOINT:
{ {
byte b; uint32 n;
uint32 n, u;
int i; int i;
Functor functor; Functor functor;
Term *c_list; Term *c_list;
@ -264,10 +263,10 @@ static Term get_geometry(uint32 type){
for ( i = 0; i < n; i++ ) { for ( i = 0; i < n; i++ ) {
/* read (and ignore) the byteorder and type */ /* read (and ignore) the byteorder and type */
b = get_inbyteorder(); get_inbyteorder();
u = get_wkbType(); get_wkbType();
c_list[i] = get_point(NULL); c_list[i] = get_point(NULL PASS_REGS);
} }
list = MkAtomTerm(Yap_LookupAtom("[]")); list = MkAtomTerm(Yap_LookupAtom("[]"));
@ -282,8 +281,7 @@ static Term get_geometry(uint32 type){
} }
case WKBMULTILINESTRING: case WKBMULTILINESTRING:
{ {
byte b; uint32 n;
uint32 n, u;
int i; int i;
Functor functor; Functor functor;
Term *c_list; Term *c_list;
@ -298,8 +296,8 @@ static Term get_geometry(uint32 type){
for ( i = 0; i < n; i++ ) { for ( i = 0; i < n; i++ ) {
/* read (and ignore) the byteorder and type */ /* read (and ignore) the byteorder and type */
b = get_inbyteorder(); get_inbyteorder();
u = get_wkbType(); get_wkbType();
c_list[i] = get_linestring(NULL); c_list[i] = get_linestring(NULL);
} }
@ -316,8 +314,7 @@ static Term get_geometry(uint32 type){
} }
case WKBMULTIPOLYGON: case WKBMULTIPOLYGON:
{ {
byte b; uint32 n;
uint32 n, u;
int i; int i;
Functor functor; Functor functor;
Term *c_list; Term *c_list;
@ -332,8 +329,8 @@ static Term get_geometry(uint32 type){
for ( i = 0; i < n; i++ ) { for ( i = 0; i < n; i++ ) {
/* read (and ignore) the byteorder and type */ /* read (and ignore) the byteorder and type */
b = get_inbyteorder(); get_inbyteorder();
u = get_wkbType(); get_wkbType();
c_list[i] = get_polygon(NULL); c_list[i] = get_polygon(NULL);
} }
@ -350,7 +347,6 @@ static Term get_geometry(uint32 type){
} }
case WKBGEOMETRYCOLLECTION: case WKBGEOMETRYCOLLECTION:
{ {
byte b;
uint32 n; uint32 n;
int i; int i;
Functor functor; Functor functor;
@ -365,7 +361,7 @@ static Term get_geometry(uint32 type){
for ( i = 0; i < n; i++ ) { for ( i = 0; i < n; i++ ) {
b = get_inbyteorder(); get_inbyteorder();
c_list[i] = get_geometry(get_wkbType()); c_list[i] = get_geometry(get_wkbType());
} }

10
configure vendored
View File

@ -1539,7 +1539,7 @@ Optional Packages:
--with-java=JAVA_HOME use Java instalation in JAVA_HOME --with-java=JAVA_HOME use Java instalation in JAVA_HOME
--with-readline=DIR use GNU Readline Library in DIR --with-readline=DIR use GNU Readline Library in DIR
--with-matlab=DIR use MATLAB package in DIR --with-matlab=DIR use MATLAB package in DIR
--with-mpi=DIR use MPI library in DIR --with-mpi=DIR use LAM/MPI library in DIR
--with-mpe=DIR use MPE library in DIR --with-mpe=DIR use MPE library in DIR
--with-lam=DIR use LAM MPI library in DIR --with-lam=DIR use LAM MPI library in DIR
--with-heap-space=space default heap size in Kbytes --with-heap-space=space default heap size in Kbytes
@ -4860,16 +4860,16 @@ fi
# Check whether --with-mpi was given. # Check whether --with-mpi was given.
if test "${with_mpi+set}" = set; then : if test "${with_mpi+set}" = set; then :
withval=$with_mpi; if test "$withval" = yes; then withval=$with_mpi; if test "$withval" = yes; then
yap_cv_mpi=yes yap_cv_lam=yes
elif test "$withval" = no; then elif test "$withval" = no; then
yap_cv_mpi=no yap_cv_lam=no
else else
yap_cv_mpi=$with_mpi yap_cv_lam=$with_mpi
LDFLAGS="$LDFLAGS -L${yap_cv_mpi}/lib" LDFLAGS="$LDFLAGS -L${yap_cv_mpi}/lib"
CPPFLAGS="$CPPFLAGS -I${yap_cv_mpi}/include" CPPFLAGS="$CPPFLAGS -I${yap_cv_mpi}/include"
fi fi
else else
yap_cv_mpi=no yap_cv_lam=no
fi fi

10
configure.in
View File

@ -360,18 +360,18 @@ AC_ARG_WITH(matlab,
[yap_cv_matlab=no]) [yap_cv_matlab=no])
AC_ARG_WITH(mpi, AC_ARG_WITH(mpi,
[ --with-mpi[=DIR] use MPI library in DIR], [ --with-mpi[=DIR] use LAM/MPI library in DIR],
if test "$withval" = yes; then if test "$withval" = yes; then
dnl handle UBUNTU systems dnl handle UBUNTU systems
yap_cv_mpi=yes yap_cv_lam=yes
elif test "$withval" = no; then elif test "$withval" = no; then
yap_cv_mpi=no yap_cv_lam=no
else else
yap_cv_mpi=$with_mpi yap_cv_lam=$with_mpi
LDFLAGS="$LDFLAGS -L${yap_cv_mpi}/lib" LDFLAGS="$LDFLAGS -L${yap_cv_mpi}/lib"
CPPFLAGS="$CPPFLAGS -I${yap_cv_mpi}/include" CPPFLAGS="$CPPFLAGS -I${yap_cv_mpi}/include"
fi, fi,
[yap_cv_mpi=no]) [yap_cv_lam=no])
AC_ARG_WITH(mpe, AC_ARG_WITH(mpe,

4
library/lammpi/Makefile.in
View File

@ -37,8 +37,8 @@ RANLIB=@RANLIB@
srcdir=@srcdir@ srcdir=@srcdir@
SO=@SO@ SO=@SO@
CWD=$(PWD) CWD=$(PWD)
MPILDF=`$(MPI_CC) -showme|sed "s/[^ ]*//"|sed "s/-pt/-lpt/"` MPILDF=`$(MPI_CC) --showme:link`
MPICF=`$(MPI_CC) -showme| cut -d " " -f 2` MPICF=`$(MPI_CC) --showme:compile`
# #
OBJS=yap_mpi.o hash.o prologterms2c.o OBJS=yap_mpi.o hash.o prologterms2c.o

32
library/mpi/mpi.c
View File

@ -32,23 +32,23 @@ static char *rcsid = "$Header: /Users/vitor/Yap/yap-cvsbackup/library/mpi/mpi.c,
void STD_PROTO(YAP_Write, (Term, void (*)(int), int)); void STD_PROTO(YAP_Write, (Term, void (*)(int), int));
STATIC_PROTO (Int p_mpi_open, (void)); STATIC_PROTO (Int p_mpi_open, ( USES_REGS1 ));
STATIC_PROTO (Int p_mpi_close, (void)); STATIC_PROTO (Int p_mpi_close, ( USES_REGS1 ));
STATIC_PROTO (Int p_mpi_send, (void)); STATIC_PROTO (Int p_mpi_send, ( USES_REGS1 ));
STATIC_PROTO (Int p_mpi_receive, (void)); STATIC_PROTO (Int p_mpi_receive, ( USES_REGS1 ));
STATIC_PROTO (Int p_mpi_bcast3, (void)); STATIC_PROTO (Int p_mpi_bcast3, ( USES_REGS1 ));
STATIC_PROTO (Int p_mpi_bcast2, (void)); STATIC_PROTO (Int p_mpi_bcast2, ( USES_REGS1 ));
STATIC_PROTO (Int p_mpi_barrier, (void)); STATIC_PROTO (Int p_mpi_barrier, ( USES_REGS1 ));
/* /*
* Auxiliary Data * Auxiliary Data
*/ */
static Int rank, numprocs, namelen; static int rank, numprocs, namelen;
static char processor_name[MPI_MAX_PROCESSOR_NAME]; static char processor_name[MPI_MAX_PROCESSOR_NAME];
static Int mpi_argc; static int mpi_argc;
static char **mpi_argv; static char **mpi_argv;
/* this should eventually be moved to config.h */ /* this should eventually be moved to config.h */
@ -111,7 +111,7 @@ mpi_putc(Int ch)
static Int static Int
p_mpi_open(void) /* mpi_open(?rank, ?num_procs, ?proc_name) */ p_mpi_open( USES_REGS1 ) /* mpi_open(?rank, ?num_procs, ?proc_name) */
{ {
Term t_rank = Deref(ARG1), t_numprocs = Deref(ARG2), t_procname = Deref(ARG3); Term t_rank = Deref(ARG1), t_numprocs = Deref(ARG2), t_procname = Deref(ARG3);
Int retv; Int retv;
@ -156,7 +156,7 @@ Yap exit(FAILURE), whereas in Yap/LAM mpi_open/3 simply fails.
static Int /* mpi_close */ static Int /* mpi_close */
p_mpi_close() p_mpi_close( USES_REGS1 )
{ {
MPI_Finalize(); MPI_Finalize();
return TRUE; return TRUE;
@ -164,7 +164,7 @@ p_mpi_close()
static Int static Int
p_mpi_send() /* mpi_send(+data, +destination, +tag) */ p_mpi_send( USES_REGS1 ) /* mpi_send(+data, +destination, +tag) */
{ {
Term t_data = Deref(ARG1), t_dest = Deref(ARG2), t_tag = Deref(ARG3); Term t_data = Deref(ARG1), t_dest = Deref(ARG2), t_tag = Deref(ARG3);
int tag, dest, retv; int tag, dest, retv;
@ -216,7 +216,7 @@ p_mpi_send() /* mpi_send(+data, +destination, +tag) */
static Int static Int
p_mpi_receive() /* mpi_receive(-data, ?orig, ?tag) */ p_mpi_receive( USES_REGS1 ) /* mpi_receive(-data, ?orig, ?tag) */
{ {
Term t, t_data = Deref(ARG1), t_orig = Deref(ARG2), t_tag = Deref(ARG3); Term t, t_data = Deref(ARG1), t_orig = Deref(ARG2), t_tag = Deref(ARG3);
int tag, orig, retv; int tag, orig, retv;
@ -305,7 +305,7 @@ p_mpi_receive() /* mpi_receive(-data, ?orig, ?tag) */
static Int static Int
p_mpi_bcast3() /* mpi_bcast( ?data, +root, +max_size ) */ p_mpi_bcast3( USES_REGS1 ) /* mpi_bcast( ?data, +root, +max_size ) */
{ {
Term t_data = Deref(ARG1), t_root = Deref(ARG2), t_max_size = Deref(ARG3); Term t_data = Deref(ARG1), t_root = Deref(ARG2), t_max_size = Deref(ARG3);
int root, retv, max_size; int root, retv, max_size;
@ -386,7 +386,7 @@ p_mpi_bcast3() /* mpi_bcast( ?data, +root, +max_size ) */
*/ */
static Int static Int
p_mpi_bcast2() /* mpi_bcast( ?data, +root ) */ p_mpi_bcast2( USES_REGS1 ) /* mpi_bcast( ?data, +root ) */
{ {
Term t_data = Deref(ARG1), t_root = Deref(ARG2); Term t_data = Deref(ARG1), t_root = Deref(ARG2);
int root, retv; int root, retv;
@ -460,7 +460,7 @@ p_mpi_bcast2() /* mpi_bcast( ?data, +root ) */
static Int static Int
p_mpi_barrier() /* mpi_barrier/0 */ p_mpi_barrier( USES_REGS1 ) /* mpi_barrier/0 */
{ {
int retv; int retv;

2
packages/CLPBN/clpbn.yap
View File

@ -473,7 +473,7 @@ factor_to_dist(Hash, f(bayes, Id, Ks)) :-
maplist(key_to_var(Hash), Ks, [V|Parents]), maplist(key_to_var(Hash), Ks, [V|Parents]),
Ks =[Key|_], Ks =[Key|_],
pfl:skolem(Key, Domain), pfl:skolem(Key, Domain),
pfl:get_pfl_parameters(Id, CPT), pfl:get_pfl_parameters(Id, Ks, CPT),
dist(p(Domain,CPT,Parents), DistInfo, Key, Parents), dist(p(Domain,CPT,Parents), DistInfo, Key, Parents),
put_atts(V,[dist(DistInfo,Parents)]). put_atts(V,[dist(DistInfo,Parents)]).

12
packages/CLPBN/clpbn/bdd.yap
View File

@ -122,7 +122,7 @@ evtotree(K=V,Ev0,Ev) :-
rb_insert(Ev0, K, V, Ev). rb_insert(Ev0, K, V, Ev).
ftotree(F, Fs0, Fs) :- ftotree(F, Fs0, Fs) :-
F = f([K|_Parents],_,_,_), F = fn([K|_Parents],_,_,_,_),
rb_insert(Fs0, K, F, Fs). rb_insert(Fs0, K, F, Fs).
bdd([[]],_,_) :- !. bdd([[]],_,_) :- !.
@ -160,7 +160,7 @@ sort_keys(AllFs, AllVars, Leaves) :-
dgraph_leaves(Graph, Leaves), dgraph_leaves(Graph, Leaves),
dgraph_top_sort(Graph, AllVars). dgraph_top_sort(Graph, AllVars).
add_node(f([K|Parents],_,_,_), Graph0, Graph) :- add_node(fn([K|Parents],_,_,_,_), Graph0, Graph) :-
dgraph_add_vertex(Graph0, K, Graph1), dgraph_add_vertex(Graph0, K, Graph1),
foldl(add_edge(K), Parents, Graph1, Graph). foldl(add_edge(K), Parents, Graph1, Graph).
@ -190,7 +190,7 @@ add_parents([V0|Parents], V, Graph0, GraphF) :-
get_keys_info([], _, _, _, Vs, Vs, Ps, Ps, _, _) --> []. get_keys_info([], _, _, _, Vs, Vs, Ps, Ps, _, _) --> [].
get_keys_info([V|MoreVs], Evs, Fs, OrderVs, Vs, VsF, Ps, PsF, Lvs, Outs) --> get_keys_info([V|MoreVs], Evs, Fs, OrderVs, Vs, VsF, Ps, PsF, Lvs, Outs) -->
{ rb_lookup(V, F, Fs) }, !, { rb_lookup(V, F, Fs) }, !,
{ F = f([V|Parents], _, _, DistId) }, { F = fn([V|Parents], _, _, DistId, _) },
%{writeln(v:DistId:Parents)}, %{writeln(v:DistId:Parents)},
[DIST], [DIST],
{ get_key_info(V, F, Fs, Evs, OrderVs, DistId, Parents, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) }, { get_key_info(V, F, Fs, Evs, OrderVs, DistId, Parents, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) },
@ -200,7 +200,7 @@ get_key_info(V, F, Fs, Evs, OrderVs, DistId, Parents0, Vs, Vs2, Ps, Ps1, Lvs, Ou
reorder_keys(Parents0, OrderVs, Parents, Map), reorder_keys(Parents0, OrderVs, Parents, Map),
check_key_p(DistId, F, Map, Parms, _ParmVars, Ps, Ps1), check_key_p(DistId, F, Map, Parms, _ParmVars, Ps, Ps1),
unbound_parms(Parms, ParmVars), unbound_parms(Parms, ParmVars),
F = f(_,[Size|_],_,_), F = fn(_,[Size|_],_,_,_),
check_key(V, Size, DIST, Vs, Vs1), check_key(V, Size, DIST, Vs, Vs1),
DIST = info(V, Tree, Ev, Values, Formula, ParmVars, Parms), DIST = info(V, Tree, Ev, Values, Formula, ParmVars, Parms),
% get a list of form [[P00,P01], [P10,P11], [P20,P21]] % get a list of form [[P00,P01], [P10,P11], [P20,P21]]
@ -599,7 +599,7 @@ to_disj2([V,V1|Vs], V0, Out) :-
% %
check_key_p(DistId, _, Map, Parms, ParmVars, Ps, Ps) :- check_key_p(DistId, _, Map, Parms, ParmVars, Ps, Ps) :-
rb_lookup(DistId-Map, theta(Parms, ParmVars), Ps), !. rb_lookup(DistId-Map, theta(Parms, ParmVars), Ps), !.
check_key_p(DistId, f(_, Sizes, Parms0, DistId), Map, Parms, ParmVars, Ps, PsF) :- check_key_p(DistId, fn(_, Sizes, Parms0, DistId, _), Map, Parms, ParmVars, Ps, PsF) :-
swap_parms(Parms0, Sizes, [0|Map], Parms1), swap_parms(Parms0, Sizes, [0|Map], Parms1),
length(Parms1, L0), length(Parms1, L0),
Sizes = [Size|_], Sizes = [Size|_],
@ -693,7 +693,7 @@ get_parents(V.Parents, Values.PVars, Vs0, Vs) :-
get_key_parent(Fs, V, Values, Vs0, Vs) :- get_key_parent(Fs, V, Values, Vs0, Vs) :-
INFO = info(V, _Parent, _Ev, Values, _, _, _), INFO = info(V, _Parent, _Ev, Values, _, _, _),
rb_lookup(V, f(_, [Size|_], _, _), Fs), rb_lookup(V, fn(_, [Size|_], _, _, _), Fs),
check_key(V, Size, INFO, Vs0, Vs). check_key(V, Size, INFO, Vs0, Vs).
check_key(V, _, INFO, Vs, Vs) :- check_key(V, _, INFO, Vs, Vs) :-

2
packages/CLPBN/clpbn/connected.yap
View File

@ -42,7 +42,7 @@ init_influences(Vs, G, RG) :-
to_dgraph(Vs, G0, G), to_dgraph(Vs, G0, G),
dgraph_transpose(G, RG). dgraph_transpose(G, RG).
factor_to_dgraph(f([V|Parents],_,_,_), G0, G) :- factor_to_dgraph(fn([V|Parents],_,_,_,_), G0, G) :-
dgraph_add_vertex(G0, V, G00), dgraph_add_vertex(G0, V, G00),
build_edges(Parents, V, Edges), build_edges(Parents, V, Edges),
dgraph_add_edges(G00, Edges, G). dgraph_add_edges(G00, Edges, G).

4
packages/CLPBN/clpbn/dists.yap
View File

@ -238,7 +238,7 @@ get_dist_all_sizes(Id, DSizes) :-
get_dist_domain_size(DistId, DSize) :- get_dist_domain_size(DistId, DSize) :-
use_parfactors(on), !, use_parfactors(on), !,
pfl:get_pfl_parameters(DistId, Dist), pfl:get_pfl_parameters(DistId, _, Dist),
length(Dist, DSize). length(Dist, DSize).
get_dist_domain_size(avg(D,_), DSize) :- !, get_dist_domain_size(avg(D,_), DSize) :- !,
length(D, DSize). length(D, DSize).
@ -297,7 +297,7 @@ empty_dist(Dist, TAB) :-
dist_new_table(DistId, NewMat) :- dist_new_table(DistId, NewMat) :-
use_parfactors(on), !, use_parfactors(on), !,
matrix_to_list(NewMat, List), matrix_to_list(NewMat, List),
pfl:new_pfl_parameters(DistId, List). pfl:new_pfl_parameters(DistId, _, List).
dist_new_table(Id, NewMat) :- dist_new_table(Id, NewMat) :-
matrix_to_list(NewMat, List), matrix_to_list(NewMat, List),
recorded(clpbn_dist_db, db(Id, Key, _, A, B, C, D), R), recorded(clpbn_dist_db, db(Id, Key, _, A, B, C, D), R),

164
packages/CLPBN/clpbn/gibbs.yap
View File

@ -28,6 +28,8 @@
sum_list/2 sum_list/2
]). ]).
:- use_module(library(maplist)).
:- use_module(library(ordsets), :- use_module(library(ordsets),
[ord_subtract/3]). [ord_subtract/3]).
@ -87,7 +89,7 @@ run_gibbs_solver(LVs, LPs, Vs) :-
initialise(LVs, Graph, GVs, OutputVars, VarOrder) :- initialise(LVs, Graph, GVs, OutputVars, VarOrder) :-
init_keys(Keys0), init_keys(Keys0),
gen_keys(LVs, 0, VLen, Keys0, Keys), foldl2(gen_key, LVs, 0, VLen, Keys0, Keys),
functor(Graph,graph,VLen), functor(Graph,graph,VLen),
graph_representation(LVs, Graph, 0, Keys, TGraph), graph_representation(LVs, Graph, 0, Keys, TGraph),
compile_graph(Graph), compile_graph(Graph),
@ -99,21 +101,18 @@ initialise(LVs, Graph, GVs, OutputVars, VarOrder) :-
init_keys(Keys0) :- init_keys(Keys0) :-
rb_new(Keys0). rb_new(Keys0).
gen_keys([], I, I, Keys, Keys). gen_key(V, I0, I0, Keys0, Keys0) :-
gen_keys([V|Vs], I0, If, Keys0, Keys) :- clpbn:get_atts(V,[evidence(_)]), !.
clpbn:get_atts(V,[evidence(_)]), !, gen_key(V, I0, I, Keys0, Keys) :-
gen_keys(Vs, I0, If, Keys0, Keys).
gen_keys([V|Vs], I0, If, Keys0, Keys) :-
I is I0+1, I is I0+1,
rb_insert(Keys0,V,I,KeysI), rb_insert(Keys0,V,I,Keys).
gen_keys(Vs, I, If, KeysI, Keys).
graph_representation([],_,_,_,[]). graph_representation([],_,_,_,[]).
graph_representation([V|Vs], Graph, I0, Keys, TGraph) :- graph_representation([V|Vs], Graph, I0, Keys, TGraph) :-
clpbn:get_atts(V,[evidence(_)]), !, clpbn:get_atts(V,[evidence(_)]), !,
clpbn:get_atts(V, [dist(Id,Parents)]), clpbn:get_atts(V, [dist(Id,Parents)]),
get_possibly_deterministic_dist_matrix(Id, Parents, _, Vals, Table), get_possibly_deterministic_dist_matrix(Id, Parents, _, Vals, Table),
get_sizes(Parents, Szs), maplist(get_size, Parents, Szs),
length(Vals,Sz), length(Vals,Sz),
project_evidence_out([V|Parents],[V|Parents],Table,[Sz|Szs],Variables,NewTable), project_evidence_out([V|Parents],[V|Parents],Table,[Sz|Szs],Variables,NewTable),
% all variables are parents % all variables are parents
@ -123,7 +122,7 @@ graph_representation([V|Vs], Graph, I0, Keys, [I-IParents|TGraph]) :-
I is I0+1, I is I0+1,
clpbn:get_atts(V, [dist(Id,Parents)]), clpbn:get_atts(V, [dist(Id,Parents)]),
get_possibly_deterministic_dist_matrix(Id, Parents, _, Vals, Table), get_possibly_deterministic_dist_matrix(Id, Parents, _, Vals, Table),
get_sizes(Parents, Szs), maplist( get_size, Parents, Szs),
length(Vals,Sz), length(Vals,Sz),
project_evidence_out([V|Parents],[V|Parents],Table,[Sz|Szs],Variables,NewTable), project_evidence_out([V|Parents],[V|Parents],Table,[Sz|Szs],Variables,NewTable),
Variables = [V|NewParents], Variables = [V|NewParents],
@ -131,7 +130,7 @@ graph_representation([V|Vs], Graph, I0, Keys, [I-IParents|TGraph]) :-
reorder_CPT(Variables,NewTable,[V|SortedNVs],NewTable2,_), reorder_CPT(Variables,NewTable,[V|SortedNVs],NewTable2,_),
add2graph(V, Vals, NewTable2, SortedIndices, Graph, Keys), add2graph(V, Vals, NewTable2, SortedIndices, Graph, Keys),
propagate2parents(NewParents, NewTable, Variables, Graph,Keys), propagate2parents(NewParents, NewTable, Variables, Graph,Keys),
parent_indices(NewParents, Keys, IVariables0), maplist(parent_index(Keys), NewParents, IVariables0),
sort(IVariables0, IParents), sort(IVariables0, IParents),
arg(I, Graph, var(_,_,_,_,_,_,_,NewTable2,SortedIndices)), arg(I, Graph, var(_,_,_,_,_,_,_,NewTable2,SortedIndices)),
graph_representation(Vs, Graph, I, Keys, TGraph). graph_representation(Vs, Graph, I, Keys, TGraph).
@ -141,18 +140,12 @@ write_pars([V|Parents]) :-
clpbn:get_atts(V, [key(K),dist(I,_)]),write(K:I),nl, clpbn:get_atts(V, [key(K),dist(I,_)]),write(K:I),nl,
write_pars(Parents). write_pars(Parents).
get_sizes([], []). get_size(V, Sz) :-
get_sizes([V|Parents], [Sz|Szs]) :-
clpbn:get_atts(V, [dist(Id,_)]), clpbn:get_atts(V, [dist(Id,_)]),
get_dist_domain_size(Id, Sz), get_dist_domain_size(Id, Sz).
get_sizes(Parents, Szs).
parent_indices([], _, []).
parent_indices([V|Parents], Keys, [I|IParents]) :-
rb_lookup(V, I, Keys),
parent_indices(Parents, Keys, IParents).
parent_index(Keys, V, I) :-
rb_lookup(V, I, Keys).
% %
% first, remove nodes that have evidence from tables. % first, remove nodes that have evidence from tables.
@ -180,52 +173,36 @@ add2graph(V, Vals, Table, IParents, Graph, Keys) :-
member(tabular(Table,Index,IParents), VarSlot), !. member(tabular(Table,Index,IParents), VarSlot), !.
sort_according_to_indices(NVs,Keys,SortedNVs,SortedIndices) :- sort_according_to_indices(NVs,Keys,SortedNVs,SortedIndices) :-
vars2indices(NVs,Keys,ToSort), maplist(var2index(Keys), NVs, ToSort),
keysort(ToSort, Sorted), keysort(ToSort, Sorted),
split_parents(Sorted, SortedNVs,SortedIndices). maplist(split_parent, Sorted, SortedNVs,SortedIndices).
split_parents([], [], []). split_parent(I-V, V, I).
split_parents([I-V|Sorted], [V|SortedNVs],[I|SortedIndices]) :-
split_parents(Sorted, SortedNVs, SortedIndices).
var2index(Keys, V, I-V) :-
vars2indices([],_,[]). rb_lookup(V, I, Keys).
vars2indices([V|Parents],Keys,[I-V|IParents]) :-
rb_lookup(V, I, Keys),
vars2indices(Parents,Keys,IParents).
% %
% This is the really cool bit. % This is the really cool bit.
% %
compile_graph(Graph) :- compile_graph(Graph) :-
Graph =.. [_|VarsInfo], Graph =.. [_|VarsInfo],
compile_vars(VarsInfo,Graph). maplist( compile_var(Graph), VarsInfo).
compile_vars([],_). compile_var(Graph, var(_,I,_,Vals,Sz,VarSlot,Parents,_,_)) :-
compile_vars([var(_,I,_,Vals,Sz,VarSlot,Parents,_,_)|VarsInfo],Graph) foldl2( fetch_parent(Graph), VarSlot, [], Parents, [], Sizes),
:- foldl( mult_list, Sizes,1,TotSize),
compile_var(I,Vals,Sz,VarSlot,Parents,Graph),
compile_vars(VarsInfo,Graph).
compile_var(I,Vals,Sz,VarSlot,Parents,Graph) :-
fetch_all_parents(VarSlot,Graph,[],Parents,[],Sizes),
mult_list(Sizes,1,TotSize),
compile_var(TotSize,I,Vals,Sz,VarSlot,Parents,Sizes,Graph). compile_var(TotSize,I,Vals,Sz,VarSlot,Parents,Sizes,Graph).
fetch_all_parents([],_,Parents,Parents,Sizes,Sizes) :- !. fetch_parent(Graph, tabular(_,_,Ps), Parents0, ParentsF, Sizes0, SizesF) :-
fetch_all_parents([tabular(_,_,Ps)|CPTs],Graph,Parents0,ParentsF,Sizes0,SizesF) :- foldl2( merge_these_parents(Graph), Ps, Parents0, ParentsF, Sizes0, SizesF).
merge_these_parents(Ps,Graph,Parents0,ParentsI,Sizes0,SizesI),
fetch_all_parents(CPTs,Graph,ParentsI,ParentsF,SizesI,SizesF).
merge_these_parents([],_,Parents,Parents,Sizes,Sizes). merge_these_parents(_Graph, I,Parents0,Parents0,Sizes0,Sizes0) :-
merge_these_parents([I|Ps],Graph,Parents0,ParentsF,Sizes0,SizesF) :- member(I,Parents0), !.
member(I,Parents0), !, merge_these_parents(Graph, I, Parents0,ParentsF,Sizes0,SizesF) :-
merge_these_parents(Ps,Graph,Parents0,ParentsF,Sizes0,SizesF).
merge_these_parents([I|Ps],Graph,Parents0,ParentsF,Sizes0,SizesF) :-
arg(I,Graph,var(_,I,_,Vals,_,_,_,_,_)), arg(I,Graph,var(_,I,_,Vals,_,_,_,_,_)),
length(Vals, Sz), length(Vals, Sz),
add_parent(Parents0,I,ParentsI,Sizes0,Sz,SizesI), add_parent(Parents0,I,ParentsF,Sizes0,Sz,SizesF).
merge_these_parents(Ps,Graph,ParentsI,ParentsF,SizesI,SizesF).
add_parent([],I,[I],[],Sz,[Sz]). add_parent([],I,[I],[],Sz,[Sz]).
add_parent([P|Parents0],I,[I,P|Parents0],Sizes0,Sz,[Sz|Sizes0]) :- add_parent([P|Parents0],I,[I,P|Parents0],Sizes0,Sz,[Sz|Sizes0]) :-
@ -234,10 +211,8 @@ add_parent([P|Parents0],I,[P|ParentsI],[S|Sizes0],Sz,[S|SizesI]) :-
add_parent(Parents0,I,ParentsI,Sizes0,Sz,SizesI). add_parent(Parents0,I,ParentsI,Sizes0,Sz,SizesI).
mult_list([],Mult,Mult). mult_list(Sz,Mult0,Mult) :-
mult_list([Sz|Sizes],Mult0,Mult) :- Mult is Sz*Mult0.
MultI is Sz*Mult0,
mult_list(Sizes,MultI,Mult).
% compile node as set of facts, faster execution % compile node as set of facts, faster execution
compile_var(TotSize,I,_Vals,Sz,CPTs,Parents,_Sizes,Graph) :- compile_var(TotSize,I,_Vals,Sz,CPTs,Parents,_Sizes,Graph) :-
@ -247,7 +222,7 @@ compile_var(TotSize,I,_Vals,Sz,CPTs,Parents,_Sizes,Graph) :-
compile_var(_,_,_,_,_,_,_,_). compile_var(_,_,_,_,_,_,_,_).
multiply_all(I,Parents,CPTs,Sz,Graph) :- multiply_all(I,Parents,CPTs,Sz,Graph) :-
markov_blanket_instance(Parents,Graph,Values), maplist( markov_blanket_instance(Graph), Parents, Values),
( (
multiply_all(CPTs,Graph,Probs) multiply_all(CPTs,Graph,Probs)
-> ->
@ -261,11 +236,9 @@ multiply_all(I,_,_,_,_) :-
% note: what matters is how this predicate instantiates the temp % note: what matters is how this predicate instantiates the temp
% slot in the graph! % slot in the graph!
markov_blanket_instance([],_,[]). markov_blanket_instance(Graph, I, Pos) :-
markov_blanket_instance([I|Parents],Graph,[Pos|Values]) :- arg(I, Graph, var(_,I,Pos,Vals,_,_,_,_,_)),
arg(I,Graph,var(_,I,Pos,Vals,_,_,_,_,_)), fetch_val(Vals, 0, Pos).
fetch_val(Vals,0,Pos),
markov_blanket_instance(Parents,Graph,Values).
% backtrack through every value in domain % backtrack through every value in domain
% %
@ -275,21 +248,19 @@ fetch_val([_|Vals],I0,Pos) :-
fetch_val(Vals,I,Pos). fetch_val(Vals,I,Pos).
multiply_all([tabular(Table,_,Parents)|CPTs],Graph,Probs) :- multiply_all([tabular(Table,_,Parents)|CPTs],Graph,Probs) :-
fetch_parents(Parents, Graph, Vals), maplist( fetch_parent(Graph), Parents, Vals),
column_from_possibly_deterministic_CPT(Table,Vals,Probs0), column_from_possibly_deterministic_CPT(Table,Vals,Probs0),
multiply_more(CPTs,Graph,Probs0,Probs). multiply_more(CPTs,Graph,Probs0,Probs).
fetch_parents([], _, []). fetch_parent(Graph, P, Val) :-
fetch_parents([P|Parents], Graph, [Val|Vals]) :- arg(P,Graph,var(_,_,Val,_,_,_,_,_,_)).
arg(P,Graph,var(_,_,Val,_,_,_,_,_,_)),
fetch_parents(Parents, Graph, Vals).
multiply_more([],_,Probs0,LProbs) :- multiply_more([],_,Probs0,LProbs) :-
normalise_possibly_deterministic_CPT(Probs0, Probs), normalise_possibly_deterministic_CPT(Probs0, Probs),
list_from_CPT(Probs, LProbs0), list_from_CPT(Probs, LProbs0),
accumulate_up_list(LProbs0, 0.0, LProbs). accumulate_up_list(LProbs0, 0.0, LProbs).
multiply_more([tabular(Table,_,Parents)|CPTs],Graph,Probs0,Probs) :- multiply_more([tabular(Table,_,Parents)|CPTs],Graph,Probs0,Probs) :-
fetch_parents(Parents, Graph, Vals), maplist( fetch_parent(Graph), Parents, Vals),
column_from_possibly_deterministic_CPT(Table, Vals, P0), column_from_possibly_deterministic_CPT(Table, Vals, P0),
multiply_possibly_deterministic_factors(Probs0, P0, ProbsI), multiply_possibly_deterministic_factors(Probs0, P0, ProbsI),
multiply_more(CPTs,Graph,ProbsI,Probs). multiply_more(CPTs,Graph,ProbsI,Probs).
@ -378,7 +349,7 @@ process_chains(0,_,F,F,_,_,Est,Est) :- !.
process_chains(ToDo,VarOrder,End,Start,Graph,Len,Est0,Estf) :- process_chains(ToDo,VarOrder,End,Start,Graph,Len,Est0,Estf) :-
%format('ToDo = ~d~n',[ToDo]), %format('ToDo = ~d~n',[ToDo]),
process_chains(Start,VarOrder,Int,Graph,Len,Est0,Esti), process_chains(Start,VarOrder,Int,Graph,Len,Est0,Esti),
% (ToDo mod 100 =:= 1 -> statistics,cvt2problist(Esti, Probs), Int =[S|_], format('did ~d: ~w~n ~w~n',[ToDo,Probs,S]) ; true), % (ToDo mod 100 =:= 1 -> statistics,maplist(cvt2prob, Esti, Probs), Int =[S|_], format('did ~d: ~w~n ~w~n',[ToDo,Probs,S]) ; true),
ToDo1 is ToDo-1, ToDo1 is ToDo-1,
process_chains(ToDo1,VarOrder,End,Int,Graph,Len,Esti,Estf). process_chains(ToDo1,VarOrder,End,Int,Graph,Len,Esti,Estf).
@ -388,7 +359,7 @@ process_chains([Sample0|Samples0], VarOrder, [Sample|Samples], Graph, SampLen,[E
functor(Sample,sample,SampLen), functor(Sample,sample,SampLen),
do_sample(VarOrder,Sample,Sample0,Graph), do_sample(VarOrder,Sample,Sample0,Graph),
% format('Sample = ~w~n',[Sample]), % format('Sample = ~w~n',[Sample]),
update_estimates(E0,Sample,Ef), maplist(update_estimate(Sample), E0, Ef),
process_chains(Samples0, VarOrder, Samples, Graph, SampLen,E0s,Efs). process_chains(Samples0, VarOrder, Samples, Graph, SampLen,E0s,Efs).
do_sample([],_,_,_). do_sample([],_,_,_).
@ -439,15 +410,10 @@ pick_new_value([V|Vals],X,I0,Val) :-
pick_new_value(Vals,X,I,Val) pick_new_value(Vals,X,I,Val)
). ).
update_estimates([],_,[]). update_estimate(Sample, [I|E],[I|NE]) :-
update_estimates([Est|E0],Sample,[NEst|Ef]) :-
update_estimate(Est,Sample,NEst),
update_estimates(E0,Sample,Ef).
update_estimate([I|E],Sample,[I|NE]) :-
arg(I,Sample,V), arg(I,Sample,V),
update_estimate_for_var(V,E,NE). update_estimate_for_var(V,E,NE).
update_estimate(me(Is,Mult,E),Sample,me(Is,Mult,NE)) :- update_estimate(Sample,me(Is,Mult,E),me(Is,Mult,NE)) :-
get_estimate_pos(Is, Sample, Mult, 0, V), get_estimate_pos(Is, Sample, Mult, 0, V),
update_estimate_for_var(V,E,NE). update_estimate_for_var(V,E,NE).
@ -481,21 +447,15 @@ clean_up.
gibbs_params(5,100,1000). gibbs_params(5,100,1000).
cvt2problist([], []). cvt2prob([[_|E]], Ps) :-
cvt2problist([[[_|E]]|Est0], [Ps|Probs]) :- foldl(sum_all, E, 0, Sum),
sum_all(E,0,Sum), maplist( do_prob(Sum), E, Ps).
do_probs(E,Sum,Ps),
cvt2problist(Est0, Probs) .
sum_all([],Sum,Sum). sum_all(E, S0, Sum) :-
sum_all([E|Es],S0,Sum) :- Sum is S0+E.
SI is S0+E,
sum_all(Es,SI,Sum).
do_probs([],_,[]). do_prob(Sum, E, P) :-
do_probs([E|Es],Sum,[P|Ps]) :- P is E/Sum.
P is E/Sum,
do_probs(Es,Sum,Ps).
show_sorted([], _) :- nl. show_sorted([], _) :- nl.
show_sorted([I|VarOrder], Graph) :- show_sorted([I|VarOrder], Graph) :-
@ -506,13 +466,11 @@ show_sorted([I|VarOrder], Graph) :-
sum_up_all([[]|_], []). sum_up_all([[]|_], []).
sum_up_all([[C|MoreC]|Chains], [Dist|Dists]) :- sum_up_all([[C|MoreC]|Chains], [Dist|Dists]) :-
extract_sums(Chains, CurrentChains, LeftChains), maplist( extract_sum, Chains, CurrentChains, LeftChains),
sum_up([C|CurrentChains], Dist), sum_up([C|CurrentChains], Dist),
sum_up_all([MoreC|LeftChains], Dists). sum_up_all([MoreC|LeftChains], Dists).
extract_sums([], [], []). extract_sum([C|Chains], C, Chains).
extract_sums([[C|Chains]|MoreChains], [C|CurrentChains], [Chains|LeftChains]) :-
extract_sums(MoreChains, CurrentChains, LeftChains).
sum_up([[_|Counts]|Chains], Dist) :- sum_up([[_|Counts]|Chains], Dist) :-
add_up(Counts,Chains, Add), add_up(Counts,Chains, Add),
@ -523,25 +481,21 @@ sum_up([me(_,_,Counts)|Chains], Dist) :-
add_up(Counts,[],Counts). add_up(Counts,[],Counts).
add_up(Counts,[[_|Cs]|Chains], Add) :- add_up(Counts,[[_|Cs]|Chains], Add) :-
sum_lists(Counts, Cs, NCounts), maplist(sum, Counts, Cs, NCounts),
add_up(NCounts, Chains, Add). add_up(NCounts, Chains, Add).
add_up_mes(Counts,[],Counts). add_up_mes(Counts,[],Counts).
add_up_mes(Counts,[me(_,_,Cs)|Chains], Add) :- add_up_mes(Counts,[me(_,_,Cs)|Chains], Add) :-
sum_lists(Counts, Cs, NCounts), maplist( sum_list, Counts, Cs, NCounts),
add_up_mes(NCounts, Chains, Add). add_up_mes(NCounts, Chains, Add).
sum_lists([],[],[]). sum(Count, C, NC) :-
sum_lists([Count|Counts], [C|Cs], [NC|NCounts]) :- NC is Count+C.
NC is Count+C,
sum_lists(Counts, Cs, NCounts).
normalise(Add, Dist) :- normalise(Add, Dist) :-
sum_list(Add, Sum), sum_list(Add, Sum),
divide_list(Add, Sum, Dist). maplist(divide(Sum), Add, Dist).
divide_list([], _, []). divide(Sum, C, P) :-
divide_list([C|Add], Sum, [P|Dist]) :- P is C/Sum.
P is C/Sum,
divide_list(Add, Sum, Dist).

12
packages/CLPBN/clpbn/horus_ground.yap
View File

@ -32,7 +32,7 @@
[clpbn_bind_vals/3]). [clpbn_bind_vals/3]).
:- use_module(library(pfl), :- use_module(library(pfl),
[get_pfl_parameters/2, [get_pfl_parameters/3,
skolem/2 skolem/2
]). ]).
@ -50,7 +50,7 @@ call_horus_ground_solver(QueryVars, QueryKeys, AllKeys, Factors, Evidence,
end_horus_ground_solver(State). end_horus_ground_solver(State).
init_horus_ground_solver(QueryKeys, AllKeys, Factors, Evidence, init_horus_ground_solver(_QueryKeys, AllKeys, Factors, Evidence,
state(Network,Hash,Id,DistIds)) :- state(Network,Hash,Id,DistIds)) :-
factors_type(Factors, Type), factors_type(Factors, Type),
keys_to_numbers(AllKeys, Factors, Evidence, Hash, Id, FacIds, EvIds), keys_to_numbers(AllKeys, Factors, Evidence, Hash, Id, FacIds, EvIds),
@ -64,10 +64,10 @@ init_horus_ground_solver(QueryKeys, AllKeys, Factors, Evidence,
run_horus_ground_solver(QueryKeys, Solutions, run_horus_ground_solver(QueryKeys, Solutions,
state(Network,Hash,Id, DistIds)) :- state(Network,Hash,Id, _DistIds)) :-
lists_of_keys_to_ids(QueryKeys, QueryIds, Hash, _, Id, _), lists_of_keys_to_ids(QueryKeys, QueryIds, Hash, _, Id, _),
%maplist(get_pfl_parameters, DistIds, DistParams), %maplist(get_pfl_parameters, _DistIds, _, DistParams),
%cpp_set_factors_params(Network, DistIds, DistParams), %cpp_set_factors_params(Network, _DistIds, DistParams),
cpp_run_ground_solver(Network, QueryIds, Solutions). cpp_run_ground_solver(Network, QueryIds, Solutions).
@ -79,7 +79,7 @@ factors_type([f(bayes, _, _)|_], bayes) :- ! .
factors_type([f(markov, _, _)|_], markov) :- ! . factors_type([f(markov, _, _)|_], markov) :- ! .
get_dist_id(f(_, _, _, DistId), DistId). get_dist_id(fn(_, _, _, DistId, _), DistId).
get_domain(_:Key, Domain) :- !, get_domain(_:Key, Domain) :- !,

6
packages/CLPBN/clpbn/horus_lifted.yap
View File

@ -28,7 +28,7 @@
:- use_module(library(pfl), :- use_module(library(pfl),
[factor/6, [factor/6,
skolem/2, skolem/2,
get_pfl_parameters/2 get_pfl_parameters/3
]). ]).
:- use_module(library(maplist)). :- use_module(library(maplist)).
@ -50,9 +50,9 @@ init_horus_lifted_solver(_, AllVars, _, state(Network, DistIds)) :-
sort(DistIds0, DistIds). sort(DistIds0, DistIds).
run_horus_lifted_solver(QueryVars, Solutions, state(Network, DistIds)) :- run_horus_lifted_solver(QueryVars, Solutions, state(Network, _DistIds)) :-
maplist(get_query_keys, QueryVars, QueryKeys), maplist(get_query_keys, QueryVars, QueryKeys),
%maplist(get_pfl_parameters, DistIds,DistsParams), %maplist(get_pfl_parameters, DistIds, _, DistsParams),
%cpp_set_parfactors_params(Network, DistIds, DistsParams), %cpp_set_parfactors_params(Network, DistIds, DistsParams),
cpp_run_lifted_solver(Network, QueryKeys, Solutions). cpp_run_lifted_solver(Network, QueryKeys, Solutions).

2
packages/CLPBN/clpbn/numbers.yap
View File

@ -41,7 +41,7 @@ key_to_id(Key, I0, Hash0, Hash, I0, I) :-
b_hash_insert(Hash0, Key, I0, Hash), b_hash_insert(Hash0, Key, I0, Hash),
I is I0+1. I is I0+1.
factor_to_id(Ev, f(_, DistId, Keys), f(Ids, Ranges, CPT, DistId), Hash0, Hash, I0, I) :- factor_to_id(Ev, f(_, DistId, Keys), fn(Ids, Ranges, CPT, DistId, Keys), Hash0, Hash, I0, I) :-
get_pfl_cpt(DistId, Keys, Ev, NKeys, CPT), get_pfl_cpt(DistId, Keys, Ev, NKeys, CPT),
foldl2(key_to_id, NKeys, Ids, Hash0, Hash, I0, I), foldl2(key_to_id, NKeys, Ids, Hash0, Hash, I0, I),
maplist(get_range, Keys, Ranges). maplist(get_range, Keys, Ranges).

4
packages/CLPBN/clpbn/ve.yap
View File

@ -131,9 +131,9 @@ init_ve(FactorIds, EvidenceIds, Hash, Id, ve(FactorIds, Hash, Id, Ev)) :-
evtotree(K=V,Ev0,Ev) :- evtotree(K=V,Ev0,Ev) :-
rb_insert(Ev0, K, V, Ev). rb_insert(Ev0, K, V, Ev).
factor_to_graph( f(Nodes, Sizes, _Pars0, Id), Factors0, Factors, Edges0, Edges, I0, I) :- factor_to_graph( fn(Nodes, Sizes, _Pars0, Id, Keys), Factors0, Factors, Edges0, Edges, I0, I) :-
I is I0+1, I is I0+1,
pfl:get_pfl_parameters(Id, Pars0), pfl:get_pfl_parameters(Id, Keys, Pars0),
init_CPT(Pars0, Sizes, CPT0), init_CPT(Pars0, Sizes, CPT0),
reorder_CPT(Nodes, CPT0, FIPs, CPT, _), reorder_CPT(Nodes, CPT0, FIPs, CPT, _),
F = f(I0, FIPs, CPT), F = f(I0, FIPs, CPT),

6
packages/CLPBN/horus/HorusYap.cpp
View File

@ -523,7 +523,11 @@ readParameters (YAP_Term paramL)
Params params; Params params;
assert (YAP_IsPairTerm (paramL)); assert (YAP_IsPairTerm (paramL));
while (paramL != YAP_TermNil()) { while (paramL != YAP_TermNil()) {
params.push_back ((double) YAP_FloatOfTerm (YAP_HeadOfTerm (paramL))); YAP_Term hd = YAP_HeadOfTerm (paramL);
if (YAP_IsFloatTerm(hd))
params.push_back ((double) YAP_FloatOfTerm (hd));
else
params.push_back ((double) YAP_IntOfTerm (hd));
paramL = YAP_TailOfTerm (paramL); paramL = YAP_TailOfTerm (paramL);
} }
if (Globals::logDomain) { if (Globals::logDomain) {

29
packages/CLPBN/pfl.yap
View File

@ -12,8 +12,8 @@
skolem/2, skolem/2,
defined_in_factor/2, defined_in_factor/2,
get_pfl_cpt/5, % given id and keys, return new keys and cpt get_pfl_cpt/5, % given id and keys, return new keys and cpt
get_pfl_parameters/2, % given id return par factor parameter get_pfl_parameters/3, % given id return par factor parameter
new_pfl_parameters/2, % given id set new parameters new_pfl_parameters/3, % given id set new parameters
get_first_pvariable/2, % given id get firt pvar (useful in bayesian) get_first_pvariable/2, % given id get firt pvar (useful in bayesian)
get_factor_pvariable/2, % given id get any pvar get_factor_pvariable/2, % given id get any pvar
add_ground_factor/5 %add a new bayesian variable (for now) add_ground_factor/5 %add a new bayesian variable (for now)
@ -184,24 +184,25 @@ add_evidence(Sk,Var) :-
clpbn:put_atts(_V,[key(Sk),evidence(E)]). clpbn:put_atts(_V,[key(Sk),evidence(E)]).
%% get_pfl_cpt(Id, Keys, Ev, NewKeys, Out) :- get_pfl_cpt(Id, Keys, Ev, NewKeys, Out) :-
%% factor(_Type,Id,[Key|_],_FV,avg,_Constraints), !, factor(_Type,Id,[Key|_],_FV,avg,_Constraints), !,
%% Keys = [Key|Parents], Keys = [Key|Parents],
%% writeln(Key:Parents), writeln(Key:Parents),
%% avg_factors(Key, Parents, 0.0, Ev, NewKeys, Out). avg_factors(Key, Parents, 0.0, Ev, NewKeys, Out).
get_pfl_cpt(Id, Keys, _, Keys, Out) :- get_pfl_cpt(Id, Keys, _, Keys, Out) :-
get_pfl_parameters(Id,Out). factor(_Type,Id,Keys,_FV,Phi,_Constraints),
( Phi = [_|_] -> Phi = Out ; call(user:Phi, Out) ).
get_pfl_parameters(Id,Out) :- get_pfl_parameters(Id, Keys, Out) :-
factor(_Type,Id,_FList,_FV,Phi,_Constraints), factor(_Type,Id,Keys,_FV,Phi,_Constraints),
( Phi = [_|_] -> Phi = Out ; call(user:Phi, Out) ). ( Phi = [_|_] -> Phi = Out ; call(user:Phi, Out) ).
new_pfl_parameters(Id, NewPhi) :- new_pfl_parameters(Id, Keys, NewPhi) :-
retract(factor(Type,Id,FList,FV,_Phi,Constraints)), retract(factor(Type,Id,Keys,FV,_Phi,Constraints)),
assert(factor(Type,Id,FList,FV,NewPhi,Constraints)), assert(factor(Type,Id,Keys,FV,NewPhi,Constraints)),
fail. fail.
new_pfl_parameters(_Id, _NewPhi). new_pfl_parameters(_Id, _Keys, _NewPhi).
get_pfl_factor_sizes(Id, DSizes) :- get_pfl_factor_sizes(Id, DSizes) :-
factor(_Type, Id, FList, _FV, _Phi, _Constraints), factor(_Type, Id, FList, _FV, _Phi, _Constraints),

4
packages/prism/src/c/core/bpx.c
View File

@ -34,7 +34,7 @@ double floatval(TERM);
#ifdef __YAP_PROLOG__ #ifdef __YAP_PROLOG__
static inline static inline
#endif #endif
TERM encodefloat1(double); TERM encodefloat1(double USES_REGS);
/* loader.c */ /* loader.c */
SYM_REC_PTR insert(const char *, int, int); SYM_REC_PTR insert(const char *, int, int);
@ -272,7 +272,7 @@ TERM bpx_build_float(double x)
{ {
CACHE_REGS CACHE_REGS
REQUIRE_HEAP(4); REQUIRE_HEAP(4);
return encodefloat1(x); return encodefloat1(x PASS_REGS);
} }
TERM bpx_build_atom(const char *name) TERM bpx_build_atom(const char *name)

2
packages/prism/src/c/core/bpx.h
View File

@ -128,7 +128,7 @@ double floatval(TERM t)
} }
static inline static inline
TERM encodefloat1(double f) TERM encodefloat1(double f USES_REGS)
{ {
return MkFloatTerm((Float)f); return MkFloatTerm((Float)f);
} }