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] ====