programming mathematica to find a specific perfect square number set

Question

A colleague of mine gave the following question to his C programming class which i found very interesting. It can easily be done in any programming language and immediately i thought wolfram. The question is this:

The number 25 is a unique perfect square, If we increase each digit by one, it becomes 36 which is also a a perfect square! write a program to find another set of numbers with the same qualities.

I am sure this can be easily done in mathematica. Can someone explain how i can do this in mathematica. please note the reason of the question is just an excuse to get me into mathematica programming of which i know nothing.

thanks to all.

Answer 1

A more functional solution.

Table[x^2, {x, 1, 100}] // Select[IntegerQ[Sqrt[FromDigits[IntegerDigits[#] + 1]]] &]

How should the digit 9 be handled?

IntegerDigits[19]
(* {1, 9} *)

IntegerDigits[19] + 1
(* {2, 10} *)

FromDigits[IntegerDigits[19] + 1]
(* 30 *)

Should the +1 carry so the resulting number is 20 rather than 30?

Answer 2

You can easily expand this to any base and you only need to know how long the number is in a given base. What I mean is the following. Assume in base 10, the number 25. To check the premise, we need to add 11. But 11 is nothing more than:

25 + 11
= 25 + 10^1 + 10^0
= 25 + (10^2-1)/(10-1)
= 36 = 6^2

imagine now the number 72 × 72 = 5184, but represented in base 3 (5184₁₀ = 21010000₃). Doing now the computation in base 3, you get

21010000 + 11111111
= 21010000 + 3^7 + 3^6 + 3^5 + 3^4 + 3^3 + 3^2 + 3^1 + 3^0
= 21010000 + (3^8-1)/(3-1)
= 102121111 = 10102^2

where 102121111₃ = 8464₁₀ = 92₁₀ × 92₁₀.

As you notice, all you need to do is add the number (bⁿ - 1)/(b-1) to the number and check if it is a square. Here n, represents the total amount of digits of the number x in base b.

With a simple lookuptable, you do this in Mathematica as:

b = 10 
x = Table[n^2, {n, 1, 1000}];
Select[x, MemberQ[x, # + (b^IntegerLength[#, b] - 1)/(b - 1)] &];
{25, 289, 2025, 13225, 100489, 198025, 319225, 466489}

and the full list for base 2 till base 10 is then:

Table[Select[x, MemberQ[x, # + (b^IntegerLength[#, b] - 1)/(b - 1)] &], {b, 2, 10}]

Answer 3

Instead of throwing you into the ocean, lets help you paddle around in the shallow end of the pool first.

n=1;
While[n<100,
  d=IntegerDigits[n];(*get the list of digits making up n*)
  newd=d+1;(*add one to every element of the list giving a new list*)
  newn=FromDigits[newd];(*turn that new list of digits back into a number*)
  If[IntegerQ[Sqrt[newn]],Print[{n,newn}]];
  n++
]

That doesn't only look at square values of n, but it might give you the hint needed about how to increment the digits and test for a square result.

There are always at least a dozen different ways of doing anything in Mathematica and some of the culture revolves around making the programs as short, and potentially cryptic, as possible. You can start picking that up later. Simplicity seems better when getting started with a new language.

I hope you have fun.

Answer 4

find[from_, to_] := Module[{a, b, c, d, e},
  a = Range[from, to];
  b = a^2;
  c = IntegerDigits[b];
  (*Add 1's to the digits of the square,
  except where the square contains a 9*)
  d = MapThread[
    If[MemberQ[#2, 9], Null,
      #1 + FromDigits[ConstantArray[1, Length[#2]]]] &,
    {b, c}];
  (*Find the positions where the square roots are integers*)
  e = Position[Sqrt[d], _?IntegerQ, {1}];
  Extract[a, e]]

find[1, 1000000]

{5, 45, 115, 2205, 245795, 455645}

For example

Sqrt[45^2 + 1111]

56

and

Sqrt[455645^2 + 111111111111]

564556