The following competitive extensions contain more or less additional list functions:
The wiki also has a variety of pages discussing list operations
Note that versions of Tcl 8.4 from mid-November 2001 on contain enhanced list functionality ; see http://purl.org/tcl/tip/ number 22, 33, and 45 for the functionality that was added to lset and lindex.
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 ?
LV: I notice that Glenn Jackman has posted the article [L13 ], which is a proposal for a new Tcllib module called listutil [L14 ] that will contain several new list functions.
Note that tcllib now has struct::list with some list functions - would someone like to start submitting patches to tcllib to add to that functionality?
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 [L15 ] should be emailed.):
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 [L16 ] 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 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. Larry Virden: the following pages have recently appeared on the Wiki: 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.
Shuffle a list, Striding a list, Summing a list - Cartesian product of a list of lists Recursive list searching 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]} ....
proc lel {L element} {expr {[lsearch $L $element]>=0}}proc ladd {_L args} {
upvar $_L L
proc ladd {_L args} {
upvar $_L L
if {![info exists L]} {set L {}}
foreach i $args {if {![lel $L $i]} {lappend L $i}}
}
upvar 1 $_L L
set pos [expr {int(rand() * [llength $L])}]
set res [lindex $L $pos]
set res
proc lrandom L {lindex $L [expr {int(rand()*[llength $L])}]}'''Remove elements from a list''' by value:
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
}
'''[lreverse%|%Reverse] the order of a list''':
Since 8.5, `[lreverse]` is a [Tcl Commands%|%built-in] Tcl command.
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
}
}
set res
'''Reverse the order of a list''': proc lreverse L {
set ret {}
foreach i $l {
set ret [linsert $ret 0 $i]
}
return $ret
} ;# RS, tuned 10% faster by [rmax][RS]: Note however that the `[linsert]` requires copying the whole sublist N
proc lreverse2 l {
set ret ""
proc lreverse3 {l} {
set start -1 } #EAS
Note however that the linsert requires copying the whole sublist N times, while, the lappend copies each element exactly once. (RS)
while {[incr start] < [incr end -1]} {KPV Here are three more ways of reversing a list that utilize lset to swap pairs of elements in place:
lset l $end $tmp
proc lreverse3 {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 {
}
lset l $start [lindex $l $end]
lset l $end $tmpFor long lists you can squeeze out a bit more performance with the help of foreach: }
proc lreverse4 {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
}
}}
Here's a very simple version — faster than lreverse4 but alas not the fastest:
nice in cases where you want to process the list elements while reversing their
order.
proc lreverse5 {l} {proc lreverse6 {l} {
set stack {}
foreach item $l {set stack [list $stack $item]}
set res {}
}
foreach {stack item} $stack break
lappend res $itemLars 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} {
'''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\]"
}
}} ;# RS
{john smith 14} {abe zyx 25} {mary jones 32} {harold brown 99}
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}Permute a list: returns a list of the possible orderings of the input
set res $L
set pos 0Permute 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} {} ;# RS
''Find 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)}]
} ;# RS
if {abs($value-$i) < $minDist} {
set minDist [expr {abs($value-$i)}]
set minElement $i
}[F]or a given value, find one element from a given list with minimal absolute difference [...] } In borderline cases, it picks the first hit, though:
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}
2
foreach i [lappend list {}] {
lappend buf $iCompact 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):
set buf $i
proc rangify list {
set res {}
set buf {}
foreach i [lappend list ""] {
if {$buf=="" || $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-19
for {set i 1} {$i < [llength $list] - 1} {incr i} {
}
lappend res [lindex $list end]
regsub -all -- { - (- )*} $res -
proc compress list {
for {set i 1} {$i <[llength $list]-1} {incr i} { proc expand clist {
if {$it==[lindex $list [expr {$i-1}]]+1
&& $it==[lindex $list [expr {$i+1}]]-1} {
while {$from <= $to} {lappend res $from; incr from}
} else {lappend res $part}
}
set res };# RS
}
----
proc expand clist { List 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
while {$from<=$to} {lappend res $from; incr from} proc lrepeat {value number} {
};# RS
lappend res $value
}
set res
'''List 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} {
separately, just like lset or lindex:
proc lrepeat {value args} {
} ;# 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}
lappend buf $valueThe 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]}% lrepeat 0 {3 4} {0 0 0} {0 0 0} {0 0 0} {0 0 0} % lrepeat 0 {3 4 5}
for {set i 0} {$i<$number} {incr i} {
(1): See [Stress testing] for why this makes the code safer.
[DKF]: Tcl 8.5a0 has a variation on this which behaves like this:
}
% 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}}
}
return $result
} proc lrepeat {count value args} {proc lrepeat {count args} {
set result {}
set cmd [list eval [list lappend result]]
for {set i 0} {$i < $count} {incr i} {
lappend cmd $args
}
}}
proc lrepeat {count args} {
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} { FW: Here's a most minimalist way (and of course the less efficient).
proc lrepeat {count args} {string repeat "$args " $count}HaO 2014-09-16: aspect proposed on the chat:
[list {*}$l1] eq [list {*}$l2] proc lequal {a b} {Check if combination of list elements is valid against a list of lists,
JM 2004-01-04: this code relies on 'lequal'
} ;# RS
set thisCase list a c b
} 2004-Jan-4 JM (this code relies on 'lequal')
set thisCase [list a c b]
set lstValid [list \
{a b c}\
{a a c}\
{a b b}\
{a a a}\
]
foreach validCase $lstValid {
proc chkValidCombination {lstValid thisCase} {
set valid 0
foreach validCase $lstValid {
set equal [lequal $validCase $thisCase]
if {$equal} {set valid 1}
}puts chkValidCombination $lstValid $thisCase
return $valid }
puts [chkValidCombination $lstValid $thisCase]
} ;# RS
% keyget {fnm John lnm Brown phone (123)456-7890 email [email protected]} phone
(123)456-7890
[plist] is for lists what [parray] is for arrays.
----
'''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} {
proc linsertsorted {list newElement} {
} ;# 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]} fax
}} ;# RS -- testing:
a b c d e f
proc linsertsorted {list newElement} {
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
} ;# 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 eAF: here is my implementation of a BINARY insertion sort: DKF 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.
04oct04 jcw - 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!).
set hi [llength $list]
AF here is my implementation of a BINARY insertion sort:
} elseif {$res > 0} {
return [linsert $list $test $pattern]
proc BinaryInsert {list 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
}% lswap {a b c d e f g h} b a d c f e h g
----
'''List intersection:''' For a number of lists, return only those elements that
proc lswap list {
proc intersect args {
} ;# RS
% lswap {a b c d e f g h}
b a d c f e h g
foreach list [lrange $args 1 end] {
set found 0; breakList intersection: For a number of lists, return only those elements that are present in all lists:
set res
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
} ;# RS
List intersect3: Compares 2 lists and detects entries that only exist in list 1, only exist in list 2 or that exist in both lists
* list1 - The first input list
* list2 - The second input list
* inList1 - Name of the list in which to put list1 only elements
* inList2 - Name of the list in which to put list2 only elements
* inBoth - Name of the list in which to put elements in list1 & list2
upvar $inList2 in2
proc intersect3 {list1 list2 inList1 inList2 inBoth} {
upvar $inList1 in1
upvar $inList2 in2
upvar $inBoth inB
set i 0
set in1 [list]
set in2 [list]
set inB [list]
set list1 [lsort $list1]
set list2 [lsort $list2]
} else {
# 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 Easton
is -2 ... like so:set myList lreplace $myList -1 -2 5
proc lprepend {var args} {
} ;# DKF
[GPS] 2003: In the [Tcl Chatroom] I came up with this idea. You may find it
[TR] 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] Oct 14, 2003 - In the Tcl'ers Chat 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]}% set l [list a b c] a b c % remove.list.item l 1 a c % set l a c
% kvsearch {1 one 2 two 3 three} four ;# returns empty string/list Key-value list searching: Before dict arrives, we can 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
1
lappend res [list [lindex $set $ia] $b]
}
}
} ;# RS
{a b} {a c} {a d} {b c} {b d} {c d}
proc pairs set {
Simpler:
proc pairs set {
set res {}
foreach a [lrange $set 0 end-1] {
set set [lrange $set 1 end]
} ;# RS
% pairs {a b c d}
{a b} {a c} {a d} {b c} {b d} {c d}} ;# RS
proc pairs set {In-place queues using the K combinator
proc K {a b} {set a}
##
# Pop an item off a list, left or right
} ;# RS
proc lpop {how listName} {
upvar $listName list
switch -- $how {
right {
}
left {
K [lindex $list 0] [set list [lrange $list 1 end]]
proc K {a b} {set a}
##
# Pop an item off a list, left or right
#
proc lpop {how listName} {
}
##
"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"
}
set list [linsert [K $list [set list {}]] 0 $item]
}
##
# Pop an item onto a list, left or right
#
proc lpush {how listName item} {
} "right" {
lappend list $item
}
"left" {
set list [linsert [K $list [set list ""]] 0 $item]
}
default {
return -code error "lpush right|left listName item"
}
}::struct::list flatten ?-full? ?--? sequence
See also [Stacks and queues], [Implementing FIFO queues] and [Tcllib]'s [stack] and [queue]. The subcommand will remove any nesting it finds if the option -full is
proc flatten list {string map {\{ "" \} ""} $list} ;#RS
% flatten {a {b {c d {e f {g h}}}}}
a b c d e f g h1 2 3 4 5 6 7 {8 9} 10 An alternative way which handles embedded { in lists
proc flatten {list} {
while {1} {
set lt [join $list]
if {[llength $lt]==[llength $list]} {
return $list
} else {
set list $lt
}
}
}[LES]: No, it doesn't:
% ::struct::list flatten -full {1 2 3{4 5} {6 7} {{8 9}} 10}
$ set foo [list \{ \}]
$ flatten $foo
(empty string)
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.
$ set foo "\{ \}"
$ flatten $foo
(empty string)
[MAK]: Perhaps belongs in [Additional string functions], but:
I just spent 40 minutes looking for a solution here and in [list] and haven't found the perfect solution that will pass all my tests.
[MAK] Perhaps belongs in [Additional string functions], but: array set lengths {}
# Determine the longest element in each columnThis 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.
set lengths($colnum) $length
}
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
}AMG: interleave lets you combine parallel lists so you can pass them to [array set]. [listc] and [lcomp] provide list comprehensions.
% listToTable {a {aaaa bb cccccc} {aaaaaa bbbbbbb cc ddddddd} {a b c d}}
a
aaaa bb cccccc
aaaaaa bbbbbbb cc ddddddd
a b c dset beginning [lrange $list 0 end-$size]
[AMG] [interleave] lets you combine parallel lists so you can pass them to [[array set]]. [[listc]] and [[[lcomp]]] provide [list comprehension]s.
set end [lrange $list end-[expr {$size-1}] end]
[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]Ok, so I'd propose also my extensions.
Selects elements of a list on given positions and return them as a list.
foreach {beginning end} [lrange -split $list end-$size] {break}
...
%lselect $a 0 3-4
one four fiveproc lselect {list args} {
set result {}
foreach i $args {
}
%set a {one two three four five}
...
%lselect $a 0 3-4
one four five
continue
proc lselect {list args} {
set result {}
return $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]
list [
return $result
}
Functional extensions:
'''Filter each element through given command and return them as a list:'''
proc lsplit {ls index} {
return [list \
[lrange $ls 0 [expr $index-1]] \
[lrange $ls $index end] \
]
}
return $result
}%set a { { 1 } { 2 } { 3 } }
...
%set a { " 1 " " 2 " " 3 " }
...
%filter $a "string trim"
1 2 3
proc filter {list cmd} {
1 2 3
lappend result [eval "$cmd {$i}"]
}
foreach i $list {
% set l {0 5 3 4 2}
0 5 3 4 2
% select $l "expr 2<"
5 3 4
[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
proc select {list pred} {
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
if { [eval "$pred {$i}"] } { lappend result $i }
}
set result [list]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]
a b c d e
foreach i $list {
if { [uplevel 1 "expr {[string map "## $i" $pred]}"] } {lappend result $i}
}
return $result;
}
item to consider, thus:
% 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 e
}
[Lars 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} {
% select3 s {string is integer $s} {0 3 x 0x3 09 35 -7 0. 000 1e3}
if {[uplevel 1 [list ::expr $expr]]} then {
lappend res $item
}
}
% interp alias {} nonzero {} select3 s {$s!=0}
% 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 1e3 % interp alias {} nonzero {} select3 s {$s!=0}
% nonzero {0 3 x 0x3 09 35 -7 0. 000 1e3}
3 x 0x3 09 35 -7 1e3proc filter {p xs} { NEM (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: # Usage:
foreach x $xs { if {[uplevel #0 $p [list $x]]} { lappend ys $x } }
proc func {p b} {list ::apply list $p [list expr $b]} filter [func x {$x != 0} $xs
proc let {name = args} { interp alias {} $name {} {*}$args }
[FW]: '''A more versatile key-value search'''
list, with the added feature that the length of each "row" can be anything
the key and for the value to retrieve. The first argument is the list, the
proc func {p b} { list ::apply [list $p [list expr $b]] }
filter [func x { $x != 0 }] $xs
key, and the fifth (default 1) is the index within the row of the value to
one here for completeness).
[FW]: '''A more versatile key-value search''' This function allows for searching an associative [dict]- or [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).
return -code error {No match found.}
proc lrepeat {val num} {Example:
}
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}
{J'achèterai le potage} \
return -code error "No match found."
}Sarnold: I would like to filter elements when walking a list with foreach.
# English, Dutch, French set phrases [list \
{I'll have the soup.} {Ik geef opdracht tot de soep.} {J'achèterai le potage} \
puts [lassoc $phrases "Hi" 3 0 2] ;# English to French
whole list. (foreach is lazy)
[AK]: I have no idea what you mean by 'foreach is lazy'. Can you elaborate ?
[Sarnold] 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 ?
The [struct::list] package has a command very similar that, modulo arrangement of the arguments, and not using a script body ... This is
[http://docs.activestate.com/activetcl/8.5/tcllib/struct/struct_list.html#13%|%filterfor].
[Sarnold] I admit I abused the term 'lazy' but I meant that, in the following:
foreach-filter x cmd $hugelist {
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:
internals would be the introduction of generators. Although, with Tcl 8.6's
foreach-filter x cmd $hugelist {
if {[somecmd x]} break
}
not yet a workable way of partial processing of a computed/infinite list.
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.
Tcl 8.6?
[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?
if {whatever} break
[MR]: Wouldn't following suffice (unless Haskell-like / generators-like semantics are really required) ?
uplevel 1 [list foreach $varName $lst [list if $predicate $cmd]]
foreach x $lst {
if {![predicate $x]} {continue}
if {whatever} {break}
we_can_do_whatever_we_want_with $x now
}
foreach_filter x {aa bb ab ac} {string index $x 0 == {a}} {
if {$x == {ab}} break
proc foreach_filter {varName lst predicate cmd} {
uplevel 1 [list foreach $varName $lst [list if $predicate $cmd]]
}aa
foreach_filter x {aa bb ab ac} {[string index $x 0] == "a"} {
puts $x
if {$x == "ab"} {break}
}
[YOSIFOV]:
http://balkansoft.blogspot.ru/2012/10/traversing-over-paths.html%|%Original is
aa
ab
ie. bb is skipped by the filter and after encountering/printing ab the '''break''' kicks in (hallelujah for Tcl metaprogramming !!! ;-))
here%|%
[YOSIFOV] http://balkansoft.blogspot.ru/2012/10/traversing-over-paths.html%|%Original is here%|%Walking on paths (like MS-DOS paths, but each path should be list of dirs, not one string):
proc _cmp {a b} {
if {[expr {$a > $b}]} {
return 1
} elseif {[expr {$a < $b}]} {
return -1
} else {return 0}
}
proc _trackpath {track level dir} {
dict set group {*}$path "@LEAF"
switch -- [_cmp [expr $level+1] [llength $track]] {
0 {lset track end $dir}
if {[expr {$a > $b}]} { return 1 } \
elseif {[expr {$a < $b}]} { return -1 } \
else { return 0 }
# here $level is level in tree, not in stack
if {$track eq ""} { set track {"@DUMMY"} }
upvar $_deep $keyName key $levelName level
1 { lappend track $dir }
0 { lset track end $dir }
-1 { set track [lreplace $track $level end $dir] }
set level [expr {$_deep-2}]
set gtrack [_trackpath $gtrack $level $k]
set key $gtrack
if {$v eq @LEAF} {
uplevel $_deep $body
} else {
# nested
set leaf 0
uplevel $_deep $body
if {$leafName ne ""} { upvar $_deep $leafName leaf }
}
}
}
_walk $group $keyName $levelName $leafName $body
if {$v eq "@LEAF"} {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''
lmap elem $a { expr {$elem in $b ? [continue] : $elem} }}
---- [AMG]: '''Sorting a list by element string length'''