Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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
share|improve this question
1  
This is because your puzzle is impossible. Every number appears at least once in your sentence, but you force us to use 0. –  VF1 Jan 7 '13 at 16:32
    
There is one solution in this puzzle, {1,7,3,2,1,1,1,2,1,1} –  chyaong Jan 7 '13 at 17:01
1  
@VF1 The link OP provided also has the solution... –  rm -rf Jan 7 '13 at 18:10
    
@Hypnotoad There is a solution because OP edited the question. Before, it stated that every number 0-9 should be used. –  VF1 Jan 7 '13 at 18:30
1  
Isnt that cheating to use part of the known solution? Anyway this would seem to lend itself to a genetic algorithm, or at least track solutions that have been tried so you dont repeat. –  george2079 Jan 7 '13 at 18:44

4 Answers 4

up vote 13 down vote accepted

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}  *)
share|improve this answer

Represent the solution as a list $\{z_0, z_1, \ldots, z_9\}$. The counts of appearances of the various digits can be computed as

appearanceCount[n_Integer, i_Integer, b_: 10] := Count[IntegerDigits[n, b], i];
appearanceCount[z_List, i_Integer, b_: 10] := Sum[appearanceCount[n, i, b], {n, z}]

(This may be inefficient, especially considering the question will later be limited to one-digit answers, but I prefer it for its expressiveness and full generality. Notice, too, the possible generalization to bases $b$ other than $10$.)

We seek a fixed point of the function that counts the appearances of digits in the answer and adds $1$ to each (to account for their appearances in the question itself):

f[z_List] := appearanceCount[z, #] & /@ Range[0, Length[z] - 1] + 1
FixedPoint[f, ConstantArray[1, 10], 20]

This starts with a somewhat arbitrary guess $z_i=1$ for all $i$. (I asked the iteration not to proceed more than $20$ times, to avoid infinite loops.)

{1, 11, 2, 1, 1, 1, 1, 1, 1, 1}

We need to check that this is indeed a fixed point (and not just the last thing that was tried):

f[%]==%

True

The question does use the term "digit" to refer to what goes in the blanks, so perhaps the value of "11" would be considered invalid: it uses two digits. Rather than thinking too hard about this, let's optimistically start with some random guesses and check everything that emerges as a possible fixed point:

Select[Union[FixedPoint[f, #, 10] & /@ RandomChoice[Range[0, 9], {100, 10}]], f[#] == # &]

{{1, 7, 3, 2, 1, 1, 1, 2, 1, 1}}

One could systematically search for solutions by checking all $10$-tuples; there are $10^{10}$ of them, so this would take some time!

share|improve this answer
    
+1 for the fixed point method. btw there is a function DigitCount could do what appearanceCount does. –  Silvia Jan 7 '13 at 19:42
    
@Silvia Thank you--it seems like almost any one-line function I can write has already been incorporated in the software somewhere :-). –  whuber Jan 7 '13 at 19:45

too long for a comment -- but your basic approach does work in some reasonable time if we are a little smart about restricting the range of the values:

(either test works about the same)

test[v_] := Tally[Range[0, 9]~Join~v][[All, 2]] == v ;
test[v_] := Count[ v   , #] + 1 & /@ Range[0, 9] ==  v
result = Table[0, {9}];
Timing[While[! test[result] ,
    result = (Join[{1, RandomInteger[{5, 8}]}, 
    RandomInteger[{1, 5}, 8]]) ]; result]

{68.5, {1, 7, 3, 2, 1, 1, 1, 2, 1, 1}}

edit: again with a little less built in knowedge of the solution.. I think if you start working it by hand you'll quickly realise the #1's and 2 must be both greater than 2 and the others cant be too big..

test[v_] := Count[ v   , #] + 1 & /@ Range[0, 9] ==  v
result = Table[0, {9}];
Timing[While[! test[result] ,
  result = Join[ {1 , Count[#, 1] + 2 , Count[#, 2] + 1}, # ] & @ 
   RandomInteger[{1, 6}, 7]]; result]
share|improve this answer
A = Table[{i,}, {i, 0, 9}];
Table[A〚i, -1〛 = Thread[Join @@ A == i - 1]~Count~True,
 {10}, {i, 10}] // Grid

Output:

1   2   2   1   1   1   1   1   1   1
1   9   2   1   1   1   1   1   1   2
1   8   3   2   1   1   1   1   2   1
1   7   3   2   1   1   1   2   1   1
1   7   3   2   1   1   1   2   1   1
1   7   3   2   1   1   1   2   1   1
1   7   3   2   1   1   1   2   1   1
1   7   3   2   1   1   1   2   1   1
1   7   3   2   1   1   1   2   1   1
1   7   3   2   1   1   1   2   1   1
share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.