Re: Sierpinski's thing
- To: mathgroup at smc.vnet.net
- Subject: [mg76834] Re: Sierpinski's thing
- From: Jean-Marc Gulliet <jeanmarc.gulliet at gmail.com>
- Date: Mon, 28 May 2007 01:02:48 -0400 (EDT)
- Organization: The Open University, Milton Keynes, UK
- References: <f38qg9$hq4$1@smc.vnet.net> <f3bgfp$313$1@smc.vnet.net>
Szabolcs wrote:
> 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
>
> I don't understand completely what you were doing above, but here's a
> function that constructs a Sierpinski carpet:
>
> In[1]:= pieces = Complement[
> Join@@Table[{i, j}, {i, 0, 2}, {j, 0, 2}],
> {{1, 1}}]
>
> Out[1]= {{0,0},{0,1},{0,2},{1,0},{1,2},{2,0},{2,1},{2,2}}
>
> In[2]:= sierp[cornerPt_, sideLen_, n_] :=
> sierp[cornerPt + #1*(sideLen/3), sideLen/3, n-1] & /@ pieces
>
> In[3]:= sierp[cornerPt_, sideLen_, 0] :=
> Rectangle[cornerPt, cornerPt + sideLen*{1, 1}]
>
> In[4]:= Graphics[sierp[{0, 0}, 1, 5], AspectRatio -> Automatic]//Show
>
>
> Could someone please explain why is this SO MUCH slower in Mathematica 6
> than in Mathematica 5.2?
>
> Szabolcs
For what is worth, I have made some speed tests of your code on version
5.2 and 6.0. The speed difference is striking in this case. The culprit
seems to be the rendering engine in v6. As a summary,
------------------------------------------------------
V5.2 ! V6.0
! Native Engine ! Legacy Engine 5.2*
------------------------------------------------------
Create ! Display ! Create ! Display ! Create ! Display
0.938 ! 0.187 ! 1.703 ! 24.765 ! 0.954 ! 0.234
------------------------------------------------------
Times expressed in second.
Columns "Create" show cpu time.
Columns "Display" show elapsed time.
* See Dimitris's post [1].
V6 appears to be slower than V5.2 even when using the compatibility mode
that emulate (?) the graphic engine of V5.2.
(* Code tested with versions 5.2 and 6.0 *)
In[1]:=
pieces = Complement[Join @@ Table[{i, j}, {i, 0, 2}, {j, 0, 2}], {{1, 1}}];
sierp[cornerPt_, sideLen_, n_] :=
(sierp[cornerPt + #1*(sideLen/3), sideLen/3, n - 1] & ) /@ pieces
sierp[cornerPt_, sideLen_, 0] := Rectangle[cornerPt,
cornerPt + sideLen*{1, 1}]
(* Version 5.2 *)
In[4]:=
Timing[g = Graphics[sierp[{0, 0}, 1, 5], AspectRatio -> Automatic]][[1]]
Out[4]=
0.938 Second
In[5]:=
start = TimeUsed[];
Show[g];
stop = TimeUsed[];
stop - start
[graphic deleted]
Out[8]=
0.187
(* Version 6.0 *)
In[1]:= pieces =
Complement[Join @@ Table[{i, j}, {i, 0, 2}, {j, 0, 2}],
{{1, 1}}];
sierp[cornerPt_, sideLen_, n_] :=
(sierp[cornerPt + #1*(sideLen/3), sideLen/3, n - 1] & ) /@ pieces
sierp[cornerPt_, sideLen_, 0] := Rectangle[cornerPt,
cornerPt + sideLen*{1, 1}]
In[4]:= Timing[
g = Graphics[sierp[{0, 0}, 1, 5], AspectRatio -> Automatic]; ][[
1]]
Out[4]= 1.703
In[5]:= start = TimeUsed[];
g
stop = TimeUsed[];
stop - start
[graphic deleted]
Out[8]= 24.765
(* Switching to legacy graphic engine. See Dimitris's post [1] *)
In[9]:= << Version5`Graphics`
In[10]:= Timing[
g = Graphics[sierp[{0, 0}, 1, 5], AspectRatio -> Automatic]; ][[
1]]
Out[10]= 0.954
In[11]:= start = TimeUsed[];
Show[g];
stop = TimeUsed[];
stop - start
[graphic deleted]
Out[14]= 0.234
In[15]:= << Version6`Graphics`
Regards,
Jean-Marc
[1] "general"
http://groups.google.com/group/comp.soft-sys.math.mathematica/browse_thread/thread/eb2b72709109f82b/?hl=en#