You selected dtree0.pl
headline:-
write('% -------------------------------------------- %'),nl,
write('% simple decision tree analysis on Prolog %'),nl,
write('% -------------------------------------------- %'),nl,
h0.
h0:-
write('% expected_value_of(X,Eq,V):- '),nl,
write('% evaluate a project or decision tree.'),nl,
write('% roll_back([r|X],H,V):- '),nl,
write('% evaluate optimal path for decision tree.'),nl,
write('% is_an_optimap_path(A,H,V):- '),nl,
write('% same as above.'),nl,
write('% and '),nl,
write('% h0:- this.'),nl.
me:-
write('% file: dtree0.pl.'),nl,
write('% created: 21 Feb 2003.'),nl,
write('% modified: 22 Feb 2003.'),nl,
write('% author: Kenryo INDO (Kanto Gakuen University) '),nl,
write('% url: http://www.us.kanto-gakuen.ac.jp/indo/front.html'),nl.
:- headline.
%
%-----------------------------------------------------
% decision tree representation of sequential choice
%-----------------------------------------------------
% an example of decision tree
%-----------------------------------------------------
decision_tree(node(r),parent(null),choice([node(a),node(b)]),delay([0,0])).
decision_tree(node(a),parent(r),chance([node(c),node(d)]),prob([0.5,0.5])).
decision_tree(node(b),parent(r),choice([node(e),node(f)]),delay([0,1])).
decision_tree(node(f),parent(b),chance([node(c),node(e)]),prob([0.2,0.8])).
decision_tree(node(c),payoff(10)).
decision_tree(node(d),payoff(0)).
decision_tree(node(e),payoff(4)).
figure(1):-
write('% r a 0.5 '),nl,
write('% -------[ ]--------------( )--------* c(10) '),nl,
write('% | | '),nl,
write('% | 0.5| '),nl,
write('% b| e * d(0) '),nl,
write('% [ ]------* e(4) '),nl,
write('% | '),nl,
write('% f| 0.2 '),nl,
write('% ( )------* c(10) '),nl,
write('% | '),nl,
write('% 0.8| '),nl,
write('% * e(4) '),nl,
write('%'),nl,
write('% Figure 1. a decision tree.'),nl.
%
% recursive expected values in decision tree
%---------------------------------------------
expected_value_of(node(N),E,V):-
decision_tree(node(N),payoff(E)),
V is E.
expected_value_of(node(N),Eq,V):-
decision_tree(node(N),_,_,_),
expected_value_of_0(node(N),Eq,V).
expected_value_of_0(node(N),Eq,V):-
decision_tree(node(N),parent(_),choice(C),delay(_F)),
optimal_choice(C,_Y,Eq,V),
!.
expected_value_of_0(node(N),Eq,V):-
decision_tree(node(N),parent(_),chance(X),prob(P)),
findall(U1,
(
member(B,X),
expected_value_of(B,U1,_)
),
U),
p_expected_value_eq(P,U,_,Eq0),
npv_of_node(N,_A,Eq0,Eq),
V is Eq.
%
%---------------------------------------------------
% net present value (NPV)
%---------------------------------------------------
%
% time preference: discount factor
%---------------------------------------------
interest_rate(1.1).
discount_factor(_,0,1,1).
discount_factor(R,Y,DF,DFV):-
\+ Y is 0,
DF = R ^ (-Y),
DFV is DF.
npv(A,Y,Eq,V):-
interest_rate(R),
discount_factor(R,Y,DF,_),
(Y = 0 -> Eq = A; Eq = DF * A),
V is Eq.
npv_of_node(N,A,Eq0,Eq):-
(
decision_tree(node(N),parent(A),_,_);
decision_tree(node(N),payoff(Eq0))
),
(
decision_tree(node(A),parent(_),choice(C),delay(F))
->
(
nth1(K,C,node(N)),
nth1(K,F,Y),
npv(Eq0,Y,Eq,_V)
)
; Eq = Eq0
).
%
%---------------------------------------------
% choice problem (of project and so on)
%---------------------------------------------
do_or_not(X):-
do_or_not(X,_EqV,_V).
do_or_not(X,EqV,V):-
expected_value_of(X,EqV,V),
V > 0.
optimal_choice(Y,X):-
optimal_choice(Y,X,_EqV,_V).
optimal_choice([X],X,EqV,V):-
expected_value_of(X,EqV,V).
optimal_choice([X|Y],Z,Eq,V):-
optimal_choice(Y,Z1),
expected_value_of(Z1,Eq1,_V1),
expected_value_of(X,EqX,Vx),
V is max(EqX, Eq1),
(Vx >= V -> Z = X; Z = Z1),
(Vx >= V -> Eq = EqX; Eq = Eq1).
%
%---------------------------------------------
% optimal path of decision tree : a roll back
%---------------------------------------------
roll_back([N],[terminal],[X]):-
decision_tree(node(N),payoff(X)).
roll_back([N|[Y|H]],[choice|W],[EV|Q]):-
decision_tree(node(N),parent(_),choice(X),delay(_F)),
optimal_choice(X,node(Y),EV,_V),
roll_back([Y|H],W,Q).
roll_back([N|[Y|H]],[chance|W],[PY*EV|Q]):-
decision_tree(node(N),parent(_),chance(X),prob(P)),
nth1(K,X,node(Y)),
nth1(K,P,PY),
expected_value_of(node(Y),EV,_V),
roll_back([Y|H],W,Q).
is_an_optimal_path([N|H],W,Q):-
decision_tree(node(N),parent(null),_),
roll_back([N|H],W,Q).
%
% ----------------------------------------------------------- %
% Arithmetic and so on including probabilistic operators
% ----------------------------------------------------------- %
%
% max,min
% ----------------------------------------------------------- %
max_of(X,[X]).
max_of(Z,[X|Y]):-
max_of(Z1,Y),
(X > Z1 -> Z=X; Z=Z1).
min_of(X,[X]).
min_of(Z,[X|Y]):-
min_of(Z1,Y),
(X < Z1 -> Z=X; Z=Z1).
% count frequency of occurence of the specified value of variable, M.
% ----------------------------------------------------------- %
% note: Both of M and L have to be specified.
counter(N,M,L):-
length(L,_),
findall(M,member(M,L),Mx),
length(Mx,N).
% sum
% ----------------------------------------------------------- %
sum([],0).
sum([X|Members],Sum):-
sum(Members,Sum1),
%number(X),
Sum is Sum1 + X.
%
% product
% ----------------------------------------------------------- %
product([],1).
product([X|Members],Z):-
product(Members,Z1),
%number(X),
Z is Z1 * X.
%
% weighted sum
% ----------------------------------------------------------- %
product_sum([],[],[],0).
product_sum([P|Q],[A|B],[E|F],V):-
length(Q,N),
length(B,N),
product_sum(Q,B,F,V1),
E is P * A,
V is V1 + E.
product_sum_eq([],[],[],0,0).
product_sum_eq([P|Q],[A|B],[E|F],V,Vq):-
length(Q,N),
length(B,N),
product_sum_eq(Q,B,F,V1,Vq1),
Eq = (P) * A,
E is Eq,
(Vq1=0 -> Vq = Eq; Vq = Vq1 + Eq),
V is V1 + E.
%
% allocation
% ----------------------------------------------------------- %
allocation(N,A,[X|Y]):-
allocation(N,A,A,[X|Y]).
allocation(0,_,0,[]).
allocation(N,A,B,[X|Y]):-
integer(A),
length([X|Y],N),
allocation(_N1,A,B1,Y),
% N1 is N - 1,
% sum(Y,B1),
K is A - B1 + 1,
length(L,K),
nth0(X,L,X),
B is B1 + X.
%
% probability (percentile) by using allocation
% ----------------------------------------------------------- %
probabilities(0,[]).
probabilities(N,[X|Y]):-
integer(N),
length([X|Y],N),
allocation(N,100,[X|Y]).
%
% any ratio (weight) can be interpreted into a prob.
%---------------------------------------------
scale(W,1/Z,P):-
findall(Y,(nth1(_K,W,X),Y is X/Z),P).
probabilities(W,N,P):-
length(W,N),
sum(W,Z),
scale(W,1/Z,P).
%
% degenerate probability
%---------------------------------------------
degenerate(Ps):-
nth1(K,Ps,P),
characteristic_vector(K,P,Ps,Ps).
%
% probablity distribution with step values.
%---------------------------------------------
make_a_prob(P,base(M),steps(L)):-
var(P),
length(P,M),
allocation(M,L,W),
probabilities(W,M,P).
make_a_prob(P,base(M),_):-
\+ var(P),
length(P,M),
\+ (
member(P1,P),
(
var(P1);
P1 > 1;
P1 < 0
)
),
sum(P,1).
%
% expected value
% ----------------------------------------------------------- %
p_expected_value(W,A,E):-
length(A,N),
probabilities(W,N,P),
product_sum(P,A,_,E).
p_expected_value_eq(W,A,E,Eq):-
length(A,N),
probabilities(W,N,P),
product_sum_eq(P,A,_,E,Eq).
%
% ----------------------------------------------------------- %
% Utilities for list operations
% ----------------------------------------------------------- %
%
%
% descending/ascending natural number sequence less than N.
% ----------------------------------------------------------- %
dnum_seq([],N):-N<0,!.
dnum_seq([0],1).
dnum_seq([A|Q],N):-
A is N - 1,
length(Q,A),
dnum_seq(Q,A).
anum_seq(Aseq,N):-dnum_seq(Dseq,N),sort(Dseq,Aseq).
%
% inquire the goal multiplicity
% ----------------------------------------------------------- %
sea_multiple(Goal,Cond,N,M):-
Clause=..Goal,
findall(Cond,Clause,Z),length(Z,N),sort(Z,Q),length(Q,M).
%
% bag0/3 : allow multiplicity
% ----------------------------------------------------------- %
bag0([],_A,0).
bag0([C|B],A,N):-length([C|B],N),bag0(B,A,_N1),%N is N1 + 1,
member(C,A).
%
% bag1/3 : do not allow multiplicity
% ----------------------------------------------------------- %
% modified: 15 Oct 2002. bag fixed for unboundness.
bag1([],_A,0).
bag1([C|B],A,N1):-
\+var(A),
length(A,L),
asc_nnseq(Q,L),
member(N,Q),
length(B,N),bag1(B,A,N),N1 is N + 1,
member(C,A),\+member(C,B).
%
% ordering/3
% ----------------------------------------------------------- %
ordering(A,B,C):-bag1(A,B,C).
zeros(Zero,N):-bag0(Zero,[0],N).
ones(One,N):-bag0(One,[1],N).
%
% subset_of/3 : subset-enumeration
% ----------------------------------------------------------- %
subset_of(A,N,As):-
length(As,L),
length(D,L),
list_projection(D,As,B),
length(B,N),
sort(B,A).
% a sequence of binary choice for a list:
%--------------------------------------------------
list_projection([],[],[]).
list_projection([X|Y],[_A|B],C):-
X = 0,
list_projection(Y,B,C).
list_projection([X|Y],[A|B],[A|C]):-
X = 1,
list_projection(Y,B,C).
%
% characteristic_vector/3
% ----------------------------------------------------------- %
% modified: 8 Feb 2003. without using nth1.
% modified: 13 Feb 2003. bug fix. without using member.
characteristic_vector(X,B,Index):-
\+ var(B),
%member(X,B),
list_projection(Index,B,[X]).
characteristic_vector(1,X,[X|B],[1|DX]):-
characteristic_vector(X,[X|B],[1|DX]).
characteristic_vector(K,X,[_|B],[0|DX]):-
characteristic_vector(K1,X,B,DX),
K is K1 + 1.
%end
%
return to front page.