Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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 :-)!

share|improve this question
1  
Here's a functional approach: define f[x_, n_] := f[x - n, n + 1]; f[0, n_] := True; f[x_ /; x < 0, n_] := False and evaluate f[testNumber, 1], if True it is a triangular number, if False then not. Of course, there's an explicit formula for triangular numbers (try Sum[k, {k, 1, n}]) so using that formula you could simply check whether the number being tested has a positive integral solution in n. But that's no longer a functional programming solution. –  Aky Jul 12 '14 at 10:58
    
Aky I know that formula Sum[k, {k, 1, n}] will return the nth triangular number but I cannot understand what do you mean by "...you could simply check whether the number being tested has a positive integral solution in n..." –  dimitris Jul 12 '14 at 11:28
    
If m is a triangular number then m == n(n+1)/2 will be satisfied by some positive integer n, otherwise it won't. –  Aky Jul 12 '14 at 12:14
    
I obtain much quicker times (<1ms) than you cite for @Nasser Binomial approach - you may want to Clear formulae and variables and retest? –  PlaysDice Jul 12 '14 at 15:34
    
You are right! My apologies to Nasser! –  dimitris Jul 12 '14 at 22:45

6 Answers 6

up vote 5 down vote accepted

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]

enter image description here

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}

share|improve this answer
    
What is this timeAvg function? –  dimitris Jul 12 '14 at 12:11
    
Definetely, very quick! –  dimitris Jul 12 '14 at 12:13
    
@dimitris Mr. Wizard provided this code as a way to get the average timing of a function/procedure by doing it over and over again. You can search the site for more insights. –  ubpdqn Jul 12 '14 at 12:14
    
@ubqdqn +1 how would you code (f.e. with a Manipulate) images like here: link? I tried but ended up with extremely ugly code. –  eldo Jul 12 '14 at 23:16
    
@eldo sorry for the delay in replying...this is related and in the post there is a link to a notebook...I have not looked at this since the time...my code may be ugly: mathematica.stackexchange.com/a/39347/1997 –  ubpdqn Jul 14 '14 at 3:43

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

Mathematica graphics

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

share|improve this answer

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

enter image description here

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.

share|improve this answer
2  
always learning something...thank you for nice answer –  ubpdqn Jul 12 '14 at 11:55
MemberQ[f2 /@ Range@1000, 3003]

True

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

enter image description here

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

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

share|improve this answer

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}

share|improve this answer

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]
share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.