Recursive function which uses Which

It can be done with a recursive function that uses Which, but that function won't be able to compute the answer for large values of the sum. Here is how such a recursive function is properly written.

Clear[findTriple]
findTriple[sum_, a_: 1, b_: 2] :=
  Block[{$RecursionLimit = 100000, c = Sqrt[a^2 + b^2]},
    Which[
      a + b + c == sum, {a, b, c},
      b <= sum/2, findTriple[sum, a, b + 1],
      a <= sum/2, findTriple[sum, a + 1, a + 2],
      True, Failed[a, b, c]]]

With this definition

findTriple[420]

{28, 195, 197}

works on my computer, but

findTriple[421]

doesn't complete because it runs out of memory.

So does this mean Mathematica can't solve the problem recursively. No, it doesn't. It means we must be more careful about how we write the recursion; we must make it tail-recursive, like so:

Clear[helper]
helper[sum_, a_, b_] /; a + b + Sqrt[a^2 + b^2] == sum := {a, b, Sqrt[a^2 + b^2]}
helper[sum_, a_, b_] /; b <= sum/2 := helper[sum, a, b + 1]
helper[sum_, a_, b_] /; a <= sum/2 := helper[sum, a + 1, a + 2]
helper[_, a_, b_] := Failed[a, b, Sqrt[a^2 + b^2]]

Clear[findTriple]
findTriple[sum_] :=
  Block[{$IterationLimit = 100000}, helper[sum, 1, 2]]

findTriple[1000]

{200, 375, 425}

Since all the real work is done when the righthand side of helper is evaluated, this version is both fast and uses little memory.


To avoid the Recursion error you can instead use NestWhile, which effectively implement the same logic in a more efficient manner:

NestWhile[
 Which[
   #[[2]] < 500, {#[[1]], #[[2]] + 1},
   #[[1]] < 500, {#[[1]] + 1, #[[1]] + 2},
   True, Abort[]
   ] &,
 {1, 2},
 (Total@# + Norm@# != 1000) &
 ]
(* Out[1]= {200, 375} *)

An easy way to solve the problem without using recursion is to instead just use SelectFirst, as in:

SelectFirst[
 Subsets[Range@500, {2}],
 Norm@# + Total@# == 1000 &
 ]

Also, for a much faster solution, you should have a look at Mr.Wizard's function to generate Pythagorean triples. Using his function and SelectFirst, the solution of the problem is obtained immediately with:

SelectFirst[
 genPTunder[500],
 Total@# == 1000 &
 ]