# 用 Wolfram 语言解答2018年刑侦科推理题

`SetAttributes[#, {Protected, ReadProtected}] & /@ {a, b, c, d};`

```已作答[n_Integer, 答案_] := 答案[[n]] =!= Indeterminate;

`检查[1, 答案_] := If[已作答[1, 答案], True, Indeterminate];`

```检查[2, 答案_] :=
If[已作答[{2, 5}, 答案],
答案[[5]] === (答案[[2]] /. {a -> c, b -> d, c -> a, d -> b}),
Indeterminate];```

```检查[3, 答案_] := Module[
{相同3题, 选项 = {a -> 3, b -> 6, c -> 2, d -> 4}},
If[已作答[{3, 6, 2, 4}, 答案]
,
相同3题 = 答案[[DeleteCases[{3, 6, 2, 4}, 答案[[3]] /. 选项]]];
(SameQ @@ 相同3题) && (答案[[答案[[3]] /. 选项]] =!= 相同3题[[1]])
,
Indeterminate]
];```

```检查[4, 答案_] := Module[
{选项 = {a -> {1, 5}, b -> {2, 7}, c -> {1, 9}, d -> {6, 10}}},
If[已作答[Append[Flatten@选项[[All, 2]], 4], 答案]
,
Select[选项[[All, 2]], SameQ @@ 答案[[#]] &] === {答案[[4]] /. 选项}
,
Indeterminate]
];```

```检查[5, 答案_] := Module[
{选项 = {a -> 8, b -> 4, c -> 9, d -> 7}},
If[已作答[Append[Flatten@选项[[All, 2]], 5], 答案]
,
Select[选项[[All, 2]], 答案[[#]] == 答案[[5]] &] === {答案[[5]] /. 选项}
,
Indeterminate]
];```

```检查[6, 答案_] := Module[
{选项 = {a -> {2, 4}, b -> {1, 6}, c -> {3, 10}, d -> {5, 9}}},
If[已作答[Append[Flatten@选项[[All, 2]], 6], 答案]
,
Select[选项[[All, 2]],
SameQ @@ 答案[[Append[#, 8]]] &] === {答案[[6]] /. 选项}
,
Indeterminate]
];```

```检查[7, 答案_] := Module[
{统计},
If[FreeQ[答案, Indeterminate]
,
统计 = SortBy[Tally@答案, Last];
(Length@统计 > 1) && (统计[[1, 2]] != 统计[[2, 2]]) && (答案[[7]] ===
统计[[1, 1]])
,
Indeterminate]
];

{统计},
If[FreeQ[答案, Indeterminate]
,
统计 = SortBy[Tally@答案, Last];
统计[[-1, 2]] -
统计[[1, 2]] === (答案[[10]] /. {a -> 3, b -> 2, c -> 4, d -> 1})
,
Indeterminate]
];```

```检查[8, 答案_] := Module[
{temp, 选项替换 = {a -> 1, b -> 2, c -> 3, d -> 4}},
If[已作答[{8, 7, 5, 2, 10, 1}, 答案]
,
Select[{a, b, c, d},
Abs[答案[[# /. {a -> 7, b -> 5, c -> 2, d -> 10}]] - 答案[[1]] /.
选项替换] =!= 1 &] === {答案[[8]]}
,
Indeterminate]
];```

```检查[9, 答案_] :=
If[已作答[{1, 6, 5, 10, 2, 9}, 答案]
,
(答案[[1]] === 答案[[6]])~
Xor~(答案[[答案[[9]] /. {a -> 6, b -> 10, c -> 2, d -> 9}]] ===
答案[[5]])
,
Indeterminate];```

```搜索[现答案_, _, {}] := Throw[现答案];

{新答案 = 现答案, 结果},
(
新答案[[新题号]] = #;
结果 = 检查[#, 新答案] & /@ 待查题目;
If[FreeQ[结果, False]
,
搜索[新答案, {剩余题目}, Delete[待查题目, Position[结果, True]]]]
) & /@ {a, b, c, d};
];```

```搜索[Table[Indeterminate, {10}], {5, 3, 1, 2, 4, 6, 7, 8, 9, 10},
Range[10]]```

```AbsoluteTiming@
Catch@搜索[Table[Indeterminate, {10}], #, Range[10]] & /@ {{5, 3, 1,
2, 4, 6, 7, 8, 9, 10}, Range[10]} // Grid```

```终极检查[10, 答案_] := If[已作答[10, 答案], True, Indeterminate];

```Clear[终极检查];

(终极检查[#, 答案_] := If[已作答[#, 答案], True, Indeterminate]) & /@ {2, 3, 5};```

```部分答案[] :=
终极搜索[Table[Indeterminate, {10}], {5, 3, 1, 2, 4, 6, 7, 8, 9, 10},
Range[10]];

{新答案 = 现答案, 结果},
Catch[Fold[Function[{答案累计, 尝试选项},
If[Length@答案累计 > 1, Throw[答案累计]];
新答案[[新题号]] = 尝试选项;
结果 = 终极检查[#, 新答案] & /@ 待查题目;
If[FreeQ[结果, False]
,
Join[答案累计,
终极搜索[新答案, {剩余题目}, Delete[待查题目, Position[结果, True]]]]
,
答案累计]
], {}, {a, b, c, d}]]
];```

```答案统计 = ParallelMap[Function[{要修改的题目},
Clear[终极检查];
终极检查[n_, 答案_] := 检查[n, 答案];
(终极检查[#, 答案_] := If[已作答[#, 答案], True, Indeterminate]) & /@
要修改的题目;
{要修改的题目, 部分答案[]}],
Union[Sort /@ Permutations[{2, 3, 4, 5, 6, 7, 8, 9, 10}, {3}]]];
Grid[Select[答案统计, Length@#[[2]] == 1 &], Frame -> All]```

284 篇文章53 人订阅

0 条评论