3
$\begingroup$

I am trying to learn the mathematica language. And it was suggested to me to start by doing the Project Euler problems. I am currently working on

Problem # 4: A palindromic number reads the same both ways. The largest palindrome made from the product of two 2-digit numbers is 9009 = 91 × 99. Find the largest palindrome made from the product of two 3-digit numbers.

The first step I am taking is learning how to make a table containing the product of every three digit number like, 100x100, 101x100, then using the PalindromeQ function to Print all the palindromes from that table or list.

Any other suggestions would me learn,thanks

Here's what ive tried so far, dont laugh at me:

ATTEMPT #1: Table[(xx*xx) n, {n, 999}]

Attempt #2 For[i = 100; t = 100, i < 10, i++; t++, t = t*1 =; Print[t]]

Attempt#3 (times = Table[ Inactive[Times][a, b] == a b, {a, 999}, {b, 999}]) // TableForm

Attempt#4 (AFTER TAKING ADVICE FROM YOU ALL) mydata = Table[a*b, {a, 100, 999}, {b, 100, 999}] Select[mydata, PalindromeQ] This only gave me the output of empty brackets, i see that PalindromeQ is the function but it only gives true or false. how do i make a statement where if palindromeQ is true to print Palindrome? HELP!!

Attempt #5 mydata = Table[a*b, {a, 100, 999}, {b, 100, 999}] Select[list[mydata], PalindromeQ]

$\endgroup$
24
  • $\begingroup$ Welcome to the Mathematica Stack Exchange. It is a homework question or a self-learning exercise, so forum participants would appreciate it if you could include copy-paste-able Mathematica code for what you have tried out so far. Thanks. $\endgroup$
    – Syed
    Sep 2, 2022 at 17:53
  • $\begingroup$ ok will post that now $\endgroup$
    – SugarFoot
    Sep 2, 2022 at 18:12
  • 1
    $\begingroup$ As for creating a table of products of 3-digit factors, your third attempt is the most promising. Since you're only interested in 3-digit numbers, you can use indices like {a,100,999} and {b,100,999}. $\endgroup$
    – lericr
    Sep 2, 2022 at 18:25
  • 1
    $\begingroup$ I can see that you're trying to produce something that you can inspect visually, but you're going to have a huge table. It would be better to just generate the data, maybe save it in a variable, and then run functions over the data to analyze it. So, dispense with the Inactive and TableForm. You already had the idea of using PalindromeQ, so instead of viaually inspecting, use Select and PalindromeQ to filter your data. $\endgroup$
    – lericr
    Sep 2, 2022 at 18:27
  • 1
    $\begingroup$ You might try this with smaller tables first to avoid any scaling problems you might run into. Make sure your algorithm is working first, then "sneak" up on the final answer. $\endgroup$
    – lericr
    Sep 2, 2022 at 18:28

4 Answers 4

1
$\begingroup$
Clear["Global`*"]

You should store the minimum amount of information necessary. Further, you need only look at the cases for b >= a

{#[[1]], #[[2]], Times @@ #} &[
 SortBy[
   Flatten[
    Table[
     If[PalindromeQ[a*b], {a, b}, Nothing],
     {a, 100, 999}, {b, a, 999}],
    1],
   Times @@ # &][[-1]]]

(* {913, 993, 906609} *)

EDIT: If you also require the factors to be palindromes,

{#[[1]], #[[2]], Times @@ #} &[
 SortBy[
   Flatten[
    Table[
     If[And @@ (PalindromeQ /@ {a, b, a*b}), {a, b}, Nothing],
     {a, 100, 999}, {b, a, 999}],
    1],
   Times @@ # &][[-1]]]

(* {777, 858, 666666} *)
$\endgroup$
1
  • $\begingroup$ I think this answer was a bit too complex for a beginner like me to understand but thanks for contributing! the answer i came up with is below. It took some getting to and it may not be instantaneous but damnit I got the answer so now i can eat. I wasnt going to eat until I came up with an answer i could understand. $\endgroup$
    – SugarFoot
    Sep 2, 2022 at 20:33
1
$\begingroup$

If one wants to avoid using PalindromeQ:

all = DeleteDuplicates@
   Flatten[Table[IntegerDigits[i j], {i, 100, 999}, {j, 100, 999}], 1];

palindromes = Select[all, # == Reverse[#] &];

FromDigits@First@MaximalBy[palindromes, FromDigits]

(* 906 609 *)
$\endgroup$
1
$\begingroup$
Do[
  If[PalindromeQ[i*j], Print[{i, j, i*j}]; Break[]],
  {i, 999, 100, -1},
  {j, 999, i, -1}
]
$\endgroup$
0
$\begingroup$

Thanks to all those who helped make this answer possible. As someone has commented, this may be the long way home but hey,we got home :-)

mydata = Table[a*b, {a, 100, 999}, {b, 100, 999}]
mydata2 = Select[Flatten[mydata], PalindromeQ]
TakeLargest[mydata2, 1]

Im just learning my way through Mathematica so this helps a ton, thanks again.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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