Richard Suchenwirth 2002-05-30 - I was reading SICP again - here are the Tcl experiments that chapter 2.5, "Systems with Generic Operations", led me to, culminating in mixed rational/complex arithmetics... Generic operations are abstractions for sets of specific operations on data on different types. For instance, addition of rational numbers a/b+c/d should be implemented as (ad+cb)/bd and then simplified, which is quite different from integer addition.

Rational numbers are not built-in in Tcl, but easily implemented (see e.g. Fraction math) or here, again following SICP, with tagged data in lists. For example, the list tagged to be of type "rat"(ional),

 {rat 2 3}

stands for the rational number 2/3, "two thirds" (and with more precision than double numbers !-) "Construction" of such "rats" could be dead easy:

 proc make(rat) {num den} {list rat $num $den}

but we also wish simplified representation, e.g. make(rat) 3 6 should result in {rat 1 2}, so we better determine the greatest common denominator and normalize with that:

 proc make(rat) {num den} {
    set gcd [gcd $num $den]
    list rat [expr {$num/$gcd}] [expr {$den/$gcd}]
 }
 proc gcd {a b} {expr {$b==0? $a: [gcd $b [expr {$a % $b}]]}}

#.. and some accessor functions:

 proc num(rat) rat {lindex $rat 1}
 proc den(rat) rat {lindex $rat 2}

Notice the unusual proc names that look like elements of a (virtual) array of procs - so far, that's only sugar, but will soon come into full play. Now we can implement addition of rationals:

 proc +(rat) {a b} {
    set an [num(rat) $a]; set ad [den(rat) $a]
    set bn [num(rat) $b]; set bd [den(rat) $b]
    make(rat) [expr {$an*$bd + $bn*$ad}] [expr {$ad * $bd}]
 }

So far the "rat-specific" code. Generic addition shall dispatch on the type of the arguments, which recognizes rats (and future other tagged data types) by their tag, and else implicitly returns an empty string ("") for regular Tcl numbers, which can be seen as one-element lists:

 proc type x {if {[llength $x]>1} {lindex $x 0}}

For now assume that both operands are of same type, so it suffices to check the first. Generic addition, which immediately calls the appropriate specific addition routine, may look like this:

 proc + {a b} {+([type $a]) $a $b}

#--- and the addition for "regular" numbers is of course easy:

 proc +() {a b} {expr {$a + $b}}

...which has the empty string in its parens. Quick test:

 + {rat 1 2} {rat 1 3} ==> {rat 5 6}

But of course the restriction that both operands must be of same type is too strict (hey, this is not Ada;-). We better determine the "maximal" type of the operands, and "coerce" (upgrade) those that are behind:

 proc maxtype {a b} {
    set types {"" rat real compl}
    set typea [lsearch $types [type $a]]
    set typeb [lsearch $types [type $b]]
    lindex $types [max $typea $typeb]
 }
 proc max args {lindex [lsort -real $args] end}

Coercion (raising arguments to the required height) and the possible lowering of the result is best triggered in the generic addition, "+":

 proc + {a b} {
    set type [maxtype $a $b]
    lower [+($type) [raise($type) $a] [raise($type) $b]]
 }
 proc raise(rat) x {
    switch -- [type $x] {
    rat {return $x}
    ""  {make(rat) $x 1}
    }
 }
 proc raise() x {set x} ;# identity
 #-- Lowering works under certain constraints, otherwise it's identity:
 proc lower      x {lower([type $x]) $x}
 proc lower()    x {set x}
 proc lower(rat) x {expr {[den(rat) $x]==1? [num(rat) $x]: $x}}

Testing again:

 + 1 {rat 2 3}         ==> {rat 5 3}
 + {rat 1 2} {rat 3 2} ==> 2

Obviously, our generic addition works, both in raising an integer to a rational, and lowering a rational result back to integer. The end-user should only see and use the generic routines, while the specific implementation works under-cover. In SICP's Scheme, a global table of mappings from generic to specific was used, but I chose the simpler way of constructing command names, which like everything in Tcl are just strings, from a constant and a variable (type-dependent) part. The parens around the latter make no difference to Tcl (they matter only in variable references), but they gave me the opportunity to

• "generalize" the array concept, virtually, to procs, and
• allow the empty string as type name, so + and +() are different.

The latter decision, which also excludes namespaces in specific-name construction, springs out of uneasiness, because Tcl numbers can of course also approximate "real" numbers, which in number theory would however be one layer above rationals, and one below complex numbers.

Oh, talking of complex numbers (see also Complex math made simple), as in SICP we can of course introduce them too. I neglect the choice of rectangular vs. polar representation, since the first is much more "natural", and extend the above generic operations (without needing to modify them - "compl" was already in proc type2 ;-) to the complex domain too (no raising required, as complex numbers are on top ;-):

 proc make(compl) {real im} {list compl $real $im} ;# constructor
 proc real(compl)  c {lindex $c 1}
 proc im(compl)    c {lindex $c 2}
 proc abs(compl)   c {expr {hypot([real(compl) $c],[im(compl) $c])}}
 proc angle(compl) c {expr {atan2([im(compl) $c],[real(compl) $c])}}
 proc +(compl) {x y} {
    set xr [real(compl) $x]; set xi [im(compl) $x]
    set yr [real(compl) $y]; set yi [im(compl) $y]
    make(compl) [expr {$xr+$yr}] [expr {$xi+$yi}]
 }
 proc raise(compl) x {
    switch -- [type $x] {
    compl {return $x}
    rat   {make(compl) [expr 1.0*[num(rat) $x]/[den(rat) $x]] 0}
    ""    {make(compl) $x 0}
    }
 }
 proc lower(compl) x {
    expr {[im(compl) $x]==0? [real(compl) $x]: $x}
 }

In my never-ending quest for the limits of Tcl I can only say: here they aren't... A final example for how we can now mix and match:

 + {compl 1 1} {rat 1 4}
 compl 1.25 1

---

AK Using

  make(compl) [+ $xr $yr] [+ $xi $yi]

instead might allow rationals as components of complex numbers. Of course, we have to make sure that users don't try to use a complex number as a component of complex number. This is not part of this code snippet.

---