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/