current community

your communities

more stack exchange communities

Stack Exchange
tour help
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.
up vote 3 down vote favorite

I read the new book of Paul Wellin for Programming in Mathematica. There is an exercise about triangular numbers. (The nth 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 = \[Infinity]}, 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 2 days ago
    
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 2 days ago
    
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 yesterday
    
I obtain much quicker times (<1ms) than you cite for @Nasser Binomial approach - you may want to Clear formulae and variables and retest? –  PlaysDice yesterday
    
You are right! My apologies to Nasser! –  dimitris yesterday
add comment

5 Answers

up vote 3 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 2 days ago
    
Definetely, very quick! –  dimitris 2 days ago
    
@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 yesterday
    
@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 yesterday
    
@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 8 hours ago
add comment
up vote 4 down vote

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
add comment
up vote 3 down vote

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
1  
always learning something...thank you for nice answer –  ubpdqn 2 days ago
add comment
up vote 2 down vote 
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
add comment
up vote 1 down vote

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
add comment

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.