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 /* M_WILLIAMS */
{
splfild = 0; /* We do not have an open file */
splfild = -1; /* We do not have an open file */
return -1;
}
#ifdef undf0
@ -1466,7 +1466,7 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac
} else {
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) {
return mode;
}
@ -1499,7 +1499,7 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac
#endif
if (YAP_LIBDIR != NULL) {
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) {
return mode;
}
@ -1508,7 +1508,7 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac
}
#if _MSC_VER || defined(__MINGW32__)
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) {
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_inbyteorder(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_polygon(char *functor);
static Term get_geometry(uint32 type);
@ -150,7 +150,7 @@ static void readswap8(double *buf) {
cursor += 8;
}
static Term get_point(char *func){
static Term get_point(char *func USES_REGS){
Term args[2];
Functor functor;
double d;
@ -188,7 +188,7 @@ static Term get_linestring(char *func){
c_list = (Term *) calloc(sizeof(Term),n);
for ( i = 0; i < n; i++) {
c_list[i] = get_point(NULL);
c_list[i] = get_point(NULL PASS_REGS);
}
list = MkAtomTerm(Yap_LookupAtom("[]"));
@ -241,15 +241,14 @@ static Term get_geometry(uint32 type){
switch(type) {
case WKBPOINT:
return get_point("point");
return get_point("point" PASS_REGS);
case WKBLINESTRING:
return get_linestring("linestring");
case WKBPOLYGON:
return get_polygon("polygon");
case WKBMULTIPOINT:
{
byte b;
uint32 n, u;
uint32 n;
int i;
Functor functor;
Term *c_list;
@ -264,10 +263,10 @@ static Term get_geometry(uint32 type){
for ( i = 0; i < n; i++ ) {
/* read (and ignore) the byteorder and type */
b = get_inbyteorder();
u = get_wkbType();
get_inbyteorder();
get_wkbType();
c_list[i] = get_point(NULL);
c_list[i] = get_point(NULL PASS_REGS);
}
list = MkAtomTerm(Yap_LookupAtom("[]"));
@ -282,8 +281,7 @@ static Term get_geometry(uint32 type){
}
case WKBMULTILINESTRING:
{
byte b;
uint32 n, u;
uint32 n;
int i;
Functor functor;
Term *c_list;
@ -298,8 +296,8 @@ static Term get_geometry(uint32 type){
for ( i = 0; i < n; i++ ) {
/* read (and ignore) the byteorder and type */
b = get_inbyteorder();
u = get_wkbType();
get_inbyteorder();
get_wkbType();
c_list[i] = get_linestring(NULL);
}
@ -316,8 +314,7 @@ static Term get_geometry(uint32 type){
}
case WKBMULTIPOLYGON:
{
byte b;
uint32 n, u;
uint32 n;
int i;
Functor functor;
Term *c_list;
@ -332,8 +329,8 @@ static Term get_geometry(uint32 type){
for ( i = 0; i < n; i++ ) {
/* read (and ignore) the byteorder and type */
b = get_inbyteorder();
u = get_wkbType();
get_inbyteorder();
get_wkbType();
c_list[i] = get_polygon(NULL);
}
@ -350,7 +347,6 @@ static Term get_geometry(uint32 type){
}
case WKBGEOMETRYCOLLECTION:
{
byte b;
uint32 n;
int i;
Functor functor;
@ -365,7 +361,7 @@ static Term get_geometry(uint32 type){
for ( i = 0; i < n; i++ ) {
b = get_inbyteorder();
get_inbyteorder();
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-readline=DIR use GNU Readline Library 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-lam=DIR use LAM MPI library in DIR
--with-heap-space=space default heap size in Kbytes
@ -4860,16 +4860,16 @@ fi
# Check whether --with-mpi was given.
if test "${with_mpi+set}" = set; then :
withval=$with_mpi; if test "$withval" = yes; then
yap_cv_mpi=yes
yap_cv_lam=yes
elif test "$withval" = no; then
yap_cv_mpi=no
yap_cv_lam=no
else
yap_cv_mpi=$with_mpi
yap_cv_lam=$with_mpi
LDFLAGS="$LDFLAGS -L${yap_cv_mpi}/lib"
CPPFLAGS="$CPPFLAGS -I${yap_cv_mpi}/include"
fi
else
yap_cv_mpi=no
yap_cv_lam=no
fi

10
configure.in
View File

@ -360,18 +360,18 @@ AC_ARG_WITH(matlab,
[yap_cv_matlab=no])
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
dnl handle UBUNTU systems
yap_cv_mpi=yes
yap_cv_lam=yes
elif test "$withval" = no; then
yap_cv_mpi=no
yap_cv_lam=no
else
yap_cv_mpi=$with_mpi
yap_cv_lam=$with_mpi
LDFLAGS="$LDFLAGS -L${yap_cv_mpi}/lib"
CPPFLAGS="$CPPFLAGS -I${yap_cv_mpi}/include"
fi,
[yap_cv_mpi=no])
[yap_cv_lam=no])
AC_ARG_WITH(mpe,

4
library/lammpi/Makefile.in
View File

@ -37,8 +37,8 @@ RANLIB=@RANLIB@
srcdir=@srcdir@
SO=@SO@
CWD=$(PWD)
MPILDF=`$(MPI_CC) -showme|sed "s/[^ ]*//"|sed "s/-pt/-lpt/"`
MPICF=`$(MPI_CC) -showme| cut -d " " -f 2`
MPILDF=`$(MPI_CC) --showme:link`
MPICF=`$(MPI_CC) --showme:compile`
#
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));
STATIC_PROTO (Int p_mpi_open, (void));
STATIC_PROTO (Int p_mpi_close, (void));
STATIC_PROTO (Int p_mpi_send, (void));
STATIC_PROTO (Int p_mpi_receive, (void));
STATIC_PROTO (Int p_mpi_bcast3, (void));
STATIC_PROTO (Int p_mpi_bcast2, (void));
STATIC_PROTO (Int p_mpi_barrier, (void));
STATIC_PROTO (Int p_mpi_open, ( USES_REGS1 ));
STATIC_PROTO (Int p_mpi_close, ( USES_REGS1 ));
STATIC_PROTO (Int p_mpi_send, ( USES_REGS1 ));
STATIC_PROTO (Int p_mpi_receive, ( USES_REGS1 ));
STATIC_PROTO (Int p_mpi_bcast3, ( USES_REGS1 ));
STATIC_PROTO (Int p_mpi_bcast2, ( USES_REGS1 ));
STATIC_PROTO (Int p_mpi_barrier, ( USES_REGS1 ));
/*
* Auxiliary Data
*/
static Int rank, numprocs, namelen;
static int rank, numprocs, namelen;
static char processor_name[MPI_MAX_PROCESSOR_NAME];
static Int mpi_argc;
static int mpi_argc;
static char **mpi_argv;
/* this should eventually be moved to config.h */
@ -111,7 +111,7 @@ mpi_putc(Int ch)
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);
Int retv;
@ -156,7 +156,7 @@ Yap exit(FAILURE), whereas in Yap/LAM mpi_open/3 simply fails.
static Int /* mpi_close */
p_mpi_close()
p_mpi_close( USES_REGS1 )
{
MPI_Finalize();
return TRUE;
@ -164,7 +164,7 @@ p_mpi_close()
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);
int tag, dest, retv;
@ -216,7 +216,7 @@ p_mpi_send() /* mpi_send(+data, +destination, +tag) */
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);
int tag, orig, retv;
@ -305,7 +305,7 @@ p_mpi_receive() /* mpi_receive(-data, ?orig, ?tag) */
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);
int root, retv, max_size;
@ -386,7 +386,7 @@ p_mpi_bcast3() /* mpi_bcast( ?data, +root, +max_size ) */
*/
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);
int root, retv;
@ -460,7 +460,7 @@ p_mpi_bcast2() /* mpi_bcast( ?data, +root ) */
static Int
p_mpi_barrier() /* mpi_barrier/0 */
p_mpi_barrier( USES_REGS1 ) /* mpi_barrier/0 */
{
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]),
Ks =[Key|_],
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),
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).
ftotree(F, Fs0, Fs) :-
F = f([K|_Parents],_,_,_),
F = fn([K|_Parents],_,_,_,_),
rb_insert(Fs0, K, F, Fs).
bdd([[]],_,_) :- !.
@ -160,7 +160,7 @@ sort_keys(AllFs, AllVars, Leaves) :-
dgraph_leaves(Graph, Leaves),
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),
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([V|MoreVs], Evs, Fs, OrderVs, Vs, VsF, Ps, PsF, Lvs, Outs) -->
{ rb_lookup(V, F, Fs) }, !,
{ F = f([V|Parents], _, _, DistId) },
{ F = fn([V|Parents], _, _, DistId, _) },
%{writeln(v:DistId:Parents)},
[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),
check_key_p(DistId, F, Map, Parms, _ParmVars, Ps, Ps1),
unbound_parms(Parms, ParmVars),
F = f(_,[Size|_],_,_),
F = fn(_,[Size|_],_,_,_),
check_key(V, Size, DIST, Vs, Vs1),
DIST = info(V, Tree, Ev, Values, Formula, ParmVars, Parms),
% 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) :-
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),
length(Parms1, L0),
Sizes = [Size|_],
@ -693,7 +693,7 @@ get_parents(V.Parents, Values.PVars, Vs0, Vs) :-
get_key_parent(Fs, V, Values, Vs0, Vs) :-
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, _, 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),
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),
build_edges(Parents, V, Edges),
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) :-
use_parfactors(on), !,
pfl:get_pfl_parameters(DistId, Dist),
pfl:get_pfl_parameters(DistId, _, Dist),
length(Dist, DSize).
get_dist_domain_size(avg(D,_), DSize) :- !,
length(D, DSize).
@ -297,7 +297,7 @@ empty_dist(Dist, TAB) :-
dist_new_table(DistId, NewMat) :-
use_parfactors(on), !,
matrix_to_list(NewMat, List),
pfl:new_pfl_parameters(DistId, List).
pfl:new_pfl_parameters(DistId, _, List).
dist_new_table(Id, NewMat) :-
matrix_to_list(NewMat, List),
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
]).
:- use_module(library(maplist)).
:- use_module(library(ordsets),
[ord_subtract/3]).
@ -87,7 +89,7 @@ run_gibbs_solver(LVs, LPs, Vs) :-
initialise(LVs, Graph, GVs, OutputVars, VarOrder) :-
init_keys(Keys0),
gen_keys(LVs, 0, VLen, Keys0, Keys),
foldl2(gen_key, LVs, 0, VLen, Keys0, Keys),
functor(Graph,graph,VLen),
graph_representation(LVs, Graph, 0, Keys, TGraph),
compile_graph(Graph),
@ -99,21 +101,18 @@ initialise(LVs, Graph, GVs, OutputVars, VarOrder) :-
init_keys(Keys0) :-
rb_new(Keys0).
gen_keys([], I, I, Keys, Keys).
gen_keys([V|Vs], I0, If, Keys0, Keys) :-
clpbn:get_atts(V,[evidence(_)]), !,
gen_keys(Vs, I0, If, Keys0, Keys).
gen_keys([V|Vs], I0, If, Keys0, Keys) :-
gen_key(V, I0, I0, Keys0, Keys0) :-
clpbn:get_atts(V,[evidence(_)]), !.
gen_key(V, I0, I, Keys0, Keys) :-
I is I0+1,
rb_insert(Keys0,V,I,KeysI),
gen_keys(Vs, I, If, KeysI, Keys).
rb_insert(Keys0,V,I,Keys).
graph_representation([],_,_,_,[]).
graph_representation([V|Vs], Graph, I0, Keys, TGraph) :-
clpbn:get_atts(V,[evidence(_)]), !,
clpbn:get_atts(V, [dist(Id,Parents)]),
get_possibly_deterministic_dist_matrix(Id, Parents, _, Vals, Table),
get_sizes(Parents, Szs),
maplist(get_size, Parents, Szs),
length(Vals,Sz),
project_evidence_out([V|Parents],[V|Parents],Table,[Sz|Szs],Variables,NewTable),
% all variables are parents
@ -123,7 +122,7 @@ graph_representation([V|Vs], Graph, I0, Keys, [I-IParents|TGraph]) :-
I is I0+1,
clpbn:get_atts(V, [dist(Id,Parents)]),
get_possibly_deterministic_dist_matrix(Id, Parents, _, Vals, Table),
get_sizes(Parents, Szs),
maplist( get_size, Parents, Szs),
length(Vals,Sz),
project_evidence_out([V|Parents],[V|Parents],Table,[Sz|Szs],Variables,NewTable),
Variables = [V|NewParents],
@ -131,7 +130,7 @@ graph_representation([V|Vs], Graph, I0, Keys, [I-IParents|TGraph]) :-
reorder_CPT(Variables,NewTable,[V|SortedNVs],NewTable2,_),
add2graph(V, Vals, NewTable2, SortedIndices, Graph, Keys),
propagate2parents(NewParents, NewTable, Variables, Graph,Keys),
parent_indices(NewParents, Keys, IVariables0),
maplist(parent_index(Keys), NewParents, IVariables0),
sort(IVariables0, IParents),
arg(I, Graph, var(_,_,_,_,_,_,_,NewTable2,SortedIndices)),
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,
write_pars(Parents).
get_sizes([], []).
get_sizes([V|Parents], [Sz|Szs]) :-
get_size(V, Sz) :-
clpbn:get_atts(V, [dist(Id,_)]),
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).
get_dist_domain_size(Id, Sz).
parent_index(Keys, V, I) :-
rb_lookup(V, I, Keys).
%
% 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), !.
sort_according_to_indices(NVs,Keys,SortedNVs,SortedIndices) :-
vars2indices(NVs,Keys,ToSort),
maplist(var2index(Keys), NVs, ToSort),
keysort(ToSort, Sorted),
split_parents(Sorted, SortedNVs,SortedIndices).
maplist(split_parent, Sorted, SortedNVs,SortedIndices).
split_parents([], [], []).
split_parents([I-V|Sorted], [V|SortedNVs],[I|SortedIndices]) :-
split_parents(Sorted, SortedNVs, SortedIndices).
split_parent(I-V, V, I).
vars2indices([],_,[]).
vars2indices([V|Parents],Keys,[I-V|IParents]) :-
rb_lookup(V, I, Keys),
vars2indices(Parents,Keys,IParents).
var2index(Keys, V, I-V) :-
rb_lookup(V, I, Keys).
%
% This is the really cool bit.
%
compile_graph(Graph) :-
Graph =.. [_|VarsInfo],
compile_vars(VarsInfo,Graph).
maplist( compile_var(Graph), VarsInfo).
compile_vars([],_).
compile_vars([var(_,I,_,Vals,Sz,VarSlot,Parents,_,_)|VarsInfo],Graph)
:-
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(Graph, var(_,I,_,Vals,Sz,VarSlot,Parents,_,_)) :-
foldl2( fetch_parent(Graph), VarSlot, [], Parents, [], Sizes),
foldl( mult_list, Sizes,1,TotSize),
compile_var(TotSize,I,Vals,Sz,VarSlot,Parents,Sizes,Graph).
fetch_all_parents([],_,Parents,Parents,Sizes,Sizes) :- !.
fetch_all_parents([tabular(_,_,Ps)|CPTs],Graph,Parents0,ParentsF,Sizes0,SizesF) :-
merge_these_parents(Ps,Graph,Parents0,ParentsI,Sizes0,SizesI),
fetch_all_parents(CPTs,Graph,ParentsI,ParentsF,SizesI,SizesF).
fetch_parent(Graph, tabular(_,_,Ps), Parents0, ParentsF, Sizes0, SizesF) :-
foldl2( merge_these_parents(Graph), Ps, Parents0, ParentsF, Sizes0, SizesF).
merge_these_parents([],_,Parents,Parents,Sizes,Sizes).
merge_these_parents([I|Ps],Graph,Parents0,ParentsF,Sizes0,SizesF) :-
member(I,Parents0), !,
merge_these_parents(Ps,Graph,Parents0,ParentsF,Sizes0,SizesF).
merge_these_parents([I|Ps],Graph,Parents0,ParentsF,Sizes0,SizesF) :-
merge_these_parents(_Graph, I,Parents0,Parents0,Sizes0,Sizes0) :-
member(I,Parents0), !.
merge_these_parents(Graph, I, Parents0,ParentsF,Sizes0,SizesF) :-
arg(I,Graph,var(_,I,_,Vals,_,_,_,_,_)),
length(Vals, Sz),
add_parent(Parents0,I,ParentsI,Sizes0,Sz,SizesI),
merge_these_parents(Ps,Graph,ParentsI,ParentsF,SizesI,SizesF).
add_parent(Parents0,I,ParentsF,Sizes0,Sz,SizesF).
add_parent([],I,[I],[],Sz,[Sz]).
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).
mult_list([],Mult,Mult).
mult_list([Sz|Sizes],Mult0,Mult) :-
MultI is Sz*Mult0,
mult_list(Sizes,MultI,Mult).
mult_list(Sz,Mult0,Mult) :-
Mult is Sz*Mult0.
% compile node as set of facts, faster execution
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(_,_,_,_,_,_,_,_).
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)
->
@ -261,11 +236,9 @@ multiply_all(I,_,_,_,_) :-
% note: what matters is how this predicate instantiates the temp
% slot in the graph!
markov_blanket_instance([],_,[]).
markov_blanket_instance([I|Parents],Graph,[Pos|Values]) :-
arg(I,Graph,var(_,I,Pos,Vals,_,_,_,_,_)),
fetch_val(Vals,0,Pos),
markov_blanket_instance(Parents,Graph,Values).
markov_blanket_instance(Graph, I, Pos) :-
arg(I, Graph, var(_,I,Pos,Vals,_,_,_,_,_)),
fetch_val(Vals, 0, Pos).
% backtrack through every value in domain
%
@ -275,21 +248,19 @@ fetch_val([_|Vals],I0,Pos) :-
fetch_val(Vals,I,Pos).
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),
multiply_more(CPTs,Graph,Probs0,Probs).
fetch_parents([], _, []).
fetch_parents([P|Parents], Graph, [Val|Vals]) :-
arg(P,Graph,var(_,_,Val,_,_,_,_,_,_)),
fetch_parents(Parents, Graph, Vals).
fetch_parent(Graph, P, Val) :-
arg(P,Graph,var(_,_,Val,_,_,_,_,_,_)).
multiply_more([],_,Probs0,LProbs) :-
normalise_possibly_deterministic_CPT(Probs0, Probs),
list_from_CPT(Probs, LProbs0),
accumulate_up_list(LProbs0, 0.0, LProbs).
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),
multiply_possibly_deterministic_factors(Probs0, P0, ProbsI),
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) :-
%format('ToDo = ~d~n',[ToDo]),
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,
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),
do_sample(VarOrder,Sample,Sample0,Graph),
% 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).
do_sample([],_,_,_).
@ -439,15 +410,10 @@ pick_new_value([V|Vals],X,I0,Val) :-
pick_new_value(Vals,X,I,Val)
).
update_estimates([],_,[]).
update_estimates([Est|E0],Sample,[NEst|Ef]) :-
update_estimate(Est,Sample,NEst),
update_estimates(E0,Sample,Ef).
update_estimate([I|E],Sample,[I|NE]) :-
update_estimate(Sample, [I|E],[I|NE]) :-
arg(I,Sample,V),
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),
update_estimate_for_var(V,E,NE).
@ -481,21 +447,15 @@ clean_up.
gibbs_params(5,100,1000).
cvt2problist([], []).
cvt2problist([[[_|E]]|Est0], [Ps|Probs]) :-
sum_all(E,0,Sum),
do_probs(E,Sum,Ps),
cvt2problist(Est0, Probs) .
cvt2prob([[_|E]], Ps) :-
foldl(sum_all, E, 0, Sum),
maplist( do_prob(Sum), E, Ps).
sum_all([],Sum,Sum).
sum_all([E|Es],S0,Sum) :-
SI is S0+E,
sum_all(Es,SI,Sum).
sum_all(E, S0, Sum) :-
Sum is S0+E.
do_probs([],_,[]).
do_probs([E|Es],Sum,[P|Ps]) :-
P is E/Sum,
do_probs(Es,Sum,Ps).
do_prob(Sum, E, P) :-
P is E/Sum.
show_sorted([], _) :- nl.
show_sorted([I|VarOrder], Graph) :-
@ -506,13 +466,11 @@ show_sorted([I|VarOrder], Graph) :-
sum_up_all([[]|_], []).
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_all([MoreC|LeftChains], Dists).
extract_sums([], [], []).
extract_sums([[C|Chains]|MoreChains], [C|CurrentChains], [Chains|LeftChains]) :-
extract_sums(MoreChains, CurrentChains, LeftChains).
extract_sum([C|Chains], C, Chains).
sum_up([[_|Counts]|Chains], Dist) :-
add_up(Counts,Chains, Add),
@ -523,25 +481,21 @@ sum_up([me(_,_,Counts)|Chains], Dist) :-
add_up(Counts,[],Counts).
add_up(Counts,[[_|Cs]|Chains], Add) :-
sum_lists(Counts, Cs, NCounts),
maplist(sum, Counts, Cs, NCounts),
add_up(NCounts, Chains, Add).
add_up_mes(Counts,[],Counts).
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).
sum_lists([],[],[]).
sum_lists([Count|Counts], [C|Cs], [NC|NCounts]) :-
NC is Count+C,
sum_lists(Counts, Cs, NCounts).
sum(Count, C, NC) :-
NC is Count+C.
normalise(Add, Dist) :-
sum_list(Add, Sum),
divide_list(Add, Sum, Dist).
maplist(divide(Sum), Add, Dist).
divide_list([], _, []).
divide_list([C|Add], Sum, [P|Dist]) :-
P is C/Sum,
divide_list(Add, Sum, Dist).
divide(Sum, C, P) :-
P is C/Sum.

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

