Manipulating infinite sets in Tcl

Arjen Markus As the sample implementation for manipulating infinite sets was quite a bit larger than the fragments in the original page, I thought it would be a nice idea to let the script have its own page. So, here it is!

   # infinite_sets.tcl --
   #    An example of how to implement infinite sets
   #

   # Sets --
   #    Namespace reserved for the set manipulation routines
   #
   namespace eval ::Sets {

   # inducedSet --
   #    Infinite sets are actually sets generated via induction. This
   #    routine defines such a set
   #
   # Arguments:
   #    first       The first value of the set
   #    nextMethod  The name of the procedure that returns a successor
   #    distMethod  The name of the procedure that determines the "distance"
   # Results:
   #    Returns a list structured such that is acceptable as an induced set
   #
   proc inducedSet { first nextMethod distMethod } {
      return [list INDUCEDSET $first $nextMethod $distMethod]
   }

   # union --
   #    Construct a list that acts as the union of two infinite sets.
   #
   # Arguments:
   #    seta        The first infinite set
   #    setb        The second infinite set
   # Results:
   #    Returns a list structured such that is acceptable as an union set
   # Note:
   #    If the distance methods are not the same, then an error is raised
   #
   proc union { seta setb } {
      if { [getDistMethod $seta] != [getDistMethod $setb] } {
         error "Distance methods for the two sets must be equal!"
      } else {
         return [list UNION $seta $setb]
      }
   }

   # intersection --
   #    Construct a list that acts as the intersection of two infinite sets.
   #
   # Arguments:
   #    seta        The first infinite set
   #    setb        The second infinite set
   # Results:
   #    Returns a list structured such that is acceptable as an
   #    intersection set
   # Note:
   #    If the distance methods are not the same, then an error is raised
   #
   proc intersection { seta setb } {
      if { [getDistMethod $seta] != [getDistMethod $setb] } {
         error "Distance methods for the two sets must be equal!"
      } else {
         return [list INTERSECTION $seta $setb]
      }
   }

   # first --
   #    Return the first element of a given set
   #
   # Arguments:
   #    seta        The given infinite set
   # Results:
   #    The first element
   #
   proc first { seta } {
      if { [lindex $seta 0] == "INDUCEDSET" } {
         return [lindex $seta 1]
      }
      if { [lindex $seta 0] == "UNION" } {
         set firstset   [lindex $seta 1]
         set secondset  [lindex $seta 2]
         set firstelem  [first $firstset]
         set secondelem [first $secondset]
         if { [distance $firstset $firstelem] <= [distance $secondset $secondelem] } {
            return $firstelem
         } else {
            return $secondelem
         }
      }
      if { [lindex $seta 0] == "INTERSECTION" } {
         set firstset   [lindex $seta 1]
         set secondset  [lindex $seta 2]
         set firstelem  [first $firstset]
         set secondelem [first $secondset]
         if { [distance $firstset $firstelem] <= [distance $secondset $secondelem] } {
            return $firstelem
         } else {
            return $secondelem
         }
      }

      #
      # Raise an error: unknown type
      #
      error "Unknown type of set: [lindex $seta 0]"
   }

   # next --
   #    Return the next element of a given set
   #
   # Arguments:
   #    seta        The given infinite set
   #    elem        The element whose successor is to returned
   # Results:
   #    The next element
   #
   proc next { seta elem } {
      if { [lindex $seta 0] == "INDUCEDSET" } {
         set method [lindex $seta 2]
         return [$method $elem]
      }
      if { [lindex $seta 0] == "UNION" } {
         set firstset   [lindex $seta 1]
         set secondset  [lindex $seta 2]
         set firstelem  [next   $firstset $elem]
         set secondelem [next   $secondset $elem]
         if { [distance $firstset $firstelem] <= [distance $secondset $secondelem] } {
            return $firstelem
         } else {
            return $secondelem
         }
      }
      if { [lindex $seta 0] == "INTERSECTION" } {
         set firstset   [lindex $seta 1]
         set secondset  [lindex $seta 2]
         set firstelem  [next   $firstset $elem]
         set secondelem [next   $secondset $elem]
         set tries         0
         set maxtries   1000
         while { $firstelem != $secondelem && $tries < $maxtries } {
            if { [distance $firstset $firstelem] < [distance $secondset $secondelem] } {
               set firstelem  [next $firstset $firstelem]
            } else {
               set secondelem [next $secondset $secondelem]
            }
            incr tries
         }
         return $firstelem
      }

      #
      # Raise an error: unknown type
      #
      error "Unknown type of set: [lindex $seta 0]"
   }

   # getDistMethod --
   #    Return the distance method of a given set
   #
   # Arguments:
   #    seta        The given infinite set
   # Results:
   #    The name of the method
   #
   proc getDistMethod { seta } {
      if { [lindex $seta 0] == "INDUCEDSET" } {
         return [lindex $seta 3]
      }
      if { [lindex $seta 0] == "UNION" } {
         set firstset   [lindex $seta 1]
         return [lindex $firstset 3]
      }
      if { [lindex $seta 0] == "INTERSECTION" } {
         set firstset   [lindex $seta 1]
         return [lindex $firstset 3]
      }

      #
      # Raise an error: unknown type
      #
      error "Unknown type of set: [lindex $seta 0]"
   }

   # distance --
   #    Return the distance to the first element of a given set
   #
   # Arguments:
   #    seta        The given infinite set
   #    elem        The element in question
   # Results:
   #    The distance
   #
   proc distance { seta elem } {
      if { [lindex $seta 0] == "INDUCEDSET" } {
         set method [lindex $seta 3]
         return [$method $elem]
      }
      if { [lindex $seta 0] == "UNION" } {
         set firstset   [lindex $seta 1]
         return [distance $firstset $elem]
      }
      if { [lindex $seta 0] == "INTERSECTION" } {
         set firstset   [lindex $seta 1]
         return [distance $firstset $elem]
      }

      #
      # Raise an error: unknown type
      #
      error "Unknown type of set: [lindex $seta 0]"
   }

   } ;# End of namespace

   #
   # Test the procedures
   #
   proc simpleDist    { elem } { return $elem }
   proc nextTwofold   { elem } { return [expr {2*($elem/2)+2}] }
   proc nextFivefold  { elem } { return [expr {5*($elem/5)+5}] }
   proc nextSevenfold { elem } { return [expr {7*($elem/7)+7}] }

   set seta [::Sets::inducedSet 0 nextTwofold simpleDist]
   set setb [::Sets::inducedSet 0 nextFivefold simpleDist]
   set setc [::Sets::inducedSet 0 nextSevenfold simpleDist]

   set unionab   [::Sets::union $seta $setb]
   set unionabc  [::Sets::union $unionab $setc]
   set intersab  [::Sets::intersection $seta $setb]
   set intersabc [::Sets::intersection $intersab $setc]

   #
   # Print the first 10 elements
   #
   set elema    [::Sets::first $seta]
   set elemb    [::Sets::first $setb]
   set elemab   [::Sets::first $unionab]
   set elemabc  [::Sets::first $unionabc]
   set elemiab  [::Sets::first $intersab]
   set elemiabc [::Sets::first $intersabc]

   for { set i 0 } { $i < 10 } { incr i } {
      puts "$elema $elemb $elemab $elemabc $elemiab $elemiabc"
      set elema    [::Sets::next $seta      $elema]
      set elemb    [::Sets::next $setb      $elemb]
      set elemab   [::Sets::next $unionab   $elemab]
      set elemabc  [::Sets::next $unionabc  $elemabc]
      set elemiab  [::Sets::next $intersab  $elemiab]
      set elemiabc [::Sets::next $intersabc $elemiabc]
   }

   #
   # Test the error handling
   # Note: there currently is no "simpleDist2", but that is not checked
   #
   set setc [::Sets::inducedSet 0 nextFivefold simpleDist2]
   set unionac [::Sets::union $seta $setc]

RS Note that you can have the same effects with considerably shorter scripts, e.g.

 proc Sets::first seta {
     switch -- [lindex $seta 0] {
      INDUCEDSET           {set res [lindex $seta 1]}
      UNION - INTERSECTION {
         set s1 [lindex $seta 1] ;# shorter names ...
         set s2 [lindex $seta 2] ;# ... so as to keep the condition short
         set e1 [first $s1]
         set e2 [first $s2]
         set res [expr { 
            [distance $s1 $e1] <= [distance $s2 $e2]?
              $e1
            : $e2 }]
         }
      default {error "Unknown set type [lindex $seta 0]"}
     }
     set res ;# I prefer return-less procs ;-)
 }

Arjen Markus Yes, I have seen more examples of this - including a very neat "sum" proc of one-line only. I still have to learn this, because in languages like C I detest this type of shortness. (In C it leads to formidable typographic complexity, in my opinion).

RS Sure enough, also in the expr a?b:c usage above. On the other hand, shorter code may be easier inspected for bugs. In general I try to avoid repetitions of similar code, e.g. in the unified treatment of UNION and INTERSECTION - otherwise you fix a bug in one place and forget the parallel branch ;-)