2
$\begingroup$

My goal is to find the largest palindrome which is the product of two 2-digit numbers using the following program. I want the program to add each palindrome it finds, to the list H. I also want it to test all $n$ from $10$ to $99$, on each respective value of $m$ from $10$ to $99$. Where is the error in the following code?

Clear[H];
H = {};
n = 10;
Do[While[n < 100, 
   If[PalindromeQ[n*m], H = Append[H, m*n]; n = n + 1, 
    n = n + 1]], {m, 10, 99}];
Max[H]
$\endgroup$
2
$\begingroup$

Your code can be made to work with one minor change. You must initialize n at each step of your Do-loop.

H = {};
Do[
  n = 10; 
  While[n < 100, 
    If[PalindromeQ[n*m], H = Append[H, m*n]; n = n + 1, n = n + 1]], 
  {m, 10, 99}]
Max[H]

9009

Staying with procedural methods, I would would still recommend searching in the other direction, large products to small, as a better approach. With that approach you can break out the loops as soon as you find the 1st palindromic integer. The following code is simpler and faster than yours.

Module[{m, n, result},
  result = $Failed;
  m = 99;
  While[m > 0,
    n = 99;
    While[n > 0,
      If[PalindromeQ[n m], result = n m; n = 0; m = 0];
      n--];
    m--];
 result]

9009

$\endgroup$
1
$\begingroup$
sub = Subsets[Range[10, 99], {2}];

res = Last@Select[Times @@@ sub, IntegerDigits[#] == Reverse@IntegerDigits[#] &]

9009

Extract[sub, FirstPosition[Times @@@ sub, res]]

{91, 99}

$\endgroup$
  • $\begingroup$ Replace Permutations[Range[10, 99], {2}] with Subsets[Range[10, 99], {2}] to reduce the search space (multiplication is commutative). If you're already on version 10.3 or higher, use PalindromeQ[] for testing. $\endgroup$ – J. M. is away Jul 30 '17 at 22:35
  • $\begingroup$ Thanks, I changed to Subsets. - Still on V10 $\endgroup$ – eldo Jul 30 '17 at 22:47
1
$\begingroup$

You can use DivisorPairs[n] from a post by Mr.Wizard to find two numbers whose product is n.

DivisorPairs[n_] :=
   Thread[{#, Reverse[#]}][[ ;; Ceiling[Length[#]/2]]] &[Divisors[n]]

The second helper function twoDigitProductQ[n] tests that both elements in the pair have 2 digits.

twoDigitProductQ[n_] := 
   DeleteDuplicates[
      Pick[#, IntegerLength[#], {2, 2}] &[DivisorPairs[n]]] =!= {{}}

Now count down from the maximum as @m_goldberg suggests.

Do[
   If[PalindromeQ[n] && twoDigitProductQ[n], Return[n]],
   {n, 99*99, 1, -1}]

9009

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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