Diophantus's approach
Diophantus (Book II, problem 9) gives parameterized solutions to x^2 + y^2 == z^2 + a^2
, here parametrized by C[1]
, which may be a rational number (different than 1
). We can use his method to find solutions to the OP's case, a == 1
. Since Diophantus' method produces rational solutions, we have to clear denominators to get a solution in integers. This complicates searching for solutions with a == 1
.
ClearAll[diophantusII9, opcase];
diophantusII9[x_, y_] := Module[{t, t0},
t0 = Solve[(t + x)^2 + (C[1] t - y)^2 == x^2 + y^2, t];
{x, y, t + x, C[1] t - y} /. Last@t0
];
opcase[seedx_, seedy_] :=
Module[{p, sol},
sol = diophantusII9[seedx, seedy];
Select[
LCM @@ Denominator[#] # & /@ Abs[sol /. Flatten[
Solve[# == 1, C[1], Rationals] & /@ Numerator@Together@sol,
1]],
MemberQ[#, 1] &]
];
Example:
diophantusII9[5, 7]
opcase[5, 7]
(*
{5, 7, 5 + (2 (-5 + 7 C[1]))/(1 + C[1]^2), -7 + (2 C[1] (-5 + 7 C[1]))/(1 + C[1]^2)}
{{25, 35, 43, 1}}
*)
Now, it is not the case that every opcase[x, y]
produces solutions. A necessary condition is for there to be a solution with a == 1
is that
(x + Sqrt[x^2 + y + y^2])/y
is an integer. Searching up to x
or y
equal to 50
yields 16
solutions:
With[{$max = 50},
Flatten[
opcase @@@ (Position[
Table[IntegerQ[(x + Sqrt[x^2 + y + y^2])/y], {x, 2, $max}, {y,
2, $max}], True] + 1),
1]
]
Subtract @@@ Total[Partition[%^2, {Length[%], 2}], {4}] (* verify *)
Length@First[%]
(*
{{10, 15, 18, 1}, {25, 35, 43, 1}, {40, 55, 68, 1}, {55, 75, 93, 1},
{221, 119, 251, 1}, {70, 95, 118, 1}, {85, 115, 143, 1}, {100, 135, 168, 1},
{115, 155, 193, 1}, {130, 175, 218, 1}, {476, 255, 540, 1}, {145, 195, 243, 1},
{1184, 407, 1252, 1}, {160, 215, 268, 1}, {175, 235, 293, 1}, {731, 391, 829, 1}}
{{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}}
16
*)
Improvement to Diophantus' approach
Note that the approach above misses solutions, such as {4, 7, 8}
or {14, 17, 22}
. Indeed, I do not think it can produce {14, 17, 22}
. Applying a little thought to Diophantus's method yields the following improvement to finding nontrivial solutions. (A trivial solution is one in which x
or y
is 1
; there are no nontrivial solutions with x
and y
less than 4
.)
ClearAll[nontrivial];
nontrivial[a_] /; a >= 4 := Sort /@ Join[
With[{d = Divisors[a + 1]},
Select[{a, (# (a - 1) - (a + 1)/#)/2} & /@ d[[2 ;; -2]], VectorQ[#, IntegerQ] &]
],
With[{d = Divisors[a - 1]},
Select[{a, (# (a + 1) - (a - 1)/#)/2} & /@ d[[2 ;; -2]], VectorQ[#, IntegerQ] &]
]
]
Example:
Join @@ Table[nontrivial[n], {n, 4, 10}] // DeleteDuplicates
(* {{5, 5}, {4, 7}, {7, 11}, {8, 9}, {9, 19}, {10, 15}} *)
Here we find several thousand nontrivial solutions:
(sols = Join @@ Table[nontrivial[n], {n, 4, 1000}] // DeleteDuplicates) //
Length // AbsoluteTiming
(* {0.160005, 6602} *)
AllTrue[sols, IntegerQ@Sqrt[#.# - 1] &]
(* True *)
Reduce[x^2 + y^2 == z^2 + 1, {x, y, z}, Integers]
. $\endgroup${1, n, n}
and{n, 1, n}
are solutions for any integern
. $\endgroup$