Dragon Curve
Keith Vetter 2002-05-09 : Here's a quick and dirty rendering of the Dragon Curve or Paper Folding fractal. What happens if you repeatedly fold a piece of paper in half numerous times then unfold it once 90 degrees, then again 90 degrees and so on. You get a fractal curve which has several interesting properties. For example, you can combine 4 of these curves and not only will they not overlap but they fill the plane. For more details see http://www.math.okstate.edu/mathdept/dynamics/lecnotes/node17.html
The Penney numerals are closely related.
What does it mean to "unfold it once 90 degrees"? I just can't picture what you mean at all. -- CLN
Try DrawDragons 1, then 2, then 3, and it'll become clear... -jcw
Beware, drawing a Dragon Curve of degree 10 or above can be real slow (the canvas has to render 4 * 2^^degree lines segments).
The following code is available as a starkit on sdarchive.
####################################################################
#
# dragon.tcl
#
# Draws a dragon curve
# by Keith Vetter
#
# Revisions:
# KPV May 09, 2002 - initial revision
#
# http://www.math.okstate.edu/mathdept/dynamics/lecnotes/node17.html
####################################################################
package require Tk
set cw 500 ; set ch 500 ;# canvas size
array set comp {R L L R}
array set turn {E,R S E,L N S,R W S,L E W,R N W,L S N,R E N,L W}
array set fill {E cyan S magenta W blue N yellow}
proc DoDisplay {} {
global cw cw2 ch ch2
canvas .c -width $cw -height $ch -bd 2 -relief ridge
set cw2 [expr {$cw / 2}]
set ch2 [expr {$ch / 2}]
.c config -scrollregion [list -$cw2 -$ch2 $cw2 $ch2]
.c yview moveto .5
.c xview moveto .5
.c create oval -5 -5 5 5 -fill yellow -tag o
.c create text -$cw2 -$ch2 -anchor nw -font bold -tag lbl
pack .c -side top
scale .deg -label Degree -orient horizontal -from 1 -to 12
.deg config -relief ridge -showvalue 1
.deg set 4
bind .deg <ButtonRelease-1> [list after 1 [list DrawDragons -1]]
pack .deg -side left
}
# DrawDragons -- draw four dragon curve of this degree
proc DrawDragons {n} {
.c config -cursor watch
if {$n == -1} {set n [.deg get]} else {.deg set $n}
.c delete dragon
.c itemconfig lbl -text "Dragon Curve: $n"
DrawDragon $n E ; update
DrawDragon $n W ; update
DrawDragon $n S ; update
DrawDragon $n N ; update
.c config -cursor {}
}
# DrawDragon -- draw one dragon curve of this degree and orientation
proc DrawDragon {n {dir E}} {
global cw2 ch2 fill
set dir [string toupper $dir]
set tag "dragon_$dir"
set coords [GetCoords $n $dir]
set coords [ScaleCoords $coords]
.c create line $coords -tag [list dragon $tag] -width 2 -fill $fill($dir)
.c raise o
.c raise lbl
}
# ScaleCoords -- scale the unit coords to fit into the window
proc ScaleCoords {coords} {
global cw2 ch2 ;# Window size
# Find max coordinate from origin
set max_x [set max_y [set min_x [set min_y 0]]]
foreach {x y} $coords {
if {$x > $max_x} {set max_x $x
} elseif {$x < $min_x} {set min_x $x}
if {$y > $max_y} {set max_y $y
} elseif {$y < $min_y} {set min_y $y}
}
set max_x [expr {-$min_x > $max_x ? -$min_x : $max_x}]
set max_y [expr {-$min_y > $max_y ? -$min_y : $max_y}]
set max [expr {$max_x > $max_y ? $max_x : $max_y}]
set sc [expr {($cw2 - 50) / $max}]
set new {}
foreach {x y} $coords {
set nx [expr {$x * $sc}] ; set ny [expr {$y * $sc}]
lappend new $nx $ny
}
return $new
}
# GetCoords -- get the unit coordinates for this degree curve
proc GetCoords {n dir} {
global turn
set turns $dir
foreach leg [MakeDragon $n] {
set dir $turn($dir,$leg)
lappend turns $dir
}
set x 0 ; set y 0
set coords [list $x $y]
foreach leg $turns {
if {$leg == "E"} { incr x
} elseif {$leg == "S"} { incr y
} elseif {$leg == "W"} { incr x -1
} elseif {$leg == "N"} { incr y -1 }
lappend coords $x $y
}
return $coords
}
# MakeDragon -- gets the turn data for this degree dragon curve
proc MakeDragon {n} {
global dragon
# Do we already have it?
if {[info exists dragon($n)]} { return $dragon($n) }
if {$n == 0} { return {}}
# dragon(n) = dragon(n-1) + "R" + reverse(complement(dragon(n-1)))
set last [MakeDragon [expr {$n - 1}]]
set dragon($n) $last
lappend dragon($n) R
set idx [llength $last]
while {[incr idx -1] >= 0} {
set item [lindex $last $idx]
lappend dragon($n) $::comp($item)
}
return $dragon($n)
}
DoDisplay
DrawDragons 4More on this subject appears under the title "Fractales, SWIG et performances" [L1 ]. See also Recursive curves.
Pretty cool drawing app. The only thing was when I ran the Dragon Curve with a Degree setting of 12 my computer was nonresponsive for 10 minutes. My processor was running at 100%, and did not allow me to do any other work while it was creating the curve.
KPV Well, there is a warning that at level 12 it must draw 4 * 2^^12 line segments. Fixing this is actually more difficult than it would seem at first blush. The obvious solution would be to throw in some update commands, or better yet, to reorganize the code ala Update considered harmful and Keep a GUI alive during a long calculation. However, that doesn't work because it is not the tcl code taking all the time but in the tk library (written in C) rendering the line: .c create line $coord.... So the only way to make the code more responsive would be to draw the dragon curve in smaller pieces and have some kind of GUI refresh in between segments.
rdt - Ten minutes, thats hard to believe. Its almost instantanious on my machine. What speed processor are you using - a 5Mhz 8085 ? :)
uniquename 2013aug18
Here are a couple of images that show the Dragon Curve at level 8 and level 12. (I changed the default GUI palette of light gray to blue, so that the lines would show up better.)
With respect to drawing speed, even at level 12, the entire image was drawn in a fraction of a second --- and that was on a little netbook computer with an Intel Atom chip.
I have to suspect that the fellow who said that level 12 took about 10 minutes must have a virus on his computer (or some other process or processes running in a tight loop) robbing cycles from the 'wish' interpreter.