@ -32,7 +32,7 @@
[clpbn_bind_vals/3]).
:- use_module(library(pfl),
[get_pfl_parameters/2,
[get_pfl_parameters/3,
skolem/2
]).
@ -50,7 +50,7 @@ call_horus_ground_solver(QueryVars, QueryKeys, AllKeys, Factors, Evidence,
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)) :-
factors_type(Factors, Type),
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,
state(Network,Hash,Id, DistIds)) :-
state(Network,Hash,Id, _DistIds)) :-
lists_of_keys_to_ids(QueryKeys, QueryIds, Hash, _, Id, _),
%maplist(get_pfl_parameters, DistIds, DistParams),
%cpp_set_factors_params(Network, DistIds, DistParams),
%maplist(get_pfl_parameters, _DistIds, _, DistParams),
%cpp_set_factors_params(Network, _DistIds, DistParams),
cpp_run_ground_solver(Network, QueryIds, Solutions).
@ -79,7 +79,7 @@ factors_type([f(bayes, _, _)|_], bayes) :- ! .
factors_type([f(markov, _, _)|_], markov) :- ! .
get_dist_id(f(_, _, _, DistId), DistId).
get_dist_id(fn(_, _, _, DistId, _), DistId).
get_domain(_:Key, Domain) :- !,

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

