Using a list, is it possible to find the first value within a list ? (without using the obvious foreach item> $list loop)
eg I have a list {23dsf} { } {2a} {255} {gsd3fs} {fg'dslk23} {...}
I was looking at lsearch -integer, but that requires identifying what the number is :(
I need to simply identify the first numeric value, ie 255 (lindex 3)
Using lsearch -regexp as pointed out in comments.
given the list:
set lst {{23dsf} { } {2a} {255} {gsd3fs} {fg'dslk23} {...}}
lsearch -regexp $lst {^\d+$}
or its equivalent
lsearch -regexp $lst {^[[:digit:]]+$}
Return the index (3) of the first numeric value in the list.
I'd just use a foreach loop, but if you really don't want to, well, recursion is just looping in a different dress:
#!/usr/bin/env tclsh
package require Tcl 8.6
proc firstint {lst} {
if {[llength $lst]} {
set first [lindex $lst 0]
if {[string is integer -strict $first]} {
return $first
} else {
tailcall firstint [lrange $lst 1 end]
}
}
}
set lst [list {23dsf} { } {2a} {255} {gsd3fs} {fg'dslk23} {...}]
puts [firstint $lst]
Here's a one-liner, using lmap to filter out non-integers and then just taking the first element of what's left:
(bin) 9 % set lst [list {23dsf} { } {2a} {255} {gsd3fs} {fg'dslk23} {...} 42]
23dsf { } 2a 255 gsd3fs fg'dslk23 ... 42
(bin) 10 % lindex [lmap i $lst {expr {[string is integer -strict $i] ? $i : [continue]}}] 0
255
Related
I have following code to print string which appears more than once in the list
set a [list str1/str2 str3/str4 str3/str4 str5/str6]
foreach x $a {
set search_return [lsearch -all $a $x]
if {[llength $search_return] > 1} {
puts "search_return : $search_return"
}
}
I need to print str3/str4 which appears more than once in the list
The canonical methods of doing this are with arrays or dictionaries, both of which are associative maps. Here's a version with a single loop over the data using a dictionary (it doesn't know the total number of times an item appears when it prints, but sometimes just knowing you've got a multiple is enough).
set a [list str1/str2 str3/str4 str3/str4 str5/str6]
# Make sure that the dictionary doesn't exist ahead of time!
unset -nocomplain counters
foreach item $a {
if {[dict incr counters $item] == 2} {
puts "$item appears several times"
}
}
I guess you could use an array to do something like that, since arrays have unique keys:
set a [list str1/str2 str3/str4 str3/str4 str5/str6]
foreach x $a {
incr arr($x) ;# basically counting each occurrence
}
foreach {key val} [array get arr] {
if {$val > 1} {puts "$key appears $val times"}
}
Looking for a way to lsort a list of strings by the n last characters.
Desired outcome:
lsort -lastchars 3 {123xyz 456uvw 789abc}
789abc 456uvw 123xyz
My fall back position would be to use -command option and write my proc discarding all but the last 3 characters.
Thanks,
Gert
A fast way to do this is to compute a collation key and to sort on that. A collation key is just a string that sorts in the order that you want; you package them up with the real values to sort and sort together.
set yourList {123xyz 456uvw 789abc}
set withCKs {}
foreach value $yourList {
lappend withCKs [list $value [string range $value end-2 end]]
}
set sorted {}
foreach pair [lsort -index 1 $withCKs] {
lappend sorted [lindex $pair 0]
}
This can be made more elegant in Tcl 8.6:
set sorted [lmap pair [lsort -index 1 [lmap val $yourList {list $val [string range $val end-2 end]}]] {lindex $pair 0}]
Splitting up the one-liner for clarity:
# Add in the collation keys
set withCKs [lmap val $yourList {list $val [string range $val end-2 end]}]
# Sort by the collation keys and then strip them from the result list
set sorted [lmap pair [lsort -index 1 $withCKs] {lindex $pair 0}]
A different approach is to produce the collation keys in a separate list and then to get lsort to spit out the indices it produces when sorting.
set CKs [lmap val $yourList {string range $val end-2 end}]
set sorted [lmap idx [lsort -indices $CKs] {lindex $yourList $idx}]
As a one-liner:
set sorted [lmap idx [lsort -indices [lmap val $yourList {string range $val end-2 end}]] {lindex $yourList $idx}]
For Tcl 8.5 (there's no -indices option in 8.4 or before):
set CKs [set sorted {}]
foreach val $yourList {
lappend CKs [string range $val end-2 end]
}
foreach idx [lsort -indices $CKs] {
lappend sorted [lindex $yourList $idx]
}
(The foreach/lappend pattern is precisely what lmap improves on in 8.6.)
Your fallback idea is the way to achieve this.
proc f {lhs rhs} {
return [string compare [string range $lhs end-2 end] \
[string range $rhs end-2 end]]
}
lsort -command f {123xyz 456uvw 789abc}
returns
789abc 456uvw 123xyz
How to remove duplicate element from Tcl list say:
list is like [this,that,when,what,when,how]
I have Googled and have found lsort unique but same is not working for me. I want to remove when from list.
The following works for me
set myList [list this that when what when how]
lsort -unique $myList
this returns
how that this what when
which you could store in a new list
set uniqueList [lsort -unique $myList]
You could also use an dictionary, where the keys must be unique:
set l {this that when what when how}
foreach element $l {dict set tmp $element 1}
set unique [dict keys $tmp]
puts $unique
this that when what how
That will preserve the order of the elements.
glenn jackman's answer work perfectly on Tcl 8.6 and above.
For Tcl 8.4 and below (No dict command). You can use:
proc list_unique {list} {
array set included_arr [list]
set unique_list [list]
foreach item $list {
if { ![info exists included_arr($item)] } {
set included_arr($item) ""
lappend unique_list $item
}
}
unset included_arr
return $unique_list
}
set list [list this that when what when how]
set unique [list_unique $list]
This will also preserve the order of the elements
and this is the result:
this that when what how
Another way, if do not wanna use native lsort function.This is what the interviewer asks :)
`set a "this that when what when how"
for {set i 0} {$i < [llength $a]} {incr i} {
set indices [lsearch -all $a [lindex $a $i]]
foreach index $indices {
if {$index != $i} {
set a [lreplace $a $index $index]
}
}
}
`
I am doing :
glob -nocomplain *
as a result I get 4 files:
a b c d
how can I remove from list b?
I am using this func:
proc lremove {args} {
if {[llength $args] < 2} {
puts stderr {Wrong # args: should be "lremove ?-all? list pattern"}
}
set list [lindex $args end-1]
set elements [lindex $args end]
if [string match -all [lindex $args 0]] {
foreach element $elements {
set list [lsearch -all -inline -not -exact $list $element]
}
} else {
# Using lreplace to truncate the list saves having to calculate
# ranges or offsets from the indexed element. The trimming is
# necessary in cases where the first or last element is the
# indexed element.
foreach element $elements {
set idx [lsearch $list $element]
set list [string trim \
"[lreplace $list $idx end] [lreplace $list 0 $idx]"]
}
}
return $list
}
however it does not working with glob results, but only with strings. please help.
That lreplace procedure is rather dodgy, really, what with swapping the order around, ghetto concatenation and string trim to try to clean up the mess. Yuck. Here's a simpler version (without support for -all, which you don't need for processing the output of glob as that's normally a list of unique elements anyway):
proc lremove {list args} {
foreach toRemove $args {
set index [lsearch -exact $list $toRemove]
set list [lreplace $list $index $index]
}
return $list
}
Let's test it!
% lremove {a b c d e} b d f
a c e
Theoretically it could be made more efficient, but it would take a lot of work and be a PITA to debug. This version is way easier to write and is obviously correct. It should also be substantially faster than what you were working with, as it sticks to purely list operations.
The results from glob shouldn't be particularly special that any unusual effort be required to work with them, but there were some really nasty historic bugs that made that not always true. The latest versions of 8.4 and 8.5 (i.e., 8.4.20 and 8.5.15) don't have the bugs. Nor does any release version of 8.6 (8.6.0 or 8.6.1). If stuff is behaving mysteriously, we'll get into asking about versions and telling you to not be quite so behind the times…
I found a wiki page about how to calculate the depth of a list:
http://wiki.tcl.tk/11602
How can I rewrite the above code as a single proc using tcl 8.6 features lmap and apply? Perhaps "apply" is not really needed.
proc max list {
set res [lindex $list 0]
foreach e [lrange $list 1 end] {if {$e>$res} {set res $e}}
set res
}
# llmap perhaps can be replaced with lmap from Tcl 8.6
proc llmap {func list} {
set res {}
foreach e $list {lappend res [$func $e]}
set res
}
proc ldepth list {
expr {
[llength $list] == 0? 1:
[expr {[lindex $list 0] eq $list}]? 0:
1+[max [llmap ldepth $list]]
}
}
The first level of adaptation already gets us close to where you want to go, sufficiently so that this is what I'd consider as a production solution:
proc ldepth {list} {
expr {
[llength $list] == 0 ? 1 :
[lindex $list 0] eq $list ? 0 :
1 + [tcl::mathfunc::max {*}[lmap e $list {
ldepth $e
}]]
}
}
This uses the standard lmap and tcl::mathfunc::max (which is the implementation of the max() function). Note that expansion and tcl::mathfunc::max are features of Tcl 8.5, but they're very useful here.
Eliminating expansion
Let's see if we can get rid of that call to tcl::mathfunc::max with the expansion.
proc ldepth {list} {
set m -inf
expr {
[llength $list] == 0 ? 1 :
[lindex $list 0] eq $list ? 0 :
1 + [lindex [lmap e $list {
set m [expr { max($m, [ldepth $e]) }]
}] end]
}
}
Hmm, that's just a touch ugly. We might as well do this:
proc ldepth {list} {
set m -inf
expr {
[llength $list] == 0 ? 1 :
[lindex $list 0] eq $list ? 0 :
[foreach e $list {
set m [expr { max($m,[ldepth $e]) }]
}
expr {$m + 1}]
}
}
This definitely isn't getting better, except in that it doesn't keep so much state around (just a running maximum, not a list of depths). Let's go back to the version with lmap!
(What is really needed for true beauty is lfold, but that didn't get done on the grounds that sometimes you've just got to stop adding features and call a release.)
“Eliminating” recursion
The other way we can go is to see about removing the outer recursion. We can't completely eliminate the recursion altogether — we're dealing with a recursive operation over a recursive structure — but we don't need to put it in the outer level where a rename ldepth fred will cause problems. We do this by using apply to create an internal procedure-like thing, and since we're doing recursive calls, we pass the lambda term into itself. (There are tricks you can do to get that value without explicitly passing it in, but they're ugly and we might as well be honest here.)
proc ldepth {list} {
set ldepth {{ldepth list} {expr {
[llength $list] == 0 ? 1 :
[lindex $list 0] eq $list ? 0 :
1 + [tcl::mathfunc::max {*}[lmap e $list {
apply $ldepth $ldepth $e
}]]
}}
apply $ldepth $ldepth $list
}
Full-bytecode version
Subject to still doing a recursive call.
proc ldepth {list} {
expr {
[llength $list] == 0 ? [return 1] :
[lindex $list 0] eq $list ? [return 0] :
[set m -inf
foreach e $list {
set m [expr {[set d [ldepth $e]]+1>$m ? $d+1 : $m}]
}
return $m]
}
}
Fully recursion-free by using a work queue instead. This is 8.5 code — no 8.6 features required — and you could write this to be 8.4-suitable by replacing the lassigns:
proc ldepth {list} {
set work [list $list 0]
set maxdepth 0
while {[llength $work]} {
### 8.4 version
# foreach {list depth} $work break
# set work [lrange $work 2 end]
set work [lassign $work[unset -nocomplain work] list depth]
if {[llength $list] == 0} {
incr depth
} elseif {[lindex $list 0] ne $list} {
incr depth
foreach e $list {
lappend work $e $depth
}
continue
}
set maxdepth [expr {$maxdepth<$depth ? $depth : $maxdepth}]
}
return $maxdepth
}
The moral of the story? The 8.6 features don't make sense for everything.
Here's a simple one that works.
It just flattens the list until it can't be flattened any further. The number of attempts is the depth. No recursion needed.
proc ldepth {lst} {
set depth 1
set fatter $lst
set flatter [join $fatter]
while {$flatter ne $fatter} {
set fatter $flatter
set flatter [join $fatter]
incr depth
}
return depth
}
Hope this helps!