This commit is contained in:
Vitor Santos Costa
2019-03-29 14:37:03 +00:00
parent de153bd479
commit 2af4dae017
3 changed files with 98 additions and 114 deletions

View File

@@ -58,11 +58,6 @@ update_query(QueryID,Symbol,What_To_Update) :-
)
).
maplist_to_hash([], H0, H0).
maplist_to_hash([I-V|MapList], H0, Hash) :-
rb_insert(H0, V, I, H1),
maplist_to_hash(MapList, H1, Hash).
prob2log(_X,Slope,FactID,V) :-
get_fact_probability(FactID, V0),
@@ -73,14 +68,11 @@ log2prob(X,Slope,FactID,V) :-
sigmoid(V0, Slope, V).
bind_maplist([], _Slope, _X).
bind_maplist([Node-Pr|MapList], Slope, X) :-
Pr <== X[Node],
bind_maplist([Node-(Node-Pr)|MapList], Slope, X) :-
SigPr <== X[Node],
sigmoid(SigPr, Slope, Pr),
bind_maplist(MapList, Slope, X).
tree_to_grad([], _, Grad, Grad).
tree_to_grad([Node|Tree], H, Grad0, Grad) :-
node_to_gradient_node(Node, H, GNode),
tree_to_grad(Tree, H, [GNode|Grad0], Grad).
%get_prob(Node, Prob) :-
% query_probability(Node,Prob), !.
@@ -97,58 +89,51 @@ gradient(_QueryID, l, _).
gradient(QueryID, g, Slope) :-
recorded(QueryID, BDD, _),
query_gradients(BDD,Slope,I,Grad),
% writeln(grad(QueryID:I:Grad)),
assert(query_gradient_intern(QueryID,I,p,Grad)),
fail.
gradient(QueryID, g, Slope) :-
gradient(QueryID, l, Slope).
query_probability( DBDD, Slope, X, Prob) :-
DBDD = bdd(Dir, Tree, MapList),
bind_maplist(MapList, Slope, X),
run_sp(Tree, Slope, 1.0, Prob0),
query_probabilities( DBDD, Prob) :-
DBDD = bdd(Dir, Tree, _MapList),
findall(P, evalp(Tree,P), [Prob0]),
(Dir == 1 -> Prob0 = Prob ; Prob is 1.0-Prob0).
evalp( Tree, Prob0) :-
foldl(evalp, Tree, _, Prob0).
query_gradients(bdd(Dir, Tree, MapList),Slope,X,I,Grad) :-
bind_maplist(MapList, Slope, X),
member(I-_, MapList),
run_grad(Tree, I, Slope, 0.0, Grad0),
( Dir = 1 -> Grad = Grad0 ; Grad is -Grad0).
node_to_gradient_node(pp(P-G,X,L,R), H, gnodep(P,G,X,Id,PL,GL,PR,GR)) :-
rb_lookup(X,Id,H),
(L == 1 -> GL=0, PL=1 ; L == 0 -> GL = 0, PL=0 ; L = PL-GL),
(R == 1 -> GR=0, PR=1 ; R == 0 -> GR = 0, PR=0 ; R = PR-GR).
node_to_gradient_node(pn(P-G,X,L,R), H, gnoden(P,G,X,Id,PL,GL,PR,GR)) :-
rb_lookup(X,Id,H),
(L == 1 -> GL=0, PL=1 ; L == 0 -> GL = 0, PL=0 ; L = PL-GL),
(R == 1 -> GR=0, PR=1 ; R == 0 -> GR = 0, PR=0 ; R = PR-GR).
run_sp([], _, P0, P0).
run_sp(gnodep(P,_G, X, _Id, PL, _GL, PR, _GR).Tree, Slope, _, PF) :-
EP = 1.0 / (1.0 + exp(-X * Slope) ),
P is EP*PL+ (1.0-EP)*PR,
run_sp(Tree, Slope, P, PF).
run_sp(gnoden(P,_G, X, _Id, PL, _GL, PR, _GR).Tree, Slope, _, PF) :-
EP is 1.0 / (1.0 + exp(-X * Slope) ),
P is EP*PL + (1.0-EP)*(1.0 - PR),
run_sp(Tree, Slope, P, PF).
run_grad([], _I, _, G0, G0).
run_grad([gnodep(P,G, X, Id, PL, GL, PR, GR)|Tree], I, Slope, _, GF) :-
EP is 1.0/(1.0 + exp(-X * Slope)),
P is EP*PL+ (1.0-EP)*PR,
G0 is EP*GL + (1.0-EP)*GR,
% don' t forget the -X
( I == Id -> G is G0+(PL-PR)* EP*(1-EP)*Slope ; G = G0 ),
run_grad(Tree, I, Slope, G, GF).
run_grad([gnoden(P,G, X, Id, PL, GL, PR, GR)|Tree], I, Slope, _, GF) :-
EP is 1.0 / (1.0 + exp(-X * Slope) ),
P is EP*PL + (1.0-EP)*(1.0 - PR),
G0 is EP*GL - (1.0 - EP) * GR,
( I == Id -> G is G0+(PL+PR-1)*EP*(1-EP)*Slope ; G = G0 ),
run_grad(Tree, I, Slope, G, GF).
query_gradients(bdd(Dir, Tree, MapList),I,IProb,Grad) :-
member(I-(_-IProb), MapList),
% run_grad(Tree, I, Slope, 0.0, Grad0),
foldl( evalg(I), Tree, _, Grad0),
( Dir == 1 -> Grad = Grad0 ; Grad is -Grad0).
evalp( pn(P, _-X, PL, PR), _,P ):-
P is X*PL+ (1.0-X)*(1.0-PR).
evalp( pp(P, _-X, PL, PR), _,P ):-
P is X*PL+ (1.0-X)*PR.
evalg( I, pp(P-G, J-X, L, R), _, G ):-
( number(L) -> PL=L, GL = 0.0 ; L = PL-GL ),
( number(R) -> PR=R, GR = 0.0 ; R = PR-GR ),
P is X*PL+ (1.0-X)*PR,
(
I == J
->
G is X*GL+ (1.0-X)*GR+PL-PR
;
G is X*GL+ (1.0-X)*GR
).
evalg( I, pn(P-G, J-X, L, R), _,G ):-
( number(L) -> PL=L, GL = 0.0 ; L = PL-GL ),
( number(R) -> PR=R, GR = 0.0 ; R = PR-GR ),
P is X*PL+ (1.0-X)*(1.0-PR),
(
I == J
->
G is X*GL-(1.0-X)*GR+PL-(1-PR)
;
G is X*GL- (1.0-X)*GR
).