lselect

Klaus Saalfeld A function lselect is proposed that selects a number of items from a list and returns them as a new list. In contrast to known lindex with multiple indices lselect doesn't operate on nested lists but on flat lists. The returned list contains the items in the same order as specified with the indices argument.

Using a list argument

# Returns from the specified list one or more elements identified by given indices.
# The first element in list is given by index 0, the last element of list is given by "end".
# An optional negative offset (e.g. "end-1") can be used to specify elements relative to the end of list.
# The list to operate on is passed by value.
proc lselect {value indices} {
   set result {}
   set length [llength $value]
   if {0 != $length} {
      foreach index $indices {
         if {0 == [string compare -length 3 $index end]} {
            set offset [string range $index 3 end]
            set index [expr {$length - 1}]
            if {$offset ne ""} {
               incr index $offset
            }
         }
         if {($index >= 0) && ($index < $length)} {
            lappend result [lindex $value $index]
         }
      }
   }
   return $result
}

Some examples:

% lselect {car house tiger penguin} {end-1 1 end 0}
tiger house penguin car

% lselect {banana pineapple orange} 1
pineapple

% lselect {tcl is great} {-1 17 end-8}
<empty>

% lselect {more awesome stuff} {1 1 1}
awesome awesome awesome

Using args

Larry Smith Might I suggest the slightly less verbose:

# Returns from the specified list one or more elements identified by given indices.
# The first element in list is given by index 0, the last element of list is given by "end".
# An optional negative offset (e.g. "end-1") can be used to specify elements relative to the end of list.
# The list to operate on is passed by listval.
proc lselect {listval args} {
   set result {}
   if {[llength $listval]>0} {
      foreach index $args {
         lappend result [lindex $listval $index]
      }
   }
   return $result
}

Which has (mostly) the same results. The comparisons against "end" are unneeded since lindex takes care of them itself. Using args means the indices does not have to itself be a list.

% lselect {car house tiger penguin} end-1 1 end 0
tiger house penguin car

% lselect {banana pineapple orange} 1
pineapple

% lselect {tcl is great} -1 17 end-8
{} {} {}

% lselect {more awesome stuff} 1 1 1
awesome awesome awesome

Klaus Saalfeld As far as I can see the results differ when an invalid index is given: Using this variant lappend concats empty values to the resulting list (which I think is not a good feature). At first I throught you're right concerning "end" handling which might be delegated to lindex. But then I thought lselect might get problems dealing with empty list items. This is because you can't tell whether lindex has not found an item or the item was found but is empty (in which case lselect should return it).

The result also differs if args is given but empty:

% lselect {a b c} {}
{a b c}

Using a lambda to select items

The function can be extended to use apply to decide which items to select:

proc lselect {value indices args} {
   set result {}
   set length [llength $value]
   if {$length > 0} {
      if {$indices ne "-apply"} {
         foreach index $indices {
            if {0 == [string compare -length 3 $index end]} {
               set offset [string range $index 3 end]
               set index [expr {$length - 1}]
               if {$offset ne ""} {
                  incr index $offset
               }
            }
            if {($index >= 0) && ($index < $length)} {
               lappend result [lindex $value $index]
            }
         }
      } else {
         foreach item $value {
            lappend result [apply {*}$args $item]
         }
      }
   }
   return $result
}

This is useful to select items based on their value or to transform items:

;# Square all values in list
% lselect {3 5 1 4} -apply {{x} {return [expr {$x*$x}]}}
9 25 1 16

;# Apply a lower limit on values in list
% lselect {1 -3 7 2} -apply {{x} {return [expr {max(0, $x)}]}}
1 0 7 2

Moreover items can be removed from a list depending on their value:

;# Get all positive non-zero values from a list
% lselect {9 1 -3 5 -7} -apply {{x} {if {$x > 0} {return $x} else {return -code continue}}}
9 1 5

