Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2007
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2007

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

Search the Archive

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#


  • Prev by Date: Re: Stopping Automatic Animation in v6
  • Next by Date: Left eigenvector of generalized eigenvalue problem
  • Previous by thread: Re: Sierpinski's thing
  • Next by thread: Sierpinski carpet