[Date Index]
[Thread Index]
[Author Index]
Re: Integers that are the sum of 2 nonzero squares in
*To*: mathgroup at smc.vnet.net
*Subject*: [mg125750] Re: Integers that are the sum of 2 nonzero squares in
*From*: James Stein <mathgroup at stein.org>
*Date*: Sat, 31 Mar 2012 03:44:00 -0500 (EST)
*Delivered-to*: l-mathgroup@mail-archive0.wolfram.com
*References*: <201203300934.EAA03615@smc.vnet.net>
If my routine below is correct, there are 317,573 distinct numbers k that
can be formed in exactly two ways (no more, no fewer) as the sum of the
squares of two positive numbers not greater than 2000.
(I may have misunderstood, but I think this is the problem you posed, where
'2000' is the bound in the case you ran that "yielded 528,041 pairs of
which about 450,000 seem good."
(2)
My routine is below. The set operations, and the table trimming could be
more efficiently coded, nevertheless it found the 318,173 solutions in less
than 45 seconds (on a year old MacBook Pro). The routine examines sums of
pairs of squares in a sequence that never repeats the two underlying number
pair.
(3)
My routine found 318,173 sums; you say you found "about 450,000." It might
be useful, in either routine, to replace each sum with a tuple {sum,a,b},
making necessary adjustments to the routines. Then the validity of each sum
output could be trivially checked.
I hope I didn't make too many errors, and that this helps.
James
f [ maxSq_ ] :=
Module [ { bin1, bin2, bin3, dup1, dup2, dup3, i = 1, i2, matches, new},
bin1 = bin2 = bin3 = {};
(* bin1: pairs of squares occurring once only *)
(* bin2: pairs of squares occurring twice only *)
(* bin3: pairs of squares occurring thrice or more *)
While [ True,
(* new := new candidate pairs of squares: *)
++i; i2 = i i;
new = Table[i2 + j j, {j, 1, i - 1}];
If [ First [ new ] > maxSq,
Return [ {bin2 // Length, bin2 } ] ];
(* trim new, removing overlarge pairs: *)
If [ Last [ new ] > maxSq,
new = Select[new, # <= maxSq &]];
dup1 = Intersection[bin1, new];
dup2 = Intersection[bin2, new];
dup3 = Intersection[bin3, new];
new = Complement [ new, dup1, dup2, dup3 ];
bin1 = Union [ Complement [ bin1, dup1 ], new ];
bin2 = Union [ Complement [ bin2, dup2 ], dup1 ];
bin3 = Join [ bin3, dup2 ];
];
];
On Fri, Mar 30, 2012 at 2:34 AM, Cisco Lane <travlorf at yahoo.com> wrote:
> Hi - thanks for the help. I should have said 2 positive squares, without
> respect to order. So for the case of 50, its {5,5} and {1,7} only. SquaresR
> gives {5,5},{1,7},{7,1} times four, for the four permutations of sign
> {+,+},{+,_},{-,+} and {-,-}.
>
> I'm trying to find energy eigenfunctions, with energy proportional to n^2.
> An eigenfunction will be a linear combination of all wave functions with
> the same energy. Right now, I'm just concerned with pairs. Then triplets,
> etc.
>
> The slope is an average, so the first 3 does not have enough data points
> to draw any conclusions, I think.
>
> I tried using your method out to 500 to get:
>
> t=Table[{n,PowersRepresentations[n,2,2]},{n,500}];
> tt=First/@Select[t,Length[Last[#]]==2 &] //Rest
>
> {50, 65, 85, 100, 125, 130, 145, 169, 170, 185, 200, 205,
> 221, 225, 250, 260, 265, 289, 290, 305, 338, 340, 365, 370, 377, 400,
> 410, 442, 445, 450, 481, 485, 493, 500}
>
> and the first problem I see is 100 - This is perhaps using {10,10} twice,
> but I don't think 100 is the sum of the squares of a different pair of
> positive integers. The expression I use is:
>
> set2[nmin_, nmax_] := Module[{w, data},
> w = Table[{n1, n2, n1^2 + n2^2}, {n1, nmin, nmax}, {n2, n1, nmax}];
> w = Flatten[w, 1];
> w = Sort[w, #1[[3]] <= #2[[3]] &];
> data = {};
> data = Reap[
> For[i = 1, i <= Length[w] - 2, i++,
> If[(w[[i, 3]] == w[[i + 1, 3]]) && (w[[i, 3]] != w[[i + 2, 3]]),
> Sow[w[[i, 3]]] ]] ];
> data[[2, 1]]
> ]
>
> which takes the sums of two squares of all numbers between nmin and nmax,
> without respect to order, and picks out the ones that occur only twice.
> Kind of inelegant, but it works, except for the higher numbers. For
> example, if you calculate set2[1,250], you get 7656 entries. You will miss
> the ones that match {250,250} that are of the form e.g. {1,250^2}. So the
> "line" goes straight, then takes a jump as some are missed.
>
> I have gone out as far as set2[1,2000] which took 76 seconds on my machine
> and yielded 528,041 pairs of which about 450,000 seem good.
>
>
Prev by Date:
**Fwd: new functional operator... paM is Map spelled backwards**
Previous by thread:
**Re: Integers that are the sum of 2 nonzero squares in exactly 2**
Next by thread:
**simplify Arg[E^(I x)]?**
| |