MakeRanges

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