Non-transitive dice: Difference between revisions
→{{header|MiniZinc}}
m (→{{header|J}}: fix markup) |
|||
Line 789:
[[2, 2, 2, 4], [2, 2, 3, 3], [1, 3, 3, 3], [1, 1, 4, 4]]
[[2, 2, 3, 3], [1, 3, 3, 3], [1, 1, 4, 4], [2, 2, 2, 4]]</pre>
=={{header|Mathematica}}/{{header|Wolfram Language}}==
<lang Mathematica>ClearAll[DieFight]
DieFight[d1_List, d2_List] := Module[{sets},
sets = Tuples[{d1, d2}];
sets = sets[[All, 2]] - sets[[All, 1]];
Sign[Total[Sign[sets]]]
]
ds = DeleteDuplicates[Sort /@ Tuples[Range[4], 4]];
ssis = Subsets[Range[Length[ds]], {3}];
ssis //= Map[Permutations];
ssis //= Catenate;
ssis //= Select[DieFight[ds[[#[[1]]]], ds[[#[[2]]]]] == 1 &];
ssis //= Select[DieFight[ds[[#[[2]]]], ds[[#[[3]]]]] == 1 &];
ssis //= Select[DieFight[ds[[#[[1]]]], ds[[#[[3]]]]] == -1 &];
nontransitiveds = Map[ds[[#]] &, ssis, {2}];
Column[Row[{#1, "<", #2, " ; ", #2, "<", #3, " ; ", #1, ">", #3}] & @@@ nontransitiveds]
ssis = Subsets[Range[Length[ds]], {4}];
ssis //= Map[Permutations];
ssis //= Catenate;
ssis //= Select[DieFight[ds[[#[[1]]]], ds[[#[[2]]]]] == 1 &];
ssis //= Select[DieFight[ds[[#[[2]]]], ds[[#[[3]]]]] == 1 &];
ssis //= Select[DieFight[ds[[#[[3]]]], ds[[#[[4]]]]] == 1 &];
ssis //= Select[DieFight[ds[[#[[1]]]], ds[[#[[4]]]]] == -1 &];
nontransitiveds = Map[ds[[#]] &, ssis, {2}];
Column[Row[{#1, "<", #2, " ; ", #2, "<", #3, " ; ", #3, "<", #4, " ; ", #1, ">", #4}] & @@@ nontransitiveds]</lang>
{{out}}
<pre>{1,1,4,4}<{2,2,2,4} ; {2,2,2,4}<{1,3,3,3} ; {1,1,4,4}>{1,3,3,3}
{1,3,3,3}<{1,1,4,4} ; {1,1,4,4}<{2,2,2,4} ; {1,3,3,3}>{2,2,2,4}
{2,2,2,4}<{1,3,3,3} ; {1,3,3,3}<{1,1,4,4} ; {2,2,2,4}>{1,1,4,4}
{1,1,4,4}<{2,2,2,4} ; {2,2,2,4}<{2,2,3,3} ; {2,2,3,3}<{1,3,3,3} ; {1,1,4,4}>{1,3,3,3}
{1,3,3,3}<{1,1,4,4} ; {1,1,4,4}<{2,2,2,4} ; {2,2,2,4}<{2,2,3,3} ; {1,3,3,3}>{2,2,3,3}
{2,2,2,4}<{2,2,3,3} ; {2,2,3,3}<{1,3,3,3} ; {1,3,3,3}<{1,1,4,4} ; {2,2,2,4}>{1,1,4,4}
{2,2,3,3}<{1,3,3,3} ; {1,3,3,3}<{1,1,4,4} ; {1,1,4,4}<{2,2,2,4} ; {2,2,3,3}>{2,2,2,4}</pre>
=={{header|MiniZinc}}==
| |||