Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

Re: Number-Theory :: All-Digit Perfect Squares

• To: mathgroup at smc.vnet.net
• Subject: [mg64283] Re: [mg64264] Number-Theory :: All-Digit Perfect Squares
• From: János <janos.lobb at yale.edu>
• Date: Thu, 9 Feb 2006 02:44:53 -0500 (EST)
• References: <200602080854.DAA25655@smc.vnet.net>
• Sender: owner-wri-mathgroup at wolfram.com

On Feb 8, 2006, at 3:54 AM, bd satish wrote:

>         Hi buddies,
>
>
>                          I set out to write a code that generates  
> nine-digit
> perfect square numbers , with each of the digits 1,2,3,...9  
> occuring only once
> in a given number. An example is 139854276  = 11826^2 .  
> Obviuously , all
> such numbers must lie in the interval [123456789 , 987654321] . Since
> 11111^2 < 123456789 and 31427^2 > 987654321 ,  all the square  
> numbers must
> have their square-roots
> in the interval (11111,31427) .
>
>               I need suggetions from you guys to help me improve  
> the code or
> to make it better or
>  shorter.
>
>                            The logic I used is this:
>
>  (a).  Generate all the squares of integers in the range [11111,31427]
>
>  (b).  Seperate the numbers into digits (using the command  
> IntegerDigits[ ]
> )
>
>  (c).  Check , how many (or which and all)  numbers in this list   
> have each
> of the digits 1,2,3,...8,9 exactly once.
>
>  (d).  Collect all those lists and put them back as numbers (using the
> command FromDigits[ ] )
>
>
>            Here is the actual code:
>
>  squares = IntegerDigits[Table[i ^ 2 , { i,11111,31427}]];
>  sel = { } ; (* empty-list*)
>  Do[
>        p = squares[[k]];
>        logic =
> And[MemberQ[p,1],MemberQ[p,2],MemberQ[p,3],MemberQ[p,4],MemberQ[p, 
> 5],MemberQ[p,6],
>                    MemberQ[p,7],MemberQ[p,8],MemberQ[p,9] ] ;
>
>        If[TrueQ[logic] , sel = Append[sel,p]] ,
>        {k,1,Length[squares]}
>     ];
>  Map[FromDigits,sel,{1}]
>
>  The code does work perfectly, giving a list of 30 such  numbers.
>
>  Will anyone help to to improve the code , if possible ?
>
>  I would like to get rid of MemberQ[..] repeated so often.
>

Here is a newbie approach, using the fact that Union will give you  
back a sorted list with non-repeating elements;
In[1]:=
a = 11111;
b = 31427;
abrange = b - a;

In[4]:=
sol = Timing[Last[
     Reap[i = 0; While[
        i <= abrange,
        If[Length[Union[
           Characters[
           StringReplace[
           ToString[(a + i)^
           2], "0" ->
           ""]]]] == 9,
          Sow[a + i], Null];
         i++; ]; ]]]
Out[4]=
{0.674188*Second,
   {{11826, 12363, 12543,
     14676, 15681, 15963,
     18072, 19023, 19377,
     19569, 19629, 20316,
     22887, 23019, 23178,
     23439, 24237, 24276,
     24441, 24807, 25059,
     25572, 25941, 26409,
     26733, 27129, 27273,
     29034, 29106, 30384}}}

János


----------------------------------------------
Trying to argue with a politician is like lifting up the head of a  
corpse.
(S. Lem: His Master Voice)

• References:
  • Number-Theory :: All-Digit Perfect Squares
    • From: bd satish <bdsatish@gmail.com>