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 ;-)

 Manipulating sets in Tcl Arts and Crafts of Tcl-Tk Programming