;# Get all values until a zero or negative value is found
% lselect {3 2 1 0 7 -1 5} -apply {{x} {if {$x > 0} {return $x} else {return -code break}}}
3 2 1

Adding a -not switch to remove elements

A -not switch can be added to support removing elements from a list:

proc lselect {value indices args} {
   set result {}
   set length [llength $value]
   if {$length > 0} {
      if {$indices ne "-not"} {
         foreach index $indices {
            if {0 == [string compare -length 3 $index end]} {
               set offset [string range $index 3 end]
               set index [expr {$length - 1}]
               if {$offset ne ""} {
                  incr index $offset
               }
            }
            if {($index >= 0) && ($index < $length)} {
               lappend result [lindex $value $index]
            }
         }
      } else {
         set mask [lrepeat $length 1]
         foreach index [lindex $args 0] {
            if {0 == [string compare -length 3 $index end]} {
               set offset [string range $index 3 end]
               set index [expr {$length - 1}]
               if {$offset ne ""} {
                  incr index $offset
               }
            }
            if {($index >= 0) && ($index < $length)} {
               set mask [lreplace $mask $index $index 0]
            }
         }
         set result {}
         for {set i 0} {$i < $length} {incr i} {
            if {[lindex $mask $i] > 0} {
               lappend result [lindex $value $i]
            }
         }
      }
   }
   return $result
}

This can be useful when implementing stacks or queues:

% lselect {a b c} -not 0
b c

% lselect {a b c} -not end
a b

It is useful to remove all elements from a list matching a given pattern:

% set fruits {banana ananas pineapple orange apple}
% lselect $fruits -not [lsearch -all $fruits a*]
banana pineapple orange

Use cases

Many list operations are special cases of lselect. For example:

  • lindex $x $n corresponds to lselect $x $n.
  • lrange means selecting a consecutive range of items from a list
  • lreplace can be used to remove elements from a list which is equivalent to selecting the remaining elements using lselect.
  • lreverse {a b c} is equivalent to lselect {a b c} {2 1 0}.

lselect can be combined with lsearch to extract items from a list that match a given pattern:

% set fruits {banana ananas pineapple orange apple}
% lselect $fruits [lsearch -all $fruits a*]
ananas apple

lselect can be used to rotate values in a list:

% set x {1 2 3 4}
% set x [lselect $x {1 2 3 0}]; # Rotate to the left by 1
2 3 4 1
% set x [lselect $x {1 2 3 0}]
3 4 1 2
...
% set x {1 2 3 4}
% set x [lselect $x {3 0 1 2}]; # Rotate to the right by 1
4 1 2 3
% set x [lselect $x {3 0 1 2}]
3 4 1 2
...

lselect in conjunction with lsort and -indices flag can be used to shuffle a list. The idea is to sort a list of pseudo-random numbers and use their rank to pick elements from the list to be shuffled.

proc shuffle {x} {
   set s {}
   for {set i 0} {$i < [llength $x]} {incr i} {
      lappend s [expr {rand()}]
   }
   return [lselect $x [lsort -real -indices $s]]
}

The qualitiy of the result depends on the quality of pseudo-random numbers returned by rand(). A typical distribution of values can be obtained by experiment:

for {set n 0} {$n < 10} {incr n} {
   set h($n) 0
}
for {set i 0} {$i < 100000} {incr i} {
   set y [shuffle {0 1 2 3 4 5 6 7 8 9}]
   # update bins
   for {set n 0} {$n < 10} {incr n} {
      incr h($n) [lindex $y $n] 
   }
}
for {set n 0} {$n < 10} {incr n} {
   puts "$n: $h($n)"
}

For a list with values from 0 to 9 the expectation value when drawing a value from this list is 4.5. For 100.000 trials this gives a sum of 450.000 within each bin. A typical output shows that the result is close to this:

0: 450571
1: 449320
2: 449632
3: 450153
4: 449569
5: 450054
6: 449381
7: 450210
8: 450678
9: 450432

See also