Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2006
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2006

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

Search the Archive

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

  • To: mathgroup at smc.vnet.net
  • Subject: [mg64281] Re: Number-Theory :: All-Digit Perfect Squares
  • From: "Scout" <Scout at nodomain.com>
  • Date: Thu, 9 Feb 2006 02:44:48 -0500 (EST)
  • References: <dscd0p$pcm$1@smc.vnet.net>
  • Sender: owner-wri-mathgroup at wolfram.com

"bd satish" <bdsatish at gmail.com>
>        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.
>
>

In[1]:= Timing[
        FromDigits/@Select[IntegerDigits[#^2]&/@Range[11111,31427],PermutationQ]
      ]

Out[1]=
{0.156 Second,
    {139854276,152843769,157326849,215384976,245893761,254817369,
    326597184,361874529,375468129,382945761,385297641,412739856,523814769,
    529874361,537219684,549386721,587432169,589324176,597362481,615387249,
    627953481,653927184,672935481,697435281,714653289,735982641,743816529,
    842973156,847159236,923187456}
}

In[2]:= Length[%[[2]]]
Out[2]= 30

    ~Scout~ 


  • Prev by Date: Re: Number-Theory :: All-Digit Perfect Squares
  • Next by Date: Re: Remove Indeterminate elements
  • Previous by thread: Re: Number-Theory :: All-Digit Perfect Squares
  • Next by thread: Re: Re: Number-Theory :: All-Digit Perfect Squares