Improving do loop speed with IntegerQ conditions

Question

The following program runs rather slow when the upper bound for n gets large (~6 secs for 10^5).

triangleA[a_, b_, c_] := Sqrt[(a + b + c)/2 ((a + b + c)/2 - c)];
perimeterTot = 0.; Do[{If[IntegerQ@triangleA[n, n, n + 1] == True, 
perimeterTot = perimeterTot + 3 n + 1], 
If[IntegerQ@triangleA[n, n, n - 1] == True, 
perimeterTot = perimeterTot + 3 n - 1]}, {n, 2, 333333333}]

I'm not sure what's causing this--the IntegerQ function or just the inefficiency of do loops in Mathematica? I'd appreciate any suggestion

Answer 1

There is an analytic solution.

For the (n,n,n+1) triangle, the area is Sqrt[(n-1)(3n+1)]/2.

Area -> FullSimplify[triangleA[n, n, n + 1]]

The valid values of n are Sloane's A103974, the smaller sides in (n,n,n+1)-integer triangle with integer area.

Table[Simplify[((2 + Sqrt[3])^(2 k) + (2 - Sqrt[3])^(2 k) + 1)/3], {k,0,10}]

{1, 5, 65, 901, 12545, 174725, 2433601, 33895685, 472105985, 6575588101, 91586127425}

For the (n,n,n-1) triangle, the area is Sqrt[(n+1)(3n-1)]/2.

Area -> FullSimplify[triangleA[n, n, n - 1]]

The valid values of n are Sloane's A103772, the larger sides in (n,n,n-1)-integer triangle with integer area.

Table[
      Round[(-1 + (7-4*Sqrt[3])^k*(2+Sqrt[3]) - (-2+Sqrt[3])*(7+4*Sqrt[3])^k)/3],
      {k,2,10}]

{17, 241, 3361, 46817, 652081, 9082321, 126500417, 1761923521, 24540428881}

For all valid values of n less than or equal to a maximum m, sum 3n+1 or 3n-1.

perimeterSum[m_] :=
   Block[{area = 0, k, n},
      k = 1;
      While[(n = Simplify[((2 + Sqrt[3])^(2 k) + (2 - Sqrt[3])^(2 k) + 1)/3]) <= m,
         k += 1;
         area += (3 n + 1)];
      k = 2;
      While[(n = Round[(-1 + (7-4*Sqrt[3])^k*(2+Sqrt[3]) - (-2+Sqrt[3])*(7+4*Sqrt[3])^k)/3]) <= m,
         k += 1;
         area += (3 n - 1)];
      area
   ]

The solution is very fast.

AbsoluteTiming[perimeterSum[10^6]]

{0.001005, 2672274}

Answer 2

This is a partial answer only.

At the core you need a fast way of checking whether or not an integer is a perfect square. Here is a version that is moderately fast, to be optimized:

squareQ[n_] := MemberQ[{0, 1, 4, 9}, Mod[n, 16]] && IntegerQ[Sqrt[n]]

The triangle is simplified for the two specific cases:

triangleA[a_, b_, c_] = Sqrt[(a + b + c)/2 ((a + b + c)/2 - c)];
t1[n_] = triangleA[n, n, n + 1]^2 // FullSimplify;
t2[n_] = triangleA[n, n, n - 1]^2 // FullSimplify;

The search is now about 3 times faster:

perimeterTot = 0;
Do[If[squareQ[t1[n]], perimeterTot += 3 n + 1];
   If[squareQ[t2[n]], perimeterTot += 3 n - 1], {n, 2, 10^5}]

To improve on this, look into superfast implementations of squareQ, inspired for example by this question and this Java thread. Probably compiling, or even hand-writing a C subroutine, would help.