Wolfram Mathematica Code please [closed]

Question

Consider two natural numbers of two-digits, like 46 and 96. They have the property that by exchanging the place of their digits and multiplying the so obtained numbers, we get the same product; i.e.,

46 96 == 64 69

(* True *)

a. [4 points] How many pairs of two-digit natural numbers have this property?

b. [2 points] How many pairs so multiplied result in four different digits?

Answer 1

You can use brute force like this for (a)

data = Range[11, 99];
result = First@Last@Reap@Do[
      d = IntegerDigits[data[[n]]];
      n1 = d[[1]];
      n2 = d[[2]];
      Do[
       d = IntegerDigits[data[[m]]];
       m1 = d[[1]];
       m2 = d[[2]];
       If[(n1 + n2*10)*(m1 + m2*10) == (n2 + n1*10)*(m2 + m1*10),
        Sow[{n1 + n2*10, m1 + m2*10}]
        ]
       ,
       {m, 1, Length[data]}
       ],
      {n, 1, Length[data]}
      ];

Length[result]
(* 209 *)

Which gives

result

{{11, 11}, {11, 22}, {11, 33}, {11, 44}, {11, 55}, {11, 66}, {11, 
  77}, {11, 88}, {11, 99}, {21, 12}, {21, 24}, {21, 36}, {21, 
  48}, {31, 13}, {31, 26}, {31, 39}, {41, 14}, {41, 28}, {51, 
  15}, {61, 16}, {71, 17}, {81, 18}, {91, 19}, {12, 21}, {12, 
  42}, {12, 63}, {12, 84}, {22, 11}, {22, 22}, {22, 33}, {22, 
  44}, {22, 55}, {22, 66}, {22, 77}, {22, 88}, {22, 99}, {32, 
  23}, {32, 46}, {32, 69}, {42, 12}, {42, 24}, {42, 36}, {42, 
  48}, {52, 25}, {62, 13}, {62, 26}, {62, 39}, {72, 27}, {82, 
  14}, {82, 28}, {92, 29}, {13, 31}, {13, 62}, {13, 93}, {23, 
  32}, {23, 64}, {23, 96}, {33, 11}, {33, 22}, {33, 33}, {33, 
  44}, {33, 55}, {33, 66}, {33, 77}, {33, 88}, {33, 99}, {43, 
  34}, {43, 68}, {53, 35}, {63, 12}, {63, 24}, {63, 36}, {63, 
  48}, {73, 37}, {83, 38}, {93, 13}, {93, 26}, {93, 39}, {14, 
  41}, {14, 82}, {24, 21}, {24, 42}, {24, 63}, {24, 84}, {34, 
  43}, {34, 86}, {44, 11}, {44, 22}, {44, 33}, {44, 44}, {44, 
  55}, {44, 66}, {44, 77}, {44, 88}, {44, 99}, {54, 45}, {64, 
  23}, {64, 46}, {64, 69}, {74, 47}, {84, 12}, {84, 24}, {84, 
  36}, {84, 48}, {94, 49}, {15, 51}, {25, 52}, {35, 53}, {45, 
  54}, {55, 11}, {55, 22}, {55, 33}, {55, 44}, {55, 55}, {55, 
  66}, {55, 77}, {55, 88}, {55, 99}, {65, 56}, {75, 57}, {85, 
  58}, {95, 59}, {16, 61}, {26, 31}, {26, 62}, {26, 93}, {36, 
  21}, {36, 42}, {36, 63}, {36, 84}, {46, 32}, {46, 64}, {46, 
  96}, {56, 65}, {66, 11}, {66, 22}, {66, 33}, {66, 44}, {66, 
  55}, {66, 66}, {66, 77}, {66, 88}, {66, 99}, {76, 67}, {86, 
  34}, {86, 68}, {96, 23}, {96, 46}, {96, 69}, {17, 71}, {27, 
  72}, {37, 73}, {47, 74}, {57, 75}, {67, 76}, {77, 11}, {77, 
  22}, {77, 33}, {77, 44}, {77, 55}, {77, 66}, {77, 77}, {77, 
  88}, {77, 99}, {87, 78}, {97, 79}, {18, 81}, {28, 41}, {28, 
  82}, {38, 83}, {48, 21}, {48, 42}, {48, 63}, {48, 84}, {58, 
  85}, {68, 43}, {68, 86}, {78, 87}, {88, 11}, {88, 22}, {88, 
  33}, {88, 44}, {88, 55}, {88, 66}, {88, 77}, {88, 88}, {88, 
  99}, {98, 89}, {19, 91}, {29, 92}, {39, 31}, {39, 62}, {39, 
  93}, {49, 94}, {59, 95}, {69, 32}, {69, 64}, {69, 96}, {79, 
  97}, {89, 98}, {99, 11}, {99, 22}, {99, 33}, {99, 44}, {99, 
  55}, {99, 66}, {99, 77}, {99, 88}, {99, 99}}

If you want to eliminate the {nn, mm} pairs, which will always be true, such as {99,77} then it will reduce the size ofcourse. This can be done by an extra If.

Your {46, 96} is in there. Part b can now be solved easily from the above list by multiplying each result and finding if the result has 4 different digits or not.

Answer 2

Here's a function that reverses a number

rev[x_]:=FromDigits@Reverse@IntegerDigits@x

Here's an interesting way to filter results once you get them.

If we know that a list of numbers {a,b} has a b==rev@a rev@b, we don't really care that {rev@a,rev@b} has that property, or the reverse of that list. So if your result is list, you can do

list//.{a___,{x_,y_},b___,OrderlessPatternSequence@{z_,w_},c___}/;
      {x,y}=={rev@z,rev@w}:>{a,{x,y},b,c}

to remove some obvious terms. This is computationally expensive, but conceptually simple. I'm replacing instances of stuff which includes pairs {x,y} and {z,w} for which x==rev@z and y==rev@w with just the stuff with {x,y} and not {z,w}.

• //., ReplaceRepeated does the replacing
• a___, b___, c___ each mean 'stuff', BlankNullSequence
• {x_,y_} and OrderlessPatternSequence@{z_,w_} mean pairs, and they're spliced between a,b,c with any amount of elements in between or before or after, and it could be {w,z} instead of {z,w}
• /;, Condition is the 'such that'
• Finally, the :> is RuleDelayed, used by //. to substitute in a new list with {z,w} absent.

Other obvious cases for {x,y} are when x has x==rev@x or x==rev@y or when there's divisibility, so you can do these simpler rules only once (with /. instead of //.) like so

list/.OrderlessPatternSequence@{x_,y_}/;
    Or[x==rev@x,x==rev@y,Divisible[rev@x,y]]->Nothing//.
    {a___,{x_,y_},b___,OrderlessPatternSequence@{z_,w_},c___}/;
  {x,y}=={rev@z,rev@w}:>{a,{x,y},b,c}

Doing this with list the full 10000 guys results in a fairly minimal set of pairs, which have GCDs ranging from 1 to 12.