@ -28,7 +28,7 @@
:- use_module(library(pfl),
[factor/6,
skolem/2,
get_pfl_parameters/2
get_pfl_parameters/3
]).
:- use_module(library(maplist)).
@ -50,9 +50,9 @@ init_horus_lifted_solver(_, AllVars, _, state(Network, 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_pfl_parameters, DistIds,DistsParams),
%maplist(get_pfl_parameters, DistIds, _, DistsParams),
%cpp_set_parfactors_params(Network, DistIds, DistsParams),
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),
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),
foldl2(key_to_id, NKeys, Ids, Hash0, Hash, I0, I),
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) :-
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,
pfl:get_pfl_parameters(Id, Pars0),
pfl:get_pfl_parameters(Id, Keys, Pars0),
init_CPT(Pars0, Sizes, CPT0),
reorder_CPT(Nodes, CPT0, 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;
assert (YAP_IsPairTerm (paramL));
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);
}
if (Globals::logDomain) {

29
packages/CLPBN/pfl.yap
View File

@ -12,8 +12,8 @@
skolem/2,
defined_in_factor/2,
get_pfl_cpt/5, % given id and keys, return new keys and cpt
get_pfl_parameters/2, % given id return par factor parameter
new_pfl_parameters/2, % given id set new parameters
get_pfl_parameters/3, % given id return par factor parameter
new_pfl_parameters/3, % given id set new parameters
get_first_pvariable/2, % given id get firt pvar (useful in bayesian)
get_factor_pvariable/2, % given id get any pvar
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)]).
%% get_pfl_cpt(Id, Keys, Ev, NewKeys, Out) :-
%% factor(_Type,Id,[Key|_],_FV,avg,_Constraints), !,
%% Keys = [Key|Parents],
%% writeln(Key:Parents),
%% avg_factors(Key, Parents, 0.0, Ev, NewKeys, Out).
get_pfl_cpt(Id, Keys, Ev, NewKeys, Out) :-
factor(_Type,Id,[Key|_],_FV,avg,_Constraints), !,
Keys = [Key|Parents],
writeln(Key:Parents),
avg_factors(Key, Parents, 0.0, Ev, NewKeys, 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) :-
factor(_Type,Id,_FList,_FV,Phi,_Constraints),
get_pfl_parameters(Id, Keys, Out) :-
factor(_Type,Id,Keys,_FV,Phi,_Constraints),
( Phi = [_|_] -> Phi = Out ; call(user:Phi, Out) ).
new_pfl_parameters(Id, NewPhi) :-
retract(factor(Type,Id,FList,FV,_Phi,Constraints)),
assert(factor(Type,Id,FList,FV,NewPhi,Constraints)),
new_pfl_parameters(Id, Keys, NewPhi) :-
retract(factor(Type,Id,Keys,FV,_Phi,Constraints)),
assert(factor(Type,Id,Keys,FV,NewPhi,Constraints)),
fail.
new_pfl_parameters(_Id, _NewPhi).
new_pfl_parameters(_Id, _Keys, _NewPhi).
get_pfl_factor_sizes(Id, DSizes) :-
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__
static inline
#endif
TERM encodefloat1(double);
TERM encodefloat1(double USES_REGS);
/* loader.c */
SYM_REC_PTR insert(const char *, int, int);
@ -272,7 +272,7 @@ TERM bpx_build_float(double x)
{
CACHE_REGS
REQUIRE_HEAP(4);
return encodefloat1(x);
return encodefloat1(x PASS_REGS);
}
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
TERM encodefloat1(double f)
TERM encodefloat1(double f USES_REGS)
{
return MkFloatTerm((Float)f);
}