[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 ;-) } ---- [Manipulating sets in Tcl] - [Arts and crafts of Tcl-Tk programming]