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 (this should work for negative integers too):
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.
Lars H: Making ranges like this is one of the subproblems in index generation for books; if a term appears on pages 15, 19, 20, 21, and 22, you usually want the index to say "15, 19–22".
Also, I can't help remarking that for ranges one should use the endash (–, \u2013) rather than the hyphen-minus (-, \u002D). If nothing else, this helps your program distinguish it from an arithmetic minus.
2010-10-21 hae
proc SplitHumanList L {
set X [split $L ,]
set Result [list]
foreach item $X {
set item [string trim $item]
if { [string first - $item] != -1 } {
lassign [split $item -] startIdx endIdx
for {set i $startIdx} { $i <= $endIdx } { incr i } {
lappend Result $i
}
} else {
lappend Result $item
}
}
return $Result
}
# Test code
set L "83, 32-36,38-42,71, 60-69"
SplitHumanList $L