Re: Pascal's Triangle
- To: mathgroup at smc.vnet.net
- Subject: [mg37389] Re: [mg37349] Pascal's Triangle
- From: Andrzej Kozlowski <andrzej at platon.c.u-tokyo.ac.jp>
- Date: Sat, 26 Oct 2002 02:03:19 -0400 (EDT)
- Sender: owner-wri-mathgroup at wolfram.com
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 triangles...in 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 attbi.com
>
>
>
>
Andrzej Kozlowski
Yokohama, Japan
http://www.mimuw.edu.pl/~akoz/
http://platon.c.u-tokyo.ac.jp/andrzej/