4
$\begingroup$

This page on W|A shows a nice substitution rule to draw kites and darts.

I'd like to implement the rule in Mathematica, so I've drawn the original kite and its replacement (separately). I've also drawn the original dart and its replacement. This seems like a job for Replace[], but I'm not sure how. I know there are similar animations on Demonstrations, but I'd like to create my own (with help!).

In my mind, this would be cool as a Manipulate[] environment, where the slider controls the number of times the replacement has occurred. Maybe even a rotation slider, too, so the kites and darts tile space in a particular direction.

Thanks!

$\endgroup$
5
  • $\begingroup$ Please post your progress so far. $\endgroup$
    – s0rce
    Apr 15, 2013 at 19:18
  • 1
    $\begingroup$ Please see Mathematica in Action by Stan Wagon. Chapter 9 of the second edition discusses Penrose tiles. It is available via Google Books. Try Googling: "TriangleDissection" "KitesAndDarts". $\endgroup$ Apr 15, 2013 at 20:17
  • $\begingroup$ You will want to see the third edition of Wagon's book as well. $\endgroup$ Apr 16, 2013 at 7:15
  • $\begingroup$ @J.M Interesting link - 8 pages for $30, or the whole book (578 pages) for $70 on Amazon... ‽ $\endgroup$
    – cormullion
    Apr 16, 2013 at 9:31
  • $\begingroup$ @cormullion, yes, the pricing is something to be puzzled about. In my case, I am thankful for the library who allows me access to these things and worries about the prices so I don't have to. :) $\endgroup$ Apr 16, 2013 at 9:55

1 Answer 1

12
$\begingroup$

Your question is too general for this site, but since I already have the code, let me give you a start. You have two replacement rules for the two different shapes t1 and t2 (note that I use triangles)

subdivide = {
   t1[{a_, b_, c_}] :> 
    With[{p1 = a + (b - a)/GoldenRatio, 
      p2 = c + (a - c)/GoldenRatio},
     {t2[{p2, p1, a}], t1[{c, p1, b}], t1[{c, p1, p2}]}], 
   t2[{a_, b_, c_}] :> With[{p = c + (b - c)/GoldenRatio},
     {t1[{c, a, p}], t2[{p, a, b}]}
     ]
   };

When you now start with an initial set of shapes you can use ReplaceAll (/.) and Nest to apply the rules several times.

penrose = 
  With[{initial = t1[{0.0, Exp[-I*Pi/10.0], Exp[I*Pi/10.0]}]}, 
   Nest[# /. subdivide &, initial, 3]];

In a last step you need to convert the data types t1 and t2 into shapes you can really draw. For this, just use another rule which transforms them into e.g. Polygone's.

draw = {t1[arg_] :> {GrayLevel[.95], 
     Polygon[{Re[#], Im[#]} & /@ arg]}, 
   t2[arg_] :> {GrayLevel[.85], Polygon[{Re[#], Im[#]} & /@ arg]}};

The rest is easy, apply the draw rule and put it into a Graphics

Graphics[penrose /. draw]

When you use more iterations (e.g. 6) you get what you expect

enter image description here

For further information, you can read along this question on Meta.

To make this all dynamic, you just need to put Manipulate around it and make some variable dynamic. E.g. To change the initial points, you could use Locator's

Manipulate[
 Graphics[
  With[{initial = t1[{Complex @@ p1, Complex @@ p2, Complex @@ p3}],
    draw = {t1[arg_] :> {GrayLevel[.95], EdgeForm[{Thin, Black}], 
        Polygon[{Re[#], Im[#]} & /@ arg]}, 
      t2[arg_] :> {GrayLevel[.85], EdgeForm[{Thin, Black}], 
        Polygon[{Re[#], Im[#]} & /@ arg]}}}, 
   Nest[# /. subdivide &, initial, 6] /. draw]
  , PlotRange -> {{-1, 1}, {-1, 1}}],
 {{p1, {-1, 0}}, Locator},
 {{p2, {1, 0.5}}, Locator},
 {{p3, {1, -0.5}}, Locator}
 ]

enter image description here

$\endgroup$
3
  • $\begingroup$ This is great. Thanks so much. I didn't realize all that information was on Meta, but that looks helpful as well. Out of curiosity, what makes this question too general for the site? I'm fairly new to Mathematica and a little frustrated by what I perceive to be a steep learning curve. Thanks again for your help! $\endgroup$
    – user6353
    Apr 16, 2013 at 2:06
  • 1
    $\begingroup$ @user6353 The question is IMO too general because you haven't asked a specific question like I want to create a Penrose pattern, here is what I have so far but it doesn't work. I expect this but instead I get that... Furthermore, it is always good to search the site before asking, which wouldn't have worked out since the Penrose post was on Meta. Have you read the FAQ and this answer on Meta? $\endgroup$
    – halirutan
    Apr 16, 2013 at 7:23
  • $\begingroup$ Hi. Ok, good to know. In my mind, I should be able to do something like this: Replace[kite, kite->kiteSubstitution, 5], though that usage of Replace only works one level deep. I had poked around the FAQ but not seen the details about Penrose tiles on Meta, so I'll keep at it. Thanks again. $\endgroup$
    – user6353
    Apr 16, 2013 at 14:03

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.