/* Nontransitive dice in Picat. From http://en.wikipedia.org/wiki/Nontransitive_dice """ A set of nontransitive dice is a set of dice for which the relation "is more likely to roll a higher number" is not transitive. See also intransitivity. This situation is similar to that in the game Rock, Paper, Scissors, in which each element has an advantage over one choice and a disadvantage to the other. """ * go/0; There are many solutions for 3 dice with values 1..6. Here is one of them (cherry picked with a good worse percentage of winning): maxWin = 17 gapSum = 5 Dice: [1,1,1,3,5,6] [1,1,2,3,3,5] [1,2,2,2,2,6] Comp: [14,13] [16,14] [17,15] Gap:[1,2,2] Wins: Die 1: 0 14 15 sum wins: 29 losses: 30 Better than: [2] WorseThan: [3] Die 2: 13 0 16 sum wins: 29 losses: 28 Better than: [3] WorseThan: [1] Die 3: 17 14 0 sum wins: 31 losses: 31 Better than: [1] WorseThan: [2] Better/Worse than: Die 1: BetterThan: [2 = 14 / 13 = 0.929] WorseThan: [3 = 17 / 15 = 0.882] Die 2: BetterThan: [3 = 16 / 14 = 0.875] WorseThan: [1 = 14 / 13 = 0.929] Die 3: BetterThan: [1 = 17 / 15 = 0.882] WorseThan: [2 = 16 / 14 = 0.875] Strategy (best win): Player A picks: Player B picks a_picks = 1 Best strategy: [b_picks = 3,wins_loss = 17 / 15,prob_win = 0.882] a_picks = 2 Best strategy: [b_picks = 1,wins_loss = 14 / 13,prob_win = 0.929] a_picks = 3 Best strategy: [b_picks = 2,wins_loss = 16 / 14,prob_win = 0.875] worsePct = 0.875 * go2/0: Minimizing GapSum. Minimizing the sum of gaps - the difference between wins/losses - tend to give quite good worse percentage of winning, but it's no guarantee that it give the best percentage. Here is a solution for 6 dice with possible values 1..6. It has a strategy that give worse probability of winning as 0.923. Found by minimizing GapSum (SAT is faster than CP for this). Note that for some cases, there might be more than one optimal strategy for a certain values. maxWin = 18 gapSum = 6 Dice: [1,1,1,4,6,6] [1,1,1,5,5,6] [1,1,3,3,3,6] [1,2,2,2,5,6] [1,2,2,3,3,4] [2,2,2,2,3,4] Comp: [13,12] [15,14] [17,16] [15,14] [13,12] [18,17] Gap:[1,1,1,1,1,1] Wins: Die 1: 0 13 15 14 17 17 sum wins: 76 losses: 75 Better than: [2,3,5] WorseThan: [4,6] Die 2: 12 0 15 13 18 18 sum wins: 76 losses: 77 Better than: [3,5] WorseThan: [1,4] Die 3: 13 14 0 17 15 18 sum wins: 77 losses: 74 Better than: [4,5,6] WorseThan: [1,2] Die 4: 17 17 16 0 15 12 sum wins: 77 losses: 70 Better than: [1,2,5] WorseThan: [3] Die 5: 15 15 13 14 0 13 sum wins: 70 losses: 77 Better than: [6] WorseThan: [1,2,3,4] Die 6: 18 18 15 12 12 0 sum wins: 75 losses: 78 Better than: [1] WorseThan: [3,5] Better/Worse than: Die 1: BetterThan: [2 = 13 / 12 = 0.923,3 = 15 / 13 = 0.867,5 = 17 / 15 = 0.882] WorseThan: [4 = 17 / 14 = 0.824,6 = 18 / 17 = 0.944] Die 2: BetterThan: [3 = 15 / 14 = 0.933,5 = 18 / 15 = 0.833] WorseThan: [1 = 13 / 12 = 0.923,4 = 17 / 13 = 0.765] Die 3: BetterThan: [4 = 17 / 16 = 0.941,5 = 15 / 13 = 0.867,6 = 18 / 15 = 0.833] WorseThan: [1 = 15 / 13 = 0.867,2 = 15 / 14 = 0.933] Die 4: BetterThan: [1 = 17 / 14 = 0.824,2 = 17 / 13 = 0.765,5 = 15 / 14 = 0.933] WorseThan: [3 = 17 / 16 = 0.941] Die 5: BetterThan: [6 = 13 / 12 = 0.923] WorseThan: [1 = 17 / 15 = 0.882,2 = 18 / 15 = 0.833,3 = 15 / 13 = 0.867,4 = 15 / 14 = 0.933] Die 6: BetterThan: [1 = 18 / 17 = 0.944] WorseThan: [3 = 18 / 15 = 0.833,5 = 13 / 12 = 0.923] Strategy (best win): Player A picks: Player B picks a_picks = 1 Best strategy: [b_picks = 6,wins_loss = 18 / 17,prob_win = 0.944] a_picks = 2 Best strategy: [b_picks = 1,wins_loss = 13 / 12,prob_win = 0.923] a_picks = 3 Best strategy: [b_picks = 2,wins_loss = 15 / 14,prob_win = 0.933] a_picks = 4 Best strategy: [b_picks = 3,wins_loss = 17 / 16,prob_win = 0.941] a_picks = 5 Best strategy: [b_picks = 4,wins_loss = 15 / 14,prob_win = 0.933] a_picks = 6 Best strategy: [b_picks = 5,wins_loss = 13 / 12,prob_win = 0.923] worsePct = 0.923 CPU time 1.048 seconds. Backtracks: 0 Symmetry breaking: adding the two lex2/1 constraint might speed up the solution, but there are larger cases when this is not true. Also, it might give no solutions, e.g. when N=6 and M > 12 together with the experimental constraint GapSum #= M, or when N=6 and M > 16 and GapSum is not constrained. Hence, when using MinGapSum = true, these two constraints are not activated. Model created by Hakan Kjellerstrand, hakank@gmail.com See also my Picat page: http://www.hakank.org/picat/ */ import util. % import cp. % faster for geting many solution (go/0). import sat. % faster for go2/0. main => time2($go). % % 3 dice with values 1..6 % go ?=> nolog, M = 3, % number of dice, nl, println(m=M), N = 6, % numver of sides of each die MinVal = 1, MaxVal = 6, % max value of dice MinGapSum = false, nontransitive_dice(M,N,MinVal,MaxVal,MinGapSum, Dice,Comp,MaxVal,MaxWin,Gap,GapSum), print_solution(M,N,MinVal,MaxVal, Dice,Comp,MaxVal,MaxWin,Gap,GapSum), fail, nl. go => true. % % Find the minimal value of GapSum. % go2 ?=> nolog, M = 6, % number of dice, N = 6, % numver of sides of each die MinVal = 1, MaxVal = 6, % max value of dice MinGapSum = true, nontransitive_dice(M,N,MinVal,MaxVal,MinGapSum, Dice,Comp,MaxVal,MaxWin,Gap,GapSum), print_solution(M,N,MinVal,MaxVal, Dice,Comp,MaxVal,MaxWin,Gap,GapSum), nl. go2 => true. % % Generate optimal GapSum solutions for M in 3..26. % go3 ?=> nolog, member(M,3..26), % number of dice, nl, println(m=M), N = 6, % numver of sides of each die MinVal = 1, MaxVal = 6, % max value of dice MinGapSum = true, nontransitive_dice(M,N,MinVal,MaxVal,MinGapSum, Dice,Comp,MaxVal,MaxWin,Gap,GapSum), print_solution(M,N,MinVal,MaxVal, Dice,Comp,MaxVal,MaxWin,Gap,GapSum), nl, fail, nl. go3 => true. % % Print the solution with a strategy. % print_solution(M,N,MinVal,MaxVal, Dice,Comp,MaxVal,MaxWin,Gap,GapSum) => println([minVal=MinVal,maxVal=MaxVal]), println(maxWin=MaxWin), println(gapSum=GapSum), println("Dice:"), foreach(DD in Dice) println(DD.to_list) end, println("Comp:"), foreach(C in Comp) println(C.to_list) end, print("Gap:"), println(Gap.to_list), nl, Wins = new_array(M,M), bind_vars(Wins,0), foreach(D1 in 1..M) foreach(D2 in 1..M, D1 != D2) Wins[D1,D2] := sum([1 : P in 1..N, Q in 1..N, Dice[D1,P] > Dice[D2,Q] ]), Wins[D2,D1] := sum([1 : P in 1..N, Q in 1..N, Dice[D2,P] > Dice[D1,Q] ]) end end, println("Wins:"), BetterThan = new_list(M), bind_vars(BetterThan,[]), WorseThan = new_list(M), bind_vars(WorseThan,[]), BetterThanSimple = new_list(M), bind_vars(BetterThanSimple,[]), WorseThanSimple = new_list(M), bind_vars(WorseThanSimple,[]), foreach(I in 1..M) printf("Die %2d: ", I), foreach(J in 1..M) printf("%3d ", Wins[I,J]), if Wins[I,J] > Wins[J,I] then Win = Wins[I,J], Loss = Wins[J,I], Pct = to_fstring("%3.3f", Loss/Win).to_float, BetterThan[I] := BetterThan[I] ++ [$(J=Win/Loss)=Pct], BetterThanSimple[I] := BetterThanSimple[I] ++ [J] end, if Wins[I,J] < Wins[J,I] then Win = Wins[J,I], Loss = Wins[I,J], Pct = to_fstring("%3.3f", Loss/Win).to_float, WorseThan[I] := WorseThan[I] ++ [$(J=Win/Loss)=Pct], WorseThanSimple[I] := WorseThanSimple[I] ++ [J] end end, printf(" sum wins:%3d losses:%3d Better than: %w WorseThan: %w\n", sum(Wins[I]), sum([Wins[J,I] : J in 1..M]), BetterThanSimple[I], WorseThanSimple[I]) end, println("\nBetter/Worse than:"), foreach(D in 1..M) printf("Die %d: BetterThan: %w WorseThan: %w\n", D, BetterThan[D], WorseThan[D]) end, println("\nStrategy (best win):"), println("Player A picks: Player B picks"), WorsePct = 1, foreach(I in 1..M) println(a_picks=I), BestProb = 0, BestStrat = [], foreach(W in WorseThan[I]) W = $(J = Win / Loss = Prob), if Prob == BestProb then BestStrat := BestStrat ++ [[b_picks=J,wins_loss=$(Win/Loss),prob_win=Prob]] elseif Prob > BestProb then BestStrat := [b_picks=J,wins_loss=$(Win/Loss),prob_win=Prob], BestProb := Prob end end, printf("\tBest strategy: %w\n",BestStrat) , if BestProb < WorsePct then WorsePct := BestProb end end, println(worsePct=WorsePct), nl. % % Generate a solution. % nontransitive_dice(M,N,MinVal,MaxVal,MinGapSum, Dice,Comp,MaxVal,MaxWin,Gap,GapSum) => % decision variables % the dice Dice = new_array(M,N), Dice :: MinVal..MaxVal, % the competitions: % (die 1 vs die 2, die 2 vs die 1), ... (die m vs die 1, die 1 vs die m) % And the first die must beat the second in each round. % Note the last wrap around which breaks the transitivity. Comp = new_array(M, 2), % [0..M-1, 1..2] in 0..n*n, Comp :: 0..N*N, % max win MaxWin :: 0..N*N, % gap, gap_sum Gap = new_array(M), % gap[0..m-1] in 0..n*n, Gap :: 0..N*N, GapSum :: 0..N*N*M, % order the number of each die (increasing) foreach(D in 1..M) increasing([Dice[D,J] : J in 1..N ]) end, % The dice should not be identical foreach(D1 in 1..M, D2 in 1..M, D1 != D2) sum([Dice[D1,J] #!= Dice[D2,J] : J in 1..N]) #> 0 end, GapSum #= sum([Gap[I] : I in 1..M]), MaxVal #= max([Dice[I,J] : I in 1..M, J in 1..N]), MaxWin #= max([Comp[I,1] : I in 1..M]), % and now we roll... % Number of wins for [A vs B, B vs A] foreach(D in 0..M-1) M1 = 1+(D mod M), M2 = 1+((D+1) mod M), Comp[D+1,1] #= sum([(Dice[M1, R1] #> Dice[M2, R2]) : R1 in 1..N, R2 in 1..N]), Comp[D+1,2] #= sum([(Dice[M2, R1] #> Dice[M1, R2]) : R1 in 1..N, R2 in 1..N]), Gap[D+1] #= Comp[D+1,1] - Comp[D+1,2] end, % non-transitivity % All dice 1..m-1 must beat the follower, and die m must beat die 1 foreach(D in 1..M) Comp[D,1] #> Comp[D,2] end, Comp[M,1] #> Comp[1,2], % symmetry breaking: % Note, this doesn't always speed things up. Also, for larger instances % it might yield no solution. % if not MinGapSum then % lex2(Dice), % lex2(Dice.transpose) % end, Vars = Dice.to_list() ++ Comp.to_list()++ Gap.to_list() ++ [MaxVal,MaxWin,GapSum], if MinGapSum then GapSum #= M, % Faster but a little experimental solve($[min(GapSum),report(printf("Found %d\n", GapSum))], Vars) else % maximize sum(i in 0..m-1, j in 1..2) comp[i,j], % maximize min(i in 0..m-1) comp[i,1], % maximize the smallest winning % maximize min(i in 0..m-1) gap[i], % maximize the smallest winning solve([constr,split], Vars) % solve([degree,updown], Vars). % solve([constr, $max(MaxWin)], Vars). % solve($[max(GapSum),report(printf("Found %d\n", GapSum))], Vars). % solve($[max(sum([Comp[I,1] : I in 1..M]))], Vars). % maximize the sum of the winnings end. % symmetry breaking lex2(X) => foreach(I in 2..X.length) lex_lt(X[I-1], X[I]) end.