# How to find the right permutation, which fits to the problem?

I'm new here and I hope I can find some help. I'm from Germany, so sorry for my English. I look for a number, whose digits are all different. It isn't known how many digits it has. But there is a rule: Take the first digit, square it and then halve it. The result has to be bigger than the product of the following two digits. And then take the second digit and apply the rule again. The result has to be bigger than the product of the third and fourth digit. And so on. I have to find the biggest number, which fits the problem. I want to use Mathematica and I'm using version 10. I started to find all permutations of {0,1,2,3,4,5,6,7,8,9}. The biggest number I can get is in general abcdefghij with 10 digits. So I want to teach Mathematica the following rule:

a²/2 > bc, b²/2 > cd, c²/2 > de, d²/2 > ef, e²/2 > fg, f²/2 > gh, g²/2 > hi, h²/2 > ij,

How can I ask Mathematica to chose the biggest result?

Any help would be fine.

Thanks!

• "take the first digit, square it and then halve it" - what if the digit is odd? – J. M.'s discontentment Aug 12 '15 at 12:25
• There is no limitation so i guess that doesn't matter. But we can discuss both possibilities (odd and even) – Masirius Aug 12 '15 at 12:27
• Working on an answer. But how can you hope to find the biggest number that meets this criteria? I'm not so great on formal proofs, but IS there a biggest number that satisfies that? – Jason B. Aug 12 '15 at 13:01
• Some number will satisfy the problem and this will be the biggest among all other possibilities. So i guess there is such a "biggest" number, otherwise the whole problem doesn't make any sense. Because there are so many possibilities, i want to solve the problem via Mathematica. – Masirius Aug 12 '15 at 13:17
• Thank you all for your help! All the answers were useful for me :) But as I mentioned before, I'm not good at programming. Can you advise me a good book to learn programming and such things especially in Mathematica? I need some good books for Mathematica to learn such computations and how to say Mathematica what I want from it. And as I can see, you all are experts :) – Masirius Aug 12 '15 at 16:32

## 3 Answers

test[list_?VectorQ] :=
And @@ (First[#]^2/2 > Times @@ Rest[#] & /@ Partition[list, 3, 1]);

test[{a, b, c, d, e, f, g, h, i, j}]


a^2/2 > bc && b^2/2 > cd && c^2/2 > de && d^2/2 > ef &&
e^2/2 > fg && f^2/2 > gh && g^2/2 > hi && h^2/2 > ij

perm[n_Integer?Positive] := Select[
Permutations[Range[0, 9], {n}],
FreeQ[Take[#, n - 2], 0] &]


There are no values of length 10 that meet the conditions.

Module[{list = perm[10]},
Max[FromDigits /@ Pick[list, test /@ list]]]


-Infinity

The largest value of length 9

val = Module[{list = perm[9]},
Max[FromDigits /@ Pick[list, test /@ list]]]


985432107

EDIT: A simpler form for this is just

 val = Max[FromDigits /@ Select[perm[9], test]]


985432107

test[IntegerDigits[val]]


True

This is a function which should find the largest n-digit number that satisfies ALL the criteria:

maxval[ndigits_] := Module[{permlist, conditions, val},
permlist = Flatten[Permutations /@ Subsets[Range[0, 9], {ndigits}], 1];
permlist = IntegerDigits[#, 10, ndigits] & /@ Reverse[Sort[FromDigits /@ permlist]];
(*This is the list of conditions that need to be met -
note that it is meaningless until 'testlist' is defined*)

conditions =
Quiet[Table[
testlist[[m]]^2 / 2 > testlist[[m + 1]]*testlist[[m + 2]],
{m, 1, ndigits - 2}]];

(*Now we loop over all the permutations, applying test,
starting at the largest value,
until we reach one that satisfies the conditions.
Then we stop the loop.  I use the Monitor function because
I like to have some idea of how long it is going to take. *)

PrintTemporary[
"Total number of permutations: " <> IntegerString[Length@permlist]];
Monitor[
val = Reap[
Do[
(*This is one of those cases where the difference between
Module and Block is important*)
Block[{testlist},
testlist = permlist[[n]];

If[And @@ conditions, Sow[FromDigits[permlist[[n]]]];
Break[]
];
];
, {n, Length@permlist}];
][[2]];, n];
Max@val
];


I find a 9-digit number that satisfies it,

maxval[9]
(*  985432107  *)


but no 10-digit number

maxval[10]
(*  -\[Infinity]  *)


If there is no n-digit number that satisfies the conditions, then Mathematica will spit back negative infinity as the answer.

• Thank you! As i said, the number has different digits. So an 11 digit number would be wrong cause there has to be at least 2 same digits. İf the number has 9 digits so it has to be for example 123456789 and not 123455889 or something like that. İ hope you considered that in your solution. – Masirius Aug 12 '15 at 13:57
• Ah, I see your point. So then the largest such number is going to have 9 digits. – Jason B. Aug 12 '15 at 13:59
• So if i copy your code into Mathematica, would it give me the answer now? – Masirius Aug 12 '15 at 14:00
• Ja - die Nummer 865.341.702 – Jason B. Aug 12 '15 at 14:02
• So the code above defines the function, which will give the largest n-digit number meeting the conditions. So once the function is defined you have to call it. Like maxval[10] which will take some time to go through and find that there is no 10-digit number. Then maxval[9] gives what must be the largest number. – Jason B. Aug 12 '15 at 14:08

I confirm Jason B's findings. Using my functions

test[{a_, b_, c_}] := a^2 > b c
goodPerm[p_] := If[And @@ test /@ Partition[p, 3, 1], p, Nothing]


I get

Max @@ FromDigits /@ goodPerm /@ Permutations[Range[0, 8]]

865341702


and

Max @@ FromDigits /@ goodPerm /@ Permutations[Range[0, 9]]

-∞


which means for permutations of the digits 0, 1, ..., 9 there is no solution.

• İf i take the first digit 9 and square it so i get 81. Now i halve it and get 40.5. The next two digits are 8 and 7. İf i multiply them i get 56. But 40.5 should be bigger than 56 but it isn't. There is a mistake. – Masirius Aug 12 '15 at 14:04
• He forgot to halve the number after squaring it. – Jason B. Aug 12 '15 at 14:05
• @m_goldberg, the biggest solution (so far) is 985432107. Something is missing in your function – Masirius Aug 12 '15 at 16:42