# equidistant solutions in Sequence Sums That Are Squares

In my demonstration "Sequence Sums That Are Squares" I demonstrate two "lines" of solutions (of infinite length) and ask whether someone can find one more line.

I am looking forward to your solution. I did not find a third line of solutions.

-
Dear Karl, welcome to Mathematica.SE! The reason your "question" has been down voted by others is that it isn't really posed as a question. It would also be good to add some more information. I have added a link to the demonstration, but it might be good to show some more workings on what you tried to find more lines. Some code would really help. I'm not going to close your question just yet, but please come back and edit it, or else we will have to close it as not a real question. – Verbeia Jan 16 '14 at 10:19

What you have found are not lines of infinite length, unless you can prove that they are, by induction e.g.

What I want to show is still not a proof for anything but a solution, not great but works, how to find more such lines.

Let generate the data

k = 300;
l = Reap[Do[If[IntegerQ[Sqrt[1/2 (1 + m - n) (m + n)]], Sow@{n, m}],
{n, k}, {m, n + 1, k}]
][[ 2, 1]];
(*and a subset where coordinates are less than z*)
z = 70;
set = Select[l, #[[ 1]] < z && #[[ 2]] < z &];
(*now we are generating a set of vectors pointing between each pair of set.*)
(*and then we are deleting duplicates etc. we want to vy>wx, otherwise it can;t be infinite*)
v = (Sort /@
GatherBy[
Select[#2 - # & @@@ Subsets[set, {2}],
#[[ 1]] < #[[ 2]] && #[[ 1]] > 0 && #[[ 2]] > 0 &], #[[ 2]]/#[[ 1]] &
]
)[[ ;; , 1]];

(*looking for euch points (x) that x+v and x+2v and so on withing the range*)
(*are members of l *)
lines = GatherBy[
Reap[
Do[
Scan[
With[{max = Floor@Min[(300 - set[[ i]])/#]},
If[Length[Complement[Table[set[[i]] + k #, {k, max}], l]] == 0,
Sow[{set[[ i]], #, max}]]
] &,
v]
, {i, 1, Length@set}]
][[ 2, 1]]
, #[[ 2]] &][[ ;; , 1]]


Ok, it seems there are more than one:

ListPlot[l, AspectRatio -> 1, ImageSize -> 1000, GridLines -> {Automatic, Automatic},
Frame -> True, PlotStyle -> {AbsolutePointSize@10, GrayLevel@.5},
Epilog -> {{Hue@RandomReal[], Dashed, Line[{#, # + 200 #2}],
AbsolutePointSize@5,
Point[Table[# + i #2, {i, 0, #3}]]} & @@@ lines},
Background -> Black]


-