# 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? Commented Aug 12, 2015 at 12:25
• There is no limitation so i guess that doesn't matter. But we can discuss both possibilities (odd and even) Commented Aug 12, 2015 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? Commented Aug 12, 2015 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. Commented Aug 12, 2015 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 :) Commented Aug 12, 2015 at 16:32

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. Commented Aug 12, 2015 at 13:57
• Ah, I see your point. So then the largest such number is going to have 9 digits. Commented Aug 12, 2015 at 13:59
• So if i copy your code into Mathematica, would it give me the answer now? Commented Aug 12, 2015 at 14:00
• Ja - die Nummer 865.341.702 Commented Aug 12, 2015 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. Commented Aug 12, 2015 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. Commented Aug 12, 2015 at 14:04
• He forgot to halve the number after squaring it. Commented Aug 12, 2015 at 14:05
• @m_goldberg, the biggest solution (so far) is 985432107. Something is missing in your function Commented Aug 12, 2015 at 16:42