MathGroup Archive 1996

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

Search the Archive

Re: generating fractal sets

  • To: mathgroup at smc.vnet.net
  • Subject: [mg3440] Re: [mg3355] generating fractal sets
  • From: jpk at apex.mpe.FTA-Berlin.de (Jens-Peer Kuska)
  • Date: Fri, 8 Mar 1996 01:29:04 -0500
  • Sender: owner-wri-mathgroup at wolfram.com

On Thu, 29 Feb 1996, David Paul wrote:

> If this is a redundant posting to this newsgroup, I apologize.
> (I posted a similar email earlier and didn't see it appear.)
> 
> I need help using Mathematica to generate high-quality fractal sets
> (like the Sierpinski gasket) which will take advantage of my 
> laserprinter's resolution - 600dpi.  
> 
> Any help would be greatly appreciated, as this is for my M.S. 
> thesis!
> 
> -David Paul, preferred email: David_Paul at Baylor.edu
> 
> 

Hi David,

a small Mathematica-package for generating the common 2d fractal
curves is appended. If You found a nice new set mail it to me.
The package offers a easy way to run out of memory with Mathematica
and to fill the memory of Your 600 dpi laserprinter with just
a simple input-line like

Show[
  Graphics[
    LSystem[Sierpinsky,14]
   ]
  AspectRatio->Automatic
 ]

Hope that helps
Jens

--- schnipp schnapp -- cut here -- schnipp schnapp -- cut here ---
--- cut here -- schnipp schnapp -- cut here -- schnipp schnapp ---

(* File: LSystem.m *)
(* Date: /03/06/96 *)
(* Author: J.-P. Kuska,
   email: jpk at mpe.fta-berlin.de
 *)

(* Copyright 1996 Jens-Peer Kuska
   this file may be freely distributet als long as the copyright notice
   is left intact
   *)

(* Version: 1.0             *)
(* Mathematica Version: 2.2 *)

(*
Sources:
  ``The Science of Fractal Images''
  Heinz-Otto Peitgen and Dietmar Saupe, Ed.
  Springer-Verlag 1988
  page 273, Appendix C
 *)

(* Requirements: None *)

(* Limitations: None *)

BeginPackage["LSystem`"]

LSystem::usage=
"LSystem[what,stage] will produce the 2D lines of the stage times iteratet
 L-sytem due to the parameters LSystemN[what], LSystemAxiom[what] and
 LSystemRules[what] of the database."

LSystemStringToTurtle::usage=
"LSystemStringToTurtle[lsys,divsions] puts the result of the
iteration lsys and will convert the lsys string to moves of the
turtle. The meaning of the characters is:\n
F  inc position and draw line\n
f  inc position and move\n
+  turn right by 2Pi/divisions\n
-  turn left by 2Pi/divisions\n
|  turn back\n
[  push the turtle state to stack\n
]  pop the turtle state from stack"

LSystemRules::usage=
"LSystemRules[fractalname] gives the transformation rules applied to
 the string on every stage."

LSystemAxiom::usage=
"LSystemAxiom[fractalname] gives the initial state of the l-system for
the fractal fractal name."

LSystemN::usage=
"LSystemN[fractalname] gives the angle delta=2Pi/LSystem[fractalname] for
the given fractal."

Sierpinsky::usage=
  "Database entry for LSystem[_,stage] to produce a Sierpinsky gasket."

SierpinskySquare::usage=
  "Database entry for LSystem[_,stage] to produce a Sierpinsky gasket."

HilbertCurve::usage=
  "Database entry for LSystem[_,stage] to produce a Hilbert curve."

KochSnowFlake::usage=
  "Database entry for LSystem[_,stage] to produce a Koch snow flake."

KochIsland::usage=
  "Database entry for LSystem[_,stage] to produce a Koch island."

DragonCurve::usage=
  "Database entry for LSystem[_,stage] to produce a dragon curve."

Bush1::usage=
  "Database entry for LSystem[_,stage] to produce a bush."

Bush2::usage=
  "Database entry for LSystem[_,stage] to produce an other bush."


Begin["`Private`"]

LSystemStringToTurtle[lstring_String,n_Integer]:=
  Block[{turtleX,turtleY,turtleDir,lsystemTurtle,
         llst=Characters[lstring],scangle,i,
         lines={},pstack={},dstack={},
         tmoves={{0.0,0.0}}},
     llst=Select[llst,MemberQ[{"F","f","+","-","]","[","|"},#]&];
     turtleX=0.0;
     turtleY=0.0;
     turtleDir=0;
     lsystemTurtle=
       {"F" :> (AppendTo[tmoves,{turtleX,turtleY}+=scangle[[turtleDir+1]]];),
        "f" :> (AppendTo[lines,tmoves];
                tmoves={{turtleX,turtleY}+=scangle[[turtleDir+1]]};),
        "+" :>(If[turtleDir+1<n,turtleDir++,turtleDir=0];),
        "[" :>(PrependTo[pstack,{turtleX,turtleY}];
               PrependTo[dstack,turtleDir];),
        "]" :>(If[pstack=!={},
                  {turtleX,turtleY}=First[pstack];
                   pstack=Rest[pstack];
                   turtleDir=First[dstack];
                   dstack=Rest[dstack]];
                   AppendTo[lines,tmoves];
                   tmoves={{turtleX,turtleY}};),
        "-" :>(If[turtleDir>0, turtleDir--,turtleDir=n-1];),
        "|" :>(If[turtleDir<Round[n/2],
                  turtleDir+=Round[n/2],
                  turtleDir-=Round[n/2]
                ];)

      };
     scangle=Table[
               N[{Cos[i*2Pi/n],Sin[i*2Pi/n]}],
               {i,0,n-1}
              ];
     llst /. lsystemTurtle;
     Line /@ Append[lines,tmoves]
   ]

LSystem[sym_Symbol,Iter_Integer]:=
  LSystemStringToTurtle[
    Nest[
      StringReplace[
        #,
        LSystemRules[sym]] &,
      LSystemAxiom[sym],
      Iter
     ],
   LSystemN[sym]
  ]

(* the data base *)

Sierpinsky /:
  LSystemRules[Sierpinsky]:={"X"->"--FXF++FXF++FXF--","F"->"FF"}
Sierpinsky /:
  LSystemAxiom[Sierpinsky]:="FXF--FF--FF"
Sierpinsky /:
  LSystemN[Sierpinsky]:=6

HilbertCurve /:
  LSystemRules[HilbertCurve]:={"X"->"-YF+XFX+FY-", "Y"->"+XF-YFY-FX+"}
HilbertCurve /:
  LSystemAxiom[HilbertCurve]:="X"
HilbertCurve /:
  LSystemN[HilbertCurve]:=4

KochSnowFlake /:
  LSystemRules[KochSnowFlake]:={"F"->"F-F++F-F"}
KochSnowFlake /:
  LSystemAxiom[KochSnowFlake]:="F"
KochSnowFlake /:
  LSystemN[KochSnowFlake]:=6

KochIsland /:
  LSystemRules[KochIsland]:={"F"->"F+F-F-FF+F+F-F"}
KochIsland /:
  LSystemAxiom[KochIsland]:="F+F+F+F"
KochIsland /:
  LSystemN[KochIsland]:=4

DragonCurve /:
  LSystemRules[DragonCurve]:={"X"->"X+YF+","Y"->"-FX-Y"}
DragonCurve /:
  LSystemAxiom[DragonCurve]:="X"
DragonCurve /:
  LSystemN[DragonCurve]:=4
SierpinskySquare /:
  LSystemRules[SierpinskySquare]:={"F"->"FF+F+F+F+FF"}
SierpinskySquare /:
  LSystemAxiom[SierpinskySquare]:="F+F+F+F"
SierpinskySquare /:
  LSystemN[SierpinskySquare]:=4

Bush1 /:
  LSystemRules[Bush1]:={"F"->"F[+F]F[-F]F"}
Bush1 /:
  LSystemAxiom[Bush1]:="F"
Bush1 /:
  LSystemN[Bush1]:=14
Bush2 /:
  LSystemRules[Bush2]:={"G"->"GFX[+G][-G]",
                        "X"->"X[-FFF][+FFF]FX"}
Bush2 /:
  LSystemAxiom[Bush2]:="G"
Bush2 /:
  LSystemN[Bush2]:=14

End[]
EndPackage[]
Null


(* Examples:

Show[Graphics[LSystem[Bush1,4]],AspectRatio->Automatic];

Show[Graphics[LSystem[Bush2,6]],AspectRatio->Automatic];

Show[Graphics[LSystem[Sierpinsky,5]],AspectRatio->Automatic];

Show[Graphics[LSystem[KochIsland,2]],AspectRatio->Automatic];

Show[Graphics[LSystem[SierpinskySquare,4]],AspectRatio->Automatic];

Show[Graphics[LSystem[DragonCurve,12]],AspectRatio->Automatic];
*)


==== [MESSAGE SEPARATOR] ====


  • Prev by Date: WIN95 and Mathematica Performance
  • Next by Date: Re: Greek symbols in Mathematica
  • Previous by thread: Re: generating fractal sets
  • Next by thread: FindRoot output format