Additional list functions is a guide to pages that provide commands and scripts or present methods for manipulating lists.
Collections of list commands.
Commands that modify the content of a list.
Commands that return some part of a list.
Commands that visit elements in a list.
Commands that provide some information about the contents or structure of a list.
Commands that reorder the elements of a list.
Commands that create new data or structures based on the content of a list.
John Ellson posted forest.tcl which contains a couple of list-oriented search functions implementing a tree structure like functionality.
LV: Anyone have a URL for this posting of forest.tcl ?
Outline of the next steps to do:
Areas of discussion:
LV: Another useful thing would be a 'wishlist' (excuse the pun) of functionality requested. This would include things like (all of these have, in the past, either been posted to the newsgroup or offered by a contributor to the newsgroup - so if code is desired, the contacts listed in [L1 ] should be emailed.):
AK: I have to admit that I currently see keyed lists as something to either add later, or to place them into a separate extension.
AK: I would also vote to definitely place DB interfaces into their own extension.
DL: also look at list utilities in the opt package of tcl 8.[01] (mostly tclX 'compatible' though)
Nat Pryce: I have implemented map, fold and zip functions in C and lambda functions in Tcl, but never released them. Anyone who is working on a list extension package is welcome to the code.
Larry Virden: the following pages have recently appeared on the Wiki: Shuffle a list, Striding a list, Summing a list - Cartesian product of a list of lists Recursive list searching
Here's some little helpers just for taking out:
List element:
proc lel {L element} {expr {[lsearch $L $element]>=0}}package require Tcl 8.5
proc lel {L element} { expr { $element in $L } }Though if you have Tcl8.5 you should write if {$elt in $list} ... rather than if {[lel $list $elt]} ....
Add an element to a list only if not present yet:
proc ladd {_L args} {
upvar $_L L
if {![info exists L]} {set L {}}
foreach i $args {if {![lel $L $i]} {lappend L $i}}
}Random element selected from a list:
proc lrandom L {lindex $L [expr {int(rand()*[llength $L])}]}Random element drawn (and removed) from a list:
proc ldraw {_L} {
upvar 1 $_L L
set pos [expr {int(rand() * [llength $L])}]
set res [lindex $L $pos]
set L [lreplace $L $pos $pos]
set res
}Remove elements from a list by value:
proc lremove {_L args} {
upvar $_L L
foreach i $args {
set pos [lsearch $L $i] ;# might be -1 if not found...
set L [lreplace $L $pos $pos] ;# ... but that's fine
}
}Reverse the order of a list:
Since 8.5, lreverse is a built-in Tcl command.
proc lreverse L {
set res {}
set i [llength $L]
#while {[incr i -1]>=0} {lappend res [lindex $L $i]}
while {$i} {lappend res [lindex $L [incr i -1]]} ;# rmax
set res
} ;# RS, tuned 10% faster by [rmax]Here's a simpler way to do it.
proc lreverse2 l {
set ret {}
foreach i $l {
set ret [linsert $ret 0 $i]
}
return $ret
} #EASRS: Note however that the linsert requires copying the whole sublist N times, while, the lappend copies each element exactly once.
KPV: Here are three more ways of reversing a list that utilize lset to swap pairs of elements in place:
proc lreverse3 {l} {
set start -1
set end [llength $l]
while {[incr start] < [incr end -1]} {
set tmp [lindex $l $start]
lset l $start [lindex $l $end]
lset l $end $tmp
}
return $l
}For long lists you can squeeze out a bit more performance with the help of foreach:
proc lreverse4 {l} {
set start -1
set end [llength $l]
foreach tmp $l {
if {[incr start] >= [incr end -1]} break
lset l $start [lindex $l $end]
lset l $end $tmp
}
return $l
}Here's a very simple version — faster than lreverse4 but alas not the fastest:
proc lreverse5 {l} {
set end [llength $l]
foreach tmp $l {
lset l [incr end -1] $tmp
}
return $l
}Lars H: This is not fast, but it avoids index arithmetic. The idea can be nice in cases where you want to process the list elements while reversing their order.
proc lreverse6 {l} {
set stack {}
foreach item $l {set stack [list $stack $item]}
set res {}
while {[llength $stack]} {
foreach {stack item} $stack break
lappend res $item
}
return $res
}Sort a list on multiple indices:
proc multisort {indices L args} {
set cmd "list $L"
foreach i [lreverse $indices] {
set cmd "lsort $args -index $i \[$cmd\]"
}
eval $cmd
} ;# RS% multisort {2 0 1} {{abe zyx 25} {john smith 14} {harold brown 99} {mary jones 32}}
{john smith 14} {abe zyx 25} {mary jones 32} {harold brown 99}
% multisort {0 2 1} {{abe zyx 25} {john smith 14} {harold brown 99} {mary jones 32}} -decreasing
{mary jones 32} {john smith 14} {harold brown 99} {abe zyx 25}see also: Custom sorting
Permute a list: returns a list of the possible orderings of the input list, e.g. lpermute {a b c} => {{a b c} {a c b} {b a c} {b c a} {c a b} {c b a}}. Be aware that the output length grows factorially, so a 7-element input produces over 5000 permutations...
proc lpermute L {
if {[llength $L] < 2} {
set res $L
} else {
set pos 0
foreach i $L {
set rest [lreplace $L $pos $pos]
incr pos
foreach j [lpermute $rest] {
lappend res [concat [list $i] $j]
}
}
}
set res
} ;# RSFind the list element numerically closest to a given value'
[F]or a given value, find one element from a given list with minimal absolute difference [...]
proc closest {value list} {
set minElement [lindex $list 0]
set minDist [expr {abs($value-$minElement)}]
foreach i [lrange $list 1 end] {
if {abs($value-$i) < $minDist} {
set minDist [expr {abs($value-$i)}]
set minElement $i
}
}
set minElement
}
In borderline cases, it picks the first hit, though:
% closest 2.5 {1 2 3 4 5}
2Compact an integer list: merge consecutive numbers, if more than two, into a dash-separated range (an extra element is appended to the list to collect the final buffer):
proc rangify list {
set res {}
set buf {}
foreach i [lappend list {}] {
if {$buf eq {} || $i == [lindex $buf end] + 1} {
lappend buf $i
} else {
if {[llength $buf] > 2} {
set buf [lindex $buf 0]-[lindex $buf end]
}
lappend res $buf
set buf $i
}
}
join $res
} ;#RS% rangify {1 2 3 5 6 7 9 10 12 13 14 17 18 19}
1-3 5-7 9 10 12-14 17-19Here's an alternative remake of October 2005, with an expander, too:
proc compress list {
set res [lindex $list 0]
for {set i 1} {$i < [llength $list] - 1} {incr i} {
set it [lindex $list $i]
if {$it == [lindex $list [expr {$i-1}]] + 1
&& $it == [lindex $list [expr {$i+1}]] - 1} {
lappend res -
} else {lappend res $it}
}
lappend res [lindex $list end]
regsub -all -- { - (- )*} $res -
}
#---- For the way back:
proc expand clist {
set res {}
foreach part $clist {
if [regexp {([0-9-]*[0-9])-(.+)} $part -> from to] {
while {$from <= $to} {lappend res $from; incr from}
} else {lappend res $part}
}
set res
};# RSList constructor: After the advent of multi-index lindex and lset, nested lists can conveniently be used e.g. for matrixes, but all list elements must be present for them to work. Here's a nestable constructor that fills a list with the specified initial value:
proc lrepeat {value number} {
for {set i 0} {$i<$number} {incr i} {
lappend res $value
}
set res
} ;# RS
% lrepeat foo 5
foo foo foo foo foo
% lrepeat [lrepeat 0 5] 5
{0 0 0 0 0} {0 0 0 0 0} {0 0 0 0 0} {0 0 0 0 0} {0 0 0 0 0}The second edition saves you the nesting, accepts indices in a list or separately, just like lset or lindex:
proc lrepeat {value args} {
if {[llength $args] == 1} {set args [lindex $args 0]}
foreach number $args {
incr number 0 ;# force integer (1)
set buf {}
for {set i 0} {$i < $number} {incr i} {
lappend buf $value
}
set value $buf
}
set buf
}
% lrepeat 0 3 4
{0 0 0} {0 0 0} {0 0 0} {0 0 0}
% lrepeat 0 {3 4}
{0 0 0} {0 0 0} {0 0 0} {0 0 0}
% lrepeat 0 {3 4 5}
{{0 0 0} {0 0 0} {0 0 0} {0 0 0}} {{0 0 0} {0 0 0} {0 0 0} {0 0 0}} {{0 0 0} {0 0 0} {0 0 0} {0 0 0}} {{0 0 0} {0 0 0} {0 0 0} {0 0 0}} {{0 0 0} {0 0 0} {0 0 0} {0 0 0}}(1): See Stress testing for why this makes the code safer.
DKF: Tcl 8.5a0 has a variation on this which behaves like this:
proc lrepeat {count value args} {
set values [linsert $args 0 $value]
set result {}
for {set i 0} {$i < $count} {incr i} {
eval [list lappend result] $values
}
return $result
}And now, because I can't resist it, here's an even hackier way to do it. :^D
proc lrepeat {count args} {
set result {}
set cmd [list eval [list lappend result]]
for {set i 0} {$i < $count} {incr i} {
lappend cmd $args
}
eval $cmd
}AMG: This second version is the more efficient of the two. It is also more correct in that it allows [lrepeat] to take only one argument (the count), in which case it returns empty string. Though to be pedantic, both are technically incorrect for Tcl 8.5a0 which predates TIP 323 [L2 ]; back then, [lrepeat] arbitrarily rejected $count = 0.
FW: Here's a most minimalist way (and of course the less efficient).
proc lrepeat {count args} {string repeat "$args " $count}AMG: DKF's "efficient" version does far more work than it has to. Here's a significantly faster approach:
proc lrepeat {count args} {
set cmd [list concat]
for {set i 0} {$i < $count} {incr i} {
lappend cmd $args
}
eval $cmd
}And another version with a slightly faster loop:
proc lrepeat {count args} {
set cmd [list concat]
incr count
while {[incr count -1]} {
lappend cmd $args
}
eval $cmd
}Timing:
% info patchlevel ;# 8.6.1
% time {dkf_1 123 x y z} 10000 ;# 773.3324 microseconds per iteration
% time {dkf_2 123 x y z} 10000 ;# 108.0783 microseconds per iteration
% time {amg_1 123 x y z} 10000 ;# 27.1447 microseconds per iteration
% time {amg_2 123 x y z} 10000 ;# 21.9983 microseconds per iteration
% time {lrepeat 123 x y z} 10000 ;# 3.5693 microseconds per iterationAnd for a laugh, here's the time for FW's less efficient approach:
% time {fw_1 123 x y z} 10000 ;# 2.4697 microseconds per iterationYup. It's faster than the native [lrepeat]! But the return value is subtly different. Let's make it fair:
% proc fw_2 {count args} {linsert [string repeat "$args " $count] 0}
% time {fw_2 123 x y z} 10000 ;# 60.4778 microseconds per iterationThis version forces its result to be a pure list. And wow, despite being "less efficient", FW's dalliance with strings is still faster than any of the list manipulation approaches that had preceded it. That's quite impressive. I believe the reason is that it avoids [eval] and all Tcl-based looping. It's just two commands, and almost no work is done in TEBC.
List equality test independent of whitespace outside of elements: Taken from A little XML parser where you can find other things to do with lists
proc lequal {a b} {
if {[llength $a] != [llength $b]} {return 0}
if {[lindex $a 0] == $a} {return [string equal $a $b]}
foreach i $a j $b {if {![lequal $i $j]} {return 0}}
return 1
} ;# RSHaO 2014-09-16: aspect proposed on the chat:
[list {*}$l1] eq [list {*}$l2]Check if combination of list elements is valid against a list of lists,
JM 2004-01-04: this code relies on 'lequal'
set thisCase [list a c b]
set lstValid {
{a b c}
{a a c}
{a b b}
{a a a}
}proc chkValidCombination {lstValid thisCase} {
set valid 0
foreach validCase $lstValid {
set equal [lequal $validCase $thisCase]
if {$equal} {set valid 1}
}
return $valid
}
puts [chkValidCombination $lstValid $thisCase]Keylist access: Data arranged as alternating key value... can be searched like this, where non-existing keys just return an empty list:
proc keyget {list key} {
foreach {lkey value} $list {
if [string equal $lkey $key] {return $value}
}
} ;# RS
% keyget {fnm John lnm Brown phone (123)456-7890 email [email protected]} phone
(123)456-7890
% keyget {fnm John lnm Brown phone (123)456-7890 email [email protected]} faxInsert element into sorted list at suitable position:
proc linsertsorted {list newElement} {
set pos 0
foreach element $list {
if {$element > $newElement} break
incr pos
}
linsert $list $pos $newElement
} ;# RS -- testing:% linsertsorted {a b c d e} f
a b c d e f
% linsertsorted {a b c d e} 0
0 a b c d e
% linsertsorted {a b c d e} aa
a aa b c d eDKF notes that this is the most efficient way to maintain a sorted list of things with occasional insertions of elements. The alternative - append and full resort - is much more costly as the list size increases.
jcw 2004-10-04: Let me split hairs here. What you end up with is "insertion sort", not the most efficient sort algorithm in the world. For single, incidental inserts: yes, good approach. But if the insertions come in bursts, it's not optimal. One could collect insertions, and resort lazily on first access. Implementation left as exercise for the reader (heh!).
AF: here is my implementation of a BINARY insertion sort:
proc BinaryInsert {list pattern} {
set lo -1
set hi [llength $list]
set test [expr {$hi / 2}]
while {$lo != $test} {
set res [string compare -nocase [lindex $list $test] $pattern]
if {$res < 0} {
set lo $test
} elseif {$res > 0} {
set hi $test
} else {
return [linsert $list $test $pattern]
}
set test [expr {($hi + $lo) / 2}]
}
return [linsert $list $hi $pattern]
}Swap a paired list: e.g. dictionaries, string maps, x/y coordinates...
proc lswap list {
set res {}
foreach {a b} $list {lappend res $b $a}
set res
} ;# RS
% lswap {a b c d e f g h}
b a d c f e h gList intersection: For a number of lists, return only those elements that are present in all lists:
proc intersect args {
set res {}
foreach element [lindex $args 0] {
set found 1
foreach list [lrange $args 1 end] {
if {[lsearch -exact $list $element] < 0} {
set found 0; break
}
}
if {$found} {lappend res $element}
}
set res
} ;# RSkpv 2018-10-24: here's a one-liner using lmap for intersecting two lists:
set intersect [lmap a $alist {if {$a in $blist} {set a} else continue}]RS 2015-05-13: a simpler take for two lists, using the in operator:
proc lintersect {alist blist} {
set res {}
foreach a $alist {if {$a in $blist} {lappend res $a}}
return $res
}RKzn 2016-09-28: the previous proc works provided the first list does not have duplicate elements. Otherwise all elements from the first list that match at least one element from the second list will be included in the result:
tcl> lintersect {a b} {a c}
a
tcl> lintersect {a a b} {a c}
a aBy the way, lists without duplicates (or ignoring the ones that may exist) can be seen as sets. For those, there are implementations for intersection in tcllib: '::struct::set intersect' and '::struct::set intersect3'
kpv 2016-10-03: it's easy to fix the above code to handle duplicates
proc lintersect {alist blist} {
set res {}
foreach a $alist {if {$a in $blist && $a ni $res} {lappend res $a}}
return $res
}intersect3 Compares 2 lists and detects entries that only exist in list 1, only exist in list 2 or that exist in both lists.
Parameters:
proc intersect3 {list1 list2 inList1 inList2 inBoth} {
upvar $inList1 in1
upvar $inList2 in2
upvar $inBoth inB
set in1 [list]
set in2 [list]
set inB [list]
set list1 [lsort $list1]
set list2 [lsort $list2]
# Shortcut for identical lists is faster
if { $list1 == $list2 } {
set inB $list1
} else {
set i 0
foreach element $list1 {
if {[set p [lsearch [lrange $list2 $i end] $element]] == -1} {
lappend in1 $element
} else {
if { $p > 0 } {
set e [expr {$i + $p -1}]
foreach entry [lrange $list2 $i $e] {
lappend in2 $entry
}
incr i $p
}
incr i
lappend inB $element
}
}
foreach entry [lrange $list2 $i end] {
lappend in2 $entry
}
}
} ;# David EastonPrepend elements to a list (add in front):
proc lprepend {var args} {
upvar 1 $var v
set v [eval [list linsert $v 0] $args]
} ;# DKFTR: You can also use lreplace where the first index is -1 and the second is -2 ... like so:
set myList [list 0 1 2] set myList [lreplace $myList -1 -2 5] #-> 5 0 1 2
GPS 2003: In the Tcl Chatroom I came up with this idea. You may find it easier than using lreplace to do the same.
proc remove.list.item {lPtr i} {
upvar $lPtr l; set l [lreplace $l $i $i]
}Example:
% set l [list a b c] a b c % remove.list.item l 1 a c % set l a c
Key-value list searching: Before dict arrived, we could have a two-way map key<->value like this:
proc kvsearch {kvlist item} {
set pos [lsearch $kvlist $item]
if {$pos != -1} {
lindex $kvlist [expr {$pos+1-2*($pos%2)}]
}
} ;# RS
% kvsearch {1 one 2 two 3 three} four ;# returns empty string/list
% kvsearch {1 one 2 two 3 three} 1
one
0 % kvsearch {1 one 2 two 3 three} one
1Pairs of members of a list:
proc pairs set {
set res {}
set last [expr {[llength $set]-1}]
for {set ia 0} {$ia < $last} {incr ia} {
foreach b [lrange $set [expr {$ia+1}] end] {
lappend res [list [lindex $set $ia] $b]
}
}
set res
} ;# RS
% pairs {a b c d}
{a b} {a c} {a d} {b c} {b d} {c d}Simpler:
proc pairs set {
set res {}
foreach a [lrange $set 0 end-1] {
set set [lrange $set 1 end]
foreach b $set {lappend res [list $a $b]}
}
set res
} ;# RSIn-place queues using the K combinator
proc K {a b} {set a}
##
# Pop an item off a list, left or right
#
proc lpop {how listName} {
upvar $listName list
switch -- $how {
right {
K [lindex $list end] [set list [lrange $list 0 end-1]]
}
left {
K [lindex $list 0] [set list [lrange $list 1 end]]
}
default {
return -code error {lpop right|left listName}
}
}
}
##
# Pop an item onto a list, left or right
#
proc lpush {how listName item} {
upvar $listName list
switch -- $how {
right {
lappend list $item
}
left {
set list [linsert [K $list [set list {}]] 0 $item]
}
default {
return -code error "lpush right|left listName item"
}
}
}See also Stacks and queues, Implementing FIFO queues and Tcllib's stack and queue.
Flatten a list of any depth, i.e. remove all grouping:
Use [::struct::list flatten] in tcllib
::struct::list flatten ?-full? ?--? sequence
The subcommand takes a single sequence and returns a new sequence where one level of nesting was removed from the input sequence. In other words, the sublists in the input sequence are replaced by their elements.
The subcommand will remove any nesting it finds if the option -full is specified.
% ::struct::list flatten {1 2 3 {4 5} {6 7} {{8 9}} 10}
1 2 3 4 5 6 7 {8 9} 10
% ::struct::list flatten -full {1 2 3 {4 5} {6 7} {{8 9}} 10}
1 2 3 4 5 6 7 8 9 10But note that it may be inconsistent or otherwise counterintuitive:
% ::struct::list flatten -full {1 2 3 {4 5} {6 7} {{8 9}} 10}
1 2 3 4 5 6 7 8 9 10
% ::struct::list flatten -full {1 2 3{4 5} {6 7} {{8 9}} 10}
1 2 3\{4 5\} 6 7 8 9 10
% ::struct::list flatten -full {1 2 3 {4 5}{6 7} {{8 9}} 10}
list element in braces followed by "{6" instead of spaceIf 3\{4 5\} then why not \{4 5\}\{6 7\} or even 3 4 5 and 4 5 6 7?
Because 3{4 and 5} are syntactically valid, which {4 5}{6 isn't (the closing brace that closes the initial opening brace isn't the last character in the word). 3{4 and 5} can't be transformed into 3 4 5 since that would change the data content.
HaO 2014-09-16: One may use 'concat {*}' to flatten a matrix by one level:
% concat {*}{1 2 3 {4 5} {6 7} {{8 9}} 10}
1 2 3 4 5 6 7 {8 9} 10MAK: Perhaps belongs in Additional string functions, but:
Convert a list to a formatted text table
This function takes a list of lists representing cell information for a table (i.e., each element of the top-level list is a row of data, and each element of those are individual columns of data) and generates text output with all of the columns aligned with each other. By default a single space is output between the longest cell and the next one; extra spaces can be added through the optional padding argument.
proc listToTable { in {padding 0} } {
set result {}
array set lengths {}
# Determine the longest element in each column
foreach line $in {
set colnum 1
foreach column $line {
set length [string length $column]
if {[info exist lengths($colnum)]} {
if {$lengths($colnum) < $length} {
set lengths($colnum) $length
}
} else {
set lengths($colnum) $length
}
incr colnum
}
}
# Format the output
foreach line $in {
set colnum 1
set maxcol [llength $line]
foreach column $line {
if {$colnum < $maxcol} {
append result [
format %-*s [
expr {$lengths($colnum) + 1 + $padding}] $column]
} else {
append result $column
}
incr colnum
}
append result "\n"
}
return $result
}Example:
% listToTable {a {aaaa bb cccccc} {aaaaaa bbbbbbb cc ddddddd} {a b c d}}
a
aaaa bb cccccc
aaaaaa bbbbbbb cc ddddddd
a b c dAMG: interleave lets you combine parallel lists so you can pass them to [array set]. [listc] and [lcomp] provide list comprehensions.
Sarnold: A command for splitting one list into segments
Instead of doing:
set beginning [lrange $list 0 end-$size]
set end [lrange $list end-[expr {$size-1}] end]write more understandable things like:
foreach {beginning end} [lrange -split $list end-$size] {break}Of course, it may be implemented in pure tcl...
Ok, so I'd propose also my extensions.
Selects elements of a list on given positions and return them as a list.
%set a {one two three four five}
...
%lselect $a 0 3-4
one four fiveproc lselect {list args} {
set result {}
foreach i $args {
set range [split $i -]
if { [llength $range] == 2 } {
mset {from to} $range
for {set n $from} {$n <= $to} {incr n} {
lappend result [lindex $list $n]
}
continue
}
lappend result [lindex $list $i]
}
return $result
}Splitting list at index:
proc lsplit {ls index} {
return [
list [
lrange $ls 0 [expr {$index-1}]] [
lrange $ls $index end]]
}Functional extensions:
Filter each element through given command and return them as a list:
proc filter {list cmd} {
set result {}
foreach i $list {
lappend result [eval "$cmd {$i}"]
}
return $result
}%set a { { 1 } { 2 } { 3 } }
...
%filter $a "string trim"
1 2 3Return a list of elements that satisfy given predicate:
% set l {0 5 3 4 2}
0 5 3 4 2
% select $l {expr 2<}
5 3 4proc select {list pred} {
set result {}
foreach i $list {
if {[eval $pred [list $i]]} {lappend result $i}
}
return $result
}MG offers an alternative version, that uses uplevel to evaluate $pred in the caller's scope, and also uses string map to allow the value being checked to placed anywhere in it (as '##') - it's called inside expr. The only reason it uses ## as the placeholder for the value is because I couldn't think of a good, more Tcl'ish way to do it, and that's what's used in another language I use. If someone can think of a good way to do it that fits more with the Tcl way, please change it.
proc select2 {list pred} {
set result [list]
foreach i $list {
if {[uplevel 1 [list expr [string map [list ## $i] $pred]]]} {
lappend result $i
}
}
return $result;
}% set list1 {a b c d e}
a b c d e
% set list2 {c d e f g}
c d e f g
% select2 $list1 {[lsearch $list2 ##]>-1}
c d eLars H thinks the Tcl way to do it is to have a variable that contains list item to consider, thus:
proc select3 {var expr list} {
upvar 1 $var item
set res {}
foreach item $list {
if {[uplevel 1 [list ::expr $expr]]} then {
lappend res $item
}
}
return $res
}Example:
% select3 s {[string is integer $s]} {0 3 x 0x3 09 35 -7 0. 000 1e3}
0 3 0x3 35 -7 000
% select3 s {$s != 0} {0 3 x 0x3 09 35 -7 0. 000 1e3}
3 x 0x3 09 35 -7 1e3Having the list last makes it easy to define aliases:
% interp alias {} nonzero {} select3 s {$s!=0}
% nonzero {0 3 x 0x3 09 35 -7 0. 000 1e3}
3 x 0x3 09 35 -7 1e3NEM 2008-02-17: Would call the filter above map, and select would be filter. I agree with Lars H about taking the list argument last (the tcllib version don't do this, alas). As an example:
proc filter {p xs} {
set ys [list]
foreach x $xs {if {[uplevel #0 $p [list $x]]} {lappend ys $x}}
return $ys
}
# Usage:
set xs {0 3 x 0x3 09 35 -7 0. 000 1e3}
filter {string is integer} $xs
# Simple aliases:
proc let {name = args} {interp alias {} $name {} {*}$args}
let integers = filter {string is integer}
integers $xs ;# Same resultMore complex expressions can easily be handled by lambdas:
proc func {p b} {list ::apply [list $p [list expr $b]]}
filter [func x {$x != 0}] $xsFW: A more versatile key-value search
This function allows for searching an associative dict/array-style list, with the added feature that the length of each "row" can be anything (instead of just 2: key value) and you can pick which sub-index is used for the key and for the value to retrieve. The first argument is the list, the second is the key to search for. Optional args: the third (default 2) is the length of each row, the fourth (default 0) is the index within the row of the key, and the fifth (default 1) is the index within the row of the value to retrieve. This proc requires an lrepeat proc (as offered above; I've included one here for completeness).
proc lrepeat {val num} {
set res [list]
for {set i 0} {$i < $num} {incr i} {lappend res $val}
return $res
}
proc lassoc {list key {rowsize 2} {keyind 0} {valind 1}} {
foreach [lreplace [lreplace [lrepeat nullvar $rowsize] \
$keyind $keyind qkey] $valind $valind qval] $list {
if {[string equal $qkey $key]} {return $qval}
}
return -code error {No match found.}
}Example:
# English, Dutch, French
set phrases [list \
Hi Hallo Bonjour \
{I'll have the soup.} {Ik geef opdracht tot de soep.} \
{J'achèterai le potage} \
Bye {Tot ziens} {Au revoir}]
puts [lassoc $phrases Hi 3 0 2] ;# English to FrenchSarnold: I would like to filter elements when walking a list with foreach. Something like this:
foreach-filter x {$x > 0} $list {puts "$x is positive"}This improves over list comprehension for cases we do not want to walk the whole list. (foreach is lazy)
AK: I have no idea what you mean by 'foreach is lazy'. Can you elaborate ?
struct::list::::filterfor is very similar, modulo arrangement of the arguments, and not using a script body
Sarnold: I admit I abused the term 'lazy' but I meant that, in the following:
foreach x [filter $hugelist cmd] {
if {[somecmd $x]} break
}the hugelist has to be filtered completely before the foreach is invoked, because of Tcl's eager evaluation. And the huge list is transformed even if only one item is processed and the foreach loop is exited (via break). But the same treatment could be optimized with the proposed foreach-filter:
foreach-filter x cmd $hugelist {
if {[somecmd x]} break
}Compared with the first version, it does not have to process $hugelist totally, like Haskell's list filters. (And Haskell works with lazy evaluation) We could build a similar foreach-map command.
AK: Ok, now I understand. Both Tcl using 'strict' evaluation and the use case you are looking for. Another possibility, but way more complex for the internals would be the introduction of generators. Although, with Tcl 8.6's coroutines we have a way of doing that already. Have the filter be a coroutine which yields each element as requested. Still, foreach is not prepared to ask for elements one by one, it will always take the whole list. So even that is not yet a workable way of partial processing of a computed/infinite list.
LV: I am not certain, but would the foreach async discussion be a way of interacting with the computed infinite generated lists? If so, then is this perhaps something that could appear in tcllib's control module for use with Tcl 8.6?
MR: Wouldn't following suffice (unless Haskell-like / generators-like semantics are really required) ?
foreach x $lst {
if {![predicate $x]} continue
if {whatever} break
we_can_do_whatever_we_want_with $x now
}Naive implementation of foreach_filter would be:
proc foreach_filter {varName lst predicate cmd} {
uplevel 1 [list foreach $varName $lst [list if $predicate $cmd]]
}
which, for the following test script:
foreach_filter x {aa bb ab ac} {[string index $x 0] == {a}} {
puts $x
if {$x == {ab}} break
}yields following output:
aa ab
ie. bb is skipped by the filter and after encountering/printing ab break kicks in (hallelujah for Tcl metaprogramming !!! ;-))
Walking on paths (like MS-DOS paths, but each path should be list of dirs, not one string):
proc forpaths {boundVarNames paths body} {
# walk on paths, each is list of dirs. $body will execute on visit each dir,
# variables bound:
# $keyName - current path
# $levelName - current level (0...N)
# $leafName - is leaf or not (1, 0)
foreach {keyName levelName leafName} [lrange $boundVarNames 0 2] {}
set group [dict create]
foreach path $paths {
dict set group {*}$path @LEAF
}
proc _cmp {a b} {
if {[expr {$a > $b}]} {
return 1
} elseif {[expr {$a < $b}]} {
return -1
} else {return 0}
}
proc _trackpath {track level dir} {
if {$track eq {}} {set track [list @DUMMY]}
switch -- [_cmp [expr $level+1] [llength $track]] {
1 {lappend track $dir
0 {lset track end $dir}
-1 {set track [lreplace $track $level end $dir]}
}
return $track
}
set gtrack {}; # current path when visit each node
proc _walk {d keyName levelName leafName body {_deep 2}} {
# here $level is level in tree, not in stack
# $_deep is level in stack
upvar $_deep $keyName key $levelName level
upvar gtrack gtrack
if {$leafName ne {}} { upvar $_deep $leafName leaf }
dict for {k v} $d {
set level [expr {$_deep-2}]
set gtrack [_trackpath $gtrack $level $k]
set key $gtrack
if {$v eq @LEAF} {
set leaf 1
uplevel $_deep $body
} else {
# nested
set leaf 0
uplevel $_deep $body
_walk $v $keyName $levelName $leafName $body [expr {$_deep+1}]
}
}
}
_walk $group $keyName $levelName $leafName $body
}And usage something like this:
forpaths {key level leaf} $dirs {...}
# OR
forpaths {key level} $dirs {...}
# OR
forpaths key $dirs {...}Find the difference between two lists
proc ldiff {a b} {
lmap elem $a { expr {$elem in $b ? [continue] : $elem} }
}AMG: Sorting a list by element string length
lsort -command {apply {{a b} {expr {[string length $a] - [string length $b]}}}} $listdomino - 2018-05-25 16:30:34
(First time edit; forgive formatting and "where on the page" issues)
Re: LPREPEND, couldn't you just use this? All produce the properly-appended lists (obeying listed-ness):
--> "{10 11 12 13 14} 25 {100 101 102 103 104} {{10 11 12 13 14}} 0 1 2 3 4"Numbers given (in ms): ( 5 single iterations: quickest -> slowest) / ( time {code} 1000 iterations ) TCL8.6.7
proc lprependDKF { var_name args } {
# https://wiki.tcl-lang.org/43 ; # DKF
upvar 1 $var_name local
lappend local
set local [eval [list linsert $local 0] $args]
}
# 24 -> 143 / 7.931
proc lprependMe1 { 1 args } {
upvar 1 $1 var
if ![info exists var ] { lappend var }
set var [concat $args $var]
return $var
}
# 42 -> 182 / 11.465
proc lprependMe2 { 1 args } {
upvar 1 $1 var
if ![info exists var ] { set var "" }
set var [concat $args $var]
return $var
}
# 40 -> 117 / 11.668
proc lprependMe3 { 1 args } {
upvar 1 $1 var
lappend var
set var [concat $args $var]
}
# 17 -> 82 / 5.862 (at 1,000,000 iterations, this drops to: 5.540067 ms)Comparatively, isn't it faster to abuse CONCAT here than cause another substitution pass via EVAL? I know, internally, there's a list-vs-string issue. However, performance provides a list as a result. Now, if there were a proper "LCOMBINE" or the like in tcl 8.6.9 .... :)
DKF: It depends on what version of Tcl you're using. In 8.6 onwards, you should do this:
proc lprepend {varName args} {
upvar 1 $varName var
set local [list {*}$args {*}$var]
}A quick bit of testing indicates that it is approximately twice as fast as my version with linsert from waaaay back when (lprependDKF above) but I can't be sure of that as the performance test wasn't clean.
The reason this is so? list gets extra efficient handling of expansion in bytecode:
% tcl::unsupported::disassemble proc lprepend
ByteCode 0x0x7fc891820c10, refCt 1, epoch 17, interp 0x0x7fc89000de10 (epoch 17)
Source "\nupvar 1 $var_name var\nset local [list {*}$args {*}$v..."
Cmds 3, src 57, inst 30, litObjs 2, aux 0, stkDepth 2, code/src 0.00
Proc 0x0x7fc890851e90, refCt 1, args 2, compiled locals 4
slot 0, scalar, arg, "var_name"
slot 1, scalar, arg, "args"
slot 2, scalar, "var"
slot 3, scalar, "local"
Commands 3:
1: pc 0-12, src 1-21 2: pc 13-28, src 23-55
3: pc 22-26, src 34-54
Command 1: "upvar 1 $var_name var..."
(0) push1 0 # "1"
(2) loadScalar1 %v0 # var "var_name"
(4) upvar %v2 # var "var"
(9) pop
(10) nop
(11) nop
(12) nop
Command 2: "set local [list {*}$args {*}$var]..."
(13) startCommand +16 2 # next cmd at pc 29, 2 cmds start here
Command 3: "list {*}$args {*}$var..."
(22) loadScalar1 %v1 # var "args"
(24) loadScalar1 %v2 # var "var"
(26) listConcat
(27) storeScalar1 %v3 # var "local"
(29) done Note the listConcat operation.