Skip to main content

programming - Efficient code for the Ten True Sentences puzzle


I am trying to solve Ten True Sentences Puzzle.



Take a look at the following sentences:




  • The number of times the digit 0 appears in this puzzle is _.

  • The number of times the digit 1 appears in this puzzle is _.

  • The number of times the digit 2 appears in this puzzle is _.

  • The number of times the digit 3 appears in this puzzle is _.

  • The number of times the digit 4 appears in this puzzle is _.

  • The number of times the digit 5 appears in this puzzle is _.

  • The number of times the digit 6 appears in this puzzle is _.

  • The number of times the digit 7 appears in this puzzle is _.

  • The number of times the digit 8 appears in this puzzle is _.

  • The number of times the digit 9 appears in this puzzle is _.



Fill these sentences with digits such that all the sentences holds true.



I wrote the following code, but it didn't work.


Do[
If[Tally[Range[0, 9] ~Join~ x][[All, 2]] == x, Print@x],
{x, Tuples[Range[0, 9], 10]}] // AbsoluteTiming

How can I imporve my code?


Updated



Compile[{},
NestWhile[Join[{1, 7, 3, 2}, RandomInteger[10, 6]] &, Range[0,9],
Tally[Range[0, 9] ~Join~ #][[All, 2]] != # &],
CompilationTarget -> "C", RuntimeOptions -> "Speed"
][] // AbsoluteTiming

Answer



Since the finished puzzle will contain exactly 20 numbers, we can assert that the solution for x will satisfy Total[x] == 20. We can therefore consider the IntegerPartitions of 20, which are of length 10, and limited to the numbers 1-9:


parts = IntegerPartitions[20, {10}, Range[1, 9]];

The solution for x must be a permutation of one of these, so the complete candidate set for x is:



can = Flatten[Permutations /@ parts, 1];

There are 92278 of these, sufficiently few to use the OP's code straight away. However, we can also note that the solution must satisfy (x-1).Range[0,9] == 20, so we can further reduce the candidate set:


can = can[[Flatten@Position[(can - 1).Range[0, 9], 20]]];

This leaves just 391 possibilities for x, making the OP's code very fast:


Do[If[Tally[Range[0, 9]~Join~x][[All, 2]] == x, Print@x], {x, can}]
(* {1,7,3,2,1,1,1,2,1,1} *)

Comments