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

[http://perso.wanadoo.fr/maurice.ulis/tcl/jewels.gif]

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 + |x/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'''.

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

----
'''[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.

----

  # build a jewel image
  # (global parms below)
  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)}]
    }
    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)}]
    }
    foreach {x y} $points { puts "$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
  }

----

A little 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 $hh
  set x 2
  set y 2
  foreach (shapefactor) {1 2 3 10} \
  { 
    .c create image $x $y -anchor nw -image [jewel]
    incr x $ww
  }
  pack .c
----
[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.)
----
[Category Mathematics]
|
[Category Example]