Mathematics jewels

ulis, 2003-11-19. Mathematics contains hidden treasures.

Updated 2003-11-21 to accept shape factor under 1.0.

The link 'http://perso.wanadoo.fr/maurice.ulis/tcl/jewels.gif ' has gone dead. Here is a 'locally stored' image.

ulis_MathematicsJewels_wiki10414_screenshot_620x232.jpg

Maybe do you remember the reduced (and elegant) equation of an ellipse: (x/a)^2 + (y/b)^2 = 1?

Constraining a & b: with a = b = R you obtain a circle: (x/R)^2 + (y/R)^2 = 1 or, simpler, x^2 + y^2 = R^2

On the other side, the power can be generalized: |x/a|^n + |y/b|^n = 1

  • With n = 1 you obtain a rhomb.
  • With n = 2 you already got an ellipse.
  • With n > 2 you obtain a rounded rectangle! The more the power, the more the rectangle.
  • With n = 2/3 you obtain an astroid.

There is a more powerful formula called Superformula. And a poetical formula: http://wfr.tcl.tk/Rosace .

Below is a proc to play with the power (of mathematics).

How it does?

The 3D effect is fairly simple to obtain:

It's just computing the value v = |x/a|^n + |y/b|^n for each point inside the shape, originating x & y from the center.

By definition the value of v is 1 on the border and declines to 0 towards the center.

Computing 255 * (1.0 - $v) give us the color component of the 3D effect.

History

KPV Martin Gardner did an Scientific American article on these curves entitled Piet Hein's Superellipse (collected in Mathematical Carnival chapter 18).

The Danish writer and inventer Piet Hein was consulted during the construction of Stockholm's Sergel's Torg for help in designing the central oval pool. The architects had a problem with its design: an ellipse was too pointy, a rectangle blocked too much traffic, and a patchwork of eight arcs looked ugly and wouldn't nest nicely.

Piet Hein looked at the curves defined here, which he called superellipses and decided that the curve where n = 2.5 was the one that had the best blend of elliptical and rectangular beauty.

Two other curious facts about this equation. First, there's no reason to limit n >= 1 (the code here explicitly forbids it). When n = 2/3 the shape is an astroid. Second, if n = 3 and you remove the absolute value signs in the formula then you get the Witch of Agnesi curve.

ulis The limit of 1 has been removed.

Links

Proc

  package require Tk
  # build a jewel image
  proc jewel {} {
    global {}
    # build outline
    set shapefactor $(shapefactor)
    #if {$shapefactor < 1} { set shapefactor 1.0 }
    if {$shapefactor > 100} { set shapefactor 100.0 }
    set width [expr {$(width) / $(granularity)}]
    set height [expr {$(height) / $(granularity)}]
    if {$width % 2 == 1} { incr width }
    if {$height % 2 == 1} { incr height }
    set a [expr {$width / 2}]
    set alpha [expr {pow($a,$shapefactor)}]
    set b [expr {$height / 2}]
    set beta [expr {pow($b,$shapefactor)}]
    set kx [expr {double($alpha) / $beta}]
    set ky [expr {double($beta) / $alpha}]
    set _y $b
    set oldy $_y
    set points {}
    for {set x 0} {$x < $a} {incr x} {
      set y [expr {round($_y)}]
      if {$y < $oldy - 1} { break }
      set oldy $y
      lappend points $x $y
      set _y [expr {pow(abs($ky * ($alpha - pow($x + 1,$shapefactor))),1.0/$shapefactor)}]
      for {set Y [expr {$y - 1}]} {$Y > $_y} {incr Y -1} {
        lappend points $x $Y
      }
    }
    set _x $x
    for {incr y} {$y >= 0} {incr y -1} {
      set x [expr {round($_x)}]
      lappend points $x $y
      set _x [expr {pow(abs($kx * ($beta - pow(abs($y - 1),$shapefactor))),1.0/$shapefactor)}]
      for {set X [expr {$x + 1}]} {$X < $_x} {incr X} {
        lappend points $X $y
      }
    }
    # fill
    set a2 [expr {1.0 / pow($width,$shapefactor) * $(lightcoef)}]
    set b2 [expr {1.0 / pow($height,$shapefactor) * $(lightcoef)}]
    set oldy $b
    set image [image create photo -width $(width) -height $(height)]
    foreach {(R) (G) (B)} [winfo rgb . $(color)] break
    foreach c {R G B} { set ($c) [expr {$($c) / 256.0}] }
    foreach {X Y} $points {
      if {$Y > $oldy} { continue }
      set oldy $Y
      set pixels1 {}
      set pixels2 {}
      set x2 [expr {pow($X,$shapefactor) * $a2}]
      for {set y 0} {$y < $Y} {incr y} {
        set _c [expr {1.0 - pow(2,$shapefactor) * ($x2 + (pow($y,$shapefactor) * $b2))}]
        if {$_c < 0} { set _c 0.0 }
        set color #
        foreach c {R G B} { append color [format %02x [expr {int($_c * $($c))}]] }
        for {set i 0} {$i < $(granularity)} {incr i} { lappend pixels1 $color }
        for {set i 0} {$i < $(granularity)} {incr i} { set pixels2 [linsert $pixels2 0 $color] }
      }
      set x1 [expr {($a + $X) * $(granularity)}]
      set x2 [expr {($a - $X) * $(granularity)}]
      set y1 [expr {$b * $(granularity)}]
      set y2 [expr {($b - $Y) * $(granularity)}]
      for {set i 0} {$i < $(granularity)} {incr i} {
        $image put $pixels1 -to $x1 $y1
        $image put $pixels1 -to $x2 $y1
        $image put $pixels2 -to $x1 $y2
        $image put $pixels2 -to $x2 $y2
        incr x1
        incr x2
      }
    }
    return $image
  }

Demo

  # parameters
  array set {} {
    width       150
    height      100
    color       gold
    granularity 1
    lightcoef   0.5
  }
  
  wm title . "Mathematics jewels"
  set ww [expr {$(width) + 4}]
  set hh [expr {$(height) + 4}]
  canvas .c -bd 0 -highlightt 0 -insertwidth 0 -width [expr {$ww * 4}] -height [expr {$hh * 2}]
  set x 2
  set y 2
  foreach (shapefactor) {1 2 4 10} { 
    .c create image $x $y -anchor nw -image [jewel]
    incr x $ww
  }
  set x 2
  incr y $hh
  foreach (shapefactor) {0.8 0.6 0.4 0.2} { 
    .c create image $x $y -anchor nw -image [jewel]
    incr x $ww
  }
  pack .c

Discussion

KPV The construct array set {} { width 150 } fails for me, and likewise so does $(width), and foreach (shapefactor).... I'm using 8.4.4.

ulis I don't understand why: these are legal constructs I use from 8.3. Maybe you defined a global scalar variable with an empty name?

However, you can change the code to:

  set Width 150
  ...
  ... $(width) replaced by $::Width
  ...
  foreach Shapefactor ...

KPV I did some testing and found that this construct works for tcl 8.0, 8.3.2 and 8.4.2 but not for 8.4.4. Why did you use the empty name for your global array instead of a real name like, say, "G"? It strikes me as kind of a hacky trick exploiting a corner of the language; this often leads to incompatibilities and to code confusing to newcomers.

Also, I had to change format %02x to format %04x because it was producing illegal colors like #ffffd7d700.

DKF: Is there a good reason for such hackery? (The colour issue is simply due to the fact that the core X colour model is 48-bit RGB.) (KPV see below)

ulis I find the name (x) very informative that x is special in some way (here, it's a global parameter). And I love this notation. I can't see any incompatibility or confusion with this. But, I agree with you, it can be hard to understand for a newcomer (and this code is not for a newcomer).

If the empty name is not supported in some version of Tcl, it's a bug that can be reported.

If you find some illegal color, this demonstrates that there is a bug in my code and I'm searching for it (but maybe it's a 64 bits bug).

I hacked this code to share the beauty of mathematics (and the efficiency of Tcl). Feel free to add your own version that will fullfil your aesthetic needs.

KPV: my bad with the color--I missed one line, which normalizes the colors, when I was converting from $(g) format to $G(g) to make it work under 8.4.4. Don't get me wrong, I think this is fun little program with a very nice visual look.

KPV: figured out the problem with the empty name array. It turns out that tkcon sets {} to the result of the last command. So when I pasted the code into the tkcon's console window I got all the errors you see above. I've emailed JH about this.

aa changed the proc, for, and foreach style in order to repair the line-continuation problems that were introduced by a recent spammish vandalization of the page.

Category MathematicsCategory ExampleCategory Graphics
Updated 2013-09-11 17:19:25