From 5d49f145450cee5b3bec1cb814bb2d502a55abb7 Mon Sep 17 00:00:00 2001 From: vsc Date: Thu, 5 Jun 2008 16:24:08 +0000 Subject: [PATCH] fix rbtrees built from ordered lists fix jt be more flexible about unbound parents git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2260 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- C/iopreds.c | 2 ++ C/save.c | 2 ++ C/tracer.c | 2 ++ C/ypsocks.c | 2 ++ CLPBN/clpbn/dists.yap | 38 ++++++++++++++++++-------------- CLPBN/clpbn/jt.yap | 2 ++ CLPBN/clpbn/matrix_cpt_utils.yap | 4 +++- library/rbtrees.yap | 36 +++++++++++++++++++----------- 8 files changed, 57 insertions(+), 31 deletions(-) diff --git a/C/iopreds.c b/C/iopreds.c index 5635873bd..feaa5fcd7 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -63,10 +63,12 @@ static char SccsId[] = "%W% %G%"; /* for O_BINARY and O_TEXT in WIN32 */ #include #endif +#ifdef _WIN32 #if HAVE_IO_H /* Windows */ #include #endif +#endif #if !HAVE_STRNCAT #define strncat(X,Y,Z) strcat(X,Y) #endif diff --git a/C/save.c b/C/save.c index 5ef84dd38..29c039c5e 100644 --- a/C/save.c +++ b/C/save.c @@ -132,9 +132,11 @@ STATIC_PROTO(void NewFileInfo, (long, long)); extern int DefVol; #endif +#ifdef _WIN32 #if HAVE_IO_H #include #endif +#endif #ifdef LIGHT diff --git a/C/tracer.c b/C/tracer.c index 52e8a6e4d..0a0fe0b4b 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -164,6 +164,8 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) LOCK(Yap_heap_regs->low_level_trace_lock); sc = Yap_heap_regs; vsc_count++; + if (vsc_count < 67689000LL) + return; #ifdef THREADS Yap_heap_regs->thread_handle[worker_id].thread_inst_count++; #endif diff --git a/C/ypsocks.c b/C/ypsocks.c index e66c3ca0f..0089cc003 100644 --- a/C/ypsocks.c +++ b/C/ypsocks.c @@ -36,9 +36,11 @@ #if HAVE_SYS_TIME_H && !defined(__MINGW32__) && !_MSC_VER #include #endif +#ifdef _WIN32 #if HAVE_IO_H #include #endif +#endif #if _MSC_VER || defined(__MINGW32__) #include #include diff --git a/CLPBN/clpbn/dists.yap b/CLPBN/clpbn/dists.yap index 1a3475fa4..f441b96a3 100644 --- a/CLPBN/clpbn/dists.yap +++ b/CLPBN/clpbn/dists.yap @@ -29,7 +29,6 @@ matrix_to_list/2, matrix_to_logs/1]). - /* :- mode dist(+, -). @@ -83,20 +82,23 @@ new_id(Id) :- dists(X) :- id(X1), X is X1-1. dist(V, Id, Parents) :- - var(V), !, - freeze(V, dist(V, Id, Parents)). -dist(p(Type, CPT, Parents), Id, FParents) :- - when( - (ground(Type), ground(CPT)) - , - distribution(Type, CPT, Id, Parents, FParents) - ). + dist_unbound(V, Culprit), !, + when(Culprit, dist(V, Id, Parents)). dist(p(Type, CPT), Id, FParents) :- - when( - (ground(Type), ground(CPT)) - , - distribution(Type, CPT, Id, [], FParents) - ). + distribution(Type, CPT, Id, [], FParents). +dist(p(Type, CPT, Parents), Id, FParents) :- + distribution(Type, CPT, Id, Parents, FParents). + +dist_unbound(V, ground(V)) :- + var(V), !. +dist_unbound(p(Type,CPT), ground(Type)) :- + \+ ground(Type), !. +dist_unbound(p(_,CPT), ground(CPT)) :- + \+ ground(CPT). +dist_unbound(p(Type,CPT,_), ground(Type)) :- + \+ ground(Type), !. +dist_unbound(p(_,CPT,_), ground(CPT)) :- + \+ ground(CPT). distribution(bool, trans(CPT), Id, Parents, FParents) :- is_list(CPT), !, @@ -149,9 +151,10 @@ add_dist(Domain, Type, CPT, Parents, Id) :- record_parent_sizes([], Id, [], DSizes) :- recordz(clpbn_dist_psizes,db(Id, DSizes),_). record_parent_sizes([P|Parents], Id, [Size|Sizes], DSizes) :- - clpbn:get_atts(P,dist(Dist,_)), + clpbn:get_atts(P,dist(Dist,_)), !, get_dist_domain_size(Dist, Size), record_parent_sizes(Parents, Id, Sizes, DSizes). +record_parent_sizes([_|_], _, _, _). % % Often, * is used to code empty in HMMs. @@ -180,7 +183,6 @@ get_dsizes([P|Parents], [Sz|Sizes], Sizes0) :- get_dist_domain_size(Dist, Sz), get_dsizes(Parents, Sizes, Sizes0). - get_dist_params(Id, Parms) :- recorded(clpbn_dist_db, db(Id, Parms, _, _, _, _), _). @@ -214,8 +216,10 @@ get_evidence_from_position(El, Id, Pos) :- dist_to_term(_Id,_Term). empty_dist(Dist, TAB) :- - recorded(clpbn_dist_psizes,db(Dist, DSizes),_), + recorded(clpbn_dist_psizes,db(Dist, DSizes),_), !, matrix_new(floats, DSizes, TAB). +empty_dist(Dist, TAB) :- + throw(error(domain_error(no_distribution,Dist),empty_dist(Dist,TAB))). dist_new_table(Id, NewMat) :- matrix_to_list(NewMat, List), diff --git a/CLPBN/clpbn/jt.yap b/CLPBN/clpbn/jt.yap index a3de32781..24eae6a05 100644 --- a/CLPBN/clpbn/jt.yap +++ b/CLPBN/clpbn/jt.yap @@ -1,4 +1,6 @@ +:- module(jt, [jt/3]). + :- use_module(library(dgraphs), [dgraph_new/1, diff --git a/CLPBN/clpbn/matrix_cpt_utils.yap b/CLPBN/clpbn/matrix_cpt_utils.yap index b22e3c9c7..a89c85a07 100644 --- a/CLPBN/clpbn/matrix_cpt_utils.yap +++ b/CLPBN/clpbn/matrix_cpt_utils.yap @@ -32,7 +32,9 @@ matrix_to_exps/1, matrix_to_logs/1, matrix_set_all_that_disagree/5, - matrix_to_list/2]). + matrix_to_list/2, + matrix_agg_lines/3, + matrix_op_to_lines/4]). init_CPT(List, Sizes, TAB) :- matrix_new(floats, Sizes, List, TAB), diff --git a/library/rbtrees.yap b/library/rbtrees.yap index 93fab6565..27965bdb8 100644 --- a/library/rbtrees.yap +++ b/library/rbtrees.yap @@ -249,8 +249,8 @@ apply(black(Left,Key0,Val0,Right), Key, Goal, -> NewLeft = Left, NewRight = Right, call(Goal,Val0,Val) - ; Cmp == (>) -> - NewRight = Right, + ; Cmp == (>) + -> NewRight = Right, Val = Val0, apply(Left, Key, Goal, NewLeft) ; @@ -431,7 +431,7 @@ fix_left(black(red(red(Al,KA,VA,Be),KB,VB,Ga),KC,VC,De), black(red(Al,KA,VA,Be),KB,VB,red(Ga,KC,VC,De)), done) :- !. % -% case 4 of RB: nothig to do +% case 4 of RB: nothing to do % fix_left(T,T,done). @@ -498,7 +498,8 @@ rb_delete(t(Nil,T), K, t(Nil,NT)) :- % Val associated with the key and a new tree TN. rb_delete(t(Nil,T), K, V, t(Nil,NT)) :- - delete(T, K, V, NT, _). + delete(T, K, V0, NT, _), + V = V0. % % I am afraid our representation is not as nice for delete @@ -864,27 +865,31 @@ list_to_rbtree(List, t(Nil,Tree)) :- % T is the red-black tree corresponding to the mapping in ordered % list L. +ord_list_to_rbtree([], t(Nil,Nil)) :- !, + Nil = black([], [], [], []). ord_list_to_rbtree(List, t(Nil,Tree)) :- Nil = black([], [], [], []), Ar =.. [seq|List], functor(Ar,_,L), - construct_rbtree(1, L, Ar, black, Nil, Tree). + Height is integer(log(L)/log(2)), + construct_rbtree(1, L, Ar, Height, Nil, Tree). construct_rbtree(L, M, _, _, Nil, Nil) :- M < L, !. -construct_rbtree(L, L, Ar, Color, Nil, Node) :- !, +construct_rbtree(L, L, Ar, Depth, Nil, Node) :- !, arg(L, Ar, K-Val), - build_node(Color, Nil, K, Val, Nil, Node, _). -construct_rbtree(I0, Max, Ar, Color, Nil, Node) :- + build_node(Depth, Nil, K, Val, Nil, Node). +construct_rbtree(I0, Max, Ar, Depth, Nil, Node) :- I is (I0+Max)//2, arg(I, Ar, K-Val), - build_node(Color, Left, K, Val, Right, Node, NewColor), + build_node(Depth, Left, K, Val, Right, Node), I1 is I-1, - construct_rbtree(I0, I1, Ar, NewColor, Nil, Left), + NewDepth is Depth-1, + construct_rbtree(I0, I1, Ar, NewDepth, Nil, Left), I2 is I+1, - construct_rbtree(I2, Max, Ar, NewColor, Nil, Right). + construct_rbtree(I2, Max, Ar, NewDepth, Nil, Right). -build_node(black, Left, K, Val, Right, black(Left, K, Val, Right), red). -build_node(red, Left, K, Val, Right, red(Left, K, Val, Right), black). +build_node( 0, Left, K, Val, Right, red(Left, K, Val, Right)) :- !. +build_node( _, Left, K, Val, Right, black(Left, K, Val, Right)). %% rb_size(+T, -Size) is det. @@ -916,6 +921,11 @@ is_rbtree(t(Nil,Nil)) :- !. is_rbtree(t(_,T)) :- catch(rbtree1(T), msg(_,_), fail). +is_rbtree(X,_) :- + var(X), !, fail. +is_rbtree(T,Goal) :- + catch(rbtree1(T), msg(S,Args), (format('when doing ~w~n got ~w',[Goal,T]), format(S,Args), trace, Goal)). + % % This code checks if a tree is ordered and a rbtree %