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