1/*
2Truel, or duel among three opponents.
3There are three truelists, a, b and c, that take turns in shooting with a gun.
4The firing order is a, b and c. Each truelist can shoot at another truelist
5or at the sky (deliberate miss). The truelist have these probabilities of
6hitting the target (if they are not aiming at the sky): a 1/3, b 2/3 and c 1.
7The aim for each truelist is kill all the other truelists.
8The question is: what should a do to maximize his probability of living?
9Aim at b, c or the sky?
10Note that the best strategy for the other truelists and situations is
11easy to find intuitively and corresponds to aim at the best shooter.
12See https://en.wikipedia.org/wiki/Truel
13Martin Shubik, Game Theory and Related Approaches to Social Behavior, 1964, page 43
14
15*/
40:- use_module(library(mcintyre)). 41 42:- if(current_predicate(use_rendering/1)). 43:- use_rendering(c3). 44:- use_rendering(graphviz). 45:- endif. 46:- dynamic kr/1,num/1. 47:- mc. 48 49 50:- begin_lpad.
/
58best_strategy(A,L,S):-
59 delete(L,A,L1),
60 append(L1,[sky],L2),
61 maplist(ev_action(A,L,0),L2,LP),
62 sort(LP,LP1),
63 reverse(LP1,[_P-S|_]).
/
73ev_action(A,L,T,S,P-S):-
74 mc_sample(survives_action(A,L,T,S),100,P).
/
82survives_action(A,L0,T,S):-
83 shoot(A,S,L0,T,L1),
84 remaining(L1,A,Rest),
85 survives_round(Rest,L1,A,T).
93shoot(H,S,L0,T,L):- 94 (S=sky -> 95 L=L0 96 ; 97 (hit(T,H) -> 98 delete(L0,S,L) 99 ; 100 L=L0 101 ) 102 ). 103 104 105hit(_,a)1/3. 106 107hit(_,b)2/3. 108 109hit(_,c)1.
/
117survives([A],A,_):-!. 118 119survives(L,A,T):- 120 survives_round(L,L,A,T).
128survives_round([],L,A,T):- 129 survives(L,A,s(T)). 130 131survives_round([H|_Rest],L0,A,T):- 132 base_best_strategy(H,L0,S), 133 shoot(H,S,L0,T,L1), 134 remaining(L1,H,Rest1), 135 member(A,L1), 136 survives_round(Rest1,L1,A,T).
These are the strategies that are easy to find (most intuitive)
/
148base_best_strategy(b,[b,c],c). 149base_best_strategy(c,[b,c],b). 150base_best_strategy(a,[a,c],c). 151base_best_strategy(c,[a,c],a). 152base_best_strategy(a,[a,b],b). 153base_best_strategy(b,[a,b],a). 154base_best_strategy(b,[a,b,c],c). 155base_best_strategy(c,[a,b,c],b). 156 157remaining([A|Rest],A,Rest):-!. 158 159remaining([_|Rest0],A,Rest):- 160 remaining(Rest0,A,Rest). 161 162:- end_lpad.
?-
best_strategy(a,[a,b,c],S)
. % What is the best action for a? % S= sky ?-mc_sample(survives_action(a,[a,b,c],0,b),100,P)
. % What is the probability that a survives if it aims at b? % P = 50/189=0.26455026455 ?-mc_sample(survives_action(a,[a,b,c],0,c),100,P)
. % What is the probability that a survives if it aims at c? % P = 59/189=0.31216931216 ?-mc_sample(survives_action(a,[a,b,c],0,sky),100,P)
. % What is the probability that a survives if it aims at the sky? % P25/63
0.39682539682 ?-mc_sample(survives([a,c],a,0),100,P)
. % What is the probability that a survives against c? % P =1/3 ?-mc_sample(survives([a,b],a,0),100,P)
. % What is the probability that a survives against b? % P3/7
0.42857142857 ?-mc_sample(survives_round([b],[a,b],a,0),100,P)
. % What is the probability that a survives against b when it's b's turn? %P1/7
0.14285714285 */