MathGroup Archive 2002

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Pascal's Triangle

Below you will find a rather messy piece of code which seems to do what 
you wanted. It is messy because I have quickly adapted a (rather 
different)  graphic representation of a Pascal triangle which I 
produced a couple of years ago at the request of another mathgroup 
contributor. The result is highly imperfect but I have no time to spend 
on improving it. Still it looks fine. The only thing I find strange is 
your request that only triangles that share an edge with a red triangle 
should be colored red. This leaves three types of triangles, red, blue 
and white. I think a Sierpinski (not Zierpinski!) triangle should only 
contain two colours. It was actually harder to make a three colored 
one, but that seemed to be what you requested. Here is my code:

triangle1 = triangle = Table[{N[Sin[2*Pi*(n/3)]],
       N[Cos[2*Pi*(n/3)]]}, {n, 3}];
triangle1[[3,2]] = -2;

translate[l_List, v_] := (v + #1 & ) /@ l;

tr[x_, y_] := Show[Graphics[Line /@ Partition[
        Prepend[translate[triangle, {x, y}],
         Last[translate[triangle, {x, y}]]], 2, 1]],
     AspectRatio -> Automatic, DisplayFunction -> Identity];

tr1[x_, y_] := Show[Graphics[If[Mod[Binomial[i, (i + j)/2], 2] == 1,
       {RGBColor[0, 0, 1], Polygon[translate[triangle, {x, y}]]},
       {RGBColor[1, 0, 0], Polygon[translate[triangle, {x, y}]],
        Polygon[translate[triangle1, {x, y}]],
        Polygon[translate[triangle1, {x + Sqrt[3]/2, y + 3/2}]],
        Polygon[translate[triangle1, {x - Sqrt[3]/2, y + 3/2}]]}]],
     AspectRatio -> Automatic, DisplayFunction -> Identity];

coords[i_, j_] := {j*(Sqrt[3]/2), (-3/2)*i};

p[n_] := Table[tr @@ coords[i, j], {i, 0, n}, {j, -i, i, 2}];

p1[n_] := Table[tr1 @@ coords[i, j], {i, 0, n}, {j, -i, i, 2}];

label[i_, j_] := Text[Binomial[i, (i + j)/2], coords[i, j]];

q[n_] := Graphics[Table[label[i, j], {i, 1, n}, {j, -i, i, 2}]];

pascal[n_] := Show[p1[n], p[n], q[n], DisplayFunction ->
      $DisplayFunction, PlotRange -> {(-n)*(3/2) + 1, 1}];

On Thursday, October 24, 2002, at 03:56 PM, Al Mannon wrote:

> I want to write a program that will create an array of equilateral 
> triangles
> such that in the first row there is 1 triangle, in the second row 
> there is 3
> triangles, in the third row there will be 5 the nth row 
> there
> will be 2n - 1 triangles. Putting all of these triangles together and
> calling the first row, row 0, we would have a large triangle with n + 
> 1 rows
> along the side of the large triangle and 2n - 1 columns along the base 
> of
> the triangle.
> This would be phase one of the project.
> Phase 2: Fill in the binomial coefficients into the triangle.
> Phase 3: Color all odd numbered triangles blue.
> Phase 4: Color all even numbered triangles red.
> Phase 5: Any triangle that shares an edge with a red triangle, color 
> red.
> The result is Zierpinski's Triangle! I have done this by hand for a 
> triangle
> with 16 rows. Needless to say the work was tedious. The result, 
> however, is
> quite satisfying and remarkable. I would like to be able to use this 
> as a
> tool to teach some of the other derivations that are possible from 
> Pascal's
> triangle other than binomial coefficients and combinations. Therefore 
> it
> would be beneficial to be able to reproduce this work at will.
> Since my Mathematica programming skills are practically nil, any help 
> would
> be appreciated.
> I can be reached directly by electronic mail by deleting "the" in the
> following:
> althemannon at
Andrzej Kozlowski
Yokohama, Japan

  • Prev by Date: Re: Off by 0.00000001, Why?
  • Next by Date: Re: how to get a real fortran file
  • Previous by thread: Re: Pascal's Triangle
  • Next by thread: matrix multiplication