Fractals
Author Message
Fractals

I've recently got hold of two books.  One is called "Fractals:
Endlessly Repeating Geometrical Figures" by Hans Lauwerier and the
other is "Chaos and Fractals: New Frontiers of Science."  Both these
books are in print.  The first is very informal and experimental; the
second is a textbook.

What is neat about both these books is that they have program listings
in them.  Unfortunately they are both written in BASIC.  The programs
in the first book are typical examples of what's wrong with
BASIC---two letter variables and difficult-to-follow program
structure.  The second uses a much better version of BASIC and the
programs are correspondingly easier to read.

However neither of these books use our favorite programming language.
So I've been either translating or re-implementing various fractal
programs in logo.  Even though logo's interpreted they seem to run
reasonably quickly---of course I'm running on P-II machines at from
266-300 Mhz.  Your mileage may vary.

Anyway here are a couple (all of them work in ucblogo; changing to MSW
logo should be easy):

Invoke this one with `cloud'.  You can try various transformations in
the `transform' function, such as the commented-out one.  Change the
repeat number in `cloud' to a lower number if you don't want to wait
that long.

----------------cloud.logo------------------------
to transform
if :x > 1 [make "w :a * :x + :b * (:x - 1) stop]
if :x < -1 [make "w :a * :x + :b * (:x + 1) stop]
make "w :a * sin :y
;make "w :a * 1 / :x
end

make "scale .5

to plot :x :y
pu setxy :scale * :x :scale * :y pd fd 0
end

to abs :num
ifelse :num < 0 [op -:num] [op :num]
end

to cloud
cs ht window
localmake "a 3.45
localmake "b -3.0
localmake "x 1.11
localmake "y 4.54
local "w
local "z
transform
repeat 100000 [
setpc int abs sqrt (:x * :x  + :y * :y)
plot :x :y
make "z :x make "x :y + :w
transform
make "y :w - :z]
end
------------------end of cloud.logo----------------------

The next one plots the mandelbrot set the slow way :-<
Invoke it with `mand'

Change

make "max 32

to

make "max 16

to make it run faster.

I'm planning on implementing the better algorithm given in CHAOS AND
FRACTALS when I get around to it.

--------------------mand.logo--------------------

;;; Mandelbrot set plotter.

make "num.x.cells 400
make "num.y.cells 300

make "start.x 2.0
make "start.y 1.6
make "plot.width 3.2

make "max 32

to plot :x :y :color
setpc :color
pu setxy (:x - :num.x.cells / 2) (:y - :num.y.cells / 2) pd fd 0
end

to c.square :z
localmake "a first :z
localmake "b first butfirst :z
output list (:a * :a - :b * :b) (2 * :a * :b)
end

output list ((first :z1) + (first :z2)) ~
((first bf :z1) + (first bf :z2))
end

; Don't bother taking sqrt....
to c.abs :z
localmake "a first :z
localmake "b first bf :z
output :a * :a + :b * :b
end

to mand
(local "color "modulus "x "y "z "ix "iy)
localmake "delta.x.cell :plot.width / :num.x.cells
localmake "delta.y.cell :plot.width / :num.y.cells

ht

repeat :num.x.cells [
make "ix repcount
make "x (:ix * :delta.x.cell) - :start.x

repeat :num.y.cells [
make "iy repcount
make "y (:iy * :delta.y.cell) - :start.y
make "z list :x :y

make "modulus 0
make "color 0
while [and (:modulus < 4) (:color < :max)] [
make "z c.add (list :x :y) (c.square :z)
make "modulus c.abs :z
make "color :color + 1
]
ifelse (:color = :max) [
make "color 0
] [
make "color (remainder :color 16)
]
plot :ix :iy :color
]
]
end

--------------------end of mand.logo--------------------

Invoke the following with `draw'.

This is a fascinating one.  It can be parameterized by changing the
"e", "f", "p" and "pt" arrays.  References to a table of parameters in
CHAOS AND FRACTALS are in the comments.  (I got the pt elements by
trial and error.)

For example, change them to the following for a completely different
figure:

make "pt {12 24 36}

make "e { 0.3726  0.1146  0.6306  0.6356}
make "f { 0.6714  0.2232  0.2232 -0.0061}

make "p {{ 0.255  0.0    0.0   0.255 }
{ 0.255  0.0    0.0   0.255 }
{ 0.255  0.0    0.0   0.255 }
{ 0.370 -0.642  0.642 0.370 }}

I've also got 3- and 5-transformation versions.  The modifications are
straightforward.

--------------------ifs.logo--------------------
;;;
;;; `Chaos game'
;;; Translated from BASIC program on pg. 351
;;; of CHAOS AND FRACTALS by Peitgen, Jurgens and Saupe.
;;;
;;; The BASIC program has a lot of embedded constants;
;;; these have been moved into global arrays for easy
;;; modification.
;;;

;;; Figure 5.34 from table on page 295.

make "iterations 20000

; The following determines the positioning
; of the fractal picture.
make "left -250
make "w 500
make "wl :w + :left

; The following arrays hold the parameters that
; dictate what the fractal will look like.

; Probability table.
make "pt {75 85 95}

make "e { 0.075  0.400  0.575  0.500}
make "f { 0.183  0.049 -0.084  0.000}

make "p {{ 0.849  0.037 -0.037  0.849}
{ 0.197 -0.226  0.226  0.197}
{-0.150  0.283  0.260  0.237}
{ 0.000  0.000  0.000  0.160}}

;;;
;;; This routine does the transformation on x and y
;;; to produce the new x and y.

to trans :x :y :p :e :f
localmake "xn (item 1 :p) * :x + (item 2 :p) * :y + :e
localmake "yn (item 3 :p) * :x + (item 4 :p) * :y + :f
output list :xn :yn
end

;;;
;;; Plot a point.  Scale the drawing using the "scale variable.
;;;
make "scale -.75  ; Negative to flip the drawing.
to plot :x :y
pu setxy :scale * :x :scale * :y pd fd 0
end

to draw
cs ht
local "newxy

; Set up e and f parameters
localmake "e1 :w * item 1 :e
localmake "e2 :w * item 2 :e
localmake "e3 :w * item 3 :e
localmake "e4 :w * item 4 :e
localmake "f1 :w * item 1 :f
localmake "f2 :w * item 2 :f
localmake "f3 :w * item 3 :f
localmake "f4 :w * item 4 :f

; Set up p parameters
localmake "p1 item 1 :p
localmake "p2 item 2 :p
localmake "p3 item 3 :p
localmake "p4 item 4 :p

; Set up probabilities
localmake "pr1 item 1 :pt
localmake "pr2 item 2 :pt
localmake "pr3 item 3 :pt

localmake "x :e1
localmake "y 0.0

repeat :iterations [
localmake "r random 100
ifelse :r < :pr1 [
setpc 1
make "newxy trans :x :y :p1 :e1 :f1
][
ifelse :r < :pr2 [
setpc 2
make "newxy trans :x :y :p2 :e2 :f2
][
ifelse :r < :pr3 [
setpc 3
make "newxy trans :x :y :p3 :e3 :f3
][
setpc 4
make "newxy trans :x :y :p4 :e4 :f4
]
]
]
make "x first :newxy
make "y first butfirst :newxy
plot :x + :left :wl - :y
]
end

--------------------end of ifs.logo--------------------

--

King Christ, this world is all aleak, / And life preservers there are none,
And waves that only He may walk / Who dared to call Himself a man.
-- e. e. cummings, from Jehovah Buried, Satan Dead

Fri, 29 Jun 2001 03:00:00 GMT
Fractals

Here are a couple more fractal programs I didn't post in my first
message.

The following lets you draw pythagorean trees.  It was fun to figure
out how to do it.

Invoke using either `straight.tree' or `bent.tree'.

Ex:

bent.tree 50 35 5

also try

pu back 200 pd
straight.tree 50 35 5

Both bent.tree and straight.tree give the same figure if the second
argument (angle) is 45.

--------------------ptree.logo--------------------

to draw :length
ifelse :length < 2 * :min [setpc 2] [setpc 9]
fd :length
end

to move :length
pu fd :length pd
end

to retrace :length
move -:length
end

to square :size
repeat 4 [draw :size rt 90]
end

to rtri :size :angle
rt :angle
draw :size * sin :angle
rt 90
draw :size * cos :angle
rt 180 - :angle
draw :size
rt 90
end

to trunk :size :angle
square :size
move :size
rtri :size :angle
retrace :size
end

to straight.tree :size :angle :min
if :size < :min [stop]
trunk :size :angle
move :size lt 90 - :angle
straight.tree :size * sin :angle 90 - :angle :min
rt 90 move :size * sin :angle
straight.tree :size * cos :angle 90 - :angle :min
retrace :size * sin :angle lt :angle retrace :size
end

to bent.tree :size :angle :min
if :size < :min [stop]
trunk :size :angle
move :size lt 90 - :angle
bent.tree :size * sin :angle :angle :min
rt 90 move :size * sin :angle
bent.tree :size * cos :angle :angle :min
retrace :size * sin :angle lt :angle retrace :size
end

--------------------end of ptree.logo--------------------

Here's a simple `h' fractal.

Ex:

h 50

You can also change the .min.size. variable to change the appearance.

--------------------h.logo-------------------
make ".min.size. 1

to H :size
if :size < :.min.size. [stop]
setpc int :size
lt 90 fd :size
H :size / sqrt 2
setpc int :size
back :size rt 90
rt 90 fd :size
H :size / sqrt 2
setpc int :size
back :size lt 90
end

--------------------end of h.logo-------------------

--

King Christ, this world is all aleak, / And life preservers there are none,
And waves that only He may walk / Who dared to call Himself a man.
-- e. e. cummings, from Jehovah Buried, Satan Dead

Fri, 29 Jun 2001 03:00:00 GMT

 Page 1 of 1 [ 2 post ]

Relevant Pages