comb

Richard Suchenwirth 2004-06-10 - A little challenge in Tcl programs for beginners made me rebake an earlier half-baked idea: the pattern of a data comb which returns some string depending on a numeric value and a specification, which gives the possible strings and the borderline values, e.g., (in Centigrades):

 {"bitter cold" -10 cold 10 fresh 15 nice 25 warm 30 hot}

You can consider the odd elements of this list (starting from 1, or the second one) as being the comb's teeth, and the even elements as the results to return when the tested value lies between two teeth (or outside). The rules are crystallized into a compact form (which is transparent pure-value), as opposed to the more C-like style

 if {$x<-10} {
     set res "bitter cold"
 } elseif {$x<10} {
     set res "cold"
 } elseif {$x<15} {
     set res "fresh"
 } elseif {$x<25} {
     set res "nice"
 } elseif {$x<30} {
     set res "warm"
 } else {
     set res "hot"
 }

which shows the comb structure, but disperses the data over different locations in the code.

The code for comb is of course pretty easy:

 proc comb {x spec} {
    foreach {value limit} $spec {if {$x<$limit} break}
    set value
 }

# Testing:

 % comb 11 {child 13 teen 19 adult}
 child
 % comb 15 {child 13 teen 19 adult}
 teen
 % comb 99 {child 13 teen 19 adult}
 adult

KPV This is very much like Java's ChoiceFormat class [L1 ] except that one allows you to control whether the comparison is less than or less than or equal.

(I've always viewed ChoiceFormat as one example of why Java's huge class library is not as useful as it may seem: why this instead of something simple, useful and basic as sorting a generic array.)

RS: Hm.. one could add the comparison operator (< or <=) as an optional argument

 proc comb {x spec {op <}} {
    foreach {value limit} $spec {if $x$op$limit {return $value}}
    return $value
 }

but this still is much simpler than what Java offers, I suppose... In fact, then one could also use this for exact matching. The last value of the "comb" is the default that applies when all else fails:

 comb 5 {steam 0 electric 1 diesel 2 shunter 3 emu 4 unknown} ==

Jorge Moreno 6-11-2004, using dates...

Let's say you want to know if current time belongs to any of the three shifts in a factory...

 set sh1_Starts "[clock format [clock seconds] -format %m/%d/%Y] 07:00:00"
 set sh2_Starts "[clock format [clock seconds] -format %m/%d/%Y] 15:00:00"
 set sh3_Starts "[clock format [clock seconds] -format %m/%d/%Y] 22:30:00"

 #Get numerical values for each date
 set ShiftBeg1 [clock scan $sh1_Starts]
 set ShiftBeg2 [clock scan $sh2_Starts]
 set ShiftBeg3 [clock scan $sh3_Starts]

 #Let's say current time is 3:01PM, which shift is it?
 set now "[clock format [clock seconds] -format %m/%d/%Y] 15:01:00"
 set nowNum [clock scan $now]

 puts [comb $nowNum "Shift3 $ShiftBeg1 Shift1 $ShiftBeg2 Shift2 $ShiftBeg3 Shift3"]

This code will print "Shift2"

RS 2005-05-22 - I found another use case when reading an article about PHP[L2 ], a kind of "advice giver" based on a person's age. I could not elegantly bring their solution of a ranging switch to Tcl, but I remembered that comb is just the thing for that - read "!" as shortcut for "you can't":

 % comb 15 {!drive 16 !vote 18 !drink 21 work,work,work 65 retire}
 !drive
 % comb 16 {!drive 16 !vote 18 !drink 21 work,work,work 65 retire}
 !vote
 % comb 18 {!drive 16 !vote 18 !drink 21 work,work,work 65 retire}
 !drink
 % comb 20 {!drive 16 !vote 18 !drink 21 work,work,work 65 retire}
 !drink
 % comb 21 {!drive 16 !vote 18 !drink 21 work,work,work 65 retire}
 work,work,work
 % comb 64 {!drive 16 !vote 18 !drink 21 work,work,work 65 retire}
 work,work,work
 % comb 65 {!drive 16 !vote 18 !drink 21 work,work,work 65 retire}
 retire