Version 5 of MakeRanges

Updated 2008-07-02 05:19:10 by aspect

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

Looks similar to Compact an integer list in Additional list functions.