Triangular numbers boolean function

Question

I read the new book by Paul Wellin Programming in Mathematica. There is an exercise about triangular numbers. (The n-th triangular number is defined as the sum of the integers 1 through n.
They are so named because they can be represented visually by arranging rows of dots in a triangular manner. The first ten triangular numbers are: 1, 3, 6, 10, 15, 21, 28, 36, 45.)

In the solution there are given functions which will give the nth triangular number.

For instance:

f1[n_] := Total[Range[n]]

f2[n_] := Fold[#1 + #2 &, 0, Range[n]]

f3[n_] := Binomial[n + 1, 2]

Regarding the timings, we have f3 > f1 > f2 (using the number 50000005000000 from Wellin's book) (in my laptop t3 = 0.01 sec, t1 = 0.18 sec, t3 = 3.8 sec).

I was thinking about a boolean function that will return true or false, whether the number is triangular or not.

My procedural style approach is:

triangularQ[n_] :=
 Module[{y, dy}, For[y = 0; dy = 1, y < n, y += dy++];
  If[y == n, Print[True], Print[False]]]

But it does not look so efficient.

Are there other approaches that use functional programming?

It seems good to compare the various solutions (the number 50000005000000 is from Wellin's book).

First the procedural:

In[182]:= triangularQ[50000005000000] // Timing

During evaluation of In[182]:= True

Out[182]= {41.562500, Null}

Aky's

In[185]:= f[x_, n_] := f[x - n, n + 1]; f[0, n_] := True;
f[x_ /; x < 0, n_] := False

In[193]:=
Block[{$IterationLimit = ∞}, f[50000005000000, 1]] // Timing

Out[193]= {114.703125, True}

Eldo's

I coud not get true for

MemberQ[ f2 /@ Range@(10^7), 50000005000000]

in reasonable time (less than $2$ minutes).

Nasser's

In[226]:= triangularQ[50000005000000] // Timing

During evaluation of In[226]:= True

Out[226]= {41.421875, Null}

So the procedural style is not deficient at all :-)!

Answer 1

Here is another approach (based on $t_n=\frac{n(n+1)}{2}$):

fn[x_] := Mod[Sqrt[1 + 8 x], 2] == 1

For the test example fn[3003] is true:

Just for fun (but factoring extremely large numbers an issue):

an[x_?(# > 0 &)] := 
 Abs[# - 2 x/#] & @@ Nearest[Divisors[ 2 x], Sqrt[2 x]] == 1
an[0] := True

Just for illustration (and not proof but are straightforward to show): this is picking from 0,1,...,100 the triangular numbers.

fnf = Pick[Range[0, 100], fn[#] & /@ Range[0, 100]]
anf = Pick[Range[0, 100], an[#] & /@ Range[0, 100]]
tn = Table[j (j + 1)/2, {j, 0, Length[anf] - 1}]
Grid[Prepend[
  Transpose[
{tn, fnf, anf}], {"Triangular number", "fn", "an"}], 
 Frame -> All]

UPDATE

Testing the case in edited question (and using Mr Wizard timeAvg function):

timeAvg[func_] := 
 Do[If[# > 0.3, Return[#/5^i]] & @@ Timing@Do[func, {5^i}], {i, 0, 
   15}]
{timeAvg[#], #} &@fn[50000005000000]

yields:{1.47200*10^-8, True}

Answer 2

There is an especially useful function HarmonicNumber appearing most likely the best approach in similar tasks since its implementation is optimized and it has close relations to number theoretic functions like the Riemann zeta function ζ represented in Mathematica by Zeta, basically HarmonicNumber tends to Zeta for Re[z] > 1 :

Limit[ HarmonicNumber[n, z], n -> Infinity, Assumptions -> Re[z] > 1]

Zeta[z]

where z can be an arbitrary complex number with the real part greater than $1$.

We ask if a given integer k is triangular, i.e. if there exist another integer n such that $$1 + 2 + \ldots + n = k$$ Here is a straightforward implementation of natural (direct) approach:

tri[k_Integer] := Resolve @ Exists[ n, n ∈ Integers && n > 0, 
                                    k == HarmonicNumber[n, -1]]

It works this way:

tri /@ Range[3, 10]

{True, False, False, True, False, False, False, True}

It can be generalized to a more universal solution, namely when we are looking for higher order triangular numbers, e.g. HarmonicNumber[n, -p] yields the following sum $$1^p + 2^p + \ldots + n^p = k(n,p)$$

tri[k_Integer, p_Integer] := Resolve @ Exists[ n, n ∈ Integers && n > 0, 
                                                 k == HarmonicNumber[n, -p]]

e.g. this gives a few first order triangular numbers

{#, HarmonicNumber [n, -#]} & /@ Range[5] // TableForm // TraditionalForm

and of course

HarmonicNumber[n, -p] == Sum[k^p, {k, n}]

True

To conclude we underline that the solution based on HarmonicNuber is the fastest, the most general and sheds light on crucial number theoretic objects.

Answer 3

The $n^{th}$ triangle number satisfies Binomial[n+1,2], therefore, solving for m=Binomial[n+1,2] and checking if the solution is an integer gives the answer directly.

triangularQ[m_] := IntegerQ@(n /. First@Solve[Binomial[n + 1, 2] == m, n])

{#, triangularQ[#]} & /@ Range[2, 28] // TableForm

reference: http://en.wikipedia.org/wiki/Triangular_number

Answer 4

Well, not to beat a dead horse, but there is a way to do this using simple arithmetic, the pieces of which are in some of the responses given so far. Since any triangular number T is equal to n(n+1)/2 for some n, a bit of algebraic manipulation gives:

2T = n^2 + n
8T = 4n^2 + 4n

Completing the square:

8T + 1 = 4n^2 + 4n + 1
       = (2n+1)^2

So, T is triangular if 8T+1 is an odd perfect-square. Here then is the test:

SquareNumberQ[n_]:= IntegerQ[Sqrt[n]];
TriangularNumberQ[t_]:= OddQ[Sqrt[8t+1]] && SquareNumberQ[8t+1]

TriangularNumberQ[50000005000000]//Timing
{0.000045, True}

Finding all triangular numbers less than 10^6 takes about 8 seconds on my computer using

Select[Range[10^6], TriangularNumberQ]

Answer 5

MemberQ[f2 /@ Range@1000, 3003]

True

With[{r = Range@10, tri = f2 /@ Range@1000}, Transpose[{r, MemberQ[tri, #] & /@ r}]] // TableForm

Take[CoefficientList[Series[x/(1 - x)^3, {x, 0, 100}], x], -10]

{4186, 4278, 4371, 4465, 4560, 4656, 4753, 4851, 4950, 5050}

Answer 6

This is not a computationally efficient solution, but it works also in a spreadsheet:

nn = 12;
a = Table[Sum[If[n == k*(k + 1)/2, 1, 0], {k, 1, nn}], {n, 1, nn}];
b = Table[If[a[[i]] == 1, True, False], {i, 1, nn}]

Output:

{True, False, True, False, False, True, False, False, False, True, False, False}