2003/May/16 -- [Joe Mistachkin] -- The following code (MakeRanges), takes a list of numbers and makes them into a list of number ranges. A "range", in this case, is a sub-list of numbers in ascending order with no gaps. Discussion? ---- proc MakeRanges { ids } { # start with no result. set result "" # how many id ids in list? set count [llength $ids] # start at FIRST index. set index "0" # continue until no more id ids to sift through. while {$index < $count} { # last id is invalid. set last_id "-1" # this id is the current one from the list. set this_id [lindex $ids $index] # the start of the range is invalid (no range found yet). set start_id "-1" # set inner loop invariant to true initially... set is_contiguous "1" while {$is_contiguous != "0"} { if {$this_id == ($last_id + "1")} then { # # ok, the current id is the last id + 1. # this means the range is still going. # } else { if {$this_id == $last_id} then { # # ok, the current id is the same as the last one. # we use "compression" to mash these consecutive # duplicates into one. # } else { if {$last_id == "-1"} then { # # ok, there is no valid last id to compare to. # } else { # # set loop invariant, we are no longer in a range. # set is_contiguous "0" } } } if {$is_contiguous != "0"} then { # # advance to next id id now. # we check the updated loop invariant again below. # set index [expr {$index + "1"}] if {$start_id == "-1"} then { # # now we have a range start. # set start_id $this_id } # # are there more ids? # if {$index < $count} then { # # there are more ids... # set last id to this id and this id to next id. # set last_id $this_id set this_id [lindex $ids $index] } else { # # no more ids left after current. # now, we check to see if the current id # is the same as the start of the current range. # if {$this_id != $start_id} then { # # must end range now, last one. # we were still contiguous so, we just # add all the way up to the current id id. # lappend result "$start_id-$this_id" } else { # # append the last solitary id id. # since it's the same as the range start. # we don't add things like "0-0" # lappend result $this_id } # # we need to bail out of the inner loop. # the outer loop will be handled by the # fact that the index is now beyond the # bounds of the list. # set is_contiguous "0" } } else { # # do we have a range going? # if {$start_id != "-1"} then { if {$last_id != $start_id} then { # # it's a valid range, add it. # lappend result "$start_id-$last_id" } else { # # it's the same, just add the last id id # we don't add things like "0-0" # lappend result $last_id } } } } } return $result } proc TestRanges {} { # torture tests... set test_parameters [list "" "0" "0 0" "0 1" "0 2" "0 0 2" "0 1 2" "0 1 2 4" "5 0 1 2 4 3 10 11" "5 4 3 2 1 0 1 2 3 4 5 6 7 8 9 10 12" "0 0 20 21 0 1 2 34 35 40 0 1 0 1 0 0" "1 2 3 4 5 6 7 8 9 10 12 13 14 15 17 18 19 20 21 23"] set test_results [list "" "0" "0" "0-1" "0 2" "0 2" "0-2" "0-2 4" "5 0-2 4 3 10-11" "5 4 3 2 1 0-10 12" "0 20-21 0-2 34-35 40 0-1 0-1 0" "1-10 12-15 17-21 23"] foreach this_parameter $test_parameters this_result $test_results { set that_result [MakeRanges $this_parameter] if {$that_result == $this_result} then { puts stdout "TEST \"$this_parameter\" PASSED,\nGOT \"$this_result\"." } else { puts stdout "TEST \"$this_parameter\" FAILED,\nWANTED \"$this_result\", \nGOT \"$that_result\"." break } } } ---- Ah, algorithms, yummie. -[jcw] # Replace ranges of consecutive integers N..M in a list by "N-M" (N >= 0) proc MakeRanges2 {ids} { set result "" set tail -2 foreach x [concat $ids -1] { if {$x != $tail + 1} { if {$tail >= 0 && $tail != [lindex $result end]} { append result - $tail } if {$x >= 0 && $x != [lindex $result end]} { lappend result $x } } set tail $x } return $result } ---- Here's another one, more like cut/awk semantics: proc range {str} { set ranges [split $str ,] set result {} foreach range $ranges { foreach {from to} [split $range -] {} if {[string length $to]} { while {$from <= $to} { lappend result $from incr from } } else { lappend result $from } } return $result } Usage: % range 1-5,8,11-15 1 2 3 4 5 8 11 12 13 14 15 ---- [Stu] 2008-10-30 ====== # Range expander. Positive integers only. No error handling. # 0-0,1,2,1-2,7-13 => 0 1 2 1 2 7 8 9 10 11 12 13 # proc expandRange {range} { set expanded {} foreach chunk [split $range ,] { foreach hi [lassign [split $chunk -] chunk] { for {set lo $chunk; set chunk {}} {$lo <= $hi} {incr lo} { lappend chunk $lo } } lappend expanded {*}$chunk } return $expanded } ====== ---- [NEM] 2008-10-30 too. Here's how to generate the ranges using [functional programming] idioms. In particular, we use [fold] and [map] here: ====== proc MakeRange {xs x} { set last [lindex $xs end 1] if {[llength $xs] && $x-$last in {0 1}} { lset xs end 1 $x } else { lappend xs [list $x $x] } } proc JoinRange range { join [lsort -unique $range] "-" } proc MakeRanges xs { map JoinRange [foldl MakeRange {} $xs] } ====== ---- Looks similar to '''Compact an integer list''' in [Additional list functions].