You selected cpb.pl
headline:-
write('% ------------------------------------------ %'),nl,
write('% simulating interactive belief systems. %'),nl,
write('% ------------------------------------------ %'),nl,
h0.
h0:-
write('% p_belief(J,P,E,B):- probabilistic_belief,'),nl,
write('% self_evident(p_belief(J,P,E,B)):- s.e.p-b.,'),nl,
write('% cpb(P,E,B):- common_p_belief,'),nl,
write('% mpb([J1,J2],P,E,H):- mutual_p_belief,'),nl,
write('% kmpb(K,Pair,P,E,[H|F]):- k-th order mutual_p_belief,'),nl,
write('% bp(J,Q,E):- belief_potential on event,'),nl,
write('% bp(Q):- belief_potential of information system,'),nl,
write('% bp1(Q):- belief_potential_1, a faster version,'),nl,
write('% and '),nl,
write('% h0:- this.'),nl.
me:-
write('% file: cpb.pl.'),nl,
write('% imported from:ck01.pl'),nl,
write('% imported from:trade.pl'),nl,
write('% imported from:nash1.pl'),nl,
write('% created: 26-29 Jan 2003.'),nl,
write('% modified: 1 Feb 2003.'),nl,
write('% author: Kenryo INDO (Kanto Gakuen University) '),nl,
write('% url: http://www.us.kanto-gakuen.ac.jp/indo/front.html'),nl.
references:-
write('% references:'),nl,
write('% [1] Aumann, R. J. and A. Brandenburger (1995). '),nl,
write('% epistemic conditions for Nash equilibrium.'),nl,
write('% Econometrica 63(5): 1161-1180.'),nl,
write('% [2] Geanakoplos, J. (1992). Common knowledge.'),nl,
write('% Journal of Economic Perspective 6: 53-82.'),nl,
write('% also in R. J. Aumann and S. Hart (eds.),'),nl,
write('% Handbook of Game Theory 2: 1437-1496, 1994.'),nl,
write('% [3] Milgrom, P. and N. Stokey (1982). Information, trade '),nl,
write('% and common knowledge. Journal of Economic Theory 26: 17-27.'),nl,
write('% [4] Monderer, D. and D. Samet (1989). Approximating common knowledge'),nl,
write('% with common beliefs.Games and Economic Behavior 1: 170-190.'),nl,
write('% [5] Morris, S. , R. Rob and H.S. Shin(1995). p-dominance %'),nl,
write('% and belief potential. Econometrica 63(1): 145-157.'),nl,
nl.
:- dynamic true_state/1.
:- dynamic said/3.
:- dynamic said/4.
:- dynamic bp_data/3.
:- dynamic precision/1.
:- dynamic game/4.
current_model(ms).
:- headline.
% alias
pb(J,P,E,B):-
probabilistic_belief(J,P,E,B).
cpb(P,E,B):-
common_p_belief(P,E,B).
mpb(Pair,P,E,H):-
mutual_p_belief(Pair,P,E,H).
kmpb(K,Pair,P,E,[H|F]):-
kth_mutual_p_belief(K,Pair,P,E,[H|F]).
lmpb(K,Pair,P,E,[H|F]):-
lim_mutual_p_belief(K,Pair,P,E,[H|F]).
bp(J,Q,E,D):-
belief_potential(J,Q,E,D).
bp(J,Q,E):-
belief_potential(J,Q,E).
bp(Q):-
belief_potential(Q).
cep(E,H,P):-
conditional_event_probability(E,H,P).
bp1(Q):-
belief_potential_1(Q).
bp1(J,Q,E):-
belief_potential_1(J,Q,E).
bp1(J,Q,E,B):-
belief_potential_1(J,Q,E,B).
bp1(J,Q,E,B,D):-
belief_potential_1(J,Q,E,B,D).
%
% ------------------------------------------------- %
% some (local) utilities for probabilistic operations
% ------------------------------------------------- %
precision(100).
make_a_prob(N0,P):-
number(P),
precision(N0),
P =< 1,
P >= 0.
make_a_prob(N0,P):-
var(P),
precision(N0),
N1 is N0 + 1,
length(L,N1),
nth0(K,L,K),
P is K / N0.
quotient_prob(user,R, P):-
(var(R)->read(R1);true),
(
R1 = Q1/Q0
->
R = Q1/Q0
;
quotient_prob(user,R, P)
),
P is R.
%
conditional_event_probability(E,H,P):-
event(E),
event(H),
H \= [],
intersection(E,H,F),
probability_of_event(_,H,P0),
(P0 = 0 -> (nl,write('-- measure 0 --'),nl,fail);true),
probability_of_event(bp1,F,P1),
P is P1 / P0.
%
% ------------------------------------------------- %
% ex. an information system
% in Monderer and Samet(1989)
% ------------------------------------------------- %
%
agent(J):-all_agents(Is),member(J,Is).
state(S):-all_states(Ss),member(S,Ss).
all_agents([1,2]).
all_states([s1,s2,s3,s4,s5,s6,s7,s8,s9]).
partition(1,S,[s1,s2,s3]):-member(S,[s1,s2,s3]).
partition(1,S,[s4,s5,s6]):-member(S,[s4,s5,s6]).
partition(1,S,[s7,s8,s9]):-member(S,[s7,s8,s9]).
partition(2,S,[s1,s4,s7]):-member(S,[s1,s4,s7]).
partition(2,S,[s2,s5,s8]):-member(S,[s2,s5,s8]).
partition(2,S,[s3,s6,s9]):-member(S,[s3,s6,s9]).
prob(bp1,s1, 1/21).
prob(bp1,s2, 1/7).
prob(bp1,s3, 1/7).
prob(bp1,s4, 1/7).
prob(bp1,s5, 1/21).
prob(bp1,s6, 1/7).
prob(bp1,s7, 1/7).
prob(bp1,s8, 1/7).
prob(bp1,s9, 1/21).
%
probability(bp1,S, R):-
prob(bp1,S, P/Q),
R is P / Q.
%
% ------------------------------------------------- %
% @common p-belief(Monderer and Samet,1989)
% ------------------------------------------------- %
/*
E is a probabilistic belief of an agent if
BE = {s| prob(E|partition(j,s))>=p}.
E is a common p-belief at s if
E is a subset of BE for each agent i.
*/
%
common_p_belief(P,E,B):-
event(E),
E\=[],
(
make_a_prob(_,P)
),
forall(
agent(J),
self_evident(p_belief(J,P,E,B))
),
p_belief(1,P,E,B).
self_evident(p_belief(J,P,E,B)):-
agent(J),
event(E),
(
make_a_prob(_,P)
),
p_belief(J,P,E,B),
subset(E,B).
%
p_belief(J,P,E,B):-
probabilistic_belief(J,P,E,B).
probabilistic_belief(J,P,E,B):-
agent(J),
event(E),
(
make_a_prob(_,P)
),
findall(S,
(
partition(J,S,H),
conditional_event_probability(E,H,Q),
%nl,write((partition(J,S,H),Q)),
Q >= P
),
B0),
sort(B0,B).
%
% ------------------------------------------------- %
% belief potential(Morris, Rob, and Shin, 1995)
% ---- a numerical computation
% ------------------------------------------------- %
/*
let H<1,p>E = union(B<1,p>B<2,p>E,E).
sigma(E) is the belief potential of E if
sigma(E)
= max{p|finite k, H<1,p>^k E atains all states.}.
sigma* is the belief potential if
sigma* = min (sigma(nonnul_partitions)).
*/
%
ordered_pair_of_agent([J1,J2]):-
agent(J1),
agent(J2),
J2 \=J1.
mutual_p_belief([J1,J2],P,E,H):-
ordered_pair_of_agent([J1,J2]),
event(E),
%E\=[],
p_belief(J2,P,E,B1),
p_belief(J1,P,B1,B),
union(E,B,H0),
sort(H0,H).
kth_mutual_p_belief(1,[J1,J2],P,E,[H]):-
mutual_p_belief([J1,J2],P,E,H).
kth_mutual_p_belief(K,[J1,J2],P,E,[H|F]):-
kth_mutual_p_belief(K1,[J1,J2],P,E,F),
K is K1 + 1,
mutual_p_belief([J1,J2],P,E,H).
lim_mutual_p_belief(K,[J1,J2],P,E,[H|F]):-
kth_mutual_p_belief(K1,[J1,J2],P,E,[H|[H|F]]),
K is K1 - 1,
!.
%
belief_potential(J,Q,E):-
belief_potential(J,Q,E,yes),
update_bp_data(J,Q,E).
belief_potential(J,P,E,D):-
(var(P)->true; event(E)),
make_a_prob(N0,P),
lim_mutual_p_belief(_Y0,[J,_],P,E,[H0|_]),
all_states(O),
(H0 \= O -> D = down;
(
nl, write(lmpb(_Y0,J,P,E,all_states_reachable)),
P1 is P + 1 / N0,
lim_mutual_p_belief(_,[J,_],P1,E,[H1|_]),
(
H1 \= O
->
(
D = yes
,nl, write(lmpb(_Y0,J,P1,E,H1))
)
; D = up
)
)
),
!.
update_bp_data(J,Q,E):-
(
clause(bp_data(J,_,E),true)
->
retract(bp_data(J,_,E))
;
true
),
assert(bp_data(J,Q,E)),
nl,write(update_bp_data(J,Q,E)).
belief_potential(Q):-
setof((J,H),J^S^partition(J,S,H),Hs),
forall(
(
agent(J),
member((J,H),Hs),
H \= []
),
(
belief_potential(J,P,H),
% if user specified a Q value.
(var(Q)->true; P >= Q)
)
),
bagof(P,
J^E^(
member((J,E),Hs),
bp_data(J,P,E),
nl,write(bp(J,P,E))
),
Qs),
member(Q,Qs),
\+ (member(P1,Qs),P1= 1 / N0,
belief_potential(J,Q,E,D).
belief_potential_1(_,_,_,_,yes).
update_target(up,Q/[L,U],Q1/[L1,U1]):-
Q is (L + U) /2,
L1 = Q,
U1 = U,
Q1 is (L1 + U1) /2.
update_target(down,Q/[L,U],Q1/[L1,U1]):-
Q is (L + U) /2,
L1 = L,
U1 = Q,
Q1 is (L1 + U1) /2.
belief_potential_1(P):-
(var(Q)->true; P is Q),
setof((J,H),J^S^partition(J,S,H),Hs),
forall(
(
agent(J),
member((J,H),Hs),
H \= []
),
belief_potential_1(J,P,H)
),
bagof(Q,
J^E^(
member((J,E),Hs),
bp_data(J,Q,E),
nl,write(bp(J,Q,E))
),
Qs),
member(P,Qs),
\+ (member(P1,Qs),P1= P,
%nl,tab(1),write(mix(M)),
defeated_by(mixed(G),J,N,[M,_V],_D)
,nl,tab(2),write(nbr(defeated_by(J,[M,_V],_D)))
).
%
% a game in Monderer and Samet(1989)
% ------------------------------------------------- %
state_of_game(ms,s1).
game(ms(s1),payoff,[t,l],[7,7]).
game(ms(s1),payoff,[t,c],[0,0]).
game(ms(s1),payoff,[t,r],[0,0]).
game(ms(s1),payoff,[m,l],[0,0]).
game(ms(s1),payoff,[m,c],[2,2]).
game(ms(s1),payoff,[m,r],[7,0]).
game(ms(s1),payoff,[d,l],[0,0]).
game(ms(s1),payoff,[d,c],[0,7]).
game(ms(s1),payoff,[d,r],[8,8]).
game(ms(s1),
form(standard),
players([1,2]),
acts([(1,[t,m,d]), (2,[l,c,r])])).
%
%*********************************
/* cited and modified from nash1.pl */
%*********************************
%
% game forms
% ----------------------------------------------------------- %
game(G,players(N),acts(A),payoffs(P)):-
game(G,form(standard),players(N),_),
game(G,payoff,A,P).
game(mixed(G),players([1,2]),acts([X,Y]),payoffs([E1,E2])):-
mixed_strategies(G,[X,Y]),
exp_payoff(G,1,E1,[X,Y]),
exp_payoff(G,2,E2,[X,Y]).
% a 2-person game of standard form which represents a game tree below.
game(undoms(G,T),form(standard), players(N), acts(A)):-
undominated(T,G,N,_,_)->true,
setof(B,P^undominated(T,G,N,B,P),A).
game(undoms(G,T),players(N),acts(A),payoffs(P)):-
undominated(T,G,N,A,P).
%
games(Y):-
findall(G,game(G,form(_),_,_),X),
sort(X,Y).
%
% strategy space for each agent
% ----------------------------------------------------------- %
acts(G,I,S):-
game(G,form(_),players(N),acts(A)),
nth1(K,N,I),
nth1(K,A,(I,S)).
%
% payoffs for each agent
% ----------------------------------------------------------- %
payoff(G,J,S,U):-
game(G,payoff,S,P),
game(G,form(_),players(N),_),
nth1(K,N,J),
nth1(K,P,U).
%
% Nash strategy equilirium and other solution concepts
% ----------------------------------------------------------- %
mutate(G,S,J,S1):-
game(G,players(N),acts(S),_),
game(G,players(N),acts(S1),_),
subtract(N,[J],NJ),%write(remains(NJ)),nl,
forall(member(J1,NJ),
(
nth1(K,N,J1),%write(j1(J1,k(J))),
nth1(K,S,SK),%write(s(SK)),
nth1(K,S1,SK1),%write(s1(SK1)),nl,
SK = SK1
)
).
%
best_response(G,J,N,S,P):-
game(G,players(N),acts(S),payoffs(P)),
member(J,N),
\+ defeated_by(G,J,N,[S,P],_).
defeated_by(G,J,N,[S,P],[S1,P1]):-
game(G,players(N),acts(S),payoffs(P)),
nth1(K,N,J),
(
mutate(G,S,J,S1),
game(G,players(N),acts(S1),payoffs(P1)),
nth1(K,P1,PK1),
nth1(K,P,PK),
PK < PK1
).
nash(G,J,N,S,P):-
best_response(G,J,N,S,P).
nash(G,N,S,P):-
game(G,players(N),acts(S),payoffs(P)),
\+ (member(J,N), \+ best_response(G,J,N,S,P)).
%
% dominance
% ----------------------------------------------------------- %
dominance(G,J,N,S,P):-
game(G,players(N),acts(S),payoffs(P)),
nth1(K,N,J),
nth1(K,S,SJ),
\+ (
game(G,players(N),acts(S1),payoffs(P1)),
nth1(K,S1,SJ),
\+ (
best_response(G,J,N,S1,P1)
->true;
(nl,tab(2),write(defeated_by(S1,P1)),fail)
)
).
dominance(G,N,S,P):-
game(G,players(N),acts(S),payoffs(P)),
\+ (member(J,N), \+ dominance(G,J,N,S,P)).
%
% iterated dominance
% ----------------------------------------------------------- %
% modified: 25, 30 Jan 2003.
dominate(strong,G,J,SJ,DJ):-
action_pair(G,J,[SJ/_S,PJ],[DJ/_D,PDJ]),
PJ > PDJ,
\+ (
game(G,players(N),acts(S1),payoffs(P1)),
\+ G =.. [mixed,_],
nth1(K,S1,SJ),
nth1(K,P1,P1J),
game(G,players(N),acts(S2),payoffs(P2)),
nth1(K,S2,DJ),
nth1(K,P2,P2J),
P2J > P1J
).
dominate(weak,G,J,SJ,DJ):-
action_pair(G,J,[SJ/_S,PJ],[DJ/_D,PDJ]),
\+ PJ > PDJ,
\+ (
game(G,players(N),acts(S1),payoffs(P1)),
\+ G =.. [mixed,_],
nth1(K,S1,SJ),
nth1(K,P1,P1J),
game(G,players(N),acts(S2),payoffs(P2)),
nth1(K,S2,DJ),
nth1(K,P2,P2J),
P2J > P1J
).
dominated(T,G,J,S,D):-
dominate(T,G,J,D,S).
undominated(T,G,N,S,P):-
game(G,players(N),acts(S),payoffs(P)),
\+ G =.. [mixed,_],
member(T,[weak,strong]),
\+ (
nth1(K,N,J),
nth1(K,S,SJ),
dominated(T,G,J,SJ,_D)
).
action_pair(G,J,[SJ/S,PJ],[DJ/D,PDJ]):-
game(G,players(N),acts(S),payoffs(P)),
nth1(K,N,J),
nth1(K,S,SJ),
nth1(K,P,PJ),
mutate(G,S,J,D),
game(G,players(N),acts(D),payoffs(PD)),
nth1(K,D,DJ),
DJ \= SJ,
nth1(K,PD,PDJ).
%
% ----------------------------------------------------------- %
% mixed strategy and expected payoff
% ----------------------------------------------------------- %
% mixed strategy profile --> probability of each outcome
mixp_precision(5).
mixed_strategies(G,[P1,P2]):-
game(G,form(standard),players([1,2]),acts([(1,A1),(2,A2)])),
length(A1,M1),
length(A2,M2),
mixp_precision(L),
make_a_prob(P1,base(M1),steps(L)),
make_a_prob(P2,base(M2),steps(L)).
exp_payoff(G,J,E,P):-
findall(V,
(
payoff(G,J,S,U), % wn(payoff(G,J,S,U)),
index_of_acts(G,S,Index), % wn(act(Index)),
index_of_tuple(P,P1,Index),% wn(p(P1)),
product(P1,Q), % wn(q(Q)),
V is U * Q %,wn(v(V)),nl
),
Vs),
sum(Vs,E).
%
% refer to an act profile.
index_of_acts(G,A,Index):-
game(G,players(N),acts(A),payoffs(_)),
length(N,LN),
length(A,LN),
length(Index,LN),
findall(L,
(
nth1(K,N,J), % K-th agent
nth1(K,A,AJ),
acts(G,J,SJ),
nth1(L,SJ,AJ)
),
Index).
%
%*********************************
/* cited from trade.pl */
%*********************************
%
%
% conditional probability and conditional expectation
% ----------------------------------------------------------- %
probability_of_event(W,E,P):-
% conditionalization by event specified directly
event(E),
(var(E)->E = E1; sort(E,E1)),
G = member(S,E1),
findall(A,(probability(W,S,A),G),Ps),
sum(Ps,P).
probability_of_event(W,E,P,G):-
\+ var(G), % conditionalization via constraints indirectly
G=(Goal,M,[W,S,A]), % constraints with params
findall(S1,
(
(M=do->(W=W1,S=S1,A=A1);true),
probability(W1,S1,A1),
Goal
),
E0),
sort(E0,E),
findall(A1,
(
(M=do->(W=W1,S=S1,A=A1);true),
probability(W1,S1,A1),
Goal
),
Ps),
sum(Ps,P).
%
% below was not used in trade.pl
conditional_probability(S,P,E):-
state(S),
event(E1),
(var(E)->E = E1; sort(E,E1)),
findall(A,conditional_probability(_W,S,A,E),Ps),
sum(Ps,P).
conditional_probability(W,S,P,E):-
probability(W,S,P1),
event(E1),
(var(E)->E = E1; sort(E,E1)),
(\+ member(S,E)
-> P=0
;
(
probability_of_event(W,E,P0),
P is P1 / P0
)
).
conditional_probability(W,S,P,E,G):-
probability(W,S,P1),
event(E1),
(var(E)->E = E1; sort(E,E1)),
(\+ member(S,E)
-> P=0
;
(
probability_of_event(_W0,E,P0,G),
P is P1 / P0
)
).
%
conditional_expected_payoff(J,S,V,H):-
game_outcome(W,agent(J),O),
conditional_probability(W,S,P,H),
payoff(agent(J),O,U),
V is P * U.
conditional_expected_payoff(J,V,H):-
agent(J),
event(H),
findall(E,
(
conditional_expected_payoff(J,_S,E,H)
),
V0),
sum(V0,V).
%
% ------------------------------------------------- %
% knowledge operators via possibility correspondences.
% ------------------------------------------------- %
% added: 25 Jan 2003.
% However, these four predicates are not used in trade.pl
know_event_when(J,E,K):-
agent(J),
event(E),
setof(S,
H^(
partition(J,S,H),
subset(H,E)
),
K).
dont_know_event_when(J,E,DK):-
agent(J),
event(DK),
DK \= [],
event(E),
E \= [],
\+ know_event_when(J,E,DK).
think_possible_when(J,E,P):-
agent(J),
event(E),
setof(S,
H^(
partition(J,S,H),
intersection(H,E,M),
M\=[]
),
P).
think_impossible_when(J,E,U):-
think_possible_when(J,E,P),
all_states(O),
subtract(O,P,U),
U\=[],
event(U).
%
% ------------------------------------------------- %
% state, agent, information (partition),
% and possibility correspondences
% ------------------------------------------------- %
%
%
/*
true_state(s3).
all_agents([1,2]).
all_states([s1,s2,s3,s4,s5]).
*/
% partitions of Milgrom and Stokey's example.
/*
partition(1,s1,[s1]).
partition(1,S,[s2,s3]):-member(S,[s2,s3]).
partition(1,S,[s4,s5]):-member(S,[s4,s5]).
partition(2,S,[s1,s2]):-member(S,[s1,s2]).
partition(2,S,[s3,s4]):-member(S,[s3,s4]).
partition(2,s5,[s5]).
%
*/
%
% a nested example inspired by Rubinstein and Wolinsky(1990)
% which induce speculative trades everywhere.
%
/*
partition(1,s1,[s1,s2,s3,s5]).
partition(1,S,[s2,s3]):-member(S,[s2,s3]).
partition(1,s4,[s4,s5]).
partition(1,s5,[s5]).
partition(2,s1,[s1]).
partition(2,s2,[s1,s2]).
partition(2,S,[s3,s4]):-member(S,[s3,s4]).
partition(2,s5,[s1,s3,s4,s5]).
%
*/
%
% trade example of Milgrom and Stokey(1982).
% ------------------------------------------------- %
% probability and game payoffs of the trade
% ------------------------------------------------- %
%
/*
probability(w1,s1, 0.20).
probability(w1,s2, 0.05).
probability(w1,s3, 0.05).
probability(w1,s4, 0.15).
probability(w1,s5, 0.05).
probability(w2,s1, 0.05).
probability(w2,s2, 0.15).
probability(w2,s3, 0.05).
probability(w2,s4, 0.05).
probability(w2,s5, 0.20).
%
*/
%
%
%*********************************
/* cited from ck01.pl */
%*********************************
%
make_public(S):-
state(S),
assert(said(public,0,is_impossible(S))).
%
% ------------------------------------------------- %
% event, (static) knowledge, and reachability
% ------------------------------------------------- %
event(E):-
all_states(O),
subset_of(E,_N,O).
know(J,S,E):-
agent(J),
state(S),
partition(J,S,H),
event(E),
subset(H,E).
%
% ------------------------------------------------- %
% common knowledge via meet of partitions
% ------------------------------------------------- %
meet_of_partitions([J],[S],H):-
partition(J,S,H).
meet_of_partitions([J|Js],[S|Ss],M):-
meet_of_partitions(Js,Ss,M1),
partition(J,S,H),
\+ cyclic(J/Js,S/Ss),
\+ subset(H,M1),
intersection(M1,H,H12),
H12 \= [],
union(H,M1,M2),
sort(M2,M).
%
%
% ----------------------------------------------------------- %
% Arithmetic and so on including probabilistic operators
% ----------------------------------------------------------- %
%
% 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.
%
% 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 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).
%
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
% ----------------------------------------------------------- %
expected_value(W,A,E/100):-
length(A,N),
probabilities(W,N,P),
product_sum(P,A,_,E).
%
% 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.
%
% ----------------------------------------------------------- %
% Utilities for list operations
% ----------------------------------------------------------- %
%
% index for a tuple.
% ----------------------------------------------------------- %
% 1) only mention for a direct product of sets.
index_of_tuple(B,A,Index):-
\+ var(B),
\+ var(A),
length(B,LN), % base sets
length(A,LN),
length(Index,LN),
findall(L,
(
nth1(K,B,BJ), %write(a(K,B,BJ)),
nth1(L,BJ,AJ),%write(b(L,BJ,AJ)),
nth1(K,A,AJ) %,write(c(K,A,AJ)),nl
),
Index).
index_of_tuple(B,A,Index):-
\+ var(B),
\+ var(Index),
var(A),
length(B,LN), % base sets
length(Index,LN),
length(A,LN),
findall(AJ,
(
nth1(K,B,BJ),
nth1(K,Index,L),
nth1(L,BJ,AJ)
),
A).
%
% 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([],_A,0).
bag0([C|B],A,N):-
length([C|B],N),
bag0(B,A,_N1),
member(C,A).
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).
%
% ----------------------------------------------------------- %
% Utilities for outputs
% ----------------------------------------------------------- %
%
% write and new line.
% ----------------------------------------------------------- %
wn(X):-write(X),nl.
%
% output to file.
% ----------------------------------------------------------- %
tell_test(Goal):-
open('tell.txt',write,S),
tell('tell.txt'),
Goal,
current_stream('tell.txt',write,S),
tell(user),wn(end),
close(S).
%
%end
return to front page.