Re: Sierpinski's thing
- To: mathgroup at smc.vnet.net
- Subject: [mg76776] Re: Sierpinski's thing
- From: Jean-Marc Gulliet <jeanmarc.gulliet at gmail.com>
- Date: Sun, 27 May 2007 04:54:40 -0400 (EDT)
- Organization: The Open University, Milton Keynes, UK
- References: <f38qg9$hq4$1@smc.vnet.net>
Anolethron wrote: > What I'm trying to do is basically constructing a Sierpinski's carpet with > an algorithm that can be generalized to the construction of a Menger Sponge. > > e1 = {1, 0}; e2 = {0, 1}; p1 = {0, 0}; p2 = {1, 0}; p3 = {1, 1}; p4 = {0, > 1}; > > Sierpinski[{p1_, p2_, p3_, p4_}] := > Delete[Flatten[ > Table[{p1 + m e1 + n e2, p2 + m e1 + n e2, p3 + n e2 + m e1, > p4 + m e1 + n e2}, {n, 0, 2}, {m, 0, 2}], 1], 5]; > > > Sierpinski1 = Sierpinski[{p1, p2, p3, p4}] > > > Sierpinski2[ls_] := Flatten[Map[Sierpinski, ls], 1] > > > S2 = Sierpinski2[Sierpinski1] > > > Sierpinski3[n_] := Nest[Sierpinski2, {{p1, p2, p3, p4}}, n] > > > Sierpinski3[3] > > > > Now, I'm not good enough to think of a much more complicated construction > and the problem is that with this algorithm the lengths of the squares I > construct at each step does not scale down with the level of the carpet I'm > constructing: e.g. He builds 9 squares from the big one at the beginning and > deletes the central one, it's ok. But as I Iterate the process at each > smaller square It builds squares of the same size, so what I get is just a > big black figure. It obviously does this way because in the algorithm > there's no instruction to decrease the size of the base vectors (e1,e2). > Thing is I can't think of a way to give mathematica that instruction inside > the Nest or in the definition of the basic "Sierpinski" function. I need > some help. Thanks in advance. This is the expected result: > http://mathworld.wolfram.com/SierpinskiCarpet.html Hi, If you have version 6.0, the following code will draw a nice Sierpinski Carpet. rules = {0 -> {{0, 0, 0}, {0, 0, 0}, {0, 0, 0}}, 1 -> {{1, 1, 1}, {1, 0, 1}, {1, 1, 1}}}; f[m_: 1] := ArrayFlatten[m /. rules] drawSerp[n_] := MatrixPlot[Nest[f, 1, n], FrameTicks -> None] drawSerp[5] You can see the resulting picture at http://homepages.nyu.edu/~jmg336/Sierpinski%20Carpet.png If you do not have access to version 6.0 and are interested by this approach, let me know so I can tell you how to tweak the code for version 5.2. Regards, Jean-Marc