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

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
This commit is contained in:
vsc 2008-06-05 16:24:08 +00:00
parent 2a0d6480c9
commit 5d49f14545
8 changed files with 57 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
C/iopreds.c
View File

@ -63,10 +63,12 @@ static char SccsId[] = "%W% %G%";
/* for O_BINARY and O_TEXT in WIN32 */
#include <fcntl.h>
#endif
#ifdef _WIN32
#if HAVE_IO_H
/* Windows */
#include <io.h>
#endif
#endif
#if !HAVE_STRNCAT
#define strncat(X,Y,Z) strcat(X,Y)
#endif

2
C/save.c
View File

@ -132,9 +132,11 @@ STATIC_PROTO(void NewFileInfo, (long, long));
extern int DefVol;
#endif
#ifdef _WIN32
#if HAVE_IO_H
#include <io.h>
#endif
#endif
#ifdef LIGHT

2
C/tracer.c
View File

@ -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

2
C/ypsocks.c
View File

@ -36,9 +36,11 @@
#if HAVE_SYS_TIME_H && !defined(__MINGW32__) && !_MSC_VER
#include <sys/time.h>
#endif
#ifdef _WIN32
#if HAVE_IO_H
#include <io.h>
#endif
#endif
#if _MSC_VER || defined(__MINGW32__)
#include <io.h>
#include <winsock2.h>

38
CLPBN/clpbn/dists.yap
View File

@ -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),

2
CLPBN/clpbn/jt.yap
View File

@ -1,4 +1,6 @@
:- module(jt, [jt/3]).
:- use_module(library(dgraphs),
[dgraph_new/1,

4
CLPBN/clpbn/matrix_cpt_utils.yap
View File

@ -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),

36
library/rbtrees.yap
View File

@ -